source: /cluster/svnroot/bccd-ng/branches/sam-test_fw/trees/usr/local/lib/site_perl/5.10.0/Bccd.pm @ 3071

Last change on this file since 3071 was 3071, checked in by leemasa, 10 years ago

Put together more sophisticated system for getting boot flags from NIC (#534)

File size: 70.1 KB
Line 
1package Bccd;
2
3use strict;
4use warnings;
5use File::Path;
6use File::Temp;
7use File::Copy;
8use WWW::Mechanize;
9use Term::ReadKey;
10use POSIX;
11use Carp;
12use Readonly;
13use UI::Dialog;
14use Data::Dumper;
15use NetAddr::IP;
16use IO::Socket::INET;
17use Net::DHCP::Packet;
18use Net::DHCP::Constants;
19use Net::CIDR ':all';
20use Errno qw(:POSIX);
21use Fcntl ':mode';
22use YAML qw/LoadFile/;
23
24my $passed = 0;
25my $total = 0;
26Readonly my $KERNREV => '2.6.31.12-aufs';
27Readonly my $DHCFILE => '/etc/dhcp3/dhclient.conf';
28Readonly my $ALLOUTFILE    => "allout";
29Readonly my $LVMROOT       => "/sbin/";
30Readonly my $PROJECT       => "bccd";
31Readonly my $IFCONFIG      => "/sbin/ifconfig -a";
32Readonly my $INTFILE       => "/etc/network/interfaces";
33Readonly my $NATSH         => "/etc/network/if-up.d/nat";
34Readonly my $IPTABLES_UP   => '/etc/iptables.up.rules';
35Readonly my $START_PKBFILE => "/etc/network/if-up.d/start-pkbcast";
36Readonly my $CMDLINE_FILE => "/proc/cmdline";
37Readonly my $BCCD_NET  => { 'ipaddr'  => '192.168.3.1',
38                            'mask' => '255.255.255.0',
39                            'bcast'   => '192.168.3.255',
40                            'dhcp'    => 0,
41                            'bccdnet' => 1,
42};
43Readonly my $DHCP_RANGES => { 'res'  => 10,
44                              'dhcp' => 100,
45                              'pxe'  => 100
46};
47Readonly my $DHCP_CONF => '/etc/dhcp3/bccd_net.conf';
48Readonly my $TEMPLATE_DHCP_CONF => $DHCP_CONF."_template";
49Readonly my $PXELINUX => "/var/lib/tftpboot/pxelinux.cfg/default";
50Readonly my $TEMPLATE_PXELINUX => $PXELINUX."_template";
51Readonly my $DISKLESS_FSTAB => "/diskless/bccd/etc/fstab";
52Readonly my $TEMPLATE_DISKLESS_FSTAB => $DISKLESS_FSTAB."_template";
53my $hostname = `/bin/hostname`;
54chomp($hostname);
55Readonly my $HOSTNAME => $hostname;
56$hostname = `/bin/hostname -s`;
57chomp($hostname);
58Readonly my $SHORT_HOSTNAME => $hostname;
59
60#Boot Flag Indices
61Readonly my $CUSTOM_NIC => "02";
62Readonly my $IS_BCCD_NETWORK_NIC => 0;
63
64undef($hostname);
65
66my $debug = 0;
67my $INFO = 0b1;
68my $DEBUG = 0b10;
69my $LOG = 0;
70
71sub new {
72    my $class = shift;
73    my $self = {};
74    bless($self,$class);
75    return $self;
76}
77
78sub log_and_cont( $$$$ ) {
79    my($self,$code,$func,$msg) = @_;
80
81    carp "$0: $code: $func: $msg\n";
82
83}
84
85sub log_and_die( $$$$ ) {
86    my($self,$code,$func,$msg) = @_;
87
88    croak "$0: $code: $func: $msg\n";
89}
90
91sub enter_sub( $$ ) {
92    my($self,$sub) = @_;
93
94    if($self->is_log($DEBUG)) {
95        $self->log_and_cont("DEBUG",$sub,"Entering $sub");
96    }
97}
98
99sub leave_sub( $$ ) {
100    my($self,$sub) = @_;
101   
102    if($self->is_log($DEBUG)) {
103        $self->log_and_cont("DEBUG",$sub,"Leaving $sub") ;
104    }
105}
106
107sub cmd_num_die( $@ ) {
108    my($self,@cmds) = @_;
109    my $sub = "cmd_num_due";
110    $self->enter_sub($sub);
111   
112    $self->log_and_die("ERROR",$sub,"Incorrect number of command line arguments: $#cmds; @cmds");
113    $self->leave_sub($sub);
114}
115
116sub print_array ( $@ ) {
117    my($self,@array) = @_;
118    my $sub = "print_array";
119    $self->enter_sub($sub);
120    my $i;
121   
122    $i = 0;
123    foreach my $row ( @array ) {
124        print "$i: $row\n";
125        $i++;
126    }
127    $self->leave_sub($sub);
128}
129
130sub get_lvminfo( $$ ) {
131    my($self,$layer) = @_;
132    my($sub,$cmd,$rc,$out);
133    my(@info,@splitinfo);
134    $sub = "get_lvminfo";
135    $self->enter_sub($sub);
136   
137    if($layer !~ m/(?:pv|vg|lv)/) {
138        $self->log_and_die("ERROR",$sub,"Layer must be one of pv, vg, or lv.");
139    }
140   
141    $cmd = "$LVMROOT/".$layer."display -c";
142    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
143        $self->log_and_cont("INFO",$sub,"Executing $cmd");
144    }
145    ($rc,$out) = $self->exec_system($cmd);
146    if($rc == 5) {
147        if($self->is_log($INFO) || $self->is_log($DEBUG)) {
148            $self->log_and_cont("INFO",$sub,"Nothing to display for $cmd.");
149        }
150        return undef;
151    }
152    elsif($rc) {
153        if($rc) {
154            $self->log_and_cont("NOTICE", $sub,"$cmd failed with output $out and rc $rc: $!");
155        }
156        return undef;
157    }
158   
159    foreach my $line ( split('\n',$out) ) {
160        $line =~ s/^\s+//g;
161        if($line =~ m/is a new physical volume/) { # pvdisplay reports this when the PV has no VG
162            next;
163        }
164        if($self->is_log($INFO) || $self->is_log($DEBUG)) {
165            $self->log_and_cont("INFO",$sub,"Pushing line $line.");
166        }
167        push(@splitinfo,[ split(':',$line) ]);
168    }
169   
170    return @splitinfo;
171}
172
173
174sub rm_all_lv( $ ) {
175    my($self) = @_;
176    my($sub,$cmdrc,$rc,$out);
177    my @info;
178    my %lvs;
179    $sub = 'rm_all_lv';
180    $self->enter_sub($sub);
181
182    $rc = 0;
183    @info = $self->get_lvminfo('lv');
184    if(@info) {   
185        for(my $i=0;$i<=$#info;$i++) {
186            if($self->is_log($INFO) || $self->is_log($DEBUG)) {
187                $self->log_and_cont("INFO",$sub,"Found volume group for logical volumes: $info[$i][1].");
188            }
189            $lvs{$info[$i][1]} = 1;
190        }
191       
192        foreach my $key ( keys %lvs ) {
193            my $cmd = "/sbin/lvremove -f $key";
194            if($self->is_log($INFO) || $self->is_log($DEBUG)) {
195                $self->log_and_cont("INFO",$sub,"Running cmd $cmd.");
196            }
197            ($cmdrc,$out) = $self->exec_system("$cmd");
198            if($self->is_log($INFO) || $self->is_log($DEBUG)) {
199                $self->log_and_cont("INFO",$sub,"$cmd returned $cmdrc with output $out");
200            }
201            if($rc) {
202                $self->log_and_cont("ERROR", $sub,"$cmd failed with output $out and rc $rc: $!");
203            }
204            $rc += $cmdrc;
205        }
206    }
207   
208    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
209        $self->log_and_cont("INFO",$sub,"Returning with rc $rc.");
210    }
211    $self->leave_sub($sub);
212    return $rc;
213}
214
215sub rm_all_vg( $ ) {
216    my($self) = @_;
217    my($sub,$rc,$cmdrc,$out);
218    my @info;
219    my %vgs;
220    $sub = 'rm_all_vg';
221    $self->enter_sub($sub);
222   
223    $rc = 0;
224    @info = $self->get_lvminfo('vg');
225    if(@info) {
226        for(my $i=0;$i<=$#info;$i++) {
227            if($self->is_log($INFO) || $self->is_log($DEBUG)) {
228                $self->log_and_cont("INFO",$sub,"Found volume group: $info[$i][0].");
229            }
230            $vgs{$info[$i][0]} = 1;
231        }
232       
233        foreach my $key ( keys %vgs ) {
234            my $cmd = "/sbin/vgremove -f $key";
235            if($self->is_log($INFO) || $self->is_log($DEBUG)) {
236                $self->log_and_cont("INFO",$sub,"Running cmd $cmd.");
237            }
238            ($cmdrc,$out) = $self->exec_system("$cmd");
239            if($self->is_log($INFO) || $self->is_log($DEBUG)) {
240                $self->log_and_cont("INFO",$sub,"$cmd returned $cmdrc with output $out");
241            }
242            if($rc) {
243                $self->log_and_cont("ERROR", $sub,"$cmd failed with output $out and rc $rc: $!");
244            }
245            $rc += $cmdrc;
246        }
247    }
248    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
249        $self->log_and_cont("INFO",$sub,"Returning with rc $rc.");
250    }
251   
252    $self->leave_sub($sub);
253    return $rc;
254}
255
256sub rm_all_pv( $ ) {
257    my($self) = @_;
258    my($sub,$cmdrc,$rc,$out);
259    my @info;
260    my %pvs;
261    $sub = 'rm_all_pv';
262    $self->enter_sub($sub);
263   
264    $rc = 0;
265    @info = $self->get_lvminfo('pv');
266    if(@info) {
267        for(my $i=0;$i<=$#info;$i++) {
268            if($self->is_log($INFO) || $self->is_log($DEBUG)) {
269                $self->log_and_cont("INFO",$sub,"Found physical volume: $info[$i][0].");
270            }
271            $pvs{$info[$i][0]} = 1;
272        }
273       
274        foreach my $key ( keys %pvs ) {
275            my $cmd = "/sbin/pvremove -f $key";
276            if($self->is_log($INFO) || $self->is_log($DEBUG)) {
277                $self->log_and_cont("INFO",$sub,"Running cmd $cmd.");
278            }
279               
280            ($cmdrc,$out) = $self->exec_system("$cmd");
281            if($self->is_log($INFO) || $self->is_log($DEBUG)) {
282                $self->log_and_cont("INFO",$sub,"$cmd returned $cmdrc with output $out");
283            }
284             
285            if($rc) { 
286                $self->log_and_die("ERROR", $sub,"$cmd failed with output $out and rc $rc: $!");
287            }
288            $rc += $cmdrc;
289        }
290    }
291
292    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
293        $self->log_and_cont("INFO",$sub,"Returning with rc $rc.");
294    }
295       
296    $self->leave_sub($sub);
297    return $rc;
298}
299
300sub get_lvinfo( $ ) {
301    my($self) = @_;
302    my $sub = "get_lvinfo";
303    $self->enter_sub($sub);
304    my($lvinfo,$cmd);
305
306    $cmd = "$LVMROOT/lvdisplay -c";
307    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
308        $self->log_and_cont("INFO",$sub,"Executing $cmd");
309    }
310    $lvinfo = `$cmd`;
311    if(WEXITSTATUS($?)) {
312        $self->log_and_die("ERROR", $sub,"$cmd with output $lvinfo: $!");
313    }
314    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
315        $self->log_and_cont("INFO",$sub,"Ran $cmd and got output $lvinfo");
316    }
317
318    $self->leave_sub($sub);
319    return split(':', $lvinfo);
320}
321
322sub get_vginfo( $ ) {
323    my($self) = @_;
324    my $sub = "get_vginfo";
325    $self->enter_sub($sub);
326    my($vginfo,$cmd);
327
328    $cmd = "$LVMROOT/vgdisplay -c";
329    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
330        $self->log_and_cont("INFO",$sub,"Executing $cmd");
331    }
332    $vginfo = `$cmd`;
333    if(WEXITSTATUS($?)) {
334        $self->log_and_die("ERROR", $sub,"$cmd with output $vginfo: $!");
335    }
336    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
337        $self->log_and_cont("INFO",$sub,"Ran $cmd and got output $vginfo");
338    }
339
340    $self->leave_sub($sub);
341    return split(':', $vginfo);
342}
343
344sub get_pvinfo( $ ) {
345    my($self) = @_;
346    my $sub = "get_pvinfo";
347    $self->enter_sub($sub);
348    my($pvinfo,$cmd);
349
350    $cmd = "$LVMROOT/pvdisplay -c";
351    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
352        $self->log_and_cont("INFO",$sub,"Executing $cmd");
353    }
354    $pvinfo = `$cmd`;
355    if(WEXITSTATUS($?)) {
356        $self->log_and_die("ERROR",$sub,"$cmd failed: $!");
357    }
358   
359    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
360        $self->log_and_cont("INFO",$sub,"Ran $cmd and got output $pvinfo");
361    }
362    $self->leave_sub($sub);
363    return split(':', $pvinfo);
364}
365
366sub get_pe_size( $ ) {
367    my($self) = @_;
368    my $sub = "get_pe_size";
369    $self->enter_sub($sub);
370    my @vginfo = $self->get_vginfo();
371    if($self->is_log($DEBUG)) {
372        $self->log_and_cont("DEBUG",$sub,"Retrieved @vginfo from get_vginfo.");
373    }
374
375    $self->leave_sub($sub);
376    return $vginfo[12];
377}
378
379sub get_free_pe_count( $ ) {
380    my($self) = @_;
381    my $sub = "get_free_pe_count";
382    $self->enter_sub($sub);
383
384    my @vginfo = $self->get_vginfo();
385    if($self->is_log($DEBUG)) {
386        $self->log_and_cont("DEBUG",$sub,"Retrieved @vginfo from get_vginfo.");
387    }
388
389    $self->leave_sub($sub);
390    return $vginfo[15];
391}
392
393sub snarf_file( $$ ) {
394    my($self,$file) = @_;
395    my($sub,$FILE);
396    $sub = "snarf_file";
397    $self->enter_sub($sub);
398    my $input;
399    {
400        local $/;
401        open($FILE, "< $file") or $self->log_and_die("ERROR",$sub,"Could not open file $file for reading: $!");
402        if($self->is_log($INFO) || $self->is_log($DEBUG)) {
403            $self->log_and_cont("INFO",$sub,"Opened $file for reading.");
404        }
405       
406        $input = <$FILE>;
407    }
408    close($FILE);
409   
410    chomp $input;
411
412    $self->leave_sub($sub);
413    return $input;
414}
415
416sub test_regexsub_file( $$$$$$$ ) {
417    my($self,$type,$okrc,$msg,$file,$regex1,$regex2) = @_;
418    my($sub,$text,$rc);
419    $sub = 'test_regexsub_file';
420
421    if($okrc eq '') {
422        $okrc = 1;
423    }
424   
425    if( ! -f $file ) {
426        $self->fail_msg("$msg: $file not found for regex sub.");
427        return 0;
428    }
429   
430    $text = $self->snarf_file($file);
431   
432    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
433        $self->log_and_cont("INFO",$sub,"Regex1: $regex1; Regex2: $regex2; Pretext: $text");
434    }
435     
436    $text =~ s/$regex1/$regex2/g;
437    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
438        $self->log_and_cont("INFO",$sub,"Posttext: $text");
439    }
440
441    $rc = $self->test_fwrite($type,$okrc,"Writing $file after $regex1 -> $regex2."
442                             ,'w',$file,$text);
443
444    if($rc == $okrc) {
445        $self->ok_msg($msg);
446        $rc = 1;
447    }
448    else {
449        $self->fail_msg($msg);
450        $rc = 0;
451    }
452
453    return $rc;
454}
455
456sub test_read_yaml{
457        my($self,$type,$okrc,$msg,$file) = @_;
458        my $sub = 'test_read_yaml';
459
460        $self->enter_sub($sub);
461
462        if(! -f $file) {
463                $self->log_and_die("ERROR",$sub,"Cannot read in $file");
464        }
465
466        if($self->is_log($INFO) || $self->is_log($DEBUG)) {
467                $self->log_and_cont("INFO",$sub,"Reading in: $file");
468        }
469        my $y = LoadFile($file);
470        if($self->is_log($INFO) || $self->is_log($DEBUG)) {
471                $self->log_and_cont("INFO",$sub,"Read in:".Dumper($y));
472        }
473
474        $self->leave_sub($sub);
475        return $y;
476}
477
478sub test_mknods{
479        my($self,$type,$okrc,$msg,$file,$base) = @_;
480        my($rc,$temprc,$out);
481        my $sub = 'test_mknods';
482
483        $self->enter_sub($sub);
484
485        if($okrc eq '') {
486        $okrc = 0;
487    }
488
489        my $y = $self->test_read_yaml($type,$okrc,"Reading mknod configuration from $file.",$file);
490        if(!defined($y)) {
491                $self->log_and_die("ERROR",$sub,"Can't proceeded with invalid configuration.");
492        }
493
494        $rc = 0;
495        foreach my $d (keys(%{$y})) {
496                my $cmd = "/bin/mknod $base/$d $y->{$d}->{type} $y->{$d}->{major} $y->{$d}->{minor}";
497        if($self->is_log($INFO) || $self->is_log($DEBUG)) {
498            $self->log_and_cont("INFO",$sub,"Running $cmd");
499        }
500
501                ($temprc,$out) = $self->exec_system($cmd);
502                if($rc) {
503                        $self->log_and_cont("$cmd failed with $temprc, out $out");
504                }
505                if($temprc > $rc) {
506                        $rc = $temprc;
507                }
508        }
509
510    if($rc == $okrc) {
511        $self->ok_msg($msg);
512        $rc = 1;
513    }
514    else {
515        $self->fail_msg($msg);
516        $rc = 0;
517    }
518
519        $self->leave_sub($sub);
520        return $rc;
521}
522
523sub test_rm_lvm( $$$$ ) {
524    my($self,$type,$okrc,$msg) = @_;
525    my($sub,$rc,$cmdrc);
526    $sub = 'test_rm_lvm';
527    $self->enter_sub($sub);
528
529    if($okrc eq '') {
530        $okrc = 0;
531    }
532
533    $rc = 0;
534    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
535        $self->log_and_cont("INFO",$sub,"Removing logical volumes.");
536    }
537    $cmdrc = $self->rm_all_lv();
538    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
539        $self->log_and_cont("INFO",$sub,"Logical volume remove exited with rc $cmdrc.");
540    }
541    $rc += $cmdrc;
542    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
543        $self->log_and_cont("INFO",$sub,"Removing volume groups.");
544    }
545    $cmdrc = $self->rm_all_vg();
546    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
547        $self->log_and_cont("INFO",$sub,"Volume group remove exited with rc $cmdrc.");
548    }
549    $rc += $cmdrc;
550    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
551        $self->log_and_cont("INFO",$sub,"Removing physical volumes.");
552    }
553    $cmdrc = $self->rm_all_pv();
554    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
555        $self->log_and_cont("INFO",$sub,"Physical volume remove exited with rc $cmdrc.");
556    }
557    $rc += $cmdrc;
558
559    if($rc == $okrc) {
560        $self->ok_msg($msg);
561        $rc = 1;
562    }
563    else {
564        $self->fail_msg($msg);
565        $rc = 0;
566    }
567
568    $self->leave_sub($sub);
569    return $rc;
570}
571
572sub test_system( $$$$$ ) {
573    my($self,$type,$okrc,$msg,$cmd) = @_;
574    my $sub = "test_system";
575    $self->enter_sub($sub);
576    my $rc = 0;
577    my $out;
578
579    if( $okrc eq "" ) {
580        $okrc = 0;
581    }
582    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
583        $self->log_and_cont("INFO",$sub,"Passing $cmd to exec_system");
584    }
585    ($rc,$out) = $self->exec_system($cmd);
586    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
587        $self->log_and_cont("INFO",$sub,"$cmd came back with rc $rc, out $out");
588    }
589
590    if($rc == $okrc) {
591        $self->ok_msg($msg);
592        $rc = 1;
593    }
594    else {
595        $self->fail_msg("$msg,$out");
596        $rc = 0;
597    }
598
599    $self->leave_sub($sub);
600    return ($out,$rc);
601}
602
603sub test_chdir( $$$$$ ) {
604    my($self,$type,$okrc,$msg,$dir) = @_;
605    my $sub = "test_chdir";
606    $self->enter_sub($sub);
607    my $rc = 0;
608
609    if( $okrc eq "" ) {
610        $okrc = 1;
611    }
612    $rc = chdir($dir);
613    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
614        $self->log_and_cont("INFO",$sub,"chdir'd to $dir with rc $rc");
615    }
616
617    if($rc == $okrc) {
618        $self->ok_msg($msg);
619        $rc = 1;
620    }
621    else {
622        $self->fail_msg($msg);
623        $rc = 0;
624    }
625
626    $self->leave_sub($sub);
627    return $rc;
628}
629
630sub test_mkpath( $$$$$ ) {
631    my($self,$type,$okrc,$msg,$dir) = @_;
632    my $sub = "test_mkpath";
633    $self->enter_sub($sub);
634    my $rc = 0;
635
636    if( $okrc eq "" ) {
637        $okrc = 1;
638    }
639    eval { mkpath($dir) };
640    if($@) {
641        $rc = 0;
642    }
643    else {
644        $rc = $okrc;
645    }
646    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
647        $self->log_and_cont("INFO",$sub,"mkpath'd $dir with rc $rc");
648    }
649
650    if($rc == $okrc) {
651        $self->ok_msg($msg);
652        $rc = 1;
653    }
654    else {
655        $self->fail_msg($msg);
656        $rc = 0;
657    }
658
659    $self->leave_sub($sub);
660    return $rc;
661}
662
663sub test_wwwmech( $$$$$$ ) {
664    my($self,$type,$okrc,$msg,$srcurl,$destfile) = @_;
665    my $sub = "test_wwwmech";
666    $self->enter_sub($sub);
667    my $rc = 0;
668    my $out;
669
670    if( $okrc eq "" ) {
671        $okrc = 1;
672    }
673    my $mech = WWW::Mechanize->new();
674    $mech->get("$srcurl", ':content_file' => "$destfile");
675    $rc = $mech->success();
676    $out = $mech->status();
677
678    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
679        $self->log_and_cont("INFO",$sub,"Fetched $srcurl to $destfile with rc $rc and output $out");
680    }
681
682    if($rc == $okrc) {
683        $self->ok_msg($msg);
684        $rc = 1;
685    }
686    else {
687        $self->fail_msg($msg);
688        $rc = 0;
689    }
690
691    $self->leave_sub($sub);
692    return $rc;
693}
694
695sub test_chmod( $$$$$$ ) {
696    my($self,$type,$okrc,$msg,$mode,$file) = @_;
697    my $sub = "test_chmod";
698    $self->enter_sub($sub);
699    my $rc = 0;
700
701    if( $okrc eq "" ) {
702        $okrc = 1;
703    }
704    $rc = chmod($mode,"$file");
705
706    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
707        $self->log_and_cont("INFO",$sub,"chmod'd $file to $mode");
708    }
709
710    if($rc == $okrc) {
711        $self->ok_msg($msg);
712        $rc = 1;
713    }
714    else {
715        $self->fail_msg($msg);
716        $rc = 0;
717    }
718
719    $self->leave_sub($sub);
720    return $rc;
721}
722
723sub test_unlink( $$$$$ ) {
724    my($self,$type,$okrc,$msg,$file) = @_;
725    my $sub = "test_unlink";
726    $self->enter_sub($sub);
727    my $rc = 0;
728
729    if( $okrc eq "" ) {
730        $okrc = 1;
731    }
732    $rc = unlink($file);
733    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
734        $self->log_and_cont("INFO",$sub,"unlink'd $file with rc $rc");
735    }
736
737    if($rc >= $okrc) {
738        $self->ok_msg($msg);
739        $rc = 1;
740    }
741    else {
742        $self->fail_msg($msg);
743        $rc = 0;
744    }
745
746    $self->leave_sub($sub);
747    return $rc;
748}
749
750# Do we even want this function? Goes against one-test-per-action philosophy
751sub test_unlinkall( $$$$$ ) {
752    my($self,$type,$okrc,$msg,$dir) = @_;
753    my $sub = "test_unlinkall";
754    $self->enter_sub($sub);
755    my $rc = 0;
756
757    if( $okrc eq "" ) {
758        $okrc = 1;
759    }
760    my @files = <$dir/*>;
761    $rc = unlink(@files);
762    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
763        $self->log_and_cont("INFO",$sub,"Unlink'd files in $dir with rc $rc");
764    }
765
766    $msg .= " Deleted $rc files out of $#files total files.";
767
768    if($rc >= $okrc && $rc == $#files) {
769        $self->ok_msg($msg);
770        $rc = 1;
771    }
772    else {
773        $self->fail_msg($msg);
774        $rc = 0;
775    }
776
777    $self->leave_sub($sub);
778    return $rc;
779}
780
781sub test_symlink( $$$$$$ ) {
782    my($self,$type,$okrc,$msg,$srcfile,$destfile) = @_;
783    my $sub = "test_symlink";
784    $self->enter_sub($sub);
785    my $rc = 0;
786
787    if( $okrc eq "" ) {
788        $okrc = 1;
789    }
790    $rc = symlink($srcfile,$destfile);
791    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
792        $self->log_and_cont("INFO",$sub,"Symlink'd $srcfile to $destfile with rc $rc");
793    }
794
795    if($rc == $okrc) {
796        $self->ok_msg($msg);
797        $rc = 1;
798    }
799    else {
800        $self->fail_msg($msg);
801        $rc = 0;
802    }
803
804    $self->leave_sub($sub);
805    return $rc;
806}
807
808sub test_fcopy( $$$$$$ ) {
809    my($self,$type,$okrc,$msg,$srcfile,$destfile) = @_;
810    my $sub = "test_fcopy";
811    $self->enter_sub($sub);
812    my $rc = 0;
813
814    if( $okrc eq "" ) {
815        $okrc = 1;
816    }
817    $rc = copy($srcfile,$destfile);
818    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
819        $self->log_and_cont("INFO",$sub,"Copied $srcfile to $destfile with rc $rc");
820    }
821
822    if($rc == $okrc) {
823        $self->ok_msg($msg);
824        $rc = 1;
825    }
826    else {
827        $self->fail_msg($msg);
828        $rc = 0;
829    }
830
831    $self->leave_sub($sub);
832    return $rc;
833}
834
835sub test_fmove( $$$$$$ ) {
836    my($self,$type,$okrc,$msg,$srcfile,$destfile) = @_;
837    my $sub = "test_fmove";
838    $self->enter_sub($sub);
839    my $rc = 0;
840
841    if( $okrc eq "" ) {
842        $okrc = 1;
843    }
844    $rc = move($srcfile,$destfile);
845    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
846        $self->log_and_cont("INFO",$sub,"Moved $srcfile to $destfile with rc $rc");
847    }
848
849    if($rc == $okrc) {
850        $self->ok_msg($msg);
851        $rc = 1;
852    }
853    else {
854        $self->fail_msg("$msg: $!");
855        $rc = 0;
856    }
857
858    $self->leave_sub($sub);
859    return $rc;
860}
861
862sub test_getsvnrev( $$$$$ ) {
863    my($self,$type,$okrc,$msg,$websvn) = @_;
864    my $sub = "test_getsvnrev";
865    $self->enter_sub($sub);
866    my $rc = 0;
867
868    if( $okrc eq "" ) {
869        $okrc = 1;
870    }
871    $rc = $self->get_svn_rev($websvn);
872    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
873        $self->log_and_cont("INFO",$sub,"Got rev $rc from $websvn");
874    }
875
876    if($rc >= $okrc) {
877        $self->ok_msg($msg);
878    }
879    else {
880        $self->fail_msg($msg);
881        $rc = 0;
882    }
883
884    $self->leave_sub($sub);
885    return $rc;
886}
887
888sub test_fwrite( $$$$$$$ ) {
889    my($self,$type,$okrc,$msg,$mode,$file,$text) = @_;
890    my($sub,$FILE);
891    $sub = "test_fwrite";
892    $self->enter_sub($sub);
893    my $rc = 0;
894        my $temprc;
895
896    if( $okrc eq "" ) {
897        $okrc = 2;
898    }
899
900    if( "$mode" =~ /^w$/ ) {
901        $rc += open($FILE, '>', $file) or $self->log_and_die("ERROR", $sub, "Opening file $file for replace&write failed with return $?: $!");
902        if($self->is_log($INFO) || $self->is_log($DEBUG)) {
903            $self->log_and_cont("INFO",$sub,"Opened file $file for replace&write.");
904        }
905    }
906    elsif( "$mode" =~ m/^a$/ ) {
907        $rc += open($FILE, '>>', $file) or $self->log_and_die("ERROR",$sub, "Opening file $file for appending failed with return $?, rc $rc: $!");
908        if($self->is_log($INFO) || $self->is_log($DEBUG)) {
909            $self->log_and_cont("INFO",$sub,"Opened file $file for appending.");
910        }
911    }
912    else {
913        $self->log_and_die("ERROR",$sub,"Unknown write option: $mode!");
914    }
915   
916    $temprc = print $FILE "$text\n";
917    $self->log_and_cont("WARN", $sub, "Writing to filehandle FILE (file $file) failed with return $?, rc $rc, errno $!.") if(!$temprc);
918        $rc += $temprc;
919    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
920        $self->log_and_cont("INFO",$sub,"Wrote text to filehandle FILE.");
921    }
922   
923    $rc += close($FILE) or $self->log_and_die("ERROR", $sub,"Can't close file handle FILE (file $file): $!");
924    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
925        $self->log_and_cont("INFO",$sub,"Closed filehandle FILE (file $file).");
926    }
927   
928    if($rc >= $okrc) {
929        $self->ok_msg($msg);
930        $rc = 1;
931    }
932    else {
933        $self->fail_msg($msg);
934        $rc = 0;
935    }
936
937    $self->leave_sub($sub);
938    return $rc;
939}
940
941sub test_revfetch( $$$$$$$ ) {
942    my($self,$type,$okrc,$msg,$svnrev,$url,$destfile) = @_;
943    my $sub = "test_revfetch";
944    $self->enter_sub($sub);
945    my $rc = 0;
946    my($out,$cmd);
947
948    if( $okrc eq "" ) {
949        $okrc = 0;
950    }
951
952    $cmd = "svn cat -r $svnrev $url > $destfile";
953    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
954        $self->log_and_cont("INFO",$sub,"Executing $cmd");
955    }
956    ($rc,$out) = $self->exec_system("$cmd");
957    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
958        $self->log_and_cont("INFO",$sub,"$cmd returned rc $rc with output $out");
959    }
960
961    if($rc == $okrc) {
962        $self->ok_msg($msg);
963        $rc = 1;
964    }
965    else {
966        $self->fail_msg("$msg: $out,$rc");
967        $self->test_unlink($type,"","Unlinking $destfile from url $url at rev $svnrev due to failure.",$destfile);
968        $rc = 0;
969    }
970
971    $self->leave_sub($sub);
972    return $rc;
973}
974
975sub test_rename( $$$$$$ ) {
976    my($self,$type,$okrc,$msg,$srcfile,$destfile) = @_;
977    my $sub = "test_rename";
978    $self->enter_sub($sub);
979    my $rc;
980
981    if( $okrc eq "" ) {
982        $okrc = 1;
983    }
984    $rc = rename("$srcfile","$destfile");
985    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
986        $self->log_and_cont("INFO",$sub,"Renamed $srcfile to $destfile with rc $rc");
987    }
988
989    if($rc == $okrc) {
990        $self->ok_msg($msg);
991        $rc = 1;
992    }
993    else {
994        $self->fail_msg($msg);
995        $rc = 0;
996    }
997
998    $self->leave_sub($sub);
999    return $rc;
1000}
1001
1002sub test_recrevfetch( $$$$$$ ) {
1003    my($self,$type,$okrc,$msg,$svnrev,$svndir) = @_;
1004    my $sub = "test_recrevfetch";
1005    $self->enter_sub($sub);
1006    my($rc,$out,$cmd);
1007
1008    if( $okrc eq "" ) {
1009        $okrc = 0;
1010    }
1011
1012    $cmd = "svn --force export -r $svnrev $svndir";
1013    ($rc,$out) = $self->exec_system("$cmd");
1014    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
1015        $self->log_and_cont("DEBUG",$sub,"Fetched from SVN with command $cmd and rc $rc");
1016    }
1017
1018    if($rc == $okrc) {
1019        $self->ok_msg($msg);
1020        $rc = 1;
1021    }
1022    else {
1023        $self->fail_msg($msg);
1024        $rc = 0;
1025    }
1026
1027    $self->leave_sub($sub);
1028    return $rc;
1029}
1030
1031sub test_rmtree( $$$$$ ) {
1032    my($self,$type,$okrc,$msg,$dir) = @_;
1033    my $sub = "test_rmtree";
1034    $self->enter_sub($sub);
1035    my $rc;
1036
1037    if( $okrc eq "" ) {
1038        $okrc = 1;
1039    }
1040    $rc = rmtree("$dir",0,0);
1041    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
1042        $self->log_and_cont("INFO",$sub,"Removed $dir tree with rc $rc");
1043    }
1044
1045    if($rc >= $okrc) {
1046        $self->ok_msg($msg);
1047        $rc = 1;
1048    }
1049    else {
1050        $self->fail_msg($msg);
1051        $rc = -1;
1052    }
1053
1054    $self->leave_sub($sub);
1055    return $rc;
1056}
1057
1058sub test_getuseruid( $$$$$ ) {
1059    my($self,$type,$okrc,$msg,$user) = @_;
1060    my $sub = "test_getuseruid";
1061    $self->enter_sub($sub);
1062    my $rc;
1063
1064    if( $okrc eq "" ) {
1065        $okrc = 1;
1066    }
1067
1068    (undef,undef,$rc,undef) = getpwnam("$user") or $self->log_and_die("ERROR",$sub,"Can't find $user in user database for user lookup: $!");
1069    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
1070        $self->log_and_cont("INFO",$sub,"getpwnam $user returned with rc $rc");
1071    }
1072
1073    if($rc >= $okrc) {
1074        $self->ok_msg($msg);
1075    }
1076    else {
1077        $self->fail_msg($msg);
1078        $rc = -1;
1079    }
1080
1081    $self->leave_sub($sub);
1082    return $rc;
1083}
1084
1085sub test_getusergid( $$$$$ ) {
1086    my($self,$type,$okrc,$msg,$user) = @_;
1087    my $sub = "test_getusergid";
1088    $self->enter_sub($sub);
1089    my $rc;
1090
1091    if( $okrc eq "" ) {
1092        $okrc = 1;
1093    }
1094
1095    (undef,undef,undef,$rc) = getpwnam("$user") or $self->log_and_die("ERROR",$sub,"Can't find $user in user database for group lookup: $!");
1096    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
1097        $self->log_and_cont("INFO",$sub,"getpwnam $user returned with rc $rc");
1098    }
1099
1100    if($rc >= $okrc) {
1101        $self->ok_msg($msg);
1102    }
1103    else {
1104        $self->fail_msg($msg);
1105        $rc = 0;
1106    }
1107
1108    $self->leave_sub($sub);
1109    return $rc;
1110}
1111
1112sub test_lsofkill( $$$$$ ) {
1113    my($self,$type,$okrc,$msg,$dirname) = @_;
1114    my $sub = "test_lsofkill";
1115    $self->enter_sub($sub);
1116    my(@pids,@pnames,@lsof);
1117    my($ppid,$rc,$i);
1118    if( $okrc eq "" ) {
1119        $okrc = 2;
1120    }
1121   
1122    $rc = 0;
1123    open(my $LSOF, "lsof|") or $self->log_and_die("ERROR",$sub,"Opening lsof for piping failed with return $?, rc $rc: $!");
1124    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
1125        $self->log_and_cont("INFO",$sub,"Running lsof|");
1126    }
1127    $rc += $?;
1128    while( @lsof = split('\s+', <$LSOF> ) ) {
1129        if($self->is_log($DEBUG)) {
1130            $self->log_and_cont("DEBUG",$sub,"Got @lsof from lsof");
1131        }
1132        if( $lsof[8] && $lsof[8] =~ m/$dirname/ && !($lsof[1] =~ m/(?:$$|getppid())/) && !($lsof[0] =~ m/lsof/) && !$self->in_list(\@pids,$lsof[1])  ) {
1133            $rc += kill(15,$lsof[1]);
1134            if($self->is_log($INFO) || $self->is_log($DEBUG)) {
1135                $self->log_and_cont("INFO",$sub,"Killed $lsof[1]");
1136            }
1137            push(@pnames,$lsof[0]);
1138            push(@pids,$lsof[1]);
1139        }
1140    }
1141    $rc += close($LSOF);
1142    for($i=0;$i<$#pnames;$i++) {
1143        $msg .= " $pnames[$i]:$pids[$i]";
1144    }
1145    $msg .= "\n";
1146   
1147    if($rc >= $okrc) {
1148        $self->ok_msg($msg);
1149        $rc = 1;
1150    }
1151    else {
1152        $self->fail_msg($msg);
1153        $rc = 0;
1154    }
1155
1156    $self->leave_sub($sub);
1157    return $rc;
1158}
1159
1160sub test_chown( $$$$$$$ ) {
1161    my($self,$type,$okrc,$msg,$user,$group,$path) = @_;
1162    my $sub = "test_chown";
1163    $self->enter_sub($sub);
1164    my $rc;
1165
1166    if( $okrc eq "" ) {
1167        $okrc = 0;
1168    }
1169
1170    $rc = chown($user,$group,$path);
1171    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
1172        $self->log_and_cont("INFO",$sub,"chown'd $path to $user:$group");
1173    }
1174
1175    if($rc > $okrc) {
1176        $self->ok_msg($msg);
1177    }
1178    else {
1179        $self->fail_msg($msg);
1180        $rc = -1;
1181    }
1182
1183    if($self->is_log($DEBUG)) {
1184        $self->log_and_cont("DEBUG",$sub,"Leaving test_chown");
1185    }
1186    return $rc;
1187}
1188
1189sub test_rsync( $$$$$$ ) {
1190    my($self,$type,$okrc,$msg,$src,$dst) = @_;
1191    my $sub = "test_rsync";
1192    $self->enter_sub($sub);
1193    my($rc,$out,$cmd);
1194
1195    if( $okrc eq "" ) {
1196        $okrc = 0;
1197    }
1198
1199    $cmd = "rsync -av $src $dst";
1200    ($rc,$out) = $self->exec_system("$cmd");
1201    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
1202        $self->log_and_cont("INFO",$sub,"Ran $cmd with rc $rc and output $out");
1203    }
1204
1205    if($rc == $okrc) {
1206        $self->ok_msg($msg);
1207        $rc = 1;
1208    }
1209    else {
1210        $self->fail_msg("$msg,$out");
1211        $rc = 0;
1212    }
1213
1214    $self->leave_sub($sub);
1215    return $rc;
1216}
1217
1218# Type will define what function is run
1219# This function should be moved into Dc.pm once all tests are entered
1220sub run_test {
1221    my $self = shift;
1222    my @args = @_;
1223    my $sub = "run_test";
1224    $self->enter_sub($sub);
1225    my $metatests = 3;
1226    my($rc,$out,$type,$okrc,$msg,$i);
1227    my @cmds;
1228
1229    if($#args < $metatests ) { # there must be at least one command
1230        $self->log_and_die("ERROR",$sub,"Not enough arguments to run_test! Minimum of $metatests.");
1231    }
1232
1233    $type = $args[0];
1234    $okrc = $args[1];
1235    $msg = $args[2];
1236
1237    @cmds = splice(@args,$metatests);
1238
1239    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
1240        $self->log_and_cont("INFO",$sub,"Running test $type");
1241    }
1242    if( $type =~ m/^system$/ ) {
1243        if( $#cmds != 0 ) {
1244            $self->cmd_num_die(@cmds);
1245        }
1246        ($out,$rc) = $self->test_system($type,$okrc,$msg,$cmds[0]);
1247    }
1248    elsif( $type =~ m/^chdir$/ ) {
1249        if( $#cmds != 0 ) {
1250            $self->cmd_num_die(@cmds);
1251        }
1252        $rc = $self->test_chdir($type,$okrc,$msg,$cmds[0]);
1253    }
1254    elsif( $type =~ m/^mkpath$/ ) {
1255        if( $#cmds != 0 ) {
1256            $self->cmd_num_die(@cmds);
1257        }
1258        $rc = $self->test_mkpath($type,$okrc,$msg,$cmds[0]);
1259    }
1260    elsif( $type =~ m/^wwwmech$/ ) {
1261        if( $#cmds != 1 ) {
1262            $self->cmd_num_die(@cmds);
1263        }
1264        $rc = $self->test_wwwmech($type,$okrc,$msg,$cmds[0],$cmds[1]);
1265    }
1266    elsif( $type =~ m/^chmod$/ ) {
1267        if( $#cmds != 1 ) {
1268            $self->cmd_num_die(@cmds);
1269        }
1270        $rc = $self->test_chmod($type,$okrc,$msg,$cmds[0],$cmds[1]);
1271    }
1272    elsif( $type =~ m/^unlink$/ ) {
1273        if( $#cmds != 0 ) {
1274            $self->cmd_num_die(@cmds);
1275        }
1276        $rc = $self->test_unlink($type,$okrc,$msg,$cmds[0]);
1277    }
1278    elsif( $type =~ m/^unlinkall$/ ) {
1279        if( $#cmds != 0 ) {
1280                $self->cmd_num_die(@cmds);
1281        }
1282        $rc = $self->test_unlinkall($type,$okrc,$msg,$cmds[0]);
1283    }
1284    elsif( $type =~ m/^symlink$/ ) {
1285        if( $#cmds != 1 ) {
1286            $self->cmd_num_die(@cmds);
1287        }
1288        $rc = $self->test_symlink($type,$okrc,$msg,$cmds[0],$cmds[1]);
1289    }
1290    elsif ( $type =~ m/^fcopy$/ ) {
1291        if( $#cmds != 1 ) {
1292            $self->cmd_num_die(@cmds);
1293        }
1294        $rc = $self->test_fcopy($type,$okrc,$msg,$cmds[0],$cmds[1]);
1295    }
1296    elsif( $type =~ m/^getsvnrev$/ ) {
1297        if( $#cmds != 0 ) {
1298            $self->cmd_num_die(@cmds);
1299        }
1300        $rc = $self->test_getsvnrev($type,$okrc,$msg,$cmds[0]);
1301    }
1302    elsif( $type =~ m/^fwrite$/ ) {
1303        if( $#cmds != 2 ) {
1304            $self->cmd_num_die(@cmds);
1305        }
1306        $rc = $self->test_fwrite($type,$okrc,$msg,$cmds[0],$cmds[1],$cmds[2]);
1307    }
1308    elsif( $type =~ m/^revfetch$/ ) {
1309        if( $#cmds != 2 ) {
1310            $self->cmd_num_die(@cmds);
1311        }
1312        $rc = $self->test_revfetch($type,$okrc,$msg,$cmds[0],$cmds[1],$cmds[2]);
1313    }
1314    elsif( $type =~ m/^recrevfetch$/ ) {
1315        if( $#cmds != 1 ) {
1316            $self->cmd_num_die(@cmds);
1317        }
1318        $rc = $self->test_recrevfetch($type,$okrc,$msg,$cmds[0],$cmds[1]);
1319    }
1320    elsif( $type =~ m/^rename$/ ) {
1321        if( $#cmds != 1 ) {
1322            $self->cmd_num_die(@cmds);
1323        }
1324        $rc = $self->test_rename($type,$okrc,$msg,$cmds[0],$cmds[1]);
1325    }
1326    elsif( $type =~ m/^rmtree$/ ) {
1327        if($#cmds != 0) {
1328            $self->cmd_num_die(@cmds);
1329        }
1330        $rc = $self->test_rmtree($type,$okrc,$msg,$cmds[0]);
1331    }
1332    elsif( $type =~ m/^lsofkill$/ ) {
1333        if( $#cmds != 0 ) {
1334            $self->cmd_num_die(@cmds);
1335        }
1336        $rc = $self->test_lsofkill($type,$okrc,$msg,$cmds[0]);
1337    }
1338    elsif( $type =~ m/^getuseruid$/ ) {
1339        if( $#cmds != 0 ) {
1340            $self->cmd_num_die(@cmds);
1341        }
1342        $rc = $self->test_getuseruid($type,$okrc,$msg,$cmds[0]);
1343    }
1344    elsif( $type =~ m/getusergid$/ ) {
1345        if( $#cmds != 0 ) {
1346            $self->cmd_num_die(@cmds);
1347        }
1348        $rc = $self->test_getusergid($type,$okrc,$msg,$cmds[0]);
1349    }
1350    elsif( $type =~ m/^chown$/ ) {
1351        if( $#cmds != 2 ) {
1352            $self->cmd_num_die(@cmds);
1353        }
1354        $rc = $self->test_chown($type,$okrc,$msg,$cmds[0],$cmds[1],$cmds[2]);
1355    }
1356    elsif( $type =~ m/^fmove$/ ) {
1357        if( $#cmds != 1 ) {
1358            $self->cmd_num_die(@cmds);
1359        }
1360        $rc = $self->test_fmove($type,$okrc,$msg,$cmds[0],$cmds[1]);
1361    }
1362    elsif( $type =~ m/^rsync$/ ) {
1363        if( $#cmds != 1 ) {
1364            $self->cmd_num_die(@cmds);
1365        }
1366        $rc = $self->test_rsync($type,$okrc,$msg,$cmds[0],$cmds[1]);
1367    }
1368    elsif($type =~ m/^rm_lvm$/ ) {
1369        $rc = $self->test_rm_lvm($type,$okrc,$msg);
1370    }
1371    elsif($type =~ m/^regexsub_file$/) {
1372        if( $#cmds != 2 ) {
1373            $self->cmd_num_die(@cmds);
1374        }
1375        $rc = $self->test_regexsub_file($type,$okrc,$msg,$cmds[0],$cmds[1],$cmds[2]);
1376    }
1377        elsif($type =~ m/^read_yaml$/) {
1378                if( $#cmds != 0 ) {
1379                        $self->cmd_num_die(@cmds);
1380                }
1381                $rc = $self->test_read_yaml($type,$okrc,$msg,$cmds[0]);
1382        }
1383        elsif($type =~ m/^mknods$/) {
1384                if( $#cmds != 1 ) {
1385                        $self->cmd_num_die(@cmds);
1386                }
1387                $rc = $self->test_mknods($type,$okrc,$msg,$cmds[0],$cmds[1]);
1388        }
1389    else {
1390        $self->log_and_die("ERROR",$sub,"This is an undefined test: $type!");
1391    }
1392
1393    incr_total($self);
1394    if($rc) {
1395        incr_passed($self);
1396    }
1397
1398    $self->leave_sub($sub);   
1399    if(defined($out)) {
1400        return($out,$rc);
1401    } else {
1402        return $rc;
1403    }
1404}
1405
1406sub exec_system( $$ ) {
1407    my($self,$cmd) = @_;
1408    my $sub = "exec_system";
1409    $self->enter_sub($sub);
1410    my($out,$rc);
1411
1412    $out = `$cmd 2>&1`;
1413    $rc = WEXITSTATUS($?);
1414
1415    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
1416        $self->log_and_cont("INFO",$sub,"Ran $cmd with rc $rc and output $out");
1417    }
1418
1419    $self->leave_sub($sub);
1420    return ($rc,$out);
1421}
1422
1423sub print_hash ( $% ) {
1424    my($self,%h) = @_;
1425    my $sub = "print_hash";
1426    $self->enter_sub($sub);
1427   
1428    foreach my $k (sort keys %h) {
1429        print "$k => $h{$k}\n";
1430    }
1431    $self->leave_sub($sub);
1432}
1433
1434sub mech_error( $$ ) {
1435    my($self,$mech) = @_;
1436    my $sub = "mech_error";
1437    $self->enter_sub($sub);
1438    $self->leave_sub($sub);
1439    return "HTTP status: ".$mech->status."\n";
1440}
1441
1442sub in_list( $$$ ) {
1443    my($self,$list_ref,$s) = @_;
1444    my $sub = "in_list";
1445    $self->enter_sub($sub);
1446    my @list = @{$list_ref};
1447
1448    if( $#list > 0 ) {
1449        foreach my $x ( @list ) {
1450            if( "$x" eq "$s" ) {
1451                $self->leave_sub($sub);
1452                return 1;
1453            }
1454        }
1455        $self->leave_sub($sub);
1456        return 0;
1457    }
1458    else {
1459        $self->leave_sub($sub);
1460        return 0;
1461    }
1462}
1463
1464sub get_stage( $ ) {
1465    my($self) = @_;
1466    my $sub = "get_state";
1467    $self->enter_sub($sub);
1468    if( !(-f "/etc/$PROJECT-stage") ) {
1469        $self->leave_sub($sub);
1470        return "BUILD"; # Should only true for build system
1471    }
1472
1473    $self->leave_sub($sub);
1474    return $self->snarf_file("/etc/$PROJECT-stage");
1475}
1476
1477sub get_svn_rev( $$ ) {
1478    my($self,$svnurl) = @_;
1479    my $sub = "get_svn_rev";
1480    $self->enter_sub($sub);
1481    my $mech = WWW::Mechanize->new();
1482   
1483    $mech->get($svnurl);
1484    if( !$mech->success() ) {
1485        $self->log_and_die("ERROR","get_svn_rev","Could not fetch $svnurl: $mech->status()!");
1486    }
1487
1488    $self->leave_sub($sub);
1489    if( ($mech->content( format => 'text' )) =~ m/^svn\s-\sRevision\s+(\d+):/ ) {
1490        return $1;
1491    }
1492
1493    return 0;
1494}
1495
1496sub get_rev( $ ) {
1497    my($self) = @_;
1498    my $sub = "get_rev";
1499    $self->enter_sub($sub);
1500
1501    if( !(-f "/etc/$PROJECT-revision") ) {
1502        $self->leave_sub($sub);
1503        return 0; # Invalid for build system
1504    }
1505
1506    $self->leave_sub($sub);
1507    return $self->snarf_file("/etc/$PROJECT-revision");
1508}
1509
1510sub get_project( $ ) {
1511    my($self) = @_;
1512    my $sub = 'get_project';
1513    $self->enter_sub($sub);
1514
1515    $self->leave_sub($sub);
1516    return $PROJECT;
1517}
1518
1519sub get_passed( $ ) {
1520    my $self = shift;
1521    my $sub = "get_passed";
1522    $self->enter_sub($sub);
1523    $self->leave_sub($sub);
1524    return $passed;
1525}
1526
1527sub get_total( $ ) {
1528    my $self = shift;
1529    my $sub = "get_total";
1530    $self->enter_sub($sub);
1531    $self->leave_sub($sub);
1532    return $total;
1533}
1534
1535sub incr_passed {
1536    my $self = shift;
1537    my $sub = "incr_passed";
1538    $self->enter_sub($sub);
1539    $self->leave_sub($sub);
1540    $passed++;
1541    return $passed;
1542}
1543
1544sub incr_total( $ ) {
1545    my $self = shift;
1546    my $sub = "incr_total";
1547    $self->enter_sub($sub);
1548    $self->leave_sub($sub);
1549    $total++;
1550}
1551
1552sub ok_msg( $$ ) {
1553    my($self,$msg) = @_;
1554    my $sub = "ok_msg";
1555    $self->enter_sub($sub);
1556    $self->leave_sub($sub);
1557    print "ok ".get_total($self)." - $msg\n";
1558}
1559
1560sub fail_msg( $$ ) {
1561    my($self,$msg) = @_;
1562    my $sub = "fail_msg";
1563    $self->enter_sub($sub);
1564    $self->leave_sub($sub);
1565    print "not ok ".get_total($self)." - $msg\n";
1566}
1567
1568sub redirect_stdio( $ ) {
1569    my $self = shift;
1570    my $sub = "redirect_stdio";
1571    $self->enter_sub($sub);
1572    my($outdir) = @_;
1573    open(STDOUT, '>', "$outdir/$ALLOUTFILE") or
1574        $self->log_and_die("ERROR","redirect_stdio","Can't open file $outdir/$ALLOUTFILE: $!");
1575    open(STDERR, ">&STDOUT");
1576    $self->leave_sub($sub);
1577}
1578
1579sub close_stdio( $ ) {
1580    my $self = shift;
1581    my $sub = "close_stdio";
1582    $self->enter_sub($sub);
1583    close(STDERR);
1584    close(STDOUT);
1585    $self->leave_sub($sub);
1586}
1587
1588sub get_lvmroot( $ ) {
1589    my $self = shift;
1590    my $sub = "get_lvmroot";
1591    $self->enter_sub($sub);
1592
1593    $self->leave_sub($sub);
1594    return $LVMROOT;
1595}
1596
1597sub set_debug( $$ ) {
1598    my($self,$log) = @_;
1599    my $sub = "set_debug";
1600    $self->enter_sub($sub);
1601    if($log eq 'INFO') {
1602        $LOG |= $INFO;
1603    }
1604    elsif($log eq 'DEBUG') {
1605        $LOG |= $DEBUG;
1606    }
1607    else {
1608        $self->log_and_cont("WARN","set_debug","Unknown log setting $log");
1609    }
1610    $self->leave_sub($sub);
1611}
1612
1613sub unset_debug( $$ ) {
1614    my($self,$log) = @_;
1615    my $sub = "unset_debug";
1616    $self->enter_sub($sub);
1617    if($log eq 'INFO') {
1618        $LOG &= ~$INFO;
1619    }
1620    elsif($log eq 'DEBUG') {
1621        $LOG &= ~$DEBUG;
1622    }
1623    else {
1624        $self->log_and_cont("WARN","unset_debug","Unknown log setting $log");
1625    }
1626    $self->leave_sub($sub);
1627}
1628
1629# No debug statements to avoid circular references now
1630sub is_log( $$ ) {
1631    my($self,$log) = @_;
1632    return ($LOG & $log);
1633}
1634
1635# Fetch from /proc/cmdline
1636sub get_cmdline( $ ) {
1637    my($self) = @_;
1638    my $sub = "get_cmdline";
1639    $self->enter_sub($sub);
1640    $self->leave_sub($sub);
1641    return $self->snarf_file("$CMDLINE_FILE");
1642}
1643
1644# Parse a value-key tuple out of /proc/cmdline
1645sub parse_cmdline( $$ ) {
1646    my($self,$key) = @_;
1647    my($sub,$cmdline,$value);
1648    $sub = "parse_cmdline";
1649    $self->enter_sub($sub);
1650
1651    foreach my $line ( split('\s+',$self->get_cmdline() ) ) {
1652        if( $line =~ m/^$key="?(.*?)"?$/ ) {
1653            return $1;
1654        }
1655        elsif($line =~ m/$key/) {
1656            return 1;
1657        }
1658    }
1659
1660    $self->leave_sub($sub);
1661    return 0;
1662}
1663
1664sub parse_nic_conf( $$ ) {
1665    my($self,$cmdline) = @_;
1666    my $sub = "parse_nic_conf";
1667    $self->enter_sub($sub);
1668    my @nicsconf;
1669
1670    if($cmdline =~ m/nics=\"(.*)\"/) {
1671        @nicsconf = split ':', $1;
1672    } else {
1673        $self->leave_sub($sub);
1674        return @nicsconf;
1675    }
1676   
1677    $self->leave_sub($sub);
1678    return @nicsconf;
1679}
1680
1681sub get_eth_nics( $ ) {
1682    my($self) = @_;
1683    my $sub = "get_eth_nics";
1684    $self->enter_sub($sub);
1685    my $line;
1686    my @nics;
1687    open(my $IF, "$IFCONFIG |") or $self->log_and_die("ERROR",$sub,"Can't open $IFCONFIG for piping: $!");
1688
1689    while($line = <$IF>) {
1690        chomp $line;
1691        if($line =~ m/^(eth\d+(\:\d+)*)\s+Link\sencap:Ethernet/) {
1692            $self->log_and_cont("INFO",$sub,"Found NIC $1")
1693                if($self->is_log($INFO) || $self->is_log($DEBUG));
1694            push(@nics,$1);
1695        }
1696    }
1697   
1698    close($IF);
1699
1700    $self->leave_sub($sub);
1701
1702    return @nics;
1703}
1704
1705sub flash_nic( $$$ ) {
1706    my($self,$nic,$sec) = @_;
1707    my $sub = "flash_nic";
1708    $self->enter_sub($sub);
1709    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
1710        $self->log_and_cont("INFO",$sub,"Flashing NIC $nic for $sec seconds.");
1711    }
1712    $self->exec_system("ethtool -p $nic $sec");
1713    $self->leave_sub($sub);
1714    return WEXITSTATUS($?);
1715}
1716
1717sub conf_nics( $$$ ) {
1718    my($self,$nicsconf_ref,$nics_ref) = @_;
1719    my $sub;
1720    my @auto;
1721    $sub = "conf_nics";
1722    $self->enter_sub($sub);
1723    my @nicsconf = @{ $nicsconf_ref };
1724    my @nics = @{ $nics_ref };
1725    my($stdin,$rc,$sec);
1726   
1727    $sec = 10; # Flash NICs for 10 seconds
1728   
1729    if($#nics < $#nicsconf) {
1730        $self->log_and_cont("WARN",$sub,"Fewer NICs than conf options; configuring all we can...");
1731    }
1732   
1733    push(@auto,'lo');
1734    open(my $INT, '>', $INTFILE) or $self->log_and_die("ERROR",$sub,"Can't open $INTFILE for writing: $!");
1735    print $INT "iface lo inet loopback\n\n";
1736   
1737    for(my $i=0;$i<=$#nics;$i++) {
1738        print STDERR "We're configuring NIC $i\n";
1739        print STDERR "Plug in the cable where the NIC is flashing. The NIC will flash for $sec seconds.\n";
1740        print STDERR "Doesn't look like you have any flashers, so just take a wild guess where to plug that cable.\n" if($self->flash_nic($nics[$i],10));
1741        push(@auto,$nics[$i]); # All NICs need auto at once
1742        if($nicsconf[$i] eq 'dhcp') {
1743            print $INT "iface $nics[$i] inet dhcp\n";
1744        }
1745        elsif($nicsconf[$i] =~ m/((?:\d{1,3}\.){1,3}\d{1,3})\/((?:\d{1,3}\.){1,3}\d{1,3})/) {
1746            print $INT "iface $nics[$i] inet static\n";
1747            print $INT "\taddress $1\n";
1748            print $INT "\tnetmask $2\n";
1749        }
1750        print STDERR "Press any key to continue.\n";
1751        $stdin = <STDIN>;
1752        print "\n\n";
1753    }
1754    print $INT "auto ".reverse(sort(@auto))."\n";
1755   
1756    close($INT);
1757    $self->leave_sub($sub);
1758}
1759
1760sub nic_dialog {
1761    my($self) = @_;
1762    my @nics;
1763    my $nic_conf;
1764    my $sub='nic_dialog';
1765    my $d = new UI::Dialog (backtitle => "Configure NICS",
1766                            listheight => 10, height => 20);
1767   
1768    foreach my $nic ($self->get_eth_nics()) {
1769        push(@nics,($nic,["",0]));
1770    }
1771   
1772    my @chosen_nics = $d->checklist(text => "Pick NICs to configure.",
1773                                    list => \@nics);
1774    if(!$self->is_dialog_ok($d)) {
1775        return undef;
1776    }
1777   
1778    foreach my $nic (@chosen_nics) {
1779        $nic_conf->{$nic} = $self->config_nic_dialog($d,$nic);
1780        if(!defined($nic_conf->{$nic})) {
1781            return undef;
1782        }
1783    }
1784   
1785    $self->config_interfaces($nic_conf);
1786   
1787    return $nic_conf;
1788}
1789
1790sub require_bccd_server {
1791    my($self) = @_;
1792    my($sub,$dhc,$replace,$rc);
1793    $sub='require_bccd_server';
1794
1795        $rc = 0;
1796
1797        $rc += $self->run_test('unlink','','Unlinking dhclient.conf for BCCD.',$DHCFILE);
1798        $rc += $self->run_test('symlink','','Relinking dhclient.conf for BCCD.',"$DHCFILE-bccd",$DHCFILE);
1799
1800        return $rc;
1801}
1802
1803sub unrequire_bccd_server {
1804    my($self) = @_;
1805    my($sub,$dhc,$replace,$rc);
1806    $sub='unrequire_bccd_server';
1807
1808        $rc = 0;
1809
1810        $rc += $self->run_test('unlink','','Unlinking dhclient.conf for BCCD.',$DHCFILE);
1811        $rc += $self->run_test('symlink','','Relinking dhclient.conf for BCCD.',"$DHCFILE-any",$DHCFILE);
1812
1813        return $rc;
1814}
1815
1816sub config_interfaces{
1817    my($self,$nic_conf) = @_;
1818    my($sub,$rc);
1819    my @auto;
1820    $sub='config_interfaces';
1821        $self->enter_sub($sub);
1822   
1823    open(my $INT, '>', $INTFILE) or
1824        $self->log_and_die("ERROR",$sub,"Couldn't open $INTFILE: $!");
1825   
1826    push(@auto,'lo');
1827    print $INT "iface lo inet loopback\n\n";
1828
1829    foreach my $nic (keys(%{$nic_conf})) {
1830        if($nic_conf->{$nic}->{'dhcp'}) {
1831            push(@auto,$nic);
1832            print $INT "iface $nic inet dhcp\n\n";
1833            if(defined($nic_conf->{$nic}->{'dhcp_source'}) && $nic_conf->{$nic}->{'dhcp_source'} eq 'BCCD') {
1834                if($self->require_bccd_server() > 2) {
1835                    $self->log_and_die("ERROR",$sub,"Couldn't set BCCD server in dhclient.");
1836                }
1837            }
1838            else {
1839                if($self->unrequire_bccd_server() > 2) {
1840                    $self->log_and_die("ERROR",$sub,"Couldn't unset BCCD server in dhclient.");
1841                }
1842            }
1843        }
1844        elsif(defined($nic_conf->{$nic}->{'ipaddr'}) && defined($nic_conf->{$nic}->{'mask'})) {
1845            push(@auto,$nic);
1846            print $INT "iface $nic inet static\n";
1847            print $INT "\taddress $nic_conf->{$nic}->{'ipaddr'}\n";
1848            print $INT "\tnetmask $nic_conf->{$nic}->{'mask'}\n";
1849            if(defined($nic_conf->{$nic}->{'bcast'})) {
1850                print $INT "\tbroadcast $nic_conf->{$nic}->{'bcast'}\n";
1851            }
1852            if(defined($nic_conf->{$nic}->{'gw'})) {
1853                print $INT "\tgateway $nic_conf->{$nic}->{'gw'}\n";
1854            }
1855        }
1856    }
1857    @auto = sort(@auto);
1858    print $INT "auto @auto\n";
1859    close($INT);
1860    $self->leave_sub($sub);
1861}
1862
1863sub check_bccd_net{
1864        my($self,$nic_conf) = @_;
1865        my $sub = 'check_bccd_net';
1866
1867        foreach my $nic (keys(%{$nic_conf})) {
1868                if(defined $nic_conf->{$nic}->{dhcp_source} and $nic_conf->{$nic}->{dhcp_source} eq 'BCCD') {
1869                        return 1;
1870                }
1871        }
1872
1873        return undef;
1874}
1875
1876sub config_dhcp{
1877    my($self,$nic_conf) = @_;
1878    my($sub,$pubnetip,$j,$oneip,$file,$pubnet,$pxenet,$havedhcp,
1879       $bcast,$mask,$i,$rc,$out,$pxenic,$pxenetip,$addr,$dhcpnic,
1880       $destfile);
1881    $sub = 'config_dhcp';
1882   
1883    $havedhcp = 0;
1884  FIND_PXE_NIC:
1885    foreach my $nic (keys(%{$nic_conf})) {
1886        if(defined($nic_conf->{$nic}->{'pxenic'})) {
1887            $pxenic = $nic;
1888            last FIND_PXE_NIC;
1889        }
1890    }
1891   
1892    foreach my $nic (keys(%{$nic_conf})) {
1893        if(defined($nic_conf->{$nic}->{'dhcp_source'}) &&
1894           $nic_conf->{$nic}->{'dhcp_source'} eq 'BCCD') {
1895            $havedhcp = 1;
1896        }
1897    }
1898   
1899  HAVE_DHCP: foreach my $nic (keys(%{$nic_conf})) {
1900      if(defined($nic_conf->{$nic}->{'bccdnet'})) {
1901          $dhcpnic = $nic;
1902          last HAVE_DHCP;
1903      }
1904  }
1905   
1906    if(defined($pxenic)) {
1907        $pxenetip = new NetAddr::IP($nic_conf->{$pxenic}->{'ipaddr'},$nic_conf->{$pxenic}->{'mask'}) ||
1908            $self->log_and_die("ERROR",$sub,"Couldn't create network IP object for $nic_conf->{$pxenic}->{'ipaddr'}: $!");
1909        if(!defined($nic_conf->{$pxenic}->{'gw'})) {
1910            $nic_conf->{$pxenic}->{'gw'} = $nic_conf->{$pxenic}->{'ipaddr'};
1911        }
1912    }
1913    $pubnetip=new NetAddr::IP($BCCD_NET->{'ipaddr'},$BCCD_NET->{'mask'}) ||
1914        $self->log_and_die("ERROR",$sub,"Couldn't create network IP object for $BCCD_NET->{'ipaddr'}: $!");
1915   
1916    $oneip=new NetAddr::IP('0.0.0.1') || # Addition doesn't work the way it should
1917        $self->log_and_die("ERROR",$sub,"Couldn't create singleton IP object: $!");
1918   
1919    $pubnet->{'network'} = $pubnetip->network();
1920    $pubnet->{'network'} =~ s/\/\d+$//g;
1921    $pubnet->{'bcast'} = $pubnetip->broadcast();
1922    $pubnet->{'bcast'} =~ s/\/\d+$//g;
1923    $pubnet->{'mask'} = $pubnetip->mask();
1924    if(defined($pxenic)) {
1925        $pxenet->{'network'} = $pxenetip->network();
1926        $pxenet->{'network'} =~ s/\/\d+$//g;
1927        $pxenet->{'bcast'} = $pxenetip->broadcast();
1928        $pxenet->{'bcast'} =~ s/\/\d+$//g;
1929        $pxenet->{'mask'} = $pxenetip->mask();
1930        $pxenet->{'next'} = $pxenetip->addr();
1931        $pxenet->{'first'} = $pxenetip->first();
1932        $pxenet->{'first'} =~ s/\/\d+$//g;
1933        $pxenet->{'last'} = $pxenetip->last();
1934        $pxenet->{'last'} =~ s/\/\d+$//g;
1935    }
1936   
1937    open(my $HOSTS,'>','/etc/hosts') or $self->log_and_die("ERROR",$sub,"Can't open file /etc/hosts: $!");
1938    print $HOSTS "127.0.0.1\tlocalhost\n";
1939   
1940    $j = 0;
1941    # Increment to first DHCP address
1942    for($i=1;$i<$DHCP_RANGES->{'res'};$i++) {
1943        if(defined($dhcpnic) && $pubnetip->addr() eq $nic_conf->{$dhcpnic}->{'ipaddr'}) {
1944            print $HOSTS sprintf("%s\tnode%.3d.bccd.net node%.3d %s %s\t# Reserved IP\n", $pubnetip->addr(), $j, $j,
1945                                 $HOSTNAME, $SHORT_HOSTNAME);
1946        }
1947        else {
1948            print $HOSTS sprintf("%s\tnode%.3d.bccd.net node%.3d\t# Reserved IP\n", $pubnetip->addr(), $j, $j);
1949        }
1950        $pubnetip++;
1951        $j++;
1952    }
1953   
1954    $pubnet->{'dhcprange'} = $pubnetip->addr();
1955   
1956    for($i=0;$i<$DHCP_RANGES->{'dhcp'};$i++) {
1957        print $HOSTS sprintf("%s\tnode%.3d.bccd.net node%.3d\t#DHCP IP\n", $pubnetip->addr(), $j, $j);
1958        $pubnetip++;
1959        $j++;
1960    }
1961   
1962    $pubnet->{'dhcprange'} .= " ".$pubnetip->addr();
1963   
1964    if(defined($pxenic)) {
1965        $i = 0;
1966        while( $pxenetip->addr() ne $pxenet->{'last'} ) {
1967            print $HOSTS sprintf("%s\tpxenode%.3d.bccd.net pxenode%.3d\t#PXE IP\n", $pxenetip->addr(), $i, $i);
1968            $pxenetip++;
1969            if($i == 10) {
1970                $pxenet->{'firstip'} = $pxenetip->addr();
1971            }
1972            elsif($i == 100) {
1973                $pxenet->{'lastip'} = $pxenetip->addr();
1974                last;
1975            }
1976            $i++;
1977        }
1978        if(!defined($pxenet->{'firstip'}) || !defined($pxenet->{'lastip'})) {
1979            $self->log_and_die("ERROR",$sub,"No PXE IP range defined!");
1980        }
1981    }
1982    close($HOSTS);
1983    open(my $DCONF,'>',$DHCP_CONF) ||
1984        $self->log_and_die("ERROR",$sub,"Can't open file $DHCP_CONF: $!");
1985   
1986    print $DCONF "allow bootp;\nallow booting;\n\n";
1987    print $DCONF "subnet $pubnet->{'network'} netmask $pubnet->{'mask'} {\n";
1988    print $DCONF "\toption subnet-mask $pubnet->{'mask'};\n";
1989    print $DCONF "\toption broadcast-address $pubnet->{'bcast'};\n";
1990    print $DCONF "\toption routers $BCCD_NET->{'ipaddr'};\n";
1991    print $DCONF "\tpool {\n";
1992    print $DCONF "\t\tallow members of \"bccd-nodes\";\n";
1993    print $DCONF "\t\trange $pubnet->{'dhcprange'};\n";
1994    print $DCONF "\t}\n";
1995    print $DCONF "}\n";
1996   
1997    if(defined($pxenic)) {
1998        print $DCONF "subnet $pxenet->{'network'} netmask $pxenet->{'mask'} {\n";
1999        print $DCONF "\toption subnet-mask $pxenet->{'mask'};\n";
2000        print $DCONF "\toption broadcast-address $pxenet->{'bcast'};\n";
2001        print $DCONF "\toption routers $nic_conf->{$pxenic}->{'gw'};\n";
2002        print $DCONF "\tpool {\n";
2003        print $DCONF "\t\trange $pxenet->{'firstip'} $pxenet->{'lastip'};\n";
2004        print $DCONF "\t\tallow members of \"pxelinux-nodes\";\n";
2005        print $DCONF "\t\tfilename \"pxelinux.0\";\n";
2006        print $DCONF "\t\tnext-server $nic_conf->{$pxenic}->{'ipaddr'};\n";
2007        print $DCONF "\t\toption root-path \"$nic_conf->{$pxenic}->{'ipaddr'}:/,nfsvers=3,tcp,hard\";\n";
2008        print $DCONF "\t}\n";
2009        print $DCONF "}\n";
2010        open(my $PCONF, '>', $PXELINUX) ||
2011            $self->log_and_die("ERROR",$sub,"Can't open file $PXELINUX: $!");
2012       
2013        print $PCONF "default bccd\n";
2014        print $PCONF "label bccd\n";
2015        print $PCONF "\tkernel vmlinuz-$KERNREV\n";
2016        print $PCONF "\tappend ETHERNET=eth0 initrd=initramfs-$KERNREV root=/dev/nfs nfsroot=$nic_conf->{$pxenic}->{'ipaddr'}:/ ip=dhcp init=/sbin/init vga=791 lang=us\n";
2017       
2018        close($PCONF);
2019        if(-d "/diskless/$PROJECT") {
2020            open(my $FCONF, '>', $DISKLESS_FSTAB) ||
2021                $self->log_and_die("ERROR",$sub,"Can't open file $DISKLESS_FSTAB: $!");
2022           
2023            print $FCONF "$nic_conf->{$pxenic}->{'ipaddr'}:/bccd/home  /bccd/home   nfs     nfsvers=3,tcp,rsize=32768,wsize=32768,hard,intr 0 0\n";
2024           
2025            close($FCONF);
2026        }
2027    }
2028   
2029    close($DCONF);
2030
2031        if($self->parse_cmdline("recoverdhcp")) {
2032                my($recentmach,$i,$latestts,$ft);
2033                $ft = new File::Temp();
2034                Readonly my $SLEEP => 60;
2035                Readonly my $PWD => getcwd();
2036                my $tempdir = $ft->tempdir("DHCP",CLEANUP => 0);
2037                my(undef,undef,$uid,$gid) = getpwnam('bccd');
2038                chown($uid, $gid, $tempdir);
2039                $rc = $self->run_test("rmtree","","Removing /etc/network/run",'/etc/network/run');
2040                if($rc) {
2041                        $self->log_and_cont("ERROR",$sub,"Couldn't remove /etc/network/run");
2042                }
2043                $rc = $self->run_test("mkpath","","mkdir /etc/network/run",'/etc/network/run');
2044                if($rc) {
2045                        $self->log_and_cont("ERROR",$sub,"Couldn't remake /etc/network/run");
2046                }
2047                ($out,$rc) = $self->run_test("system","","touch /etc/network/run/ifstate","touch /etc/network/run/ifstate");
2048                if(!$rc) {
2049                        $self->log_and_cont("ERROR",$sub,"Couldn't touch /etc/network/run/ifstate: $out");
2050                }
2051                ($out,$rc) = $self->run_test("system","","Starting networking","/etc/init.d/networking start"); # No invoke-rc.d because utmp has not been updated
2052                if(!$rc) {
2053                        $self->log_and_cont("ERROR",$sub,"Couldn't start networking: $out");
2054                }
2055                ($out,$rc) = $self->run_test("system","","Starting snmpd","/usr/sbin/invoke-rc.d snmpd start");
2056                if(!$rc) {
2057                        $self->log_and_cont("ERROR",$sub,"Couldn't start snmpd: $out");
2058                }
2059                ($rc,$out) = $self->run_test("system","","Starting DHCP server","/usr/sbin/invoke-rc.d dhcp3-server stop");
2060                if(!$rc) {
2061                        $self->log_and_cont("ERROR",$sub,"Couldn't stop DHCP server: $out");
2062                }
2063                ($rc,$out) = $self->run_test("system","","Starting sshd","/usr/sbin/invoke-rc.d ssh start");
2064                if(!$rc) {
2065                        $self->log_and_cont("ERROR",$sub,"Couldn't start ssh: $out");
2066                }
2067                ($rc,$out) = $self->run_test("system","","Starting BCCD autodetection",qq{su bccd -c "/bin/bccd-auto-ssh > /tmp/bccd-auto-ssh.out 2>&1" });
2068
2069                $self->log_and_cont("INFO",$sub,"Waiting for responses, sleeping $SLEEP seconds...");
2070                sleep($SLEEP);
2071       
2072                chdir($tempdir);
2073                ($rc,$out) = $self->run_test("system","","Snarfing hosts",qq{su bccd -c "/bin/bccd-snarfhosts $tempdir/machines"});
2074                if($rc) {
2075                        $self->log_and_cont("ERROR",$sub,"Couldn't snarf hosts, $out");
2076                }
2077
2078                open(my $MACHINES, "$tempdir/machines") or
2079                        $self->log_and_die("ERROR",$sub,"Can't open file $tempdir/machines: $!\n");
2080                $i = $latestts = 0;
2081                while(my $line = <$MACHINES>) {
2082                        chomp $line;
2083                        my $machine = (split(/\s+/,$line))[0];
2084                        if($self->is_log($DEBUG)) {
2085                                $self->log_and_cont("INFO",$sub,"Processing $machine for DHCP leases");
2086                        }
2087                        if($i++ > 0) { # The head node always appears first, and should not be processed
2088                                my $leases;
2089                                $destfile = "$tempdir/$machine"."_dhcpd.leases";
2090                                ($rc,$out) = $self->run_test("system","","Copying lease from $machine",qq{su bccd -c "scp $machine:/var/tmp/dhcpd.leases $destfile"});
2091                                if(!$rc) {
2092                                        $self->log_and_cont("WARN",$sub,"Couldn't copy lease file from $machine");
2093                                }
2094                                else {
2095                                        $leases = $self->snarf_file($destfile);
2096                                        if(!defined($leases)) {
2097                                                $self->log_and_cont("WARN",$sub,"Couldn't read lease file from $machine");
2098                                        }
2099                                        if($leases =~ m{^#\s+BCCD TS:\s+(\d+)$}m) {
2100                                                if($1 > $latestts) {
2101                                                        $latestts = $1;
2102                                                        $recentmach = $machine;
2103                                                        if($self->is_log($DEBUG)) {
2104                                                                $self->log_and_cont("INFO",$sub,"$machine is most recent");
2105                                                        }
2106                                                }
2107                                        }
2108                                }
2109                        }
2110                }
2111                if(defined($recentmach)) {
2112                        if($self->is_log($DEBUG)) {
2113                                $self->log_and_cont("INFO",$sub,"Copied $tempdir/$recentmach"."_dhcpd.leases to /var/lib/dhcp3/dhcpd.leases");
2114                        }
2115                        $rc = $self->run_test("fcopy","","Copying $tempdir/$recentmach"."_dhcpd.leases -> /var/lib/dhcp3/dhcpd.leases","$tempdir/$recentmach"."_dhcpd.leases","/var/lib/dhcp3/dhcpd.leases");
2116                        if(!$rc) {
2117                                $self->log_and_die("ERROR",$sub,"Couldn't move lease from $recentmach into place.");
2118                        }
2119                }
2120                $self->run_test("system","","Killing pkbcast","killall pkbcast");
2121                $self->run_test("system","","Killing bccd-allow-all","killall bccd-allow-all");
2122                close($MACHINES);
2123        }
2124   
2125    if(!$havedhcp) {
2126        ($rc,$out) = $self->exec_system("update-rc.d dhcp3-server defaults");
2127        if($rc == 0) {
2128            $self->log_and_cont("NOTICE",$sub,"Set DHCP server to start.\n");
2129        }
2130        else {
2131            $self->log_and_die("ERROR",$sub,"Couldn't set DHCP server to start: $out\n");
2132        }
2133    }
2134    else {
2135        ($rc,$out) = $self->exec_system("update-rc.d -f dhcp3-server remove");
2136        if($rc == 0) {
2137            $self->log_and_cont("NOTICE",$sub,"Set DHCP server not to start.\n");
2138        }
2139        else {
2140            $self->log_and_die("NOTICE",$sub,"Couldn't set DHCP server not to start: $out\n")
2141        }
2142    }
2143   
2144}
2145
2146sub config_nat{
2147        my($self) = @_;
2148        my($natnic,$sub);
2149        $sub = 'config_nat';
2150        open(my $NETSTAT, '-|', '/bin/netstat', '-rn') or
2151                $self->log_and_die("ERROR",$sub,"Couldn't open up netstat for piping!");
2152
2153        NETSTAT:
2154        while(my $line = <$NETSTAT>) {
2155                chomp $line;
2156                my @splitline = split(/\s+/, $line);
2157                if($splitline[0] eq '0.0.0.0') {
2158                        $natnic = $splitline[7];
2159                        last NETSTAT;
2160                }
2161        }
2162        close($NETSTAT);
2163
2164        if(defined($natnic)) {
2165                open(my $NAT, '>', $NATSH) or
2166                        $self->log_and_die("ERROR",$sub,"Couldn't open $NATSH for writing: $!");
2167
2168                print $NAT qq{#!/bin/bash\n\n};
2169                print $NAT qq{/sbin/iptables -t nat -A POSTROUTING -s 192.168.3.0/24 -j SNAT --to-source };
2170                print $NAT $self->get_nic_ip($natnic).qq{\n};
2171
2172                close($NAT);
2173                chmod(S_IRWXU|S_IRGRP|S_IXGRP|S_IROTH|S_IXOTH, $NATSH) or
2174                        $self->log_and_die("ERROR",$sub,"Couldn't set $NATSH to be executable: $!");
2175               
2176                return 1;
2177        }
2178        return undef;
2179}
2180
2181sub is_dialog_ok {
2182    my($self,$d) = @_;
2183   
2184    if($d->state() eq 'OK') {
2185        return 1;
2186    }
2187   
2188    return undef;
2189}
2190
2191sub config_nic_dialog {
2192    my($self,$d,$nic_conf) = @_;
2193    my($temp,$bccd_nic,$gotpxe,$dhcp_source,$sub);
2194    $sub = 'config_nic_dialog';
2195   
2196    $gotpxe = 0;
2197   
2198  FIND_EXT_NIC:
2199    {
2200        my @dhcp_nics;
2201        # See if there's a BCCD server response
2202        foreach my $nic (keys(%{$nic_conf})) {
2203            if(defined $nic_conf->{$nic}->{'dhcp_source'} and $nic_conf->{$nic}->{'dhcp_source'} eq 'BCCD') {
2204                $dhcp_source = 'BCCD';
2205            }
2206        }
2207        foreach my $nic (sort(keys(%{$nic_conf}))) {
2208            # Only if we didn't pick up a BCCD server
2209            if((defined($nic_conf->{$nic}->{'dhcp_source'}) && $nic_conf->{$nic}->{'dhcp_source'} ne 'BCCD') || !defined($dhcp_source)) {
2210                push(@dhcp_nics,($nic,$nic));
2211            }
2212        }
2213        if($#dhcp_nics == 1) {
2214            $bccd_nic = $dhcp_nics[0];
2215        }
2216        elsif($#dhcp_nics > 1 and not -e '/testmode') {
2217            $bccd_nic = $d->menu(text=>"Choose NIC to have BCCD network.", list => \@dhcp_nics);
2218        if(!$self->is_dialog_ok($d)) {
2219            redo FIND_EXT_NIC;
2220        }
2221        } else {
2222                        my %request = ( "EXPECTED_NODES" => "8,4");
2223                        get_boot_flags_from_NIC(%request);
2224                        system ("source /bccd_boot_flags") or croak "$!";
2225                        $bccd_nic = $ENV{'BCCD_NIC'};
2226                        print "BCCD NIC:$bccd_nic\n";
2227                        sleep 1;
2228                }
2229        if(defined($bccd_nic) && !$self->check_bccd_net($nic_conf)) {
2230            $nic_conf->{"$bccd_nic:1"} = $BCCD_NET;
2231                        open(my $IPT, '>>', $IPTABLES_UP) or
2232                                $self->log_and_die("ERROR",$sub,
2233                                        "Couldn't open $IPTABLES_UP for appending: $!");
2234                        print $IPT qq{-A POSTROUTING -o $bccd_nic -j MASQUERADE\n};
2235                        print $IPT qq{COMMIT\n};
2236                        print $IPT qq{# Completed on Wed Jul 15 23:51:28 2009\n};
2237                        close($IPT);
2238        }
2239
2240      NIC_CONF:
2241        foreach my $nic (sort keys %{$nic_conf}) {
2242            if(defined($nic_conf->{$nic}->{'ipaddr'}) && defined($nic_conf->{$nic}->{'dhcp_source'}) &&
2243               $nic_conf->{$nic}->{'dhcp_source'} eq 'BCCD') {
2244                if(!$self->parse_cmdline('standalone')) {
2245                    $nic_conf->{$nic}->{'dhcp'} = 1;
2246                }
2247            }
2248            elsif(defined($nic_conf->{$nic}->{'dhcp_source'}) && -e "/testmode")
2249            {
2250                    $nic_conf->{$nic}->{'dhcp'} = 1;
2251            }   
2252            elsif(defined($nic_conf->{$nic}->{'dhcp_source'}) && $d->yesno(text=>"$nic has an IP address $nic_conf->{$nic}->{'ipaddr'} from $nic_conf->{$nic}->{'dhcp_source'}. Take this address?")) {
2253                $nic_conf->{$nic}->{'dhcp'} = 1;
2254            }
2255            else {
2256                $nic_conf->{$nic}->{'dhcp'} = 0;
2257            }
2258            if($nic_conf->{$nic}->{'dhcp'} == 0 && !defined($nic_conf->{$nic}->{'ipaddr'})
2259             && ! -e '/testmode'
2260                         && ! $d->yesno(text=>"No DHCP for $nic, skip?")) {
2261                $nic_conf->{$nic}->{'dhcp'} = 0;
2262            }
2263                        else {
2264                                next NIC_CONF;
2265                        }
2266                        if($nic_conf->{$nic}->{'dhcp'} == 0) {
2267FIND_CUR_NIC:
2268                                do {
2269                                        if (-e '/testmode'){
2270                                                $nic_conf->{$nic}->{'ipaddr'} = '192.168.0.*';
2271                                        }else{
2272                                                $nic_conf->{$nic}->{'ipaddr'} =
2273                                                ($temp = $d->inputbox(text=>
2274                                                "$nic IP address (mandatory)")) ? $temp : undef;
2275
2276                                                if(!$self->is_dialog_ok($d)) {
2277                                                        redo FIND_EXT_NIC;
2278                                                }
2279                                                elsif($nic_conf->{$nic}->{'ipaddr'}
2280                                                         eq $BCCD_NET->{'ipaddr'}) {
2281                                                        $d->msgbox(text =>
2282                 "IP address cannot be the BCCD virtual IP ($BCCD_NET->{'ipaddr'}).");
2283                                                        goto FIND_CUR_NIC;
2284                                                }
2285                                        }
2286                   
2287                                        if (-e '/testmode'){
2288                                                $nic_conf->{$nic}->{'mask'} = "255.255.255.0";
2289                                        } else {
2290                                                $nic_conf->{$nic}->{'mask'} =
2291                                                ($temp = $d->inputbox(text=>
2292                                                 "$nic Subnet mask (mandatory)")) ? $temp : undef;
2293                   
2294                                                if(!$self->is_dialog_ok($d)) {
2295                                                        redo FIND_EXT_NIC;
2296                                                }
2297                                        }
2298                   
2299                    $nic_conf->{$nic}->{'gw'} = ($temp = $d->inputbox(text=>"$nic Gateway (optional)")) ? $temp : undef;
2300                   
2301                    if(!$gotpxe && $self->get_stage() eq 'LIBERATED' && $d->yesno(text=>"Make $nic the PXE-capable NIC?")) {
2302                        $gotpxe = 1;
2303                        $nic_conf->{$nic}->{'pxenic'} = $nic;
2304                    }
2305                } while(!defined($nic_conf->{$nic}->{'ipaddr'}) || !defined($nic_conf->{$nic}->{'mask'}));
2306            }
2307        }
2308    }
2309   
2310    return $nic_conf;
2311}
2312
2313sub get_nic_ip( $$ ) {
2314    my($self,$nic) = @_;
2315    my($sub,$cmd,$rc,$out,$ip);
2316    $sub = 'get_nic_ip';
2317    $self->enter_sub($sub);
2318   
2319    if(!defined($nic)) {
2320        return undef;
2321    }
2322   
2323    $cmd = "/sbin/ifconfig $nic";
2324    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
2325        $self->log_and_cont("INFO",$sub,"Running $cmd.");
2326    }
2327    ($rc,$out) = $self->exec_system($cmd);
2328    if($rc) {
2329        $self->log_and_die("ERROR",$sub,"$cmd failed with rc $rc, out $out.")
2330    }
2331    if($out =~ m/inet\s+addr:((?:\d{0,3}\.){3}\d{0,3})/) {
2332        $ip = $1;
2333    }
2334    else {
2335        undef $ip;
2336    }
2337   
2338    $self->leave_sub($sub);
2339    return $ip;
2340}
2341
2342sub get_nic_mask( $$ ) {
2343    my($self,$nic) = @_;
2344    my($sub,$cmd,$rc,$out,$mask);
2345    $sub = 'get_nic_mask';
2346    $self->enter_sub($sub);
2347   
2348    $cmd = "/sbin/ifconfig $nic";
2349    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
2350        $self->log_and_cont("INFO",$sub,"Running $cmd.");
2351    }
2352    ($rc,$out) = $self->exec_system($cmd);
2353    if($rc) {
2354        $self->log_and_die("ERROR",$sub,"$cmd failed with rc $rc, out $out.");
2355    }
2356    if($out =~ m/Mask:((?:\d{0,3}\.){3}\d{0,3})/) {
2357        $mask = $1;
2358    }
2359    else {
2360        undef $mask;
2361    }
2362
2363    $self->leave_sub($sub);
2364    return $mask;
2365}
2366
2367sub run_nic_dhcp {
2368    my($self,$nic,$cfg) = @_;
2369    my($cmd,$out,$rc,$sub);
2370    $sub = 'run_nic_dhcp';
2371   
2372    $cmd = "killall dhclient3";
2373    ($out,$rc) = $self->exec_system($cmd);
2374   
2375    foreach my $lease_file ( </var/lib/dhcp3/dhclient*leases*> ) {
2376        if(!$self->run_test('unlink','',"Removing $lease_file.",$lease_file)) {
2377            $self->log_and_die("ERROR",$sub,"Couldn't remove $lease_file.");
2378        }
2379    }
2380   
2381    $cmd = "dhclient3 -cf $cfg -1 $nic";
2382    ($out,$rc) = $self->run_test('system','',"Running $cmd.",$cmd);
2383   
2384    if($out =~ m/^bound to ((?:\d{1,3}\.){3}\d{1,3})/m) {
2385        return $1;
2386    }
2387    return undef;
2388}
2389
2390sub read_passwd {
2391    my($self) = @_;
2392    my($passwd,$confirm,$empty);
2393    do {
2394        print "Please enter your password: ";
2395        ReadMode('noecho');
2396        $passwd = <STDIN>;
2397        if ($passwd){
2398                chomp $passwd;
2399        }
2400        print "\n";
2401        ReadMode('restore');
2402       
2403        print "Please confirm your password: ";
2404        ReadMode('noecho');
2405        $confirm = <STDIN>;
2406        if ($confirm){
2407                chomp $confirm;
2408        }
2409        print "\n";
2410        ReadMode('restore');
2411        if (not $passwd){
2412                $passwd = "";
2413        }
2414        if (not $confirm){
2415                $confirm = "";
2416        }
2417    } while($passwd ne $confirm);
2418    return $passwd;
2419}
2420
2421sub get_boot_flags_from_NIC{
2422        my %request = @_;
2423        my @custom_macs;
2424        my @custom_nics;
2425        my @boot_strings;
2426        my $boot_string;
2427        my $bccd_nic;
2428
2429
2430        my @mac_addresses =
2431                split(/\n/,`$IFCONFIG | awk '/HWaddr/ {print \$1 " " \$5}'`);
2432        @custom_macs = grep {/ 02:/} @mac_addresses;
2433
2434        for(my $i = 0; $i <= $#custom_macs; ++$i){
2435                if($custom_macs[$i] =~ m/^(.*?) /) {
2436                        $custom_nics[$i] = $1;
2437                }
2438
2439                my $open_hex;
2440                if ($custom_macs[$i] =~ m/([0-9a-fA-F]):([0-9a-fA-F][0-9a-fA-F])$/){
2441                        $open_hex = $1.$2;
2442                } else {
2443                        die "Error in detecting last three hexes in MAC";
2444                }
2445
2446                $boot_strings[$i] = sprintf "%012b", hex( $open_hex );
2447
2448                if (
2449                                substr($boot_strings[$i],
2450                                        $IS_BCCD_NETWORK_NIC,1)
2451                                eq '1'
2452                   )
2453                {
2454                        $bccd_nic = $custom_nics[$i];
2455                        $boot_string = $boot_strings[$i];
2456                }
2457        }
2458       
2459        my $boot_flags = "export BCCD_NIC=$bccd_nic\n";
2460
2461        foreach my $key(keys %request){
2462                my $value;
2463                my $pointer = $request{$key};
2464                my ($index,$length) = split(/,/,$pointer);
2465
2466                unless($length){
2467                        $length = 1;
2468                }
2469
2470                $value = substr($boot_string,$index,$length);
2471                $value = oct ("0b$value");
2472                       
2473                $boot_flags .= "export $key=$value\n"; 
2474        }
2475
2476        if ($boot_flags){
2477                open(BOOTFLAGS, ">/bccd_boot_flags") or die "Could not open file:$!";
2478                        print BOOTFLAGS $boot_flags;
2479                close(BOOTFLAGS);
2480        }
2481}
2482
24831;
2484
2485__END__
2486
2487=head1 NAME
2488
2489Bccd.pm
2490
2491=head1 DESCRIPTION
2492
2493This is the Perl module common to all BCCD scripts except for the testing database. What follows
2494is a description of all the subroutines available in the module. The signature below includes
2495the reference to the module, but only extra parameters are explicitly mentioned.
2496
2497=head2 GENERAL SUBROUTINES
2498
2499These functions all take a reference to the parent module, along with whatever other
2500parameters that are passed in.
2501
2502=head3 cmd_num_die($@)
2503
2504This is the subroutine called when another subroutine does not have the proper number of
2505arguments. Takes an array.
2506
2507=head3 print_array($@)
2508
2509This prints an array with line counters. Takes an array.
2510
2511=head3 get_vginfo($)
2512
2513This subroutine returns the LVM volume group information in colon-delimited format.
2514
2515=head3 get_pvinfo($)
2516
2517Returns the LVM physical volume information in colon delimited format.
2518
2519=head3 get_free_pe_count($)
2520
2521Returns the number of available physical extents in the volume groups present.
2522
2523=head3 snarf_file($$)
2524
2525Takes a path to a file and reads it in as one string.
2526
2527=head2 TESTING SUBROUTINES
2528
2529These functions all take a refernce to the parent module, the test type, the success return
2530code to be expected (required but can be blank for a safe default), a message to print out,
2531and whatever other parameters the specific test requires. In this documentation, only extra
2532parameters are explicitly mentioned. Unless otherwise noted, this returns the exit code as a
2533Perl truth value (0 == failure, anything else is OK).
2534
2535=head3 test_system($$$$$)
2536
2537Takes a command and runs it.
2538
2539=head3 test_chdir($$$$$)
2540
2541Takes a directory and changes the present directory to it.
2542
2543=head3 test_mkpath($$$$$)
2544
2545Takes a directory and makes it.
2546
2547=head3 test_wwwmech($$$$$$)
2548
2549Takes a URL and a destination file, and fetches the URL to the file. For subversion
2550access, see test_revfetch and test_recrevfetch.
2551
2552=head3 test_chmod($$$$$$)
2553
2554Takes an octal permission mode and a file, and sets the permissions on the file to the given
2555mode. Make sure not to represent the octal permissions as text (i.e. don't use quotes).
2556
2557=head3 test_unlink($$$$$)
2558
2559Takes a directory entry and removes it.
2560
2561=head3 test_symlink($$$$$$)
2562
2563Takes a source file and destination, and symbolically links the source to the destination.
2564
2565=head3 test_fcopy($$$$$$)
2566
2567Takes a source file and destination file, and copies the source to the destination.
2568
2569=head3 test_fmove($$$$$$)
2570
2571Takes a source file and destination, and moves the source file to the destination.
2572
2573=head3 test_getsvnrev($$$$$)
2574
2575Gets the current subversion revision from the given URL. Returns the subversion revision.
2576
2577=head3 test_fwrite($$$$$$$)
2578
2579Takes a mode, file, and a text string, and writes the text to the file. Valid modes are "w"
2580for replacing the file, and "a" for appending to an existing file.
2581
2582=head3 test_revfetch($$$$$$$)
2583
2584Takes a subversion revision, URL in a subversion repository, and a destination file. Fetches
2585the file in the URL at the given revision to the destination file.
2586
2587=head3 test_rename($$$$$$)
2588
2589Takes a source file and destination file and renames the source to the destination. Functionally
2590equivalent to test_fmove.
2591
2592=head3 test_recrevfetch($$$$$$)
2593
2594Takes a subversion revision and URL, and fetches all files underneath the URL to the present
2595directory.
2596
2597=head3 test_rmtree($$$$$)
2598
2599Takes a directory tree and recursively removes it.
2600
2601=head3 test_getuseruid($$$$$)
2602
2603Takes a username and return the UID.
2604
2605=head3 test_getusergid($$$$$)
2606
2607Takes a username and returns the primary GID.
2608
2609=head3 test_lsofkill($$$$$)
2610
2611Takes a directory name and kills all processes with open files in that directory.
2612
2613=head3 test_chown($$$$$$$)
2614
2615Takes a file, user, and group and changes ownership of the file to that user and group.
2616
2617=head3 test_rsync($$$$$$)
2618
2619Takes a source and destination path and rsync's the source to the destination.
2620
2621=cut
Note: See TracBrowser for help on using the repository browser.