source: /cluster/svnroot/bccd-ng/trunk/trees/usr/local/lib/site_perl/5.10.0/Bccd.pm @ 3120

package Bccd;

# $Id: Bccd.pm 3120 2011-04-13 19:44:26Z fitz $

# This file is part of BCCD, an open-source live CD for computational science
# education.
# 
# Copyright (C) 2010 Andrew Fitz Gibbon, Paul Gray, Kevin Hunter, Dave Joiner, 
#   Sam Leeman-Munk, Tom Murphy, Charlie Peck, Skylar Thompson, & Aaron Weeden 

# 
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
# 
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.

use strict;
use warnings;
use File::Path;
use File::Temp;
use File::Copy;
use WWW::Mechanize;
use Term::ReadKey;
use POSIX;
use Carp;
use Readonly;
use UI::Dialog;
use Data::Dumper;
use NetAddr::IP;
use IO::Socket::INET;
use Net::DHCP::Packet;
use Net::DHCP::Constants;
use Net::CIDR ':all';
use Errno qw(:POSIX);
use Fcntl ':mode';
use YAML qw/LoadFile/;

my $passed = 0;
my $total = 0;
Readonly my $KERNREV => '2.6.31.12-aufs';
Readonly my $DHCFILE => '/etc/dhcp3/dhclient.conf';
Readonly my $ALLOUTFILE    => "allout";
Readonly my $LVMROOT       => "/sbin/"; 
Readonly my $PROJECT       => "bccd";
Readonly my $IFCONFIG      => "/sbin/ifconfig -a";
Readonly my $INTFILE       => "/etc/network/interfaces";
Readonly my $NATSH         => "/etc/network/if-up.d/nat";
Readonly my $TEMPLATE_IPTABLES_UP   => '/etc/iptables.up.rules.template';
Readonly my $IPTABLES_UP   => '/etc/iptables.up.rules';
Readonly my $START_PKBFILE => "/etc/network/if-up.d/start-pkbcast";
Readonly my $CMDLINE_FILE => "/proc/cmdline";
Readonly my $BCCD_NET  => { 'ipaddr'  => '192.168.3.1',
                            'mask' => '255.255.255.0',
                            'bcast'   => '192.168.3.255',
                            'dhcp'    => 0,
                            'bccdnet' => 1,
};
Readonly my $DHCP_RANGES => { 'res'  => 10,
                              'dhcp' => 100,
                              'pxe'  => 100
};
Readonly my $DHCP_CONF => '/etc/dhcp3/bccd_net.conf';
Readonly my $TEMPLATE_DHCP_CONF => $DHCP_CONF."_template";
Readonly my $PXELINUX => "/var/lib/tftpboot/pxelinux.cfg/default";
Readonly my $TEMPLATE_PXELINUX => $PXELINUX."_template";
Readonly my $DISKLESS_FSTAB => "/diskless/bccd/etc/fstab";
Readonly my $TEMPLATE_DISKLESS_FSTAB => $DISKLESS_FSTAB."_template";
my $hostname = `/bin/hostname`;
chomp($hostname);
Readonly my $HOSTNAME => $hostname;
$hostname = `/bin/hostname -s`;
chomp($hostname);
Readonly my $SHORT_HOSTNAME => $hostname;

#Boot Flag Indices
Readonly my $CUSTOM_NIC => "02";
Readonly my $IS_BCCD_NETWORK_NIC => 0;

undef($hostname);

my $debug = 0;
my $INFO = 0b1;
my $DEBUG = 0b10;
my $LOG = 0;

sub new {
    my $class = shift;
    my $self = {};
    bless($self,$class);
    return $self;
}

sub log_and_cont( $$$$ ) {
    my($self,$code,$func,$msg) = @_;

    carp "$0: $code: $func: $msg\n";

}

sub log_and_die( $$$$ ) {
    my($self,$code,$func,$msg) = @_;

    croak "$0: $code: $func: $msg\n";
}

sub enter_sub( $$ ) {
    my($self,$sub) = @_;

    if($self->is_log($DEBUG)) {
        $self->log_and_cont("DEBUG",$sub,"Entering $sub");
    }
}

sub leave_sub( $$ ) {
    my($self,$sub) = @_;
    
    if($self->is_log($DEBUG)) {
        $self->log_and_cont("DEBUG",$sub,"Leaving $sub") ;
    }
}

sub cmd_num_die( $@ ) {
    my($self,@cmds) = @_;
    my $sub = "cmd_num_due";
    $self->enter_sub($sub);
    
    $self->log_and_die("ERROR",$sub,"Incorrect number of command line arguments: $#cmds; @cmds");
    $self->leave_sub($sub);
}

sub print_array ( $@ ) {
    my($self,@array) = @_;
    my $sub = "print_array";
    $self->enter_sub($sub);
    my $i;
    
    $i = 0;
    foreach my $row ( @array ) {
        print "$i: $row\n";
        $i++;
    }
    $self->leave_sub($sub);
}

sub get_lvminfo( $$ ) {
    my($self,$layer) = @_;
    my($sub,$cmd,$rc,$out);
    my(@info,@splitinfo);
    $sub = "get_lvminfo";
    $self->enter_sub($sub);
    
    if($layer !~ m/(?:pv|vg|lv)/) {
        $self->log_and_die("ERROR",$sub,"Layer must be one of pv, vg, or lv.");
    }
    
    $cmd = "$LVMROOT/".$layer."display -c";
    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
        $self->log_and_cont("INFO",$sub,"Executing $cmd");
    }
    ($rc,$out) = $self->exec_system($cmd);
    if($rc == 5) {
        if($self->is_log($INFO) || $self->is_log($DEBUG)) {
            $self->log_and_cont("INFO",$sub,"Nothing to display for $cmd.");
        }
        return undef;
    }
    elsif($rc) {
        if($rc) {
            $self->log_and_cont("NOTICE", $sub,"$cmd failed with output $out and rc $rc: $!");
        }
        return undef;
    }
    
    foreach my $line ( split('\n',$out) ) {
        $line =~ s/^\s+//g;
        if($line =~ m/is a new physical volume/) { # pvdisplay reports this when the PV has no VG
            next;
        }
        if($self->is_log($INFO) || $self->is_log($DEBUG)) {
            $self->log_and_cont("INFO",$sub,"Pushing line $line.");
        }
        push(@splitinfo,[ split(':',$line) ]);
    }
    
    return @splitinfo;
}


sub rm_all_lv( $ ) {
    my($self) = @_;
    my($sub,$cmdrc,$rc,$out);
    my @info;
    my %lvs;
    $sub = 'rm_all_lv';
    $self->enter_sub($sub);

    $rc = 0;
    @info = $self->get_lvminfo('lv');
    if(@info) {    
        for(my $i=0;$i<=$#info;$i++) {
            if($self->is_log($INFO) || $self->is_log($DEBUG)) {
                $self->log_and_cont("INFO",$sub,"Found volume group for logical volumes: $info[$i][1].");
            }
            $lvs{$info[$i][1]} = 1;
        }
        
        foreach my $key ( keys %lvs ) {
            my $cmd = "/sbin/lvremove -f $key";
            if($self->is_log($INFO) || $self->is_log($DEBUG)) {
                $self->log_and_cont("INFO",$sub,"Running cmd $cmd.");
            }
            ($cmdrc,$out) = $self->exec_system("$cmd");
            if($self->is_log($INFO) || $self->is_log($DEBUG)) {
                $self->log_and_cont("INFO",$sub,"$cmd returned $cmdrc with output $out");
            }
            if($rc) {
                $self->log_and_cont("ERROR", $sub,"$cmd failed with output $out and rc $rc: $!");
            }
            $rc += $cmdrc;
        }
    }
    
    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
        $self->log_and_cont("INFO",$sub,"Returning with rc $rc.");
    }
    $self->leave_sub($sub);
    return $rc;
}

sub rm_all_vg( $ ) {
    my($self) = @_;
    my($sub,$rc,$cmdrc,$out);
    my @info;
    my %vgs;
    $sub = 'rm_all_vg';
    $self->enter_sub($sub);
    
    $rc = 0;
    @info = $self->get_lvminfo('vg');
    if(@info) {
        for(my $i=0;$i<=$#info;$i++) {
            if($self->is_log($INFO) || $self->is_log($DEBUG)) {
                $self->log_and_cont("INFO",$sub,"Found volume group: $info[$i][0].");
            }
            $vgs{$info[$i][0]} = 1;
        }
        
        foreach my $key ( keys %vgs ) {
            my $cmd = "/sbin/vgremove -f $key";
            if($self->is_log($INFO) || $self->is_log($DEBUG)) {
                $self->log_and_cont("INFO",$sub,"Running cmd $cmd.");
            }
            ($cmdrc,$out) = $self->exec_system("$cmd");
            if($self->is_log($INFO) || $self->is_log($DEBUG)) {
                $self->log_and_cont("INFO",$sub,"$cmd returned $cmdrc with output $out");
            }
            if($rc) {
                $self->log_and_cont("ERROR", $sub,"$cmd failed with output $out and rc $rc: $!");
            }
            $rc += $cmdrc;
        }
    }
    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
        $self->log_and_cont("INFO",$sub,"Returning with rc $rc.");
    }
    
    $self->leave_sub($sub);
    return $rc;
}

sub rm_all_pv( $ ) {
    my($self) = @_;
    my($sub,$cmdrc,$rc,$out);
    my @info;
    my %pvs;
    $sub = 'rm_all_pv';
    $self->enter_sub($sub);
    
    $rc = 0;
    @info = $self->get_lvminfo('pv');
    if(@info) {
        for(my $i=0;$i<=$#info;$i++) {
            if($self->is_log($INFO) || $self->is_log($DEBUG)) {
                $self->log_and_cont("INFO",$sub,"Found physical volume: $info[$i][0].");
            }
            $pvs{$info[$i][0]} = 1;
        }
        
        foreach my $key ( keys %pvs ) {
            my $cmd = "/sbin/pvremove -f $key";
            if($self->is_log($INFO) || $self->is_log($DEBUG)) {
                $self->log_and_cont("INFO",$sub,"Running cmd $cmd.");
            }
                
            ($cmdrc,$out) = $self->exec_system("$cmd");
            if($self->is_log($INFO) || $self->is_log($DEBUG)) {
                $self->log_and_cont("INFO",$sub,"$cmd returned $cmdrc with output $out");
            }
              
            if($rc) {  
                $self->log_and_die("ERROR", $sub,"$cmd failed with output $out and rc $rc: $!");
            }
            $rc += $cmdrc;
        }
    }

    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
        $self->log_and_cont("INFO",$sub,"Returning with rc $rc.");
    }
        
    $self->leave_sub($sub);
    return $rc;
}

sub get_lvinfo( $ ) {
    my($self) = @_;
    my $sub = "get_lvinfo";
    $self->enter_sub($sub);
    my($lvinfo,$cmd);

    $cmd = "$LVMROOT/lvdisplay -c";
    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
        $self->log_and_cont("INFO",$sub,"Executing $cmd");
    }
    $lvinfo = `$cmd`;
    if(WEXITSTATUS($?)) {
        $self->log_and_die("ERROR", $sub,"$cmd with output $lvinfo: $!");
    }
    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
        $self->log_and_cont("INFO",$sub,"Ran $cmd and got output $lvinfo");
    }

    $self->leave_sub($sub);
    return split(':', $lvinfo);
}

sub get_vginfo( $ ) {
    my($self) = @_;
    my $sub = "get_vginfo";
    $self->enter_sub($sub);
    my($vginfo,$cmd);

    $cmd = "$LVMROOT/vgdisplay -c";
    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
        $self->log_and_cont("INFO",$sub,"Executing $cmd");
    }
    $vginfo = `$cmd`;
    if(WEXITSTATUS($?)) {
        $self->log_and_die("ERROR", $sub,"$cmd with output $vginfo: $!");
    }
    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
        $self->log_and_cont("INFO",$sub,"Ran $cmd and got output $vginfo");
    }

    $self->leave_sub($sub);
    return split(':', $vginfo);
}

sub get_pvinfo( $ ) {
    my($self) = @_;
    my $sub = "get_pvinfo";
    $self->enter_sub($sub);
    my($pvinfo,$cmd);

    $cmd = "$LVMROOT/pvdisplay -c";
    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
        $self->log_and_cont("INFO",$sub,"Executing $cmd");
    }
    $pvinfo = `$cmd`;
    if(WEXITSTATUS($?)) {
        $self->log_and_die("ERROR",$sub,"$cmd failed: $!");
    }
    
    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
        $self->log_and_cont("INFO",$sub,"Ran $cmd and got output $pvinfo");
    }
    $self->leave_sub($sub);
    return split(':', $pvinfo);
}

sub get_pe_size( $ ) {
    my($self) = @_;
    my $sub = "get_pe_size";
    $self->enter_sub($sub);
    my @vginfo = $self->get_vginfo();
    if($self->is_log($DEBUG)) {
        $self->log_and_cont("DEBUG",$sub,"Retrieved @vginfo from get_vginfo.");
    }

    $self->leave_sub($sub);
    return $vginfo[12];
}

sub get_free_pe_count( $ ) {
    my($self) = @_;
    my $sub = "get_free_pe_count";
    $self->enter_sub($sub);

    my @vginfo = $self->get_vginfo();
    if($self->is_log($DEBUG)) {
        $self->log_and_cont("DEBUG",$sub,"Retrieved @vginfo from get_vginfo.");
    }

    $self->leave_sub($sub);
    return $vginfo[15];
}

sub snarf_file( $$ ) {
    my($self,$file) = @_;
    my($sub,$FILE);
    $sub = "snarf_file";
    $self->enter_sub($sub);
    my $input;
    {
        local $/;
        open($FILE, "< $file") or $self->log_and_die("ERROR",$sub,"Could not open file $file for reading: $!");
        if($self->is_log($INFO) || $self->is_log($DEBUG)) {
            $self->log_and_cont("INFO",$sub,"Opened $file for reading.");
        }
        
        $input = <$FILE>;
    }
    close($FILE);
    
    chomp $input;

    $self->leave_sub($sub);
    return $input;
}

sub test_regexsub_file( $$$$$$$ ) {
    my($self,$type,$okrc,$msg,$file,$regex1,$regex2) = @_;
    my($sub,$text,$rc);
    $sub = 'test_regexsub_file';

    if($okrc eq '') {
        $okrc = 1;
    }
    
    if( ! -f $file ) {
        $self->fail_msg("$msg: $file not found for regex sub.");
        return 0;
    }
    
    $text = $self->snarf_file($file);
    
    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
        $self->log_and_cont("INFO",$sub,"Regex1: $regex1; Regex2: $regex2; Pretext: $text");
    }
      
    $text =~ s/$regex1/$regex2/g;
    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
        $self->log_and_cont("INFO",$sub,"Posttext: $text");
    }

    $rc = $self->test_fwrite($type,$okrc,"Writing $file after $regex1 -> $regex2."
                             ,'w',$file,$text);

    if($rc == $okrc) {
        $self->ok_msg($msg);
        $rc = 1;
    }
    else {
        $self->fail_msg($msg);
        $rc = 0;
    }

    return $rc;
}

sub test_read_yaml{
        my($self,$type,$okrc,$msg,$file) = @_;
        my $sub = 'test_read_yaml';

        $self->enter_sub($sub);

        if(! -f $file) {
                $self->log_and_die("ERROR",$sub,"Cannot read in $file");
        }

        if($self->is_log($INFO) || $self->is_log($DEBUG)) {
                $self->log_and_cont("INFO",$sub,"Reading in: $file");
        }
        my $y = LoadFile($file);
        if($self->is_log($INFO) || $self->is_log($DEBUG)) {
                $self->log_and_cont("INFO",$sub,"Read in:".Dumper($y));
        }

        $self->leave_sub($sub);
        return $y;
}

sub test_mknods{
        my($self,$type,$okrc,$msg,$file,$base) = @_;
        my($rc,$temprc,$out);
        my $sub = 'test_mknods';

        $self->enter_sub($sub);

        if($okrc eq '') {
        $okrc = 0;
    }

        my $y = $self->test_read_yaml($type,$okrc,"Reading mknod configuration from $file.",$file);
        if(!defined($y)) {
                $self->log_and_die("ERROR",$sub,"Can't proceeded with invalid configuration.");
        }

        $rc = 0;
        foreach my $d (keys(%{$y})) {
                my $cmd = "/bin/mknod $base/$d $y->{$d}->{type} $y->{$d}->{major} $y->{$d}->{minor}";
        if($self->is_log($INFO) || $self->is_log($DEBUG)) {
            $self->log_and_cont("INFO",$sub,"Running $cmd");
        }

                ($temprc,$out) = $self->exec_system($cmd);
                if($rc) {
                        $self->log_and_cont("$cmd failed with $temprc, out $out");
                }
                if($temprc > $rc) {
                        $rc = $temprc;
                }
        }

    if($rc == $okrc) {
        $self->ok_msg($msg);
        $rc = 1;
    }
    else {
        $self->fail_msg($msg);
        $rc = 0;
    }

        $self->leave_sub($sub);
        return $rc;
}

sub test_rm_lvm( $$$$ ) {
    my($self,$type,$okrc,$msg) = @_;
    my($sub,$rc,$cmdrc);
    $sub = 'test_rm_lvm';
    $self->enter_sub($sub);

    if($okrc eq '') {
        $okrc = 0;
    }

    $rc = 0;
    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
        $self->log_and_cont("INFO",$sub,"Removing logical volumes.");
    }
    $cmdrc = $self->rm_all_lv();
    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
        $self->log_and_cont("INFO",$sub,"Logical volume remove exited with rc $cmdrc.");
    }
    $rc += $cmdrc;
    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
        $self->log_and_cont("INFO",$sub,"Removing volume groups.");
    }
    $cmdrc = $self->rm_all_vg();
    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
        $self->log_and_cont("INFO",$sub,"Volume group remove exited with rc $cmdrc.");
    }
    $rc += $cmdrc;
    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
        $self->log_and_cont("INFO",$sub,"Removing physical volumes.");
    }
    $cmdrc = $self->rm_all_pv();
    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
        $self->log_and_cont("INFO",$sub,"Physical volume remove exited with rc $cmdrc.");
    }
    $rc += $cmdrc;

    if($rc == $okrc) {
        $self->ok_msg($msg);
        $rc = 1;
    }
    else {
        $self->fail_msg($msg);
        $rc = 0;
    }

    $self->leave_sub($sub);
    return $rc;
}

sub test_system( $$$$$ ) {
    my($self,$type,$okrc,$msg,$cmd) = @_;
    my $sub = "test_system";
    $self->enter_sub($sub);
    my $rc = 0;
    my $out;

    if( $okrc eq "" ) {
        $okrc = 0;
    }
    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
        $self->log_and_cont("INFO",$sub,"Passing $cmd to exec_system");
    }
    ($rc,$out) = $self->exec_system($cmd);
    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
        $self->log_and_cont("INFO",$sub,"$cmd came back with rc $rc, out $out");
    }

    if($rc == $okrc) {
        $self->ok_msg($msg);
        $rc = 1;
    }
    else {
        $self->fail_msg("$msg,$out");
        $rc = 0;
    }

    $self->leave_sub($sub);
    return ($out,$rc);
}

sub test_chdir( $$$$$ ) {
    my($self,$type,$okrc,$msg,$dir) = @_;
    my $sub = "test_chdir";
    $self->enter_sub($sub);
    my $rc = 0;

    if( $okrc eq "" ) {
        $okrc = 1;
    }
    $rc = chdir($dir);
    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
        $self->log_and_cont("INFO",$sub,"chdir'd to $dir with rc $rc");
    }

    if($rc == $okrc) {
        $self->ok_msg($msg);
        $rc = 1;
    }
    else {
        $self->fail_msg($msg);
        $rc = 0;
    }

    $self->leave_sub($sub);
    return $rc;
}

sub test_mkpath( $$$$$ ) {
    my($self,$type,$okrc,$msg,$dir) = @_;
    my $sub = "test_mkpath";
    $self->enter_sub($sub);
    my $rc = 0;

    if( $okrc eq "" ) {
        $okrc = 1;
    }
    eval { mkpath($dir) };
    if($@) {
        $rc = 0;
    }
    else {
        $rc = $okrc;
    }
    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
        $self->log_and_cont("INFO",$sub,"mkpath'd $dir with rc $rc");
    }

    if($rc == $okrc) {
        $self->ok_msg($msg);
        $rc = 1;
    }
    else {
        $self->fail_msg($msg);
        $rc = 0;
    }

    $self->leave_sub($sub);
    return $rc;
}

sub test_wwwmech( $$$$$$ ) {
    my($self,$type,$okrc,$msg,$srcurl,$destfile) = @_;
    my $sub = "test_wwwmech";
    $self->enter_sub($sub);
    my $rc = 0;
    my $out;

    if( $okrc eq "" ) {
        $okrc = 1;
    }
    my $mech = WWW::Mechanize->new();
    $mech->get("$srcurl", ':content_file' => "$destfile");
    $rc = $mech->success();
    $out = $mech->status();

    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
        $self->log_and_cont("INFO",$sub,"Fetched $srcurl to $destfile with rc $rc and output $out");
    }

    if($rc == $okrc) {
        $self->ok_msg($msg);
        $rc = 1;
    }
    else {
        $self->fail_msg($msg);
        $rc = 0;
    }

    $self->leave_sub($sub);
    return $rc;
}

sub test_chmod( $$$$$$ ) {
    my($self,$type,$okrc,$msg,$mode,$file) = @_;
    my $sub = "test_chmod";
    $self->enter_sub($sub);
    my $rc = 0;

    if( $okrc eq "" ) {
        $okrc = 1;
    }
    $rc = chmod($mode,"$file");

    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
        $self->log_and_cont("INFO",$sub,"chmod'd $file to $mode");
    }

    if($rc == $okrc) {
        $self->ok_msg($msg);
        $rc = 1;
    }
    else {
        $self->fail_msg($msg);
        $rc = 0;
    }

    $self->leave_sub($sub);
    return $rc;
}

sub test_unlink( $$$$$ ) {
    my($self,$type,$okrc,$msg,$file) = @_;
    my $sub = "test_unlink";
    $self->enter_sub($sub);
    my $rc = 0;

    if( $okrc eq "" ) {
        $okrc = 1;
    }
    $rc = unlink($file);
    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
        $self->log_and_cont("INFO",$sub,"unlink'd $file with rc $rc");
    }

    if($rc >= $okrc) {
        $self->ok_msg($msg);
        $rc = 1;
    }
    else {
        $self->fail_msg($msg);
        $rc = 0;
    }

    $self->leave_sub($sub);
    return $rc;
}

# Do we even want this function? Goes against one-test-per-action philosophy
sub test_unlinkall( $$$$$ ) {
    my($self,$type,$okrc,$msg,$dir) = @_;
    my $sub = "test_unlinkall";
    $self->enter_sub($sub);
    my $rc = 0;

    if( $okrc eq "" ) {
        $okrc = 1;
    }
    my @files = <$dir/*>;
    $rc = unlink(@files);
    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
        $self->log_and_cont("INFO",$sub,"Unlink'd files in $dir with rc $rc");
    }

    $msg .= " Deleted $rc files out of $#files total files.";

    if($rc >= $okrc && $rc == $#files) {
        $self->ok_msg($msg);
        $rc = 1;
    }
    else {
        $self->fail_msg($msg);
        $rc = 0;
    }

    $self->leave_sub($sub);
    return $rc;
}

sub test_symlink( $$$$$$ ) {
    my($self,$type,$okrc,$msg,$srcfile,$destfile) = @_;
    my $sub = "test_symlink";
    $self->enter_sub($sub);
    my $rc = 0;

    if( $okrc eq "" ) {
        $okrc = 1;
    }
    $rc = symlink($srcfile,$destfile);
    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
        $self->log_and_cont("INFO",$sub,"Symlink'd $srcfile to $destfile with rc $rc");
    }

    if($rc == $okrc) {
        $self->ok_msg($msg);
        $rc = 1;
    }
    else {
        $self->fail_msg($msg);
        $rc = 0;
    }

    $self->leave_sub($sub);
    return $rc;
}

sub test_fcopy( $$$$$$ ) {
    my($self,$type,$okrc,$msg,$srcfile,$destfile) = @_;
    my $sub = "test_fcopy";
    $self->enter_sub($sub);
    my $rc = 0;

    if( $okrc eq "" ) {
        $okrc = 1;
    }
    $rc = copy($srcfile,$destfile);
    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
        $self->log_and_cont("INFO",$sub,"Copied $srcfile to $destfile with rc $rc");
    }

    if($rc == $okrc) {
        $self->ok_msg($msg);
        $rc = 1;
    }
    else {
        $self->fail_msg($msg);
        $rc = 0;
    }

    $self->leave_sub($sub);
    return $rc;
}

sub test_fmove( $$$$$$ ) {
    my($self,$type,$okrc,$msg,$srcfile,$destfile) = @_;
    my $sub = "test_fmove";
    $self->enter_sub($sub);
    my $rc = 0;

    if( $okrc eq "" ) {
        $okrc = 1;
    }
    $rc = move($srcfile,$destfile);
    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
        $self->log_and_cont("INFO",$sub,"Moved $srcfile to $destfile with rc $rc");
    }

    if($rc == $okrc) {
        $self->ok_msg($msg);
        $rc = 1;
    }
    else {
        $self->fail_msg($msg);
        $rc = 0;
    }

    $self->leave_sub($sub);
    return $rc;
}

sub test_getsvnrev( $$$$$ ) {
    my($self,$type,$okrc,$msg,$websvn) = @_;
    my $sub = "test_getsvnrev";
    $self->enter_sub($sub);
    my $rc = 0;

    if( $okrc eq "" ) {
        $okrc = 1;
    }
    $rc = $self->get_svn_rev($websvn);
    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
        $self->log_and_cont("INFO",$sub,"Got rev $rc from $websvn");
    }

    if($rc >= $okrc) {
        $self->ok_msg($msg);
    }
    else {
        $self->fail_msg($msg);
        $rc = 0;
    }

    $self->leave_sub($sub);
    return $rc;
}

sub test_fwrite( $$$$$$$ ) {
    my($self,$type,$okrc,$msg,$mode,$file,$text) = @_;
    my($sub,$FILE);
    $sub = "test_fwrite";
    $self->enter_sub($sub);
    my $rc = 0;
        my $temprc;

    if( $okrc eq "" ) {
        $okrc = 2;
    }

    if( "$mode" =~ /^w$/ ) {
        $rc += open($FILE, '>', $file) or $self->log_and_die("ERROR", $sub, "Opening file $file for replace&write failed with return $?: $!");
        if($self->is_log($INFO) || $self->is_log($DEBUG)) {
            $self->log_and_cont("INFO",$sub,"Opened file $file for replace&write.");
        }
    }
    elsif( "$mode" =~ m/^a$/ ) {
        $rc += open($FILE, '>>', $file) or $self->log_and_die("ERROR",$sub, "Opening file $file for appending failed with return $?, rc $rc: $!");
        if($self->is_log($INFO) || $self->is_log($DEBUG)) {
            $self->log_and_cont("INFO",$sub,"Opened file $file for appending.");
        }
    }
    else {
        $self->log_and_die("ERROR",$sub,"Unknown write option: $mode!");
    }
    
    $temprc = print $FILE "$text\n";
    $self->log_and_cont("WARN", $sub, "Writing to filehandle FILE (file $file) failed with return $?, rc $rc, errno $!.") if(!$temprc);
        $rc += $temprc;
    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
        $self->log_and_cont("INFO",$sub,"Wrote text to filehandle FILE.");
    }
    
    $rc += close($FILE) or $self->log_and_die("ERROR", $sub,"Can't close file handle FILE (file $file): $!");
    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
        $self->log_and_cont("INFO",$sub,"Closed filehandle FILE (file $file).");
    }
    
    if($rc >= $okrc) {
        $self->ok_msg($msg);
        $rc = 1;
    }
    else {
        $self->fail_msg($msg);
        $rc = 0;
    }

    $self->leave_sub($sub);
    return $rc;
}

sub test_revfetch( $$$$$$$ ) {
    my($self,$type,$okrc,$msg,$svnrev,$url,$destfile) = @_;
    my $sub = "test_revfetch";
    $self->enter_sub($sub);
    my $rc = 0;
    my($out,$cmd);

    if( $okrc eq "" ) {
        $okrc = 0;
    }

    $cmd = "svn cat -r $svnrev $url > $destfile";
    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
        $self->log_and_cont("INFO",$sub,"Executing $cmd");
    }
    ($rc,$out) = $self->exec_system("$cmd");
    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
        $self->log_and_cont("INFO",$sub,"$cmd returned rc $rc with output $out");
    }

    if($rc == $okrc) {
        $self->ok_msg($msg);
        $rc = 1;
    }
    else {
        $self->fail_msg("$msg: $out,$rc");
        $self->test_unlink($type,"","Unlinking $destfile from url $url at rev $svnrev due to failure.",$destfile);
        $rc = 0;
    }

    $self->leave_sub($sub);
    return $rc;
}

sub test_rename( $$$$$$ ) {
    my($self,$type,$okrc,$msg,$srcfile,$destfile) = @_;
    my $sub = "test_rename";
    $self->enter_sub($sub);
    my $rc;

    if( $okrc eq "" ) {
        $okrc = 1;
    }
    $rc = rename("$srcfile","$destfile");
    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
        $self->log_and_cont("INFO",$sub,"Renamed $srcfile to $destfile with rc $rc");
    }

    if($rc == $okrc) {
        $self->ok_msg($msg);
        $rc = 1;
    }
    else {
        $self->fail_msg($msg);
        $rc = 0;
    }

    $self->leave_sub($sub);
    return $rc;
}

sub test_recrevfetch( $$$$$$ ) {
    my($self,$type,$okrc,$msg,$svnrev,$svndir) = @_;
    my $sub = "test_recrevfetch";
    $self->enter_sub($sub);
    my($rc,$out,$cmd);

    if( $okrc eq "" ) {
        $okrc = 0;
    }

    $cmd = "svn --force export -r $svnrev $svndir";
    ($rc,$out) = $self->exec_system("$cmd");
    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
        $self->log_and_cont("DEBUG",$sub,"Fetched from SVN with command $cmd and rc $rc");
    }

    if($rc == $okrc) {
        $self->ok_msg($msg);
        $rc = 1;
    }
    else {
        $self->fail_msg($msg);
        $rc = 0;
    }

    $self->leave_sub($sub);
    return $rc;
}

sub test_rmtree( $$$$$ ) {
    my($self,$type,$okrc,$msg,$dir) = @_;
    my $sub = "test_rmtree";
    $self->enter_sub($sub);
    my $rc;

    if( $okrc eq "" ) {
        $okrc = 1;
    }
    $rc = rmtree("$dir",0,0);
    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
        $self->log_and_cont("INFO",$sub,"Removed $dir tree with rc $rc");
    }

    if($rc >= $okrc) {
        $self->ok_msg($msg);
        $rc = 1;
    }
    else {
        $self->fail_msg($msg);
        $rc = -1;
    }

    $self->leave_sub($sub);
    return $rc;
}

sub test_getuseruid( $$$$$ ) {
    my($self,$type,$okrc,$msg,$user) = @_;
    my $sub = "test_getuseruid";
    $self->enter_sub($sub);
    my $rc;

    if( $okrc eq "" ) {
        $okrc = 1;
    }

    (undef,undef,$rc,undef) = getpwnam("$user") or $self->log_and_die("ERROR",$sub,"Can't find $user in user database for user lookup: $!");
    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
        $self->log_and_cont("INFO",$sub,"getpwnam $user returned with rc $rc");
    }

    if($rc >= $okrc) {
        $self->ok_msg($msg);
    }
    else {
        $self->fail_msg($msg);
        $rc = -1;
    }

    $self->leave_sub($sub);
    return $rc;
}

sub test_getusergid( $$$$$ ) {
    my($self,$type,$okrc,$msg,$user) = @_;
    my $sub = "test_getusergid";
    $self->enter_sub($sub);
    my $rc;

    if( $okrc eq "" ) {
        $okrc = 1;
    }

    (undef,undef,undef,$rc) = getpwnam("$user") or $self->log_and_die("ERROR",$sub,"Can't find $user in user database for group lookup: $!");
    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
        $self->log_and_cont("INFO",$sub,"getpwnam $user returned with rc $rc");
    }

    if($rc >= $okrc) {
        $self->ok_msg($msg);
    }
    else {
        $self->fail_msg($msg);
        $rc = 0;
    }

    $self->leave_sub($sub);
    return $rc;
}

sub test_lsofkill( $$$$$ ) {
    my($self,$type,$okrc,$msg,$dirname) = @_;
    my $sub = "test_lsofkill";
    $self->enter_sub($sub);
    my(@pids,@pnames,@lsof);
    my($ppid,$rc,$i);
    if( $okrc eq "" ) {
        $okrc = 2;
    }
    
    $rc = 0;
    open(my $LSOF, "lsof|") or $self->log_and_die("ERROR",$sub,"Opening lsof for piping failed with return $?, rc $rc: $!");
    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
        $self->log_and_cont("INFO",$sub,"Running lsof|");
    }
    $rc += $?;
    while( @lsof = split('\s+', <$LSOF> ) ) {
        if($self->is_log($DEBUG)) {
            $self->log_and_cont("DEBUG",$sub,"Got @lsof from lsof");
        }
        if( $lsof[8] && $lsof[8] =~ m/$dirname/ && !($lsof[1] =~ m/(?:$$|getppid())/) && !($lsof[0] =~ m/lsof/) && !$self->in_list(\@pids,$lsof[1])  ) {
            $rc += kill(15,$lsof[1]);
            if($self->is_log($INFO) || $self->is_log($DEBUG)) {
                $self->log_and_cont("INFO",$sub,"Killed $lsof[1]");
            }
            push(@pnames,$lsof[0]);
            push(@pids,$lsof[1]);
        }
    }
    $rc += close($LSOF);
    for($i=0;$i<$#pnames;$i++) {
        $msg .= " $pnames[$i]:$pids[$i]";
    }
    $msg .= "\n";
    
    if($rc >= $okrc) {
        $self->ok_msg($msg);
        $rc = 1;
    }
    else {
        $self->fail_msg($msg);
        $rc = 0;
    }

    $self->leave_sub($sub);
    return $rc;
}

sub test_chown( $$$$$$$ ) {
    my($self,$type,$okrc,$msg,$user,$group,$path) = @_;
    my $sub = "test_chown";
    $self->enter_sub($sub);
    my $rc;

    if( $okrc eq "" ) {
        $okrc = 0;
    }

    $rc = chown($user,$group,$path);
    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
        $self->log_and_cont("INFO",$sub,"chown'd $path to $user:$group");
    }

    if($rc > $okrc) {
        $self->ok_msg($msg);
    }
    else {
        $self->fail_msg($msg);
        $rc = -1;
    }

    if($self->is_log($DEBUG)) {
        $self->log_and_cont("DEBUG",$sub,"Leaving test_chown");
    }
    return $rc;
}

sub test_rsync( $$$$$$ ) {
    my($self,$type,$okrc,$msg,$src,$dst) = @_;
    my $sub = "test_rsync";
    $self->enter_sub($sub);
    my($rc,$out,$cmd);

    if( $okrc eq "" ) {
        $okrc = 0;
    }

    $cmd = "rsync -av $src $dst";
    ($rc,$out) = $self->exec_system("$cmd");
    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
        $self->log_and_cont("INFO",$sub,"Ran $cmd with rc $rc and output $out");
    }

    if($rc == $okrc) {
        $self->ok_msg($msg);
        $rc = 1;
    }
    else {
        $self->fail_msg("$msg,$out");
        $rc = 0;
    }

    $self->leave_sub($sub);
    return $rc;
}

# Type will define what function is run
# This function should be moved into Dc.pm once all tests are entered
sub run_test {
    my $self = shift;
    my @args = @_;
    my $sub = "run_test";
    $self->enter_sub($sub);
    my $metatests = 3;
    my($rc,$out,$type,$okrc,$msg,$i);
    my @cmds;

    if($#args < $metatests ) { # there must be at least one command
        $self->log_and_die("ERROR",$sub,"Not enough arguments to run_test! Minimum of $metatests.");
    }

    $type = $args[0];
    $okrc = $args[1];
    $msg = $args[2];

    @cmds = splice(@args,$metatests);

    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
        $self->log_and_cont("INFO",$sub,"Running test $type");
    }
    if( $type =~ m/^system$/ ) {
        if( $#cmds != 0 ) {
            $self->cmd_num_die(@cmds);
        }
        ($out,$rc) = $self->test_system($type,$okrc,$msg,$cmds[0]);
    }
    elsif( $type =~ m/^chdir$/ ) {
        if( $#cmds != 0 ) {
            $self->cmd_num_die(@cmds);
        }
        $rc = $self->test_chdir($type,$okrc,$msg,$cmds[0]);
    }
    elsif( $type =~ m/^mkpath$/ ) {
        if( $#cmds != 0 ) {
            $self->cmd_num_die(@cmds);
        }
        $rc = $self->test_mkpath($type,$okrc,$msg,$cmds[0]);
    }
    elsif( $type =~ m/^wwwmech$/ ) {
        if( $#cmds != 1 ) {
            $self->cmd_num_die(@cmds);
        }
        $rc = $self->test_wwwmech($type,$okrc,$msg,$cmds[0],$cmds[1]);
    }
    elsif( $type =~ m/^chmod$/ ) {
        if( $#cmds != 1 ) {
            $self->cmd_num_die(@cmds);
        }
        $rc = $self->test_chmod($type,$okrc,$msg,$cmds[0],$cmds[1]);
    }
    elsif( $type =~ m/^unlink$/ ) {
        if( $#cmds != 0 ) {
            $self->cmd_num_die(@cmds);
        }
        $rc = $self->test_unlink($type,$okrc,$msg,$cmds[0]);
    }
    elsif( $type =~ m/^unlinkall$/ ) {
        if( $#cmds != 0 ) {
                $self->cmd_num_die(@cmds);
        }
        $rc = $self->test_unlinkall($type,$okrc,$msg,$cmds[0]);
    }
    elsif( $type =~ m/^symlink$/ ) {
        if( $#cmds != 1 ) {
            $self->cmd_num_die(@cmds);
        }
        $rc = $self->test_symlink($type,$okrc,$msg,$cmds[0],$cmds[1]);
    }
    elsif ( $type =~ m/^fcopy$/ ) {
        if( $#cmds != 1 ) {
            $self->cmd_num_die(@cmds);
        }
        $rc = $self->test_fcopy($type,$okrc,$msg,$cmds[0],$cmds[1]);
    }
    elsif( $type =~ m/^getsvnrev$/ ) {
        if( $#cmds != 0 ) {
            $self->cmd_num_die(@cmds);
        }
        $rc = $self->test_getsvnrev($type,$okrc,$msg,$cmds[0]);
    }
    elsif( $type =~ m/^fwrite$/ ) {
        if( $#cmds != 2 ) {
            $self->cmd_num_die(@cmds);
        }
        $rc = $self->test_fwrite($type,$okrc,$msg,$cmds[0],$cmds[1],$cmds[2]);
    }
    elsif( $type =~ m/^revfetch$/ ) {
        if( $#cmds != 2 ) {
            $self->cmd_num_die(@cmds);
        }
        $rc = $self->test_revfetch($type,$okrc,$msg,$cmds[0],$cmds[1],$cmds[2]);
    }
    elsif( $type =~ m/^recrevfetch$/ ) {
        if( $#cmds != 1 ) {
            $self->cmd_num_die(@cmds);
        }
        $rc = $self->test_recrevfetch($type,$okrc,$msg,$cmds[0],$cmds[1]);
    }
    elsif( $type =~ m/^rename$/ ) {
        if( $#cmds != 1 ) {
            $self->cmd_num_die(@cmds);
        }
        $rc = $self->test_rename($type,$okrc,$msg,$cmds[0],$cmds[1]);
    }
    elsif( $type =~ m/^rmtree$/ ) {
        if($#cmds != 0) {
            $self->cmd_num_die(@cmds);
        }
        $rc = $self->test_rmtree($type,$okrc,$msg,$cmds[0]);
    }
    elsif( $type =~ m/^lsofkill$/ ) {
        if( $#cmds != 0 ) {
            $self->cmd_num_die(@cmds);
        }
        $rc = $self->test_lsofkill($type,$okrc,$msg,$cmds[0]);
    }
    elsif( $type =~ m/^getuseruid$/ ) {
        if( $#cmds != 0 ) {
            $self->cmd_num_die(@cmds);
        }
        $rc = $self->test_getuseruid($type,$okrc,$msg,$cmds[0]);
    }
    elsif( $type =~ m/getusergid$/ ) {
        if( $#cmds != 0 ) {
            $self->cmd_num_die(@cmds);
        }
        $rc = $self->test_getusergid($type,$okrc,$msg,$cmds[0]);
    }
    elsif( $type =~ m/^chown$/ ) {
        if( $#cmds != 2 ) {
            $self->cmd_num_die(@cmds);
        }
        $rc = $self->test_chown($type,$okrc,$msg,$cmds[0],$cmds[1],$cmds[2]);
    }
    elsif( $type =~ m/^fmove$/ ) {
        if( $#cmds != 1 ) {
            $self->cmd_num_die(@cmds);
        }
        $rc = $self->test_fmove($type,$okrc,$msg,$cmds[0],$cmds[1]);
    }
    elsif( $type =~ m/^rsync$/ ) {
        if( $#cmds != 1 ) {
            $self->cmd_num_die(@cmds);
        }
        $rc = $self->test_rsync($type,$okrc,$msg,$cmds[0],$cmds[1]);
    }
    elsif($type =~ m/^rm_lvm$/ ) {
        $rc = $self->test_rm_lvm($type,$okrc,$msg);
    }
    elsif($type =~ m/^regexsub_file$/) {
        if( $#cmds != 2 ) {
            $self->cmd_num_die(@cmds);
        }
        $rc = $self->test_regexsub_file($type,$okrc,$msg,$cmds[0],$cmds[1],$cmds[2]);
    }
        elsif($type =~ m/^read_yaml$/) {
                if( $#cmds != 0 ) {
                        $self->cmd_num_die(@cmds);
                }
                $rc = $self->test_read_yaml($type,$okrc,$msg,$cmds[0]);
        }
        elsif($type =~ m/^mknods$/) {
                if( $#cmds != 1 ) {
                        $self->cmd_num_die(@cmds);
                }
                $rc = $self->test_mknods($type,$okrc,$msg,$cmds[0],$cmds[1]);
        }
    else {
        $self->log_and_die("ERROR",$sub,"This is an undefined test: $type!");
    }

    incr_total($self);
    if($rc) {
        incr_passed($self);
    }

    $self->leave_sub($sub);    
    if(defined($out)) {
        return($out,$rc);
    } else {
        return $rc;
    }
}

sub exec_system( $$ ) {
    my($self,$cmd) = @_;
    my $sub = "exec_system";
    $self->enter_sub($sub);
    my($out,$rc);

    $out = `$cmd 2>&1`;
    $rc = WEXITSTATUS($?);

    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
        $self->log_and_cont("INFO",$sub,"Ran $cmd with rc $rc and output $out");
    }

    $self->leave_sub($sub);
    return ($rc,$out);
}

sub print_hash ( $% ) {
    my($self,%h) = @_;
    my $sub = "print_hash";
    $self->enter_sub($sub);
    
    foreach my $k (sort keys %h) {
        print "$k => $h{$k}\n";
    }
    $self->leave_sub($sub);
}

sub mech_error( $$ ) {
    my($self,$mech) = @_;
    my $sub = "mech_error";
    $self->enter_sub($sub);
    $self->leave_sub($sub);
    return "HTTP status: ".$mech->status."\n";
}

sub in_list( $$$ ) {
    my($self,$list_ref,$s) = @_;
    my $sub = "in_list";
    $self->enter_sub($sub);
    my @list = @{$list_ref};

    if( $#list > 0 ) {
        foreach my $x ( @list ) {
            if( "$x" eq "$s" ) {
                $self->leave_sub($sub);
                return 1;
            }
        }
        $self->leave_sub($sub);
        return 0;
    }
    else {
        $self->leave_sub($sub);
        return 0;
    }
}

sub get_stage( $ ) {
    my($self) = @_;
    my $sub = "get_state";
    $self->enter_sub($sub);
    if( !(-f "/etc/$PROJECT-stage") ) {
        $self->leave_sub($sub);
        return "BUILD"; # Should only true for build system
    }

    $self->leave_sub($sub);
    return $self->snarf_file("/etc/$PROJECT-stage");
}

sub get_svn_rev( $$ ) {
    my($self,$svnurl) = @_;
    my $sub = "get_svn_rev";
    $self->enter_sub($sub);
    my $mech = WWW::Mechanize->new();
    
    $mech->get($svnurl);
    if( !$mech->success() ) {
        $self->log_and_die("ERROR","get_svn_rev","Could not fetch $svnurl: $mech->status()!");
    }

    $self->leave_sub($sub);
    if( ($mech->content( format => 'text' )) =~ m/^svn\s-\sRevision\s+(\d+):/ ) {
        return $1;
    }

    return 0;
}

sub get_rev( $ ) {
    my($self) = @_;
    my $sub = "get_rev";
    $self->enter_sub($sub);

    if( !(-f "/etc/$PROJECT-revision") ) {
        $self->leave_sub($sub);
        return 0; # Invalid for build system
    }

    $self->leave_sub($sub);
    return $self->snarf_file("/etc/$PROJECT-revision");
}

sub get_project( $ ) {
    my($self) = @_;
    my $sub = 'get_project';
    $self->enter_sub($sub);

    $self->leave_sub($sub);
    return $PROJECT;
}

sub get_passed( $ ) {
    my $self = shift;
    my $sub = "get_passed";
    $self->enter_sub($sub);
    $self->leave_sub($sub);
    return $passed;
}

sub get_total( $ ) {
    my $self = shift;
    my $sub = "get_total";
    $self->enter_sub($sub);
    $self->leave_sub($sub);
    return $total;
}

sub incr_passed {
    my $self = shift;
    my $sub = "incr_passed";
    $self->enter_sub($sub);
    $self->leave_sub($sub);
    $passed++;
    return $passed;
}

sub incr_total( $ ) {
    my $self = shift;
    my $sub = "incr_total";
    $self->enter_sub($sub);
    $self->leave_sub($sub);
    $total++;
}

sub ok_msg( $$ ) {
    my($self,$msg) = @_;
    my $sub = "ok_msg";
    $self->enter_sub($sub);
    $self->leave_sub($sub);
    print "ok ".get_total($self)." - $msg\n";
}

sub fail_msg( $$ ) {
    my($self,$msg) = @_;
    my $sub = "fail_msg";
    $self->enter_sub($sub);
    $self->leave_sub($sub);
    print "not ok ".get_total($self)." - $msg\n";
}

sub redirect_stdio( $ ) {
    my $self = shift;
    my $sub = "redirect_stdio";
    $self->enter_sub($sub);
    my($outdir) = @_;
    open(STDOUT, '>', "$outdir/$ALLOUTFILE") or
        $self->log_and_die("ERROR","redirect_stdio","Can't open file $outdir/$ALLOUTFILE: $!");
    open(STDERR, ">&STDOUT");
    $self->leave_sub($sub);
}

sub close_stdio( $ ) {
    my $self = shift;
    my $sub = "close_stdio";
    $self->enter_sub($sub);
    close(STDERR);
    close(STDOUT);
    $self->leave_sub($sub);
}

sub get_lvmroot( $ ) {
    my $self = shift;
    my $sub = "get_lvmroot";
    $self->enter_sub($sub);

    $self->leave_sub($sub);
    return $LVMROOT;
}

sub set_debug( $$ ) {
    my($self,$log) = @_;
    my $sub = "set_debug";
    $self->enter_sub($sub);
    if($log eq 'INFO') {
        $LOG |= $INFO;
    }
    elsif($log eq 'DEBUG') {
        $LOG |= $DEBUG;
    }
    else {
        $self->log_and_cont("WARN","set_debug","Unknown log setting $log");
    }
    $self->leave_sub($sub);
}

sub unset_debug( $$ ) {
    my($self,$log) = @_;
    my $sub = "unset_debug";
    $self->enter_sub($sub);
    if($log eq 'INFO') {
        $LOG &= ~$INFO;
    }
    elsif($log eq 'DEBUG') {
        $LOG &= ~$DEBUG;
    }
    else {
        $self->log_and_cont("WARN","unset_debug","Unknown log setting $log");
    }
    $self->leave_sub($sub);
}

# No debug statements to avoid circular references now
sub is_log( $$ ) {
    my($self,$log) = @_;
    return ($LOG & $log);
}

# Fetch from /proc/cmdline
sub get_cmdline( $ ) {
    my($self) = @_;
    my $sub = "get_cmdline";
    $self->enter_sub($sub);
    $self->leave_sub($sub);
    return $self->snarf_file("$CMDLINE_FILE");
}

# Parse a value-key tuple out of /proc/cmdline
sub parse_cmdline( $$ ) {
    my($self,$key) = @_;
    my($sub,$cmdline,$value);
    $sub = "parse_cmdline";
    $self->enter_sub($sub);

    foreach my $line ( split('\s+',$self->get_cmdline() ) ) {
        if( $line =~ m/^$key="?(.*?)"?$/ ) {
            return $1;
        }
        elsif($line =~ m/$key/) {
            return 1;
        }
    }

    $self->leave_sub($sub);
    return 0;
}

sub parse_nic_conf( $$ ) {
    my($self,$cmdline) = @_;
    my $sub = "parse_nic_conf";
    $self->enter_sub($sub);
    my @nicsconf;

    if($cmdline =~ m/nics=\"(.*)\"/) {
        @nicsconf = split ':', $1;
    } else {
        $self->leave_sub($sub);
        return @nicsconf;
    }
    
    $self->leave_sub($sub);
    return @nicsconf;
}

sub get_eth_nics( $ ) {
    my($self) = @_;
    my $sub = "get_eth_nics";
    $self->enter_sub($sub);
    my $line;
    my @nics;
    open(my $IF, "$IFCONFIG |") or $self->log_and_die("ERROR",$sub,"Can't open $IFCONFIG for piping: $!");

    while($line = <$IF>) {
        chomp $line;
        if($line =~ m/^(eth\d+(\:\d+)*)\s+Link\sencap:Ethernet/) {
            $self->log_and_cont("INFO",$sub,"Found NIC $1")
                if($self->is_log($INFO) || $self->is_log($DEBUG));
            push(@nics,$1);
        }
    }
    
    close($IF);

    $self->leave_sub($sub);

    return @nics;
}

sub flash_nic( $$$ ) {
    my($self,$nic,$sec) = @_;
    my $sub = "flash_nic";
    $self->enter_sub($sub);
    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
        $self->log_and_cont("INFO",$sub,"Flashing NIC $nic for $sec seconds.");
    }
    $self->exec_system("ethtool -p $nic $sec");
    $self->leave_sub($sub);
    return WEXITSTATUS($?);
}

sub conf_nics( $$$ ) {
    my($self,$nicsconf_ref,$nics_ref) = @_;
    my $sub;
    my @auto;
    $sub = "conf_nics";
    $self->enter_sub($sub);
    my @nicsconf = @{ $nicsconf_ref };
    my @nics = @{ $nics_ref };
    my($stdin,$rc,$sec);
    
    $sec = 10; # Flash NICs for 10 seconds
    
    if($#nics < $#nicsconf) {
        $self->log_and_cont("WARN",$sub,"Fewer NICs than conf options; configuring all we can...");
    }
    
    push(@auto,'lo');
    open(my $INT, '>', $INTFILE) or $self->log_and_die("ERROR",$sub,"Can't open $INTFILE for writing: $!");
    print $INT "iface lo inet loopback\n\n";
    
    for(my $i=0;$i<=$#nics;$i++) {
        print STDERR "We're configuring NIC $i\n";
        print STDERR "Plug in the cable where the NIC is flashing. The NIC will flash for $sec seconds.\n";
        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));
        push(@auto,$nics[$i]); # All NICs need auto at once
        if($nicsconf[$i] eq 'dhcp') {
            print $INT "iface $nics[$i] inet dhcp\n";
        }
        elsif($nicsconf[$i] =~ m/((?:\d{1,3}\.){1,3}\d{1,3})\/((?:\d{1,3}\.){1,3}\d{1,3})/) {
            print $INT "iface $nics[$i] inet static\n";
            print $INT "\taddress $1\n";
            print $INT "\tnetmask $2\n";
        }
        print STDERR "Press any key to continue.\n";
        $stdin = <STDIN>;
        print "\n\n";
    }
    print $INT "auto ".reverse(sort(@auto))."\n";
    
    close($INT);
    $self->leave_sub($sub);
}

sub nic_dialog {
    my($self) = @_;
    my @nics;
    my $nic_conf;
    my $sub='nic_dialog';
    my $d = new UI::Dialog (backtitle => "Configure NICS",
                            listheight => 10, height => 20);
    
    foreach my $nic ($self->get_eth_nics()) {
        push(@nics,($nic,["",0]));
    }
    
    my @chosen_nics = $d->checklist(text => "Pick NICs to configure.",
                                    list => \@nics);
    if(!$self->is_dialog_ok($d)) {
        return undef;
    }
    
    foreach my $nic (@chosen_nics) {
        $nic_conf->{$nic} = $self->config_nic_dialog($d,$nic);
        if(!defined($nic_conf->{$nic})) {
            return undef;
        }
    }
    
    $self->config_interfaces($nic_conf);
    
    return $nic_conf;
}

sub require_bccd_server {
    my($self) = @_;
    my($sub,$dhc,$replace,$rc);
    $sub='require_bccd_server';

        $rc = 0;

        $rc += $self->run_test('unlink','','Unlinking dhclient.conf for BCCD.',$DHCFILE);
        $rc += $self->run_test('symlink','','Relinking dhclient.conf for BCCD.',"$DHCFILE-bccd",$DHCFILE);

        return $rc;
}

sub unrequire_bccd_server {
    my($self) = @_;
    my($sub,$dhc,$replace,$rc);
    $sub='unrequire_bccd_server';

        $rc = 0;

        $rc += $self->run_test('unlink','','Unlinking dhclient.conf for BCCD.',$DHCFILE);
        $rc += $self->run_test('symlink','','Relinking dhclient.conf for BCCD.',"$DHCFILE-any",$DHCFILE);

        return $rc;
}

sub config_interfaces{
    my($self,$nic_conf) = @_;
    my($sub,$rc);
    my @auto;
    $sub='config_interfaces';
        $self->enter_sub($sub);
    
    open(my $INT, '>', $INTFILE) or
        $self->log_and_die("ERROR",$sub,"Couldn't open $INTFILE: $!");
    
    push(@auto,'lo');
    print $INT "iface lo inet loopback\n\n";

    foreach my $nic (keys(%{$nic_conf})) {
        if($nic_conf->{$nic}->{'dhcp'}) {
            push(@auto,$nic);
            print $INT "iface $nic inet dhcp\n\n";
            if(defined($nic_conf->{$nic}->{'dhcp_source'}) && $nic_conf->{$nic}->{'dhcp_source'} eq 'BCCD') {
                if($self->require_bccd_server() > 2) {
                    $self->log_and_die("ERROR",$sub,"Couldn't set BCCD server in dhclient.");
                }
            }
            else {
                if($self->unrequire_bccd_server() > 2) {
                    $self->log_and_die("ERROR",$sub,"Couldn't unset BCCD server in dhclient.");
                }
            }
        }
        elsif(defined($nic_conf->{$nic}->{'ipaddr'}) && defined($nic_conf->{$nic}->{'mask'})) {
            push(@auto,$nic);
            print $INT "iface $nic inet static\n";
            print $INT "\taddress $nic_conf->{$nic}->{'ipaddr'}\n";
            print $INT "\tnetmask $nic_conf->{$nic}->{'mask'}\n";
            if(defined($nic_conf->{$nic}->{'bcast'})) {
                print $INT "\tbroadcast $nic_conf->{$nic}->{'bcast'}\n";
            }
            if(defined($nic_conf->{$nic}->{'gw'})) {
                print $INT "\tgateway $nic_conf->{$nic}->{'gw'}\n";
            }
        }
    }
    @auto = sort(@auto);
    print $INT "auto @auto\n";
    close($INT);
    $self->leave_sub($sub);

        return $nic_conf;
}

sub check_bccd_net{
        my($self,$nic_conf) = @_;
        my $sub = 'check_bccd_net';

        foreach my $nic (keys(%{$nic_conf})) {
                if(defined($nic_conf->{$nic}->{'dhcp_source'}) &&
                        $nic_conf->{$nic}->{dhcp_source} eq 'BCCD') {
                        return 1;
                }
        }

        return undef;
}

sub config_dhcp{
    my($self,$nic_conf) = @_;
    my($sub,$pubnetip,$j,$oneip,$file,$pubnet,$pxenet,$havedhcp,
       $bcast,$mask,$i,$rc,$out,$pxenic,$pxenetip,$addr,$dhcpnic,
       $destfile);
    $sub = 'config_dhcp';
    
    $havedhcp = 0;
  FIND_PXE_NIC:
    foreach my $nic (keys(%{$nic_conf})) {
        if(defined($nic_conf->{$nic}->{'pxenic'})) {
            $pxenic = $nic;
            last FIND_PXE_NIC;
        }
    }
    
    foreach my $nic (keys(%{$nic_conf})) {
        if(defined($nic_conf->{$nic}->{'dhcp_source'}) &&
           $nic_conf->{$nic}->{'dhcp_source'} eq 'BCCD') {
            $havedhcp = 1;
        }
    }
    
  HAVE_DHCP: foreach my $nic (keys(%{$nic_conf})) {
      if(defined($nic_conf->{$nic}->{'bccdnet'})) {
          $dhcpnic = $nic;
          last HAVE_DHCP;
      }
  }
    
    if(defined($pxenic)) {
        $pxenetip = new NetAddr::IP($nic_conf->{$pxenic}->{'ipaddr'},$nic_conf->{$pxenic}->{'mask'}) ||
            $self->log_and_die("ERROR",$sub,"Couldn't create network IP object for $nic_conf->{$pxenic}->{'ipaddr'}: $!");
        if(!defined($nic_conf->{$pxenic}->{'gw'})) {
            $nic_conf->{$pxenic}->{'gw'} = $nic_conf->{$pxenic}->{'ipaddr'};
        }
    }
    $pubnetip=new NetAddr::IP($BCCD_NET->{'ipaddr'},$BCCD_NET->{'mask'}) ||
        $self->log_and_die("ERROR",$sub,"Couldn't create network IP object for $BCCD_NET->{'ipaddr'}: $!");
    
    $oneip=new NetAddr::IP('0.0.0.1') || # Addition doesn't work the way it should
        $self->log_and_die("ERROR",$sub,"Couldn't create singleton IP object: $!");
    
    $pubnet->{'network'} = $pubnetip->network();
    $pubnet->{'network'} =~ s/\/\d+$//g;
    $pubnet->{'bcast'} = $pubnetip->broadcast();
    $pubnet->{'bcast'} =~ s/\/\d+$//g;
    $pubnet->{'mask'} = $pubnetip->mask();
    if(defined($pxenic)) {
        $pxenet->{'network'} = $pxenetip->network();
        $pxenet->{'network'} =~ s/\/\d+$//g;
        $pxenet->{'bcast'} = $pxenetip->broadcast();
        $pxenet->{'bcast'} =~ s/\/\d+$//g;
        $pxenet->{'mask'} = $pxenetip->mask();
        $pxenet->{'next'} = $pxenetip->addr();
        $pxenet->{'first'} = $pxenetip->first();
        $pxenet->{'first'} =~ s/\/\d+$//g;
        $pxenet->{'last'} = $pxenetip->last();
        $pxenet->{'last'} =~ s/\/\d+$//g;
    }
    
    open(my $HOSTS,'>','/etc/hosts') or $self->log_and_die("ERROR",$sub,"Can't open file /etc/hosts: $!");
    print $HOSTS "127.0.0.1\tlocalhost\n";
    
    $j = 0;
    # Increment to first DHCP address
    for($i=1;$i<$DHCP_RANGES->{'res'};$i++) {
        if(defined($dhcpnic) && $pubnetip->addr() eq $nic_conf->{$dhcpnic}->{'ipaddr'}) {
            print $HOSTS sprintf("%s\tnode%.3d.bccd.net node%.3d %s %s\t# Reserved IP\n", $pubnetip->addr(), $j, $j,
                                 $HOSTNAME, $SHORT_HOSTNAME);
        }
        else {
            print $HOSTS sprintf("%s\tnode%.3d.bccd.net node%.3d\t# Reserved IP\n", $pubnetip->addr(), $j, $j);
        }
        $pubnetip++;
        $j++;
    }
    
    $pubnet->{'dhcprange'} = $pubnetip->addr();
    
    for($i=0;$i<$DHCP_RANGES->{'dhcp'};$i++) {
        print $HOSTS sprintf("%s\tnode%.3d.bccd.net node%.3d\t#DHCP IP\n", $pubnetip->addr(), $j, $j);
        $pubnetip++;
        $j++;
    }
    
    $pubnet->{'dhcprange'} .= " ".$pubnetip->addr();
    
    if(defined($pxenic)) {
        $i = 0;
        while( $pxenetip->addr() ne $pxenet->{'last'} ) {
            print $HOSTS sprintf("%s\tpxenode%.3d.bccd.net pxenode%.3d\t#PXE IP\n", $pxenetip->addr(), $i, $i);
            $pxenetip++;
            if($i == 10) {
                $pxenet->{'firstip'} = $pxenetip->addr();
            }
            elsif($i == 100) {
                $pxenet->{'lastip'} = $pxenetip->addr();
                last;
            }
            $i++;
        }
        if(!defined($pxenet->{'firstip'}) || !defined($pxenet->{'lastip'})) {
            $self->log_and_die("ERROR",$sub,"No PXE IP range defined!");
        }
    }
    close($HOSTS);
    open(my $DCONF,'>',$DHCP_CONF) ||
        $self->log_and_die("ERROR",$sub,"Can't open file $DHCP_CONF: $!");
    
    print $DCONF "allow bootp;\nallow booting;\n\n";
    print $DCONF "subnet $pubnet->{'network'} netmask $pubnet->{'mask'} {\n";
    print $DCONF "\toption subnet-mask $pubnet->{'mask'};\n";
    print $DCONF "\toption broadcast-address $pubnet->{'bcast'};\n";
    print $DCONF "\toption routers $BCCD_NET->{'ipaddr'};\n";
    print $DCONF "\tpool {\n";
    print $DCONF "\t\tallow members of \"bccd-nodes\";\n";
    print $DCONF "\t\trange $pubnet->{'dhcprange'};\n";
    print $DCONF "\t}\n";
    print $DCONF "}\n";
    
    if(defined($pxenic)) {
        print $DCONF "subnet $pxenet->{'network'} netmask $pxenet->{'mask'} {\n";
        print $DCONF "\toption subnet-mask $pxenet->{'mask'};\n";
        print $DCONF "\toption broadcast-address $pxenet->{'bcast'};\n";
        print $DCONF "\toption routers $nic_conf->{$pxenic}->{'gw'};\n";
        print $DCONF "\tpool {\n";
        print $DCONF "\t\trange $pxenet->{'firstip'} $pxenet->{'lastip'};\n";
        print $DCONF "\t\tallow members of \"pxelinux-nodes\";\n";
        print $DCONF "\t\tfilename \"pxelinux.0\";\n";
        print $DCONF "\t\tnext-server $nic_conf->{$pxenic}->{'ipaddr'};\n";
        print $DCONF "\t\toption root-path \"$nic_conf->{$pxenic}->{'ipaddr'}:/,nfsvers=3,tcp,hard\";\n";
        print $DCONF "\t}\n";
        print $DCONF "}\n";
        open(my $PCONF, '>', $PXELINUX) ||
            $self->log_and_die("ERROR",$sub,"Can't open file $PXELINUX: $!");
        
        print $PCONF "default bccd\n";
        print $PCONF "label bccd\n";
        print $PCONF "\tkernel vmlinuz-$KERNREV\n";
        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";
        
        close($PCONF);
        if(-d "/diskless/$PROJECT") {
            open(my $FCONF, '>', $DISKLESS_FSTAB) ||
                $self->log_and_die("ERROR",$sub,"Can't open file $DISKLESS_FSTAB: $!");
            
            print $FCONF "$nic_conf->{$pxenic}->{'ipaddr'}:/bccd/home  /bccd/home   nfs     nfsvers=3,tcp,rsize=32768,wsize=32768,hard,intr 0 0\n";
            
            close($FCONF);
        }
    }
    
    close($DCONF);

        if($self->parse_cmdline("recoverdhcp")) {
                my($recentmach,$i,$latestts,$ft);
                $ft = new File::Temp();
                Readonly my $SLEEP => 60;
                Readonly my $PWD => getcwd();
                my $tempdir = $ft->tempdir("DHCP",CLEANUP => 0);
                my(undef,undef,$uid,$gid) = getpwnam('bccd');
                chown($uid, $gid, $tempdir);
                $rc = $self->run_test("rmtree","","Removing /etc/network/run",'/etc/network/run');
                if($rc) {
                        $self->log_and_cont("ERROR",$sub,"Couldn't remove /etc/network/run");
                }
                $rc = $self->run_test("mkpath","","mkdir /etc/network/run",'/etc/network/run');
                if($rc) {
                        $self->log_and_cont("ERROR",$sub,"Couldn't remake /etc/network/run");
                }
                ($out,$rc) = $self->run_test("system","","touch /etc/network/run/ifstate","touch /etc/network/run/ifstate");
                if(!$rc) {
                        $self->log_and_cont("ERROR",$sub,"Couldn't touch /etc/network/run/ifstate: $out");
                }
                ($out,$rc) = $self->run_test("system","","Starting networking","/etc/init.d/networking start"); # No invoke-rc.d because utmp has not been updated
                if(!$rc) {
                        $self->log_and_cont("ERROR",$sub,"Couldn't start networking: $out");
                }
                ($out,$rc) = $self->run_test("system","","Starting snmpd","/usr/sbin/invoke-rc.d snmpd start");
                if(!$rc) {
                        $self->log_and_cont("ERROR",$sub,"Couldn't start snmpd: $out");
                }
                ($rc,$out) = $self->run_test("system","","Starting DHCP server","/usr/sbin/invoke-rc.d dhcp3-server stop");
                if(!$rc) {
                        $self->log_and_cont("ERROR",$sub,"Couldn't stop DHCP server: $out");
                }
                ($rc,$out) = $self->run_test("system","","Starting sshd","/usr/sbin/invoke-rc.d ssh start");
                if(!$rc) {
                        $self->log_and_cont("ERROR",$sub,"Couldn't start ssh: $out");
                }
                ($rc,$out) = $self->run_test("system","","Starting BCCD autodetection",qq{su bccd -c "/bin/bccd-auto-ssh > /tmp/bccd-auto-ssh.out 2>&1" });

                $self->log_and_cont("INFO",$sub,"Waiting for responses, sleeping $SLEEP seconds...");
                sleep($SLEEP);
        
                chdir($tempdir);
                ($rc,$out) = $self->run_test("system","","Snarfing hosts",qq{su bccd -c "/bin/bccd-snarfhosts $tempdir/machines"});
                if($rc) {
                        $self->log_and_cont("ERROR",$sub,"Couldn't snarf hosts, $out");
                }

                open(my $MACHINES, "$tempdir/machines") or
                        $self->log_and_die("ERROR",$sub,"Can't open file $tempdir/machines: $!\n");
                $i = $latestts = 0;
                while(my $line = <$MACHINES>) {
                        chomp $line;
                        my $machine = (split(/\s+/,$line))[0];
                        if($self->is_log($DEBUG)) {
                                $self->log_and_cont("INFO",$sub,"Processing $machine for DHCP leases");
                        }
                        if($i++ > 0) { # The head node always appears first, and should not be processed
                                my $leases;
                                $destfile = "$tempdir/$machine"."_dhcpd.leases";
                                ($rc,$out) = $self->run_test("system","","Copying lease from $machine",qq{su bccd -c "scp $machine:/var/tmp/dhcpd.leases $destfile"});
                                if(!$rc) {
                                        $self->log_and_cont("WARN",$sub,"Couldn't copy lease file from $machine");
                                }
                                else {
                                        $leases = $self->snarf_file($destfile);
                                        if(!defined($leases)) {
                                                $self->log_and_cont("WARN",$sub,"Couldn't read lease file from $machine");
                                        }
                                        if($leases =~ m{^#\s+BCCD TS:\s+(\d+)$}m) {
                                                if($1 > $latestts) {
                                                        $latestts = $1;
                                                        $recentmach = $machine;
                                                        if($self->is_log($DEBUG)) {
                                                                $self->log_and_cont("INFO",$sub,"$machine is most recent");
                                                        }
                                                }
                                        }
                                }
                        }
                }
                if(defined($recentmach)) {
                        if($self->is_log($DEBUG)) {
                                $self->log_and_cont("INFO",$sub,"Copied $tempdir/$recentmach"."_dhcpd.leases to /var/lib/dhcp3/dhcpd.leases");
                        }
                        $rc = $self->run_test("fcopy","","Copying $tempdir/$recentmach"."_dhcpd.leases -> /var/lib/dhcp3/dhcpd.leases","$tempdir/$recentmach"."_dhcpd.leases","/var/lib/dhcp3/dhcpd.leases");
                        if(!$rc) {
                                $self->log_and_die("ERROR",$sub,"Couldn't move lease from $recentmach into place.");
                        }
                }
                $self->run_test("system","","Killing pkbcast","killall pkbcast");
                $self->run_test("system","","Killing bccd-allow-all","killall bccd-allow-all");
                close($MACHINES);
        }
    
    if(!$havedhcp) {
        ($rc,$out) = $self->exec_system("update-rc.d dhcp3-server defaults");
        if($rc == 0) {
            $self->log_and_cont("NOTICE",$sub,"Set DHCP server to start.\n");
        }
        else {
            $self->log_and_die("ERROR",$sub,"Couldn't set DHCP server to start: $out\n");
        }
    }
    else {
        ($rc,$out) = $self->exec_system("update-rc.d -f dhcp3-server remove");
        if($rc == 0) {
            $self->log_and_cont("NOTICE",$sub,"Set DHCP server not to start.\n");
        }
        else {
            $self->log_and_die("NOTICE",$sub,"Couldn't set DHCP server not to start: $out\n")
        }
    }
    return $nic_conf;
}

sub config_nat{
        my($self,$nic_conf) = @_;
        my($natnic,$sub);
        $sub = 'config_nat';
    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
                $self->log_and_cont('INFO',$sub,"Gathering routing information");
        }

    open(my $NETSTAT, '-|', '/bin/netstat', '-rn') or
        $self->log_and_die("ERROR",$sub,"Couldn't open up netstat for piping!");

    NETSTAT:
    while(my $line = <$NETSTAT>) {
        chomp $line;
        my @splitline = split(/\s+/, $line);
        if($splitline[0] eq '0.0.0.0') {
            if($self->is_log($INFO) || $self->is_log($DEBUG)) {
                $self->log_and_cont('INFO',$sub,"$splitline[7] is a default router");
            }
            $natnic = $splitline[7];
            last NETSTAT;
        }
    }
    close($NETSTAT);

        if(defined($natnic)) {
        if($self->is_log($INFO) || $self->is_log($DEBUG)) {
                        $self->log_and_cont('INFO',$sub,"Writing out $NATSH");
                }
                open(my $NAT, '>', $NATSH) or
                        $self->log_and_die("ERROR",$sub,"Couldn't open $NATSH for writing: $!");

                my $natip = $self->get_nic_ip($natnic);
                if(!defined($natip)) {
                        $self->log_and_die("ERROR",$sub,"Couldn't get IP address for $natnic!");
                }

                print $NAT qq{#!/bin/bash\n\n};
                foreach my $LINE (
                                                                q{--flush},
                                                                q{-t nat --flush},
                                                                q{--delete-chain},
                                                                q{-t nat --delete-chain},
                                                                qq{-t nat -A POSTROUTING -s 192.168.3.0/24 -j SNAT --to $natip},
                                                        ) {
                        print $NAT "/sbin/iptables $LINE\n";
                }

                close($NAT);
        if($self->is_log($INFO) || $self->is_log($DEBUG)) {
                        $self->log_and_cont('INFO',$sub,"Making $NATSH executable");
                }
                chmod(S_IRWXU|S_IRGRP|S_IXGRP|S_IROTH|S_IXOTH, $NATSH) or
                        $self->log_and_die("ERROR",$sub,"Couldn't set $NATSH to be executable: $!");
                
                return 1;
        }
        return undef;
}

sub is_dialog_ok {
    my($self,$d) = @_;
    
    if($d->state() eq 'OK') {
        return 1;
    }
    
    return undef;
}

sub config_nic_dialog {
    my($self,$d,$nic_conf) = @_;
    my($temp,$bccd_nic,$gotpxe,$dhcp_source,$sub,$rc);
    $sub = 'config_nic_dialog';
    
    $gotpxe = 0;
    
  FIND_EXT_NIC:
    {
        my @dhcp_nics;
        # See if there's a BCCD server response
        foreach my $nic (keys(%{$nic_conf})) {
            if(defined($nic_conf->{$nic}->{'dhcp_source'})
                && $nic_conf->{$nic}->{'dhcp_source'} eq 'BCCD') {
                $dhcp_source = 'BCCD';
            }
        }
        foreach my $nic (sort(keys(%{$nic_conf}))) {
            # Only if we didn't pick up a BCCD server
            if((defined($nic_conf->{$nic}->{'dhcp_source'}) && $nic_conf->{$nic}->{'dhcp_source'} ne 'BCCD') || !defined($dhcp_source)) {
                push(@dhcp_nics,($nic,$nic));
            }
        }
        if($#dhcp_nics == 1) {
            $bccd_nic = $dhcp_nics[0];
        } 
                elsif($#dhcp_nics > 1 and not -e '/testmode') {
                        $bccd_nic = $d->menu(text=>"Choose NIC to have BCCD network.", list => \@dhcp_nics);
                        if(!$self->is_dialog_ok($d)) {
                                redo FIND_EXT_NIC;
                        } 
                }else {
                        open (TEST,'</bccd_boot_flags') or croak "$!";
                my      @command = grep (/BCCD_NIC/, <TEST>);
                        if ($command[0] =~ m/export BCCD_NIC=(.*)$/){
                                $bccd_nic = $1;
                        }
                        print STDERR "$bccd_nic selected for BCCD network\n"
                }
                # Copy iptables template regardless of NAT Status
                open(my $IPT, '>', $IPTABLES_UP) or
                        $self->log_and_die("ERROR",$sub,
                                "Couldn't open $IPTABLES_UP for appending: $!");
                foreach my $LINE (
                                                        q{*filter},
                                                        q{:INPUT ACCEPT [6562:602865]},
                                                        q{:FORWARD ACCEPT [100:8276]},
                                                        q{:OUTPUT ACCEPT [5836:748341]},
                                                        q{COMMIT},
                                                ) {
                        print $IPT "$LINE\n";
                }
                close($IPT);
        if(defined($bccd_nic) && !$self->check_bccd_net($nic_conf)) {
            $nic_conf->{"$bccd_nic:1"} = $BCCD_NET;
                        open(my $IPT, '>>', $IPTABLES_UP) or
                                $self->log_and_die("ERROR",$sub,
                                        "Couldn't open $IPTABLES_UP for appending: $!");
                        print $IPT qq{-A POSTROUTING -o $bccd_nic -j MASQUERADE\n};
                        print $IPT qq{COMMIT\n};
                        print $IPT qq{# Completed on Wed Jul 15 23:51:28 2009\n};
                        close($IPT);
        }

      NIC_CONF:
        foreach my $nic (sort keys %{$nic_conf}) {
            if(defined($nic_conf->{$nic}->{'ipaddr'}) && defined($nic_conf->{$nic}->{'dhcp_source'}) &&
               $nic_conf->{$nic}->{'dhcp_source'} eq 'BCCD') {
                if(!$self->parse_cmdline('standalone')) {
                    $nic_conf->{$nic}->{'dhcp'} = 1;
                }
            }
            elsif(defined($nic_conf->{$nic}->{'dhcp_source'}) 
                        && ((-e '/testmode') || ($d->yesno(text=>"$nic has an IP address $nic_conf->{$nic}->{'ipaddr'} from $nic_conf->{$nic}->{'dhcp_source'}. Take this address?")
                        ))) {
                $nic_conf->{$nic}->{'dhcp'} = 1;
            }
            else {
                $nic_conf->{$nic}->{'dhcp'} = 0;
            }
            if($nic_conf->{$nic}->{'dhcp'} == 0 && !defined($nic_conf->{$nic}->{'ipaddr'})
             && ! -e '/testmode' 
                         && ! $d->yesno(text=>"No DHCP for $nic, skip?")) {
                $nic_conf->{$nic}->{'dhcp'} = 0;
            }
                        else {
                                next NIC_CONF;
                        }
                        if($nic_conf->{$nic}->{'dhcp'} == 0) {
FIND_CUR_NIC:
                                do {
                                        if (-e '/testmode'){
                                                $nic_conf->{$nic}->{'ipaddr'} = '192.168.0.*';
                                        }else{
                                                $nic_conf->{$nic}->{'ipaddr'} =
                                                ($temp = $d->inputbox(text=>
                                                "$nic IP address (mandatory)")) ? $temp : undef;

                                                if(!$self->is_dialog_ok($d)) {
                                                        redo FIND_EXT_NIC;
                                                }
                                                elsif($nic_conf->{$nic}->{'ipaddr'}
                                                         eq $BCCD_NET->{'ipaddr'}) {
                                                        $d->msgbox(text =>
                 "IP address cannot be the BCCD virtual IP ($BCCD_NET->{'ipaddr'}).");
                                                        goto FIND_CUR_NIC;
                                                }
                                        }
                   
                                        if (-e '/testmode'){ 
                                                $nic_conf->{$nic}->{'mask'} = "255.255.255.0";
                                        } else {
                                                $nic_conf->{$nic}->{'mask'} =
                                                ($temp = $d->inputbox(text=>
                                                 "$nic Subnet mask (mandatory)")) ? $temp : undef;
                    
                                                if(!$self->is_dialog_ok($d)) {
                                                        redo FIND_EXT_NIC;
                                                }
                                        }
                    
                    $nic_conf->{$nic}->{'gw'} = ($temp = $d->inputbox(text=>"$nic Gateway (optional)")) ? $temp : undef;
                    
                    if(!$gotpxe && $self->get_stage() eq 'LIBERATED' && $d->yesno(text=>"Make $nic the PXE-capable NIC?")) {
                        $gotpxe = 1;
                        $nic_conf->{$nic}->{'pxenic'} = $nic;
                    }
                } while(!defined($nic_conf->{$nic}->{'ipaddr'}) || !defined($nic_conf->{$nic}->{'mask'})); 
            }
        }
    }

    return $nic_conf;
}

sub get_nic_ip( $$ ) {
    my($self,$nic) = @_;
    my($sub,$cmd,$rc,$out,$ip);
    $sub = 'get_nic_ip';
    $self->enter_sub($sub);
    
    if(!defined($nic)) {
        return undef;
    }
    
    $cmd = "/sbin/ifconfig $nic";
    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
        $self->log_and_cont("INFO",$sub,"Running $cmd.");
    }
    ($rc,$out) = $self->exec_system($cmd);
    if($rc) {
        $self->log_and_die("ERROR",$sub,"$cmd failed with rc $rc, out $out.")
    }
    if($out =~ m/inet\s+addr:((?:\d{0,3}\.){3}\d{0,3})/) {
        $ip = $1;
    }
    else {
        undef $ip;
    }
    
    $self->leave_sub($sub);
    return $ip;
}

sub get_nic_mask( $$ ) {
    my($self,$nic) = @_;
    my($sub,$cmd,$rc,$out,$mask);
    $sub = 'get_nic_mask';
    $self->enter_sub($sub);
    
    $cmd = "/sbin/ifconfig $nic";
    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
        $self->log_and_cont("INFO",$sub,"Running $cmd.");
    }
    ($rc,$out) = $self->exec_system($cmd);
    if($rc) {
        $self->log_and_die("ERROR",$sub,"$cmd failed with rc $rc, out $out.");
    }
    if($out =~ m/Mask:((?:\d{0,3}\.){3}\d{0,3})/) {
        $mask = $1;
    }
    else {
        undef $mask;
    }

    $self->leave_sub($sub);
    return $mask;
}

sub run_nic_dhcp {
    my($self,$nic,$cfg) = @_;
    my($cmd,$out,$rc,$sub);
    $sub = 'run_nic_dhcp';
    
    $cmd = "killall dhclient3";
    ($out,$rc) = $self->exec_system($cmd);
    
    foreach my $lease_file ( </var/lib/dhcp3/dhclient*leases*> ) {
        if(!$self->run_test('unlink','',"Removing $lease_file.",$lease_file)) {
            $self->log_and_die("ERROR",$sub,"Couldn't remove $lease_file.");
        }
    }
    
    $cmd = "dhclient3 -cf $cfg -1 $nic";
    ($out,$rc) = $self->run_test('system','',"Running $cmd.",$cmd);
    
    if($out =~ m/^bound to ((?:\d{1,3}\.){3}\d{1,3})/m) {
        return $1;
    }
    return undef;
}

sub read_passwd {
    my($self) = @_;
    my($passwd,$confirm,$empty); 
    do {
        print "Please enter your password: ";
        ReadMode('noecho');
        $passwd = <STDIN>;
        if ($passwd){
                chomp $passwd;
        }
        print "\n";
        ReadMode('restore');
        
        print "Please confirm your password: ";
        ReadMode('noecho');
        $confirm = <STDIN>;
        if ($confirm){
                chomp $confirm;
        }
        print "\n";
        ReadMode('restore');
        if (not $passwd){
                $passwd = "";
        }
        if (not $confirm){
                $confirm = "";
        }
    } while($passwd ne $confirm);
    return $passwd;
}

sub get_boot_flags_from_NIC{
        my %request = @_;
        my @custom_macs;
        my @custom_nics;
        my @boot_strings;
        my $boot_string;
        my $bccd_nic;


        my @mac_addresses =
                split(/\n/,`$IFCONFIG | awk '/HWaddr/ {print \$1 " " \$5}'`);
        @custom_macs = grep {/ 02:/} @mac_addresses;

        for(my $i = 0; $i <= $#custom_macs; ++$i){
                if($custom_macs[$i] =~ m/^(.*?) /) {
                        $custom_nics[$i] = $1;
                }

                my $open_hex;
                if ($custom_macs[$i] =~ m/([0-9a-fA-F]):([0-9a-fA-F][0-9a-fA-F])$/){
                        $open_hex = $1.$2;
                } else {
                        die "Error in detecting last three hexes in MAC $!";
                }

                $boot_strings[$i] = sprintf "%012b", hex( $open_hex );

                if (
                                substr($boot_strings[$i],
                                        $IS_BCCD_NETWORK_NIC,1)
                                eq '1'
                   )
                {
                        $bccd_nic = $custom_nics[$i];
                        $boot_string = $boot_strings[$i];
                }
        }
        
        my $boot_flags = "#!/bin/sh\nexport BCCD_NIC=$bccd_nic\n";      

        foreach my $key(keys %request){
                my $value;
                my $pointer = $request{$key};
                my ($index,$length) = split(/,/,$pointer);

                unless($length){
                        $length = 1;
                }

                $value = substr($boot_string,$index,$length);
                $value = oct ("0b$value");
                        
                $boot_flags .= "export $key=$value\n";  
        }

        if ($boot_flags){
                open(BOOTFLAGS, ">/bccd_boot_flags") 
                        or die "Could not open /bccd_boot_flags:$!";
                print BOOTFLAGS $boot_flags;
                close(BOOTFLAGS);
                chmod 0755, '/bccd_boot_flags'; 
        }
}

1;

__END__

=head1 NAME

Bccd.pm

=head1 DESCRIPTION

This is the Perl module common to all BCCD scripts except for the testing database. What follows
is a description of all the subroutines available in the module. The signature below includes
the reference to the module, but only extra parameters are explicitly mentioned.

=head2 GENERAL SUBROUTINES

These functions all take a reference to the parent module, along with whatever other
parameters that are passed in.

=head3 cmd_num_die($@)

This is the subroutine called when another subroutine does not have the proper number of
arguments. Takes an array.

=head3 print_array($@)

This prints an array with line counters. Takes an array.

=head3 get_vginfo($)

This subroutine returns the LVM volume group information in colon-delimited format.

=head3 get_pvinfo($)

Returns the LVM physical volume information in colon delimited format.

=head3 get_free_pe_count($)

Returns the number of available physical extents in the volume groups present.

=head3 snarf_file($$)

Takes a path to a file and reads it in as one string.

=head2 TESTING SUBROUTINES

These functions all take a refernce to the parent module, the test type, the success return
code to be expected (required but can be blank for a safe default), a message to print out,
and whatever other parameters the specific test requires. In this documentation, only extra
parameters are explicitly mentioned. Unless otherwise noted, this returns the exit code as a
Perl truth value (0 == failure, anything else is OK).

=head3 test_system($$$$$)

Takes a command and runs it.

=head3 test_chdir($$$$$)

Takes a directory and changes the present directory to it.

=head3 test_mkpath($$$$$)

Takes a directory and makes it.

=head3 test_wwwmech($$$$$$)

Takes a URL and a destination file, and fetches the URL to the file. For subversion
access, see test_revfetch and test_recrevfetch.

=head3 test_chmod($$$$$$)

Takes an octal permission mode and a file, and sets the permissions on the file to the given 
mode. Make sure not to represent the octal permissions as text (i.e. don't use quotes).

=head3 test_unlink($$$$$)

Takes a directory entry and removes it.

=head3 test_symlink($$$$$$)

Takes a source file and destination, and symbolically links the source to the destination.

=head3 test_fcopy($$$$$$)

Takes a source file and destination file, and copies the source to the destination.

=head3 test_fmove($$$$$$)

Takes a source file and destination, and moves the source file to the destination.

=head3 test_getsvnrev($$$$$)

Gets the current subversion revision from the given URL. Returns the subversion revision.

=head3 test_fwrite($$$$$$$)

Takes a mode, file, and a text string, and writes the text to the file. Valid modes are "w"
for replacing the file, and "a" for appending to an existing file.

=head3 test_revfetch($$$$$$$)

Takes a subversion revision, URL in a subversion repository, and a destination file. Fetches
the file in the URL at the given revision to the destination file.

=head3 test_rename($$$$$$)

Takes a source file and destination file and renames the source to the destination. Functionally
equivalent to test_fmove.

=head3 test_recrevfetch($$$$$$)

Takes a subversion revision and URL, and fetches all files underneath the URL to the present
directory.

=head3 test_rmtree($$$$$)

Takes a directory tree and recursively removes it.

=head3 test_getuseruid($$$$$)

Takes a username and return the UID.

=head3 test_getusergid($$$$$)

Takes a username and returns the primary GID.

=head3 test_lsofkill($$$$$)

Takes a directory name and kills all processes with open files in that directory.

=head3 test_chown($$$$$$$)

Takes a file, user, and group and changes ownership of the file to that user and group.

=head3 test_rsync($$$$$$)

Takes a source and destination path and rsync's the source to the destination.

=head2 MISCELLANEOUS SUBROUTINES

These do not take any standardized arguments

=head3 get_boot_flags_from_NIC(%)

Takes data from the NIC's MAC address and populates /bccd_boot_flags
according to key-position hash.

Splits the last three hexes of the bccd network's custom NIC
into a 12 digit binary string. Takes a hash of keys and 
positions in that binary string. Key translates directly into
the name of the environment variable into which the information
is stored, and the position is a comma-separated-value list
with an index (starting at 0) and optionally a bit length (default 1).
so ('BUILD_CONTROL' => 1) takes the second bit in the last 
three digits of the MAC and writes "export BUILD_CONTROL=<value>" to
/bccd_boot_flags

The first entry in /bccd_boot_flags is always "export BCCD_NIC=<BCCD NIC>"

For a list of the official automated test bootflags 
and their corresponding locations, check the BCCD Wiki

=cut