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

Last change on this file since 2575 was 2575, checked in by skylar, 10 years ago

using kernrev in Bccd.pm (#389)

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