source: /cluster/svnroot/bccd-ng/branches/skylar-devel/trees/usr/local/lib/site_perl/5.10.0/Bccd.pm @ 2413

Last change on this file since 2413 was 2413, checked in by skylar, 11 years ago

mknod needs to return a proper rc (#506)

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