#!/usr/bin/perl
#
# Perl script to install Atari bootstrap & kernel plus configure
# bootstrap options
#
# Copyright (C) 1998 by Roman Hodek <Roman.Hodek@informatik.uni-erlangen.de>
#
# 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 2 or
# (at your option) any later version. See the file
# /usr/doc/copyright/GPL on Debian systems for details.
#

use IO;

$imgdir = "/usr/share/atari-bootstrap";
$fdisk = "/sbin/atari-fdisk";
$mount = "/bin/mount";
$umount = "/bin/umount";
$tmpmnt = "/atari-bootstrap-mnt";
$conffile = "/etc/ataboot.conf";

@tos_partition_ids = qw(GEM BGM);
@tos_partition_systems = qw(GEMDOS Minix);
@kernel_names = qw(vmlinux.gz vmlinuz vmlinux);
@confvars = qw(partition directory use_bootp gfx_board);

# table of known gfx board data -- please extend!
@gfx_boards =
	({ name => "Gengtec ET4000",
	   base => 0xc00000,
	   io   => 0xd00000,
	   cw   => 6 },
	 { name => "Imagine Mega256",
	   base => 0xc00000,
	   io   => 0xcc0000,
	   cw   => 6 },
	 { name => "Mega4000",
	   base => 0xfec00000,
	   io   => 0xfeff0000,
	   cw   => 6 },
	 { name => "Medusa ET4000",
	   base => 0x7f000000,
	   io   => 0x7f300000,
	   cw   => 6 },
	 { name => "Nova Falcon",
	   base => 0xc00000,
	   io   => 0xb00000,
	   cw   => 6 },
	 { name => "Nova VMEplus",
	   base => 0xfec00000,
	   io   => 0xfedc0000,
	   cw   => 6 },
	 { name => "Supernova",
	   base => 0xfea00000,
	   io   => 0xfe900000,
	   cw   => 6 },
	 { name => "Spektrum 1",
	   base => 0xfec00000,
	   io   => 0xfed00000,
	   cw   => 6 },
	 { name => "Spektrum TC",
	   base => 0xfec00000,
	   io   => 0xfed80000,
	   cw   => 8 },
	 { name => "VOFA",
	   base => 0xfec00000,
	   io   => 0xfed00000,
	   cw   => 6 },
	 { name => "Crazy Dots II",
	   base => 0xfec00000,
	   io   => 0xfebf0000,
	   cw   => 8 }
	 );

# verify that various stuff is present
$< == 0 or die "Must be root for installing\n";
-f "$imgdir/ataboot.ttp.gz" or die "No ataboot images found in $imgdir!\n";
-x $fdisk or die "Can't find $fdisk\n";
-x $mount or die "Can't find $mount\n";

# last answers of last run
read_config();

# present the list of TOS partition and let user choose where to install
print <<'EOF';
atabootconfig needs to know where you want to install it and a Linux
kernel. You must install them to a TOS partition, since ataboot is a
TOS program.

EOF

%mounted = check_mounted( get_tos_partitions() );
@mlist = sort keys %mounted;
print "The following TOS partitions seem to be available:\n";
for( $i = 1; $i <= @mlist; ++$i ) {
	 $_ = $mlist[$i-1];
	 print " $i: $_ ",
		   $mounted{$_} ? "(mounted on $mounted{$_})\n" : "(not mounted)\n";
}
print "Please choose a partition by number, or enter a block device ",
	   "or pathname.\n";
while( 1 ) {
	 $ans = read_str( "Installation partition", $partition );
	 if ($ans =~ /^\d+$/ && $ans >= 1 && $ans <= @mlist) {
		 $partition = @mlist[$ans-1];
		 last;
	 }
	 elsif (-b $ans || -d $ans) {
		 $partition = $ans;
		 last;
	 }
	 else {
		 print "$ans is not a number, a block device or a directory!\n";
	 }
}

if (-b $partition) {
	 if (!$mounted{$partition}) {
		 mkdir( $tmpmnt, 0755 ) or die "mkdir $tmpmnt failed: $!\n";
		 !system( "$mount -tmsdos $partition $tmpmnt" )
			 or !system( "$mount -tminix $partition $tmpmnt" )
				 or (rmdir($tmpmnt), die "Can't mount $tmpmnt\n");
		 $do_umount = 1;
		 $mountpoint = $tmpmnt;
	 }
	 else {
		 $mountpoint = $mounted{$partition};
	 }
}
die "Shouldn't happen: $direcory doesn't exist or is no dir\n"
	 if !-d $mountpoint;

print "\nIn which directory on that partition atari-bootstrap should be ".
	   "installed?\n";
print "(Enter \".\" for root directory)\n";
while( 1 ) {
	 $ans = read_str( "Directory", $directory );
	 last if -d "$mountpoint/$ans";
	 next if !yesno("$mountpoint/$ans does not exist. Should it be created?",'y');
	 last if mkdir( "$mountpoint/$ans", 0755 );
	 warn "Can't make dir $mountpoint/$ans: $!\n";
}			
$directory = $ans;
$instdir = "$mountpoint/$directory";

print <<'EOF';

There is a version of ataboot that supports BOOTP/TFTP, which allows
you to dynamically determine that machine's IP address and to get the
Linux kernel (and ramdisk) from a boot server. This currently only
works over Ethernet, and only RieblCard ethernet boards are supported.

EOF

$use_bootp = 0 if !defined $use_bootp;
$use_bootp = yesno( "Do you want BOOTP/TFTP support? ", $use_bootp ? 'y':'n' );
$bootimage = "$imgdir/ataboot".($use_bootp ? "-bootp" : "").".ttp.gz";

print "\n";
if (kernel_exists( $instdir )) {
	 print "There is already a kernel image ($kernel) in $instdir.\n";
}
else {
	 print "I can't find a kernel image in $instdir\n";
	 @kernels = find_kernels( "", "/boot", "/usr/src/linux" );
	 if (!@kernels) {
		 print "Can't find any kernels!\n";
	 }
	 else {
		 for( $i = 1; $i <= @kernels; ++$i ) {
			 print " $i: $kernels[$i-1]\n";
		 }
		 while( 1 ) {
			 $ans = read_str( "Install which kernel image?", "1" );
			 if ($ans =~ /^\d+$/ && $ans >= 1 && $ans <= @kernels) {
				 $kernel = $kernels[$ans-1];
				 last;
			 }
			 elsif (-f $ans) {
				 $kernel = $ans;
				 last;
			 }
			 else {
				 print "Invalid answer\n";
			 }
		 }
	 }
}

if (-f "$instdir/bootstra.ttp") {
	 print "\nSaving old bootstra.ttp as bootstra.old\n";
	 rename( "$instdir/bootstra.ttp", "$instdir/bootstra.old" );
}

print "\nCopying bootstrap program to $instdir\n";
!system( "gzip -dc $bootimage >$instdir/bootstra.ttp" )
	 or die "gzip -dc failed\n";
if ($kernel) {
	 print "Copying kernel $instdir\n";
	 !system( "cp $kernel $instdir" ) or die "cp failed\n";
}

#
# Now take care of bootargs file
#

$do_bootargs = 1;
$def_stram = 'y';
$gfx_board = 0 if !defined($gfx_board);
$def_have_video = 'n';
$def_base = undef;
$def_io = undef;
$def_cw = 6;
$def_xres = undef;
$def_yres = undef;
$def_depth = undef;
$def_org = 'p';
$def_21 = 'n';
$def_rootdev = undef;
print "\n";
if (-f "$instdir/bootargs") {
	print "There is already a bootargs file.\n";
	if (yesno( "Do you want to change it?", 'n' )) {
		open( F, "<$instdir/bootargs" )
			or die "Can't open $instdir/bootargs: $!\n";
		@old_bootargs = split( /\s+/m, <F> );
		close( F );
		$def_stram = (grep( /^-s$/, @old_bootargs )) ? 'y' : 'n';
		if ($video = (grep( /^video=(atafb:)?external:/, @old_bootargs ))[0]) {
			$video =~ /external:(\S+);(\S+);(\S+);(\S+);(\S+);(\S*);(\S+);(\S+)/;
			$def_xres  = $1;
			$def_yres  = $2;
			$def_depth = $3;
			$def_org   = $4;
			$def_base  = $5;
			$def_io    = $7;
			$def_cw    = $8;
			$def_have_video = 'y';
			$def_21 = ($video =~ /video=atafb:/) ? 'y' : 'n';
		}
		if ($k = (grep( /^root=/, @old_bootargs ))[0]) {
			$k =~ /^root=(\S+)/;
			$def_rootdev = $1;
		}
	}
	else {
		$do_bootargs = 0;
	}
}
else {
	print "There is no file 'bootargs' in $instdir yet.\n";
	@old_bootargs = ();
}

if ($do_bootargs) {
	$bootargs_b = $bootargs_k = "";

	# ask whether kernel should go to ST-RAM (-s option)
	print <<"EOF";

Maybe you want to load your kernel to ST-RAM (instead of to TT-RAM).
It is faster in TT-RAM, but sometimes this has been reported to cause
spurious crashes.
EOF
	add_ba( "bargs", "-s" ) if yesno( "Load kernel to ST-RAM?", $def_stram );

	# always use the kernel we just installed
	($kname = $kernel) =~ s,.*/,,;
	add_ba( "bargs", "-k $kname" );

	# ask if an external: option should be constructed
	print <<"EOF";

If you have a graphics board installed, you must tell the Linux kernel
some data about it, so it can be used for display.
EOF
	if (yesno( "Do you want to configure a graphics board?",$def_have_video)) {
		print <<"EOF";

There are some predefined configurations for some boards. If your
board is listed below, just enter the corresponding number. Otherwise,
type '0' to enter the board data manually.

EOF
		print "   Name                 Base Addr  I/O Addr  Colreg Width\n";
		print "---------------------------------------------------------\n";
		for( $i = 0; $i < @gfx_boards; ++$i ) {
			printf "%2d %-20s 0x%08lx 0x%08lx %d\n", $i+1,
				   $gfx_boards[$i]->{'name'},
				   $gfx_boards[$i]->{'base'},
				   $gfx_boards[$i]->{'io'},
				   $gfx_boards[$i]->{'cw'};
		}
		$gfx_board = read_num( "Which board", 0, scalar(@gfx_boards),
							   $gfx_board );
		if ($gfx_board > 0) {
			print "Configuring for $gfx_boards[$ans-1]->{'name'}\n";
			$ext_base = $gfx_boards[$gfx_board-1]->{'base'};
			$ext_io   = $gfx_boards[$gfx_board-1]->{'io'};
			$ext_cw   = $gfx_boards[$gfx_board-1]->{'cw'};
		}
		else {
			print "\nPlease enter your board's data:\n";
			$ext_base = read_num( "Video base address", undef, undef, $def_base );
			$ext_io   = read_num( "I/O base address", undef, undef, $def_io );
			$ext_cw   = read_num( "Width of color registers", 1, 16, $def_cw );
		}

		print <<"EOF";

Now you have to enter data about the video mode used. Linux is currently
not yet able to program its own video modes on graphics boards, but
uses the mode active when it boots.

EOF
		$ext_xres  = read_num( "Horizontal width", 1, undef, $def_xres );
		$ext_yres  = read_num( "Vertical width", 1, undef, $def_yres );
		$ext_depth = read_num( "Number of bits per pixel (depth)", 1, undef,
							   $def_depth );
		if ($ext_depth > 1) {
			print <<"EOF";

Organization of video memory:
 1: normal planes, one plane after another
 2: interleaved planes (the way used by Atari internal graphics)
 3: packed pixels (<depth> consecutive bits for one pixel); this is
    the usual mode for depth 8 (256 colors)
 4: truecolor (no color lookup table)
EOF
			$def = $def_org eq 'n' ? 1 :
				   $def_org eq 'i' ? 2 :
				   $def_org eq 'p' ? 3 :
				   $def_org eq 't' ? 4 : 3;
			$ans = read_num( "Video organization", 1, 4, $def );
			$ext_org = $ans == 1 ? 'n' :
					   $ans == 2 ? 'i' :
					   $ans == 3 ? 'p' : 't';
		}
		else {
			$def = $def_org eq 'n' ? 'n' :
				   $def_org eq 'i' ? 'y' : 'n';
			$ext_org = yesno("Use inverted mode (bit 0=black)?", $def)?'i':'n';
		}

		print "\n2.1.x kernels need a slightly different video syntax in bootconf.\n";
		if (yesno( "Is the kernel to be booted a 2.1.x kernel?", $def_21 )) {
			$external = "video=atafb:external:";
		}
		else {
			$external = "video=external:";
		}
		$external .= sprintf( "%d;%d;%d;%s;0x%lx;;0x%lx;%d",
							  $ext_xres, $ext_yres, $ext_depth,
							  $ext_org, $ext_base, $ext_io, $ext_cw );
		add_ba( "kargs", $external );
	}

	# determine current root device from /etc/fstab
	print "\n";
	$rootdev = undef;
	if (open( F, "/etc/fstab" )) {
		while( <F> ) {
			if (m,^(/dev/\S+)\s+(\S+), && $2 eq '/') {
				$rootdev = $1;
				last;
			}
		}
		close( F );
	}
	print "Could not determine your root device!\n" if !$rootdev;
	if (defined $def_rootdev && defined $rootdev && $def_rootdev ne $rootdev) {
		print <<"EOF";
The root device currently configured in $instdir/bootargs
is $def_rootdev, and is different from what is configured in
/etc/fstab. There it is $rootdev.
EOF
	}
	# ask about root device and add root= option
	$rootdev = $def_rootdev if defined $dev_rootdev && !defined $rootdev;
	while(1) {
		$ans = read_str( "What is your root device", $rootdev );
		last if -b $ans;
		print "$ans is no block device!\n";
	}
	add_ba( "kargs", "root=$ans" );

	# add other unknown args found in old bootargs file
	for( $i = 0; $i < @old_bootargs; ++$i ) {
		$_ = $old_bootargs[$i];
		next if /^(-s$|-k\S|video=(atafb:)?external:|root=)/;
		++$i, next if /^-k$/;
		if (/^-(r|S|T|m)$/) {
			# switch takes arg which is separate
			add_ba( "bargs", $_ );
			add_ba( "bargs", $old_bootargs[$i+1] );
			++$i;
		}
		elsif (/^-/) {
			add_ba( "bargs", $_ );
		}
		else {
			add_ba( "kargs", $_ );
		}
	}

	print "Bootstrap arguments written to $instdir/bootargs are:\n  ",
		  get_ba(), "\n";
	open( F, ">$instdir/bootargs" )
		or die "Can not create $instdir/bootargs: $!\n";
	print F get_ba(), "\r\n";
	close( F );
}

save_config();
if ($do_umount) {
	!system( "$umount $tmpmnt" ) or die "Can't unmount $tmpmnt\n";
	rmdir $tmpmnt;
}
exit 0;


sub read_config {
	my( $var, $val );
	local( *F );

	foreach $var (@confvars) {
		eval "undef \$$var";
	}
	
	return if !open( F, "<$conffile" );
	while( <F> ) {
		chomp;
		next if /^#/ || /^\s*$/;
		if (!/^\s*(\S+)\s*=\s*(.*)\s*$/) {
			warn "Warning: Syntax error in $conffile, line $.\n";
			next;
		}
		($var, $val) = ($1, $2);
		if (!grep( $_ eq $var, @confvars )) {
			warn "Unknown config variable '$var' in $conffile, line $.\n";
			next;
		}
		if ($val ne 'undef') {
			$val =~ s/'/\\'/g;
			eval "\$$var = '$val'";
		}
	}
	close( F );
}

sub save_config {
	my( $var, $val );
	local( *F );

	if (!open( F, ">$conffile" )) {
		warn "Can't create $conffile: $!\n";
		return;
	}

	foreach $var (@confvars) {
		if (!eval "defined \$$var") {
			$val = "undef";
		}
		else {
			$val = eval "\$$var";
		}
		print F "$var = $val\n";
	}
	close( F );
}

sub read_str {
	my $text = shift;
	my $default = shift;
	my $ans;
	
	while( 1 ) {
		print "$text: ";
		print "[$default] " if $default;
		STDIN->flush();
		$ans = <STDIN>;
		chomp $ans;
		last unless $ans =~ /^\s*$/ && !$default;
	}
	$ans = $default if $ans =~ /^\s*$/;
	# remove leading and trailing whitespace
	$ans =~ s/^\s*(.*)\s*$/$1/;
	return $ans;
}

sub read_num {
	my $text = shift;
	my $min = shift;
	my $max = shift;
	my $default = shift;
	my $ans;

	while( 1 ) {
		print "$text: ";
		print "[$default] " if defined $default;
		STDIN->flush();
		$ans = <STDIN>;
		chomp $ans;
		if ($ans =~ /^\s*$/ && defined $default) {
			$ans = $default;
			last;
		}
		if ($ans =~ /^\s*(\d+|0x[0-9a-fA-F]+)\s*$/) {
			if ((defined($min) && $ans < $min) ||
				(defined($max) && $ans > $max)) {
				print "Must be between $min and $max\n";
				next;
			}
			last;
		}
	}
	$ans =~ s/^\s*(.*)\s*$/$1/;
	return $ans;
}

sub yesno {
	my $text = shift;
	my $default = shift;
	my $ans;

	while( 1 ) {
		print "$text (", ($default eq 'y' ? 'Y' : 'y'), "/",
			  ($default eq 'n' ? 'N' : 'n'), ") ";
		STDIN->flush();
		$ans = <STDIN>;
		chomp $ans;
		next if /^\s*$/ && !$default;
		last if $ans =~ /^\s*[yn]?\s*$/i;
	}
	if ($ans =~ /^\s*$/) {
		$ans = $default;
	}
	return ($ans =~ /y/i) ? 1 : 0;
}

sub add_ba {
	my $where = shift;
	my $arg = shift;
	my $argp;

	if ($where eq "bargs") {
		$argp = \$bootargs_b;
	}
	elsif ($where eq "kargs") {
		$argp = \$bootargs_k;
	}
	else {
		die "Internal error: Arg to add_ba must be 'bargs' or 'kargs'!\n";
	}
	
	$$argp .= " " if $$argp;
	$$argp .= $arg;
}

sub get_ba {
	return $bootargs_b . ($bootargs_b && $bootargs_k ? " " : "") . $bootargs_k;
}

sub kernel_exists {
	my $dir = shift;

	foreach (@kernel_names) {
		return $_ if -e "$dir/$_";
	}
	return "";
}

sub find_kernels {
	my @dirlist = @_;
	my( $dir, @kernels );

	foreach $dir (@dirlist) {
		foreach (@kernel_names) {
			push( @kernels, "$dir/$_" ) if -e "$dir/$_";
		}
	}
	return @kernels;
}

sub get_tos_partitions {
	my( $part, $id, $system, @tos_parts );
	local( *PIPE );
	
	open( PIPE, "$fdisk -l 2>&1 |" ) or die "Can't open pipe to $fdisk\n";
	while( <PIPE> ) {
		next if !/^(\S+).*\s([A-Z]{3})\s+(.*)\s+$/;
		($part, $id, $system) = ($1, $2, $3);
		push( @tos_parts, $part )
			if grep( $id =~ /^$_$/, @tos_partition_ids ) ||
			   grep( $system =~ /$_/i, @tos_partition_systems );
	}
	close( PIPE ) or die "$fdisk returned error status $?\n";
	return @tos_parts;
}

sub check_mounted {
	my @parts = @_;
	my( $part, $dir, %mounted );
	local( *PIPE );

	foreach (@parts) {
		$mounted{$_} = "";
	}
	
	open( PIPE, "$mount |" ) or die "Can't open pipe to $mount\n";
	while( <PIPE> ) {
		next if !/^(\/\S+) on (\S+)/;
		($part, $dir) = ($1, $2);
		$mounted{$part} = $dir if exists $mounted{$part};
	}
	close( PIPE ) or die "$mount returned error status $?\n";
	return %mounted;
}