#! /usr/bin/perl -w
#
# Configure a NetWinder
# $Id: install-tp,v 1.8 2001/04/25 14:54:29 stewart Exp $
#
# Andrew E. Mileski
# andrewm@netwinder.org
#

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
#
# Configurable stuff
#
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #

$ENV{'PATH'} = '/bin:/usr/bin:/sbin:/usr/sbin:/root';

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
#
# This is where the fun begins
#
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #

my $autoboot = 0;

sub read_config;
sub msg;
sub fatal_error;
sub menu;
sub ifconfig;
sub read_ifconfig;
sub query_drive;
sub partition_drive;
sub format_drive;
sub mount_drive;
sub install_image;
sub flash;
sub serial_test;
sub eth_test;
sub parallel_test;
sub do_everything;
sub do_flash;
sub do_tests;
sub do_prodserv;
sub set_time;
sub kernel_version;
sub backup_burn_in_data;
sub disk_dma_tests;

## my $redir = ' >/dev/tty2 2>&1 ';
my $redir = ' >>/dev/null 2>&1 ';
my $build = '';
my $config = $0.'.conf';

# ANSI colour codes
my $txt_black = "\033[0;30m";
my $txt_bblack = "\033[0;1;30m";
my $txt_red = "\033[0;31m";
my $txt_bred = "\033[0;1;31m";
my $txt_green = "\033[0;32m";
my $txt_bgreen = "\033[0;1;32m";
my $txt_orange = "\033[0;33m";
my $txt_yellow = "\033[0;1;33m";
my $txt_blue = "\033[0;34m";
my $txt_bblue = "\033[0;1;34m";
my $txt_magenta = "\033[0;35m";
my $txt_bmagenta = "\033[0;1;35m";
my $txt_cyan = "\033[0;36m";
my $txt_bcyan = "\033[0;1;36m";
my $txt_white = "\033[0;37m";
my $txt_bwhite = "\033[1;37m";
my $txt_norm = "\033[0;m";

# Codes we commonly use
my $txt_clear = "\033[2J\033[H";
my $txt_check = $txt_yellow;
my $txt_debug = $txt_bblack;
my $txt_done = "\033[0;1;5;37;42m";
my $txt_fatal = "\033[0;1;5;37;41m";
my $txt_okay = $txt_bgreen;
my $txt_prompt = $txt_bred;
my $txt_warn = "\033[0;1;5;33m";

$0 =~ m#[^/]+$#;
chdir $`;

while (1) {
	menu(read_config($config));
}
exit 0;

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
#
# Everything past here is a subroutine
#
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #

#
# Read configuration file into @conf
#
# $conf[0]  Number of default settings
# $conf[1]  Default firmware filename
# $conf[2]  Default logo filename
# $conf[3]  Default logo position
# $conf[4]  Default citrix firmware filename
# $conf[5]  Default citrix logo filename
# $conf[6]  Default citrix logo position
# $conf[7]  Default rescue image filename
#
sub read_config
{
	my $ibuild;
	my $iname;
	my $iver;
	my $ifile;
	my $ipart;
	$config = $_[0];
	my $state = 0;
	my @conf = ();
	my @tokens = (
		"firmware",
		"logo",
		"partition",
		"position",
		"rescue",
		"version",
	);

	open CONF, '<'.$config;
	while (<CONF>) {
		chop $_;
		s/^\s*#.*//;
		if ($state == 2 && m/^\s*file\s*=\s*(.*)\s*$/) {
			$ifile = $1;
			$state = 3;
		}
		if ($state == 3 && m/^\s*partition\s*=\s*(.*)\s*$/) {
			$ipart = $1;
			$state = 0;
			push @conf, $iname;
			push @conf, $iver;
			push @conf, $ifile;
			push @conf, $ipart;
		}
		if ($state == 1 && m/^\s*version\s*=\s*(.*)\s*$/) {
			$iver = $1;
			$state = 2;
		}
		if ($state == 0 && m/^\s*image\s*=\s*(.*)\s*$/) {
			$iname = $1;
			$state = 1;
		}
		if ($state == 0 && m/^\s*build\s*=\s*([0-9]+)\s*$/) {
			$build = $1;
		}
		if ($state == 0 && m/^\s*firmware\s*=\s*(.*)\s*$/) {
			$firmware = $1;
		}
                if ($state == 0 && m/^\s*citrix\s*=\s*(.*)\s*$/) {
                        $citrix[0] = $1;
			$state = 4;
                }
                if ($state == 4 && m/^\s*logo\s*=\s*(.*)\s*$/) {
                        $citrix[1] = $1;
			$state = 5;
                }
                if ($state == 5 && m/^\s*position\s*=\s*(.*)\s*$/) {
                        $citrix[2] = $1;
			$state = 0;
                }
                if ($state == 0 && m/^\s*rescue\s*=\s*(.*)\s*$/) {
                        $rescue = $1;
                }
	}
	close CONF;
	fatal_error("Invalid Configuration file${txt_debug} ($state)") if ($state);
	return @conf;
}

#
# Display a message
#
sub msg
{
	my $date = `date`;
	chop $date;
	print STDERR "${txt_cyan}${date}: ${txt_norm}@_\n";
}

#
# Fatal error
#
sub fatal_error
{
	msg($_[0]);
	msg("${txt_fatal}Fatal error!${txt_norm}  Reset to retry!");
	system ("echo 0 > /proc/sys/netwinder/green_led");
	system ("echo 1 > /proc/sys/netwinder/red_led");
	do {} while(1);
}

#
# Display a menu
#
sub menu
{
	my @cfg = @_;
	my $iname;
	my $iver;
	my $ifile;
	my $ipart;
	my $item = 1;
	my $i = 0;
	my $create_prodserv = 0;

    if ($autoboot != 1) {
	# Change the tab stops
	print STDERR "\033[2J\033[3g";
	print STDERR "\033[1;25H\033H";
	print STDERR "\033[1;53H\033H";
	print STDERR "\033[1;60H\033H";
	print STDERR "\033[H";

	print STDERR <<EOF;
\033[24C${txt_green}--------------------------------${txt_norm}
\033[24C${txt_bwhite}REBEL.COM ${txt_green}NetWinder ${txt_bwhite}Setup System${txt_norm}
\033[24C${txt_green}--------------------------------${txt_norm}
\033[36C${txt_debug}BUILD $build${txt_norm}

EOF
   }
	while ($i < $#_) {
		$iname = $cfg[$i++];
		$iname =~ s/\\t/	/g;
		$iname =~ s/\\s/${txt_bmagenta}/g;
		$iname =~ s/\\e/${txt_norm}/g;
		$iver = $cfg[$i++];
		$ifile = $cfg[$i++];
		$ipart = $cfg[$i++];
    if ($autoboot != 1) {
		print STDERR "\t${txt_bred}$item${txt_norm}) ${txt_yellow}$iname\t${txt_debug}${iver}${txt_norm}\n";
    }
		$create_prodserv = $item if ($iname =~ m/PROD/);
		$item++;
	}
    if ($autoboot != 1) {
	print STDERR "\t${txt_bred}${item}${txt_norm}) ${txt_bblue}Update the firmware${txt_norm}\t\t${txt_debug}${firmware}${txt_norm}\n";
    }
        $item++;
    if ($autoboot != 1) {
	print STDERR "\t${txt_bred}${item}${txt_norm}) ${txt_bblue}Install Rescue Image${txt_norm}\t\t${txt_debug}${rescue}${txt_norm}\n";
    }
	$item++;
    if ($autoboot != 1) {
	print STDERR "\t${txt_bred}${item}${txt_norm}) ${txt_bblue}Perform tests${txt_norm}\n";
    }
	$item++;
    if ($autoboot != 1) {
	print STDERR "\t${txt_bred}${item}${txt_norm}) Reboot the system\n";
	print STDERR "\n\033[30C${txt_bwhite}Enter your ${txt_bred}choice${txt_bwhite}:${txt_norm} "; 
    }
	if ($autoboot == 1) {
		if (-f '/root/default-install.conf') {
			$cmd = `cat /root/default-install.conf`;
			chop $cmd;
		} else {
			fatal_error ('Missing option file: ' .
				'/root/default-install.conf');
		}
	} else {
		do {
			$cmd = <STDIN>;
			chop $cmd;
		} until ($cmd =~ m/^[0-9]+$/);
	}
	print STDERR "${txt_norm}\n";

	#
	# Be very careful if you change this!
	# All the numbers are dependent on each other!
	#
	if ($cmd == $create_prodserv) {
		my $desc = $cfg[($cmd - 1) * 4];
		$desc =~ s/\\.*//;
		print STDERR $txt_clear;
		msg("${txt_bwhite}Creating a ${desc}${txt_norm}");
		do_prodserv($cfg[$cmd * 4 - 2], $cfg[$cmd * 4 - 1]);
	} elsif ($cmd <= $item - 4) {
		my $desc = $cfg[($cmd - 1) * 4];
		$desc =~ s/\\.*//;
		print STDERR $txt_clear;
		msg("${txt_bwhite}Creating a ${desc}${txt_norm}");
		do_everything($cfg[$cmd * 4 - 2], $cfg[$cmd * 4 - 1]);
	} elsif ($cmd == $item - 3) { 
		do_flash ();
        } elsif ($cmd == $item - 2) {
		do_rescue(1);
	} elsif ($cmd == $item - 1) { 
		do_tests (1);
	} elsif ($cmd == $item) {
		exec '/sbin/shutdown -h now';
	}
}

#
# ifconfig - all comm interface setup goes here
#
sub ifconfig
{
	my $ifc = $_[0];
	my $state = $_[1];
	my $plip_dev = 'plip0';

	# Cannot change the eth0 config (needed for NFS root)
	if ($ifc eq 'eth0') {
		return;
	}

	# eth[1,2] or plip0 devices 
	if ($ifc eq 'eth1' || $ifc eq 'eth2' || $ifc eq $plip_dev) {
		if ($state eq 'up') {
			system ("ifconfig $ifc down $redir");
			if ($ifc eq $plip_dev) {
				system ("rmmod plip $redir");
				system ("modprobe plip $redir");
			}
			system ("ifup $ifc $redir");
		# Device going down
		} else {
			system ("ifconfig $ifc down $redir");
			if ($ifc eq $plip_dev) {
				system ("rmmod plip $redir");
			}
		}
	}
}

#
# Get the ifconfig report for an interface
#
sub read_ifconfig
{
	my $eth = $_[0];
	my $eth_mac = '';
	my $eth_ip = '';
	my $eth_bc = '';
	my $eth_nm = '';
	my $rc = 0;

	# Bring the interface up if necessary
	ifconfig($eth, 'up');

	# Read the interface settings
	open IFCONFIG, "ifconfig $eth 2>>/dev/null|";
	while (<IFCONFIG>) {
		$eth_mac = "0x$1$2$3" if (m/HWaddr ..:..:..:(..):(..):(..)/);
		$eth_ip = $1 if (m/addr:([0-9\.]{7,})/);
		$eth_bc = $1 if (m/Bcast:([0-9\.]{7,})/);
		$eth_nm = $1 if (m/Mask:([0-9\.]{7,})/);
	}
	close IFCONFIG;
	eval "\$eth_mac = $eth_mac";

	# Bring down interface up if necessary
	ifconfig($eth, 'down');

	return ($eth, $eth_mac, $eth_ip, $eth_bc, $eth_nm);
}


#
# Get the drive specs
#
sub query_drive
{
	my $hda_cyl;
	my $hda_hds;
	my $hda_sec;
	my $hda_size;

	msg('Reading drive specs');
	$_ = `hdparm -g /dev/hda | grep geometry`;
	m#([0-9]+)/([0-9]+)/([0-9]+)#;
	$hda_cyl = $1;
	$hda_hds = $2;
	$hda_sec = $3;
	$hda_size = `/sbin/sfdisk -s /dev/hda`;
	chomp $hda_size;
	$hda_size *= 2;

	# Check for a large drive (16383/16/63 industry standard)
	if ($hda_cyl == 16383 && $hda_hds == 16 && $hda_sec == 63) {
		$hda_cyl = $hda_size / (16 * 63);
		$hda_cyl =~ s/\.*//;
#		while ($hda_cyl >= 16383) {
#			$hda_hds *= 2;
#			$hda_cyl = $hda_size / ($hda_hds * 63);
#			$hda_cyl =~ s/\.*//;
#		}
	}

	@_ = ($hda_cyl, $hda_hds, $hda_sec, $hda_size);
}

#
# Partition the drive
#
sub partition_drive
{
	my $hda_p1s;
	my $hda_p1e;
	my $hda_p2s;
	my $hda_p2e;
	my $hda_p3s;
	my $hda_p3e;
	my $hda_p4s;
	my $hda_p4e;
	my $cyl;
	my $root_cyl;
	my $swap_cyl;
	my $usr_cyl;
	my $rescue_cyl;

	msg('Partitioning drive');

	my ($hda_cyl, $hda_hds, $hda_sec, $hda_size,
	 $hda1_size, $hda2_size, $hda3_size, $hda4_size) = @_;

	fatal_error('Drive is too small.') if ($hda_size < 2400000);

	$cyl = $hda_hds * $hda_sec;

	# swap = 256 MB
	$swap_cyl = (2 * $hda2_size * 1024 / $cyl) + 1;
	$swap_cyl =~ s/\..*//;

	# rescue = 15 MB
	$rescue_cyl = (2 * $hda4_size * 1024 / $cyl) + 1;
	$rescue_cyl =~ s/\..*//;

	# if hda1 size == 0, then it means we want the left over
	# on hda1, else it goes on hda3
	if ($hda1_size == 0) {
		# /usr (or hda3)
		$usr_cyl = (2 * $hda3_size * 1024 / $cyl) + 1;
		$usr_cyl =~ s/\..*//;

		# / (root) = whatever is left
		$root_cyl = $hda_cyl - $swap_cyl - $rescue_cyl - $usr_cyl;
		$root_cyl =~ s/\..*//;
	} else {
		# /root (or hda1)
		$root_cyl = (2 * $hda1_size * 1024 / $cyl) + 1;
		$root_cyl =~ s/\..*//;

		# /usr (or hda3) = whatever is left
		$usr_cyl = $hda_cyl - $swap_cyl - $rescue_cyl - $root_cyl;
		$usr_cyl =~ s/\..*//;
	}

	# /dev/hda1
	$hda_p1s = 1;
	$hda_p1e = $root_cyl - 1;

	# /dev/hda2
	$hda_p2s = $hda_p1e + 1;
	$hda_p2e = $hda_p2s + $swap_cyl - 1;

	# /dev/hda3
	$hda_p3s = $hda_p2e + 1;
	$hda_p3e = $hda_p3s + $usr_cyl - 1;

	# /dev/hda4
	$hda_p4s = $hda_p3e + 1;
	$hda_p4e = $hda_cyl;

	open PFDISK, '|/sbin/fdisk /dev/hda'.$redir;
	print PFDISK <<"EOF";
x
c
$hda_cyl
h
$hda_hds
s
$hda_sec
r
d
1
d
2
d
3
d
4
n
p
1
$hda_p1s
$hda_p1e
n
p
2
$hda_p2s
$hda_p2e
t
2
82
n
p
3
$hda_p3s
$hda_p3e
n
p
4
$hda_p4s
$hda_p4e
p
w
EOF
	close PFDISK;
}


#
# Format the drive
#
sub format_drive
{
	my $rc;

	msg('Formatting root partition /dev/hda1');
	$rc = system ("mke2fs /dev/hda1 $redir");
	fatal_error('Error formatting /dev/hda1') if ($rc);

	msg('Formatting swap partition /dev/hda2');
	$rc = system ("mkswap /dev/hda2 $redir");
	fatal_error('Error formatting /dev/hda2') if ($rc);

	msg('Formatting usr (other) partition /dev/hda3');
	$rc = system ("mke2fs /dev/hda3 $redir");
	fatal_error('Error formatting /dev/hda3') if ($rc);

	msg('Formatting rescue partition /dev/hda4');
	$rc = system ("mke2fs /dev/hda4 $redir");
	fatal_error('Error formatting /dev/hda4') if ($rc);
}


#
# Mount the drive
#
sub mount_drive
{
	my $rc;
	my $mount;
	my $hda1_mnt;
	my $hda2_mnt;
	my $hda3_mnt;
	my $hda4_mnt;
	my $server = server();

	($mount, $hda1_mnt, $hda2_mnt, $hda3_mnt, $hda4_mnt) = @_;

	if ($mount eq 'mount') {
		msg("Mounting partition hda1 on $hda1_mnt");
		$rc = system ("mount -n -t ext2 /dev/hda1 $hda1_mnt $redir");
		fatal_error('Error mounting /dev/hda1') if ($rc);

		msg("Mounting partition hda3 on $hda3_mnt");
		system ("mkdir -p $hda3_mnt $redir");
		$rc = system ("mount -n -t ext2 /dev/hda3 $hda3_mnt $redir");
		fatal_error('Error mounting /dev/hda3') if ($rc);

		msg("Mounting partition hda4 on $hda4_mnt");
		$rc = system ("mount -n -t ext2 /dev/hda4 $hda4_mnt $redir");
		fatal_error('Error mounting /dev/hda4') if ($rc);

	} else {
		msg('Unmounting drive hda4');
		$rc = system ("umount $hda4_mnt $redir");
		fatal_error('Error unmounting /dev/hda4') if ($rc);

		msg('Unmounting drive hda3');
		$rc = system ("umount $hda3_mnt $redir");
		fatal_error('Error unmounting /dev/hda3') if ($rc);

		msg('Unmounting drive hda1');
		$rc = system ("umount $hda1_mnt $redir");
		fatal_error('Error unmounting /dev/hda1') if ($rc);
	}
}


#
# Get the FTP server address
#
# Note: the devel server is forced when booting from internal network.
#
sub server
{
	my @eth0 = read_ifconfig('eth0');
	$eth0[2] =~ s/\.[0-9]+$/\.254/;
	if ($eth0[2] =~ m/^10\./) {
		$eth0[2] = '10.8.54.38';
	}
	return $eth0[2];
}

#
# Install drive image
#
sub install_image
{
	my $server = server();
	my $rc;
	my $image = $_[0];

	msg("Installing image ${txt_debug}($image)${txt_norm}");
	if ($image =~ m/\.gz$/) {
		$rc = system ("wget ftp://$server/pub/$image -O - 2>>/dev/null | tar xzpf - -C /mnt/hda1");
	} else {
		$rc = system ("wget ftp://$server/pub/$image -O - 2>>/dev/null | tar xpf - -C /mnt/hda1");
	}
	fatal_error('Error installing image') if ($rc);
}

#
# Prompt y/n for reboot
#
sub prompt_reboot
{
	my $prompt;
	my $date = `date`;
	my $end = 0;
	chomp $date;
	# Empty the buffer in case anyone hit any extra keys.
	# Time out if there is no current data in the buffer.
	# Deal with multiple entry lines
	if ($autoboot == 1) {
		$prompt = 'h';
	} else {
		while ($end == 0) {
			eval {
				# NB: \n required
				local $SIG{ALRM} = sub { die "alarm\n" };
				alarm 2;
				<STDIN>;
				alarm 0;
			};
			if ($@) {
				# propagate unexpected errors
				die unless $@ eq "alarm\n";
				# timed out
				$end = 1;
			}
		}

		print STDERR "${txt_cyan}$date: ${txt_prompt}h " . 
			"to halt or Reboot (y/n)? ${txt_norm}";
		$prompt = <STDIN>;
		chop $prompt;
	}
	$prompt =~ tr/[A-Z]/[a-z]/;
	if ($prompt =~ /y$/ || $prompt =~ /r$/ || $prompt =~ /yes$/) {
		exec '/sbin/shutdown -r now';
	}
	if ($prompt =~ /h$/) {
		# exec '/sbin/shutdown -h now';
		exec '/sbin/halt';
	}
}

#
# Install rescue image
#
sub do_rescue
{
	my $server = server();
	my $rc;

	if ($_[0] == 1) {
		print STDERR $txt_clear;
		msg("${txt_bwhite}Installing Rescue Image");

		msg('Formatting rescue partition');
		$rc = system ("mke2fs /dev/hda4 $redir");
		fatal_error('Error formatting rescue partition') if ($rc);
	}
	msg("Installing Rescue Image ${txt_debug}($rescue)${txt_norm}");

	if ($_[0] == 1) {
		$rc = system ("mount -n -t ext2 /dev/hda4 /mnt/hda4 $redir");
		fatal_error('Error mounting rescue partition') if ($rc);
	}

	if ($rescue =~ m/\.gz$/) {
		$rc = system ("wget ftp://$server/pub/$rescue -O - 2>>/dev/null | tar xzpf - -C /mnt/hda4");
	} else {
		$rc = system ("wget ftp://$server/pub/$rescue -O - 2>>/dev/null | tar xpf - -C /mnt/hda4");
	}
	fatal_error('Error installing rescue image') if ($rc);

	if ($_[0] == 1) {
		$rc = system ("umount /dev/hda4 $redir");
		fatal_error('Error unmounting rescue partition') if ($rc);
		msg("${txt_done}Installation complete!${txt_norm}");
		prompt_reboot();
	}
}

#
# Update the flash
#
sub flash
{
	my $rc;
	my $attempt;
	my $firm_dir;
	my $firm_version;

	$firm_version = `rpm -q --queryformat '%{VERSION}\n' --root=/mnt/hda1 -f /sbin/flashwrite 2> /dev/null`;
	chomp ($firm_version);
	if ($firm_version ne "") {
		$firm_dir = "/mnt/hda1/boot/rom-$firm_version";
	} else {
		$firmware =~ m/rom-(\d+\.\d+)\.*/;
		$firm_dir = "/root/flash/rom-$1";
	}

	fatal_error ("Flash directory: $firm_dir\n\tdoes not exist.")
		if (! -d $firm_dir);

	msg("Writing the firmware");
	msg ("Using directory: $firm_dir");

	$rc = system ("/usr/sbin/upgrade-flash -d $firm_dir $redir");
	
	if ($rc) {
		msg('Failed to write the firmware');
		fatal_error('THIS BOARD IS LIKELY DEAD');
	}

	msg("${txt_okay}Flash okay.${txt_norm}");
}


#
# Serial port check
#
sub serial_test
{
	my $prompt;
	my $rc;

	msg('Connect serial dongle. Press ENTER');
	$prompt = <STDIN>;

	system ("modprobe serial $redir");
	$rc = system ("sertest $redir");
	system ("rmmod serial $redir");
	if ($rc) {
		fatal_error ("Serial test failed! Stopped!");
	}
	msg("${txt_okay}Serial port okay${txt_norm}");
}

#
# Check the ethernet100
#
sub eth_test
{
	my $rc;
	my $ping;
	my $ping_s;
	my $port;

	$port = $_[0];

        msg("Starting test on Ethernet port $port.");

	# Bring the interface up
	ifconfig($port, 'up');

	eval {
		local $SIG{ALRM} = sub { die "alarm\n" }; # NB: \n required
		alarm  50;
		open NETPERF, "netperf -H test-$port -l 25 2>/dev/null|";
		while (<NETPERF>) {
			$speed = $1 if (m/(\d+\.\d+)\s*$/);
		}
		close NETPERF;
		alarm 0;
	};
	if (! $! || $@) {
		## die unless $@ eq "alarm\n";   # propagate unexpected errors
		# timed out if $@ is set
		system "killall netperf";
		close NETPERF;
		fatal_error ("Unable to connect to server\n\tthe server " .
			"may be down, \n\tor the 100 Mbit ethernet has a " .
			"problem.\n\tEthernet 100 test failed on port: " .
			"$port!\n\tStopped!!");
	}

	# How did we do?
	## if ($speed >= 50) {
	if ($speed >= 5) {
		msg("Ethernet 100 test successful ($speed Mbits/sec)");
	} else {
		fatal_error ("Ethernet 100 test failed! " .
			"($speed Mbits/sec)\n\tNeed a minimum through " .
			"put of 50 Mbits/sec.\n\tStopped!!");
	}

	# Take the interface down
	ifconfig($port, 'down');
}

#
# Parallel port check 
#
sub parallel_test
{
	my $prompt;
	my $rc;
	my $ping;
	my $ping_s;
	my $plip_dev = 'plip0';

	# Bring the interface up
	msg("${txt_check}Checking the parallel port${txt_norm}");
	ifconfig($plip_dev, 'up');

	# Do the test - abort on first success
	PLIPLOOP: for ($ping = 1; $ping <= 5; $ping++) {
		open PING, "ping -nc 1 plip-server 2>&1|";
		while (<PING>) {
			last PLIPLOOP if (m/ 0%/);
		}
	}
	close PING;

	# Improve our vocabulary 
	$ping_s = ($ping == 1) ? 'ping': 'pings';

	# How'd we do?
	if ($ping <= 5) {
		msg("Parallel port test successful ($ping $ping_s)");
	} else {
		fatal_error ("Parallel port test failed!  Stopped!!");
	}

	# Take the interface down
	ifconfig($plip_dev, 'down');
}

#
# Do everything
#
sub do_everything
{
	my $prompt;
	my $image = $_[0];
	my $scheme = $_[1];

	# write the time to the board
	set_time ();


	if ($image =~ /burn-in/) {
		do_tests (0);
	} else {
		disk_dma_tests();
	}

	# check for and backup burn in data
	backup_burn_in_data ();

	if ($scheme eq 'scheme_3') {
		partition_drive (query_drive(), 0, 256, 2200, 20);
		format_drive ();
		mount_drive ('mount', '/mnt/hda1', 'swap',
			'/mnt/hda1/usr', '/mnt/hda4');
	}
	else {
		fatal_error ("Unknown partition scheme...");
	}

	do_rescue (0);

	# Install the drive image
	install_image($image);

	# Update the flash if necessary
	flash();

	# Unmount the drives
	mount_drive ('umount', '/mnt/hda1', 'swap',
		'/mnt/hda1/usr', '/mnt/hda4') if ($scheme eq 'scheme_3');

	# Prompt for reboot
	msg("${txt_done}Installation complete!${txt_norm}");
	prompt_reboot();
}


#
# Update the flash
#
sub do_flash
{
	# write the time to the board
	set_time ();

	print STDERR $txt_clear;
	msg("${txt_bwhite}Updating the firmware${txt_norm}");

	flash();

	# Prompt for reboot
	msg("${txt_done}Installation complete!${txt_norm}");
	prompt_reboot();
}

#
# Testing
#
sub do_tests
{
	my $reboot = $_[0];

	# write the time on the board
	set_time ();

	#serial_test();

	eth_test('eth1');
	eth_test('eth2');

	# perform a disk DMA test
	disk_dma_tests ();

	# Parrallel port test
	parallel_test();

	if ($reboot == 1) {
		# Prompt for reboot
		msg("${txt_done}Testing complete!${txt_norm}");
		prompt_reboot();
	}
}


#
# Create a production server
#
sub do_prodserv
{
	my $prompt;
	my $image = $_[0];
	my $scheme = $_[1];
	my $server = server();

	print ("Enter the Sever number for the production server to create.\n");
	print ("This is a number between 10 and 250, which does not\n");
	print ("conflict with any existing server numbers: ");
	$prompt = <STDIN>;
	chop $prompt;
	if ($prompt =~ /\D/ || $prompt < 10 || $prompt > 250) {
		print "\n\n\n\tInvalid number entered.\n";
		print "\tYou need to enter a number between 10 and 250,\n";
		print "\twhich will not conflict with any existing servers.\n";
		print "\tPress any key to continue  ";
		$prompt = <STDIN>;
		return;
	}
	msg ("Creating Production server numbered: $prompt");

	# write the time to the board
	set_time ();

	partition_drive (query_drive(), 250, 256, 0, 15);
	format_drive ();
	mount_drive ('mount', '/mnt/hda1', 'swap', 
		'/mnt/hda1/home/ftp', '/mnt/hda4');

	do_rescue (0);

	# Install the root
	install_image($image);

	# Create vncroot
	system ("mkdir -p /mnt/hda1/var/ftp/pub/vncroot");
	system ("ln -s var/ftp/pub/tftpboot /mnt/hda1");
	system ("ln -s var/ftp/pub/vncroot /mnt/hda1");

	msg("Installing NFS root image ${txt_debug}($image)${txt_norm}");
	if ($image =~ m/\.gz$/) {
		$rc = system ("wget ftp://$server/pub/$image -O - 2>>/dev/null | tar xzpf - -C /mnt/hda1/var/ftp/pub/vncroot");
	} else {
		$rc = system ("wget ftp://$server/pub/$image -O - 2>>/dev/null | tar xpf - -C /mnt/hda1/var/ftp/pub/vncroot");
	}
	fatal_error('Error installing image') if ($rc);

	# Install needed RPMS
	msg('Installing RPMS and configuring');
	system (<<"EOF");
{
	ROOT=/mnt/hda1
	SERVER=/server-root
	RPM_DIR=/server-root/home/ftp/pub
	rpm --root=\$ROOT -ihv \$RPM_DIR/RPMS/* 
	#### rpm --root=\$ROOT/var/ftp/pub/vncroot -ihv \$RPM_DIR/RPMS-vncroot/*

	cd \$ROOT

	cp -av \$SERVER/root/* \$ROOT/root
	cd \$SERVER/home/ftp/pub
	cp -av firmware tftpboot RPMS SRPMS RPMS-vncroot \$ROOT/var/ftp/pub
	cd vncroot/root
	cp -av * \$ROOT/var/ftp/pub/vncroot/root

} $redir
EOF

	msg("Going into server setup for server: $prompt");
	$rc = system ("./setup-server /mnt/hda1 $prompt $redir");
	fatal_error("Error doing server setup for server: $prompt") if ($rc);

	msg("Copying over tar images");
	$rc = system ("cd /mnt/hda1/var/ftp/pub; wget ftp://$server/pub/\*.tar.gz $redir");
	fatal_error('Error copying over tar images') if ($rc);

	# Update the flash
	flash();

	# Unmount the drives
	mount_drive ('umount', '/mnt/hda1', 'swap', 
		'/mnt/hda1/home/ftp', '/mnt/hda4');

	# Prompt for reboot
	msg("${txt_done}Installation complete!${txt_norm}");
	prompt_reboot();
}


#
# Set the time on the machine
#
sub set_time
{
	my $date = `date`;
	chop $date;
	msg("Syncing the time");
	system ("ntpdate server $redir");
	msg("Writing the time to the system");
	system ("clock --utc -w $redir");
}


#
# get the first two digits of the kernel version
#
sub kernel_version
{
	my $kern_vers;

	$kern_vers = `uname -r`;
	$kern_vers =~ /(^\d\.\d)/;
	return $1;
}

#
# Check for burn in image data and back it up on the server if it exists
#
sub backup_burn_in_data
{
	msg ("Checking for Burn-In data, backing up");

	system (<<"EOF");
{
	mount -n /dev/hda1 /mnt/hda1 || exit 1
	if [ -f /mnt/hda1/.burn_in_run ]; then
		mkdir -p /burn-data
		tar cvfz /burn-data/`/bin/date '+%Y%m%d==%H-%M-%S'`.tar.gz /mnt/hda1/tmp
	fi
	umount -n /mnt/hda1
} $redir
EOF

}


#
# A test to verify disk DMA works correctly.
# Also test to verify the drive can maintain a disk reads speed of 
# minimun 5 MB/sec.
#
sub disk_dma_tests
{
	my $rc;
	my $speed = 0 ;
	my $i;

	msg ("Beginning Disk DMA test");
	system ("dmesg -c >/dev/null");
	# Discard the value from the first run.
	system ("hdparm -t /dev/hda >/dev/null 2>&1");

	# We are taking the average speed over 5 samples.
	for ($i = 1; $i <= 5; $i++) {
		open HDPARM, "hdparm -t /dev/hda 2>/dev/null|";
		while (<HDPARM>) {
			$speed += $1 if (m/\s*(\d*\.\d*)\s*MB/);
		}
		close HDPARM;
	}

	$speed /= 5;
	# here we are looking for dma resets from a drive which does
	# not support DMA.
	$rc = system ("dmesg | egrep -i hda $redir");
	fatal_error ('Disk DMA problem!') if (! $rc);

	if ($speed < 15.0) {
		fatal_error ("Disk speed is too slow.  \n\tHave " .
			"reported: $speed MB/sec,\n\twhen a minimum " .
			"of 15 MB/sec is required.\n" .
			"Out of a sample of 5 runs");
	}
	msg ("${txt_okay}Disk DMA test passed.  Disk speed is " .
		"$speed MB/sec.${txt_norm}\n" .
		"Out of a sample of 5 runs");
}