#! /usr/bin/perl
# $Id: setup,v 1.9.2.2 1998/04/20 21:17:38 asm21 Exp $

use diagnostics;
use strict;

# extract the directory containing the binary files, and read a global set of
# routines from a file in that directory.
BEGIN {
    my @path=split("/",$0);
    $#path--;
    my $bindir=join("/",@path);
    do "$bindir/generic" or die "Failed to execute generic routine library $bindir/generic: $!\n";
}

my $vardir=$ARGV[0];
my $method=$ARGV[1];
my $option=$ARGV[2];

chdir("$vardir/methods/mountable") or die "Cannot chdir to $vardir/methods/mountable: $!\n";

# defaults
$::rootfs="/mnt";
$::rootpath='';
$::localpath='/root/debian';
@::dirlist=();
$::logfile="/var/log/dpkg-mountable";
$::insttype="stable";
$::allowoverwrite=0;
$::checkmd5=1;

do "options" or print "No configuration file.\n";

# add a way to write out the new config file. This is called from the postinst
# script, and just reads in the old options and writes them out again.
if ($option eq "int:postinst") {
    echo("Rewriting configuration file");
    writeconf();
    exit(0);
}

# this is hardwired into dpkg, and so should be non-empty.
my $arch=`dpkg --print-installation-architecture`;
chop $arch;
if ($arch eq "") {
    echo("Warning: cannot find installation architecture, defaulting to i386.");
    $arch="i386";
}

# the directory lists to use for the various modes
my %dirlist = (
    stable => ["dists/stable/main/binary-$arch",
	       "dists/stable/non-free/binary-$arch",
	       "dists/stable/contrib/binary-$arch"],
    frozen => ["dists/frozen/main/binary-$arch",
	       "dists/frozen/non-free/binary-$arch",
	       "dists/frozen/contrib/binary-$arch"],
    unstable => ["dists/unstable/main/binary-$arch",
		 "dists/unstable/non-free/binary-$arch",
		 "dists/unstable/contrib/binary-$arch"],
    developer => ["project/experimental",
		  "dists/unstable/main/binary-$arch",
		  "dists/unstable/non-free/binary-$arch",
		  "dists/unstable/contrib/binary-$arch"]
);

# getstring prompt default-value [help-text]
sub getstring {
    my ($prompt,$dflt,$blurb)=@_;
    my $rv;

    print "\n";
    echo $blurb if (defined($blurb));
    $dflt='' unless (defined($dflt));
    print "$prompt [$dflt]: ";
    chop($rv=<STDIN>);
    return $dflt if ($rv =~ /^[ \t]*$/);
    return $rv;
}

# borrowed from dpkg-ftp :)
sub yesno($$) {
  my ($d, $msg) = @_;
  my ($res, $r, $t);
  $r = 0;
  $r = 1 if $d eq "y" or $d eq "1";
  $t = $d;
  $t = 'y' if $d eq "1";
  $t = 'n' if $d eq "0";
  while (1) {
    print $msg, " [$t]: ";
    $res = <STDIN>;
    $res =~ /^[Yy]/ and return 1;
    $res =~ /^[Nn]/ and return 0;
    $res =~ /^[ \t]*$/ and return $r;
    print "Please enter y or n\n";
  }
}

sub isdebian {
    my $d=shift;
    return ( -e $d and -d "$d/dists" );
}

sub writeconf {
    # write the config file
    open(OPTS, ">$vardir/methods/mountable/options") or 
	die "Couldn't open file $vardir/methods/mountable/options: $!\n";
    print OPTS "\$rootfs='$::rootfs';\n";
    print OPTS "\$rootpath='$::rootpath';\n";
    print OPTS "\$localpath='$::localpath';\n";
    print OPTS "\@dirlist=('".join("','",@::dirlist)."');\n";
    print OPTS "\$logfile='$::logfile';\n";
    print OPTS "\$insttype='$::insttype';\n";
    print OPTS "\$allowoverwrite=$::allowoverwrite;\n";
    print OPTS "\$checkmd5=$::checkmd5;\n";
    print OPTS "1;\n";
    close(OPTS);
}

######################################################################
# Now we actually do the setup.

boldecho "Install from a mountable filesystem\n";

$::rootfs=
    getstring("Enter the root filesystem", $::rootfs,
	      "First, I need to know what partition you are installing from. This can either be\n".
	      "the device (eg /dev/hda3), or the mount point (eg /mnt), but in either case the\n".
	      "filesystem you specify MUST BE IN /etc/fstab. It can be mounted or unmounted, and\n".
	      "dpkg-mountable will tidy up properly after itself.\n\n".
	      "For autofs filesystems, give the root filesystem as /, and set the root of the\n".
	      "distribution correctly.\n");

print "Trying to mount $::rootfs: ";
domount();
echo "OK.\n";

if (isdebian($::rootfs)) {
    echo("Found Debian distribution on:\n".
	 "  $::rootfs\n".
	 "I'm going to use that. Choose the manual installation option if you want to\n".
	 "change this.\n");
    $::rootpath=$::rootfs;
} elsif (isdebian($::rootfs . "/debian")) {
    echo("Found Debian distribution on:\n".
	 "  $::rootfs/debian\n".
	 "I'm going to use that. Choose the manual installation option if you want to\n".
	 "change this.\n");
    $::rootpath=$::rootfs . "/debian";
} else {
    echo("Cannot find obvious Debian distribution (with the `dists' subdirectory)
on $::rootfs.");
    $::rootpath=
	getstring("Enter the path to the filesystem root", $::rootpath,
		  "I also need to know the path to the base of the Debian distribution on the\n".
		  "mounted filesystem, as an absolute pathname. For example, if you are mounting a\n".
		  "filesystem on /mnt, this might be /mnt/debian.\n");
    if (!isdebian($::rootpath)) {
	echo("The path you have entered does not appear to correspond to a copy of the Debian\n".
	     "distribution. I will assume you know this, and know what you're doing. (Otherwise,\n".
	     "I'll have to give up and let you try again.)");
	unless (yesno('y',"Is this true?")) {
	    doumount();
	    die "Aborting installation. Please try again!\n";
	}
    }
}

$::localpath='none' if $::localpath eq '';
$::localpath=
    getstring("Enter the local path, or `none'", $::localpath,
	      "If you wish to include packages on your system from another source than the\n".
	      "standard Debian distribution, you can give a path here where I can find them.\n".
	      "This directory should be laid out like the standard distribution (although it\n".
	      "is possible to use other names if you wish).\n");
$::localpath='' if $::localpath eq "none";

echo("By default, this version of dpkg-mountable passes the --refuse-overwrite\n".
     "switch to dpkg, which stops it overwriting files which are in multiple\n".
     "packages. This is in the interests of getting these fixed; if you find\n".
     "packages which include the same file, please file a bug report and, if you\n".
     "need the package, install manually.\n".
     "\n".
     "However, if you don't want to do this, I can turn it off.\n");
$::allowoverwrite=yesno($::allowoverwrite, "Allow overwriting repeated files?");

echo("In the packages file, all packages have an MD5 checksum, which can be used to\n".
     "(partially) verify the package file before installing; however, this\n".
     "verification takes some time, especially for large packages. Do you want to\n".
     "enable it?\n");
$::checkmd5=yesno($::checkmd5, "Enable MD5 checksumming?");

my @typelist=("stable","unstable","developer","manual");
@typelist=("stable","frozen","unstable","developer","manual")
    if ( -e $::rootpath . "/dists/frozen" );

my $type=$::insttype;

TYPE: while (1) {
    $type=
	getstring("Enter the installation mode", $::insttype,
		  "Please select a distribution to use, or manual to configure it by hand.\n".
		  "Available methods are:\n".
		  "   ".join("\n   ",@typelist)."\n");
    last TYPE if grep(/^$type$/,@typelist);
    echo("Type $type is not supported.\n");
}

$::insttype=$type;

echo('');

if (defined($dirlist{$type})) {
    echo("Using installation type $type");
    @::dirlist=@{$dirlist{$type}};
} else {
    my $rv;
    my ($p,$n);
    
    echo("Manual installation\n");

    @::dirlist=@{$dirlist{"unstable"}} if (scalar(@::dirlist) == 0);
    
  MANUAL: while (1) {
      echo("\nPlease set the list of paths to use. The current list is:");
      $n=1;
      for $p (@::dirlist) {
	  echo($n++.". $p");
      }
      print("Add, Remove, bring to Top or Done? [artD] ");
      $n=<STDIN>;
      $n=uc(substr($n,0,1));
      last MANUAL if ($n eq "D" or $n =~ /^[ \t\n\r]*$/);
      if ($n eq "A") {
	  my $i;
	  print("Enter the path to add: ");
	  $i=<STDIN>;
	  if ($i =~ /^[ \t\r\n]$/) {
	      echo("Cancelled.");
	      next MANUAL;
	  }
	  chop($i);
	  @::dirlist=(@::dirlist,$i);
      } elsif ($n eq "R") {
	  my $i;
	  print("Enter the number of the path to remove: ");
	  $i=<STDIN>;
	  chop $i;
	  if ($i == 0 or !defined($::dirlist[$i-1])) {
	      echo("No such path `$i'");
	      next MANUAL;
	  }
	  splice(@::dirlist,$i-1,1);
      } elsif ($n eq "T") {
	  my ($i,$p);
	  print("Enter the number of the path to move to the top: ");
	  $i=<STDIN>;
	  chop $i;
	  if ($i == 0 or !defined($::dirlist[$i-1])) {
	      echo("No such path `$i'");
	      next MANUAL;
	  }
	  $p=splice(@::dirlist,$i-1,1);
	  @::dirlist=($p,@::dirlist);
      } else {
	  echo("Invalid command.");
      }
  }
}

doumount();

writeconf();

exit(0);
