#!/usr/bin/perl -w
# $Id: dftp,v 2.11 1997/01/29 07:24:20 osiris Exp $
###############################################################################
#                                                                             #
#             Linux "Debian Distribution" FTP Packages Maintainer             #
#                                                                             #
#                          Copyright (c) 1995,1996 by                         #
#                                                                             #
#                     Brian C. White <bcwhite@verisim.com>                    #
#                                     and                                     #
#                   Robert L. Browning <osiris@cs.utexas.edu>                 #
#                                                                             #
#        This program is covered by the GNU General Public License.           #
#          For more information, see the file "COPYING" available             #
#        throughout the Debian distribution or /usr/doc/copyright/GPL         #
#                            on a Debian system.                              #
#                                                                             #
###############################################################################
#
# ToDo:
# Check all system() return values and die if appropriate
# Mention problem with netrc.
#
# check out docs, uses of maintainer and copyrights everywhere
#
# Bugs:
# set up on campus doesn't work --> can't mkdir through link...

require 5.002;

use English;
use strict;
use Getopt::Long;
use IO;


# Globals

my $program		= "dftp";
my $version		= "3.0";
my $maintainers	= '
                    Brian C. White <bcwhite@verisim.com>
                                    and
                  Robert L. Browning <osiris@cs.utexas.edu>
';
my @instalone	= qw(dpkg ldso libc5 libc6);
my %prefs;
my $debian_system;
my $netrc;
my $tmpfile;
my $debcf;
my $debrc;
my %cmds;

my($pkglist);
my($pkgprev);
my($pkgselect);
my($pkgdloadname);
my($pkgdload);
my($pkgftplog);
my($pkgdesc);
my($binary);
my($gunzip);
my($dotgz);

my($unwanted_file);
my($ignored_file);


###############################################################################
#
# Utility Functions
#
###############################################################################

sub errormsg {
	my($str) = @_;
	# Pass this a multiline string with no terminating newline and
	# it will print an indented error message like:
	#
	# dftp-perl: This is a problem that takes up
	#            more than one line.

	my($whitespace) = " " x (length($program) + 2);
	$str =~ s/\n/\n$whitespace/gmo;
	print STDERR "$program: $str\n";
}


sub diemsg {
	my($exit_value, $str) = @_;
	errormsg($str);
	exitdftp($exit_value);
}


sub usage_death {
	diemsg("Type \"$program\" with no parameters for usage, or\n" .
		   "type \"$program -help\" for information on using this script.",
		   1);
}


sub qecho {
	print @_ unless $prefs{"quiet"};
}


sub vecho {
	print @_ if $prefs{"verbose"};
}


# Diagnostic routine.
sub print_hash {
	my(%hash) = @_;
	my($key);
	foreach $key (sort(keys %hash)) {
		print $key, ' = ', $hash{$key}, "\n";
	}
}

sub page_text {
  my($text) = @_;
  open(PAGER, "| $ENV{PAGER}") or 
	die "Couldn't open your pager ($ENV{PAGER})";
  print PAGER $text;  
  close PAGER;
}


sub newfile {
	my($name, $mode) = @_;
	# make sure the named file exists, and is empty with the
	# permissions given
	# if someone knows a better way that's as safe, let me know.
	
	if(! -e $name) {
		open(FILE, ">$name");
		close(FILE);
	}
	chmod $mode, $name;
	open(FILE, ">$name");
	close(FILE);
}

###############################################################################
#
#  Set some standard aliases & variables
#

sub setup_defaults {
  
  # Is this a Debian system?
  if (-f "/var/lib/dpkg/status") {
	$debian_system = 1;
  } else {
	$debian_system = 0;
  }
  
  # Preferred temp directory?
  if (! exists($ENV{TMPDIR})) {
	$ENV{TMPDIR}="/tmp";
  }
  
  # Preferred editor?
  if (! exists($ENV{EDITOR})) {
	if ($debian_system) {
	  $ENV{EDITOR} = "ae";
	} else {
	  $ENV{EDITOR} = "vi";
	}
  }
  
  # Preferred pager?
  if (! exists($ENV{PAGER})) {
	$ENV{PAGER} = "more";
  }
  
  # Does this machine have a name?
  if (! exists($ENV{HOST})) {
	$ENV{HOST} = `hostname -f`;
  }
  
  # Does this user have a name?
  if (! exists($ENV{USER})) {
	if (exists($ENV{LOGNAME})) {
	  $ENV{USER} = $ENV{LOGNAME};
	} else {
	  $ENV{USER} = "anonymous";
	}
  }
  
  $netrc = "$ENV{HOME}/.netrc";
  $tmpfile = "$ENV{TMPDIR}/${program}${PID}";
  
  #  Program defaults -- don't change them here -- add them to your .dftprc!
  
  $prefs{"prefix"}	= "$ENV{HOME}/packages";
  $prefs{"include"}	= "stable,contrib,non-free";
  $prefs{"exclude"}	= "";
  $prefs{"pkgpath"}	= "";
  $prefs{"ftpsite"}	= "ftp.debian.org";
  $prefs{"ftpuser"}	= "anonymous";
  $prefs{"ftpdir"}	= "/debian";
  $prefs{"ftpgate"}	= "";
  $prefs{"arch"}		= "i386";
  $prefs{"tarfile"}	= "$ENV{HOME}/debian.tar";
  $prefs{"email"}		= "$ENV{USER}\@$ENV{HOST}";
  
  if ($debian_system) {
	chomp($prefs{"arch"} = `dpkg --print-installation-architecture`);
  }

  $debcf = "/etc/$program.conf";
  $debrc = "$ENV{HOME}/.${program}rc";
}


################################################################################
#
#  Parse the user's RC file for defaults
#

sub find_option_flag {
	my($rcfile, $prefs_ref, $option_name, $source_text) = @_;

	# If the flag is found in the source text, set the pref
	# in the hash table pointed to by $prefs_ref otherwise, don't.

	if ($source_text =~ m/^( [ \t]* $option_name [ \t\S]* )$/mgx) {
		my($source_line) = $1;

		if ($source_line =~ m/^ [ \t]* $option_name [ \t]* $/mgx) {
			$$prefs_ref{$option_name} = 1;
		} else {
			print "Bad $option_name flag line in $rcfile.\n";
		}
	}
}


sub find_option_value {
	my($rcfile, $prefs_ref, $option_name, $source_text) = @_;

	# If the option is in the source text, put the value
	# into the hash table pointed to by $prefs_ref.

	if ($source_text =~ m/^ [ \t]* ($option_name:.*) $/mgx) {
		my($source_line) = $1;

		if ($source_line =~
		   m/^ [ \t]* $option_name: [ \t]* (\S*) [ \t]* $/mgx) {
			$$prefs_ref{$option_name} = $1;
		} else {
			print "Bad $option_name value line in $rcfile.\n";
		}
	}
}


sub read_option_file {
	my($rcfile) = @_;

	if (open(RESOURCE, $rcfile)) {
		my($pref_lines) = join("",<RESOURCE>);

		# strip comments.
		$pref_lines =~ s/#.*$//gmo;

		find_option_flag($rcfile, \%prefs, "nodesc",   $pref_lines);
		find_option_flag($rcfile, \%prefs, "tardesc",  $pref_lines);
		find_option_flag($rcfile, \%prefs, "quiet",    $pref_lines);
		find_option_flag($rcfile, \%prefs, "verbose",  $pref_lines);
		find_option_flag($rcfile, \%prefs, "password-prompt", $pref_lines);

		find_option_value($rcfile, \%prefs, "prefix",  $pref_lines);
		find_option_value($rcfile, \%prefs, "include", $pref_lines);
		find_option_value($rcfile, \%prefs, "exclude", $pref_lines);
		find_option_value($rcfile, \%prefs, "pkgpath", $pref_lines);
		find_option_value($rcfile, \%prefs, "ftpsite", $pref_lines);
		find_option_value($rcfile, \%prefs, "ftpuser", $pref_lines);
		find_option_value($rcfile, \%prefs, "ftpdir",  $pref_lines);
		find_option_value($rcfile, \%prefs, "ftpgate", $pref_lines);
		find_option_value($rcfile, \%prefs, "email",   $pref_lines);
		find_option_value($rcfile, \%prefs, "arch",    $pref_lines);
		find_option_value($rcfile, \%prefs, "tarfile", $pref_lines);

		close(RESOURCE);
	}
}


###############################################################################
#
#  Display usage help if no parameters were given.  It's long, so use PAGER.
#

sub print_usage {
  #
  # Print different message if we are/aren't a Linux system
  #
  
  my($getnewdef, $getnewstart);
  
  if ($debian_system) {
	$getnewdef = '(Debian System: do "unpack" instead of "archive")';
	$getnewstart = 'getlist';
  } else {
	$getnewdef = '(Non-Debian System: do "archive" instead of "unpack")';
	$getnewstart = 'getlist';
  }
  
  page_text(usage_string($getnewdef, $getnewstart));
}



###############################################################################
#
#  Parse parameters and set up actions, flags, and options.
#

sub handle_cmdline {

  my($result) =
	GetOptions(\%prefs,
			   "version",
			   "nodesc",
			   "tardesc",
			   "quiet",
			   "verbose",
			   "whatsnew",
			   "help",
			   "password-prompt",
			   
			   "prefix=s",
			   "include=s",
			   "exclude=s",
			   "pkgpath=s",
			   "ftpsite=s",
			   "ftpuser=s",
			   "ftpdir=s",
			   "ftpgate=s",
			   "email=s",
			   "tarfile=s",
			   "ask:s@",
			   "arch=s");
  
  my($ok) = 1;
  
  while ($#ARGV >= 0) {
	my($option) = shift(@ARGV);
	
	my(%legal_cmds) = ("scaninst"	=> 1,
					   "getlist"	=> 1,
					   "select"		=> 1,
					   "getselect"	=> 1,
					   "verify"		=> 1,
					   "unpack"		=> 1,
					   "archive"	=> 1,
					   "installed"	=> 1,
					   "clean"		=> 1,
					   "getnew"		=> 1);
	
	if (exists($legal_cmds{$option})) {
	  $cmds{$option} = $option;
	} else {
	  print "ERROR: Unrecognized parameter $option\n";
	  $ok = 0;
	}
  }
  
  # Diagnostics.
  
  #print "Prefs: \n";
  #print_hash(%prefs);
  
  #print "Commands: \n";
  #print_hash(%cmds);

  
  # Do some configuration based on parameters given
  $pkglist		= "$prefs{prefix}/.available";
  $pkgprev		= "$prefs{prefix}/.prev-avail";
  $pkgselect		= "$prefs{prefix}/.selected";
  $pkgdloadname	= ".downloaded";
  $pkgdload		= "$prefs{prefix}/$pkgdloadname";
  $pkgftplog		= "$prefs{prefix}/.ftplog";
  $pkgdesc		= "$prefs{prefix}/.packages";
  $binary			= "binary-$prefs{arch}";
  $gunzip			= `bash -c "type -p gunzip"`;
  
  $unwanted_file = "$prefs{prefix}/.unwanted";
  $ignored_file = "$prefs{prefix}/.ignored";


  chop($gunzip);
  
  if ($gunzip) {
	$dotgz=".gz";
  } else {
	$dotgz="";
  }
  
  if ($prefs{"pkgpath"}) {
	$prefs{"pkgpath"} = "$prefs{pkgpath}/";
  }
  
  # Catch people trying to be clever
  
  if ($prefs{"quiet"} && $prefs{"verbose"}) {
	diemsg("Quiet AND Verbose!  Is this some kind of test?\n", 1);
  }
  
  return $ok;
}


###############################################################################
#
#  End of parse and setup -- actual work code follows
#
###############################################################################

sub find_installed_packages {
  #returns a hash table where the key is an installed
  #package name, and the value is the version.
  
  my $dpkglib = "/var/lib/dpkg/status";
  my @installed = ();
  my $fh = new IO::File;
  my %result;
  
  local($/) = '';
  $fh->open("<$dpkglib") || die "Error: Could not read '$dpkglib' -- $!";
  
  while(<$fh>) {
	my($pack) = $_;
	
	if($pack =~ /^Status: .*\sinstalled$/mo) {
	  $pack =~ /^Package:\s*(\S*)\s*/mo;
	  my $name = $1;
	  $pack =~ /^Version:\s*(\S*)\s*/mo;
	  $result{"$name"} = $1;
	}
  }
  $fh->close();

  return %result;
}

###############################################################################
#
#  Use FTP to grab the Debian "ls-laR" file and parse it for a dir structure.
#  Use that to build a list of new and uninstalled packages for the user to
#  select from.
#

sub sort_section_func {
	# Function used to sort the packages.
	# Compares the packages based on their section lines.
	# This has no args because of the behavior of sort.

	my($s1,$s2) = (0,0);
	if ($a =~ m/^[Ss]ection:\s*(\S+)/m) {
		$s1 = $1;
	}

	if ($b =~ m/^[Ss]ection:\s*(\S+)/m) {
		$s2 = $1;
	}

	if ($s1 && $s2) {
		return($s1 cmp $s2);
	} elsif ($s1) {
		return -1;
	} elsif ($s2) {
		return 1;
	} else {
		return 0 ;
	}
}


sub package_get_section {
	my($package_text) = @_;

	# Finds the name of the section in a package's text.

	if ($package_text =~ m/^[Ss]ection:\s*(\S+)/mo) {
		return $1;
	} else {
		return "sectionless";
	}
}


sub section_excluded_p {
  my($package_text, @exclude_list) = @_;
  
  # return true if the section name on the section line in
  # package_text is not in exclude_list
  
  my($package_section) = package_get_section($package_text);
  my($excluded_section);
  foreach $excluded_section (@exclude_list) {
	if ($package_section eq $excluded_section) {
	  return 0;
	}
  }
  return 1;
}



sub load_package_array {
	my($filename) = @_;

	# Splits up filename into an array where each element contains
	# a package entry and returns the array.

	local($/) = '';
	open(INPUT,"<$filename") || die "Error: Could not read '$filename' -- $!";
	my(@packages) = <INPUT>;
	close(INPUT);

	return @packages;
}

sub get_ftp_password {
  system "stty -echo";
  print "Password: ";
  my $pass = <>;
  system "stty echo";
  print "\n";
  chomp $pass;
  return $pass;
}


sub download_package_lists {
  
  if (! $prefs{"pkgpath"}) {
	qecho "Fetching list of packages in the Debian distribution via FTP...\n";
  } else {
	qecho "Fetching list of packages in the Debian distribution...\n";
  }
  
  #
  # Be kind and save any old .netrc file
  #
  my($usernetrc) = 0;
  if (-f $netrc) {
	if (! (-f "$netrc.user")) {
	  rename("$netrc","$netrc.user");
	}
	$usernetrc=1;
  }
  
  if($prefs{"password-prompt"}) {
	$prefs{"email"} = get_ftp_password();
  }

  #
  # FTP works a bit differently depending on normal or secure
  #
  open(NETRC, ">$netrc") || die "Error: Could not open '$netrc' -- $!";
  if (!($prefs{ftpgate})) {
	print NETRC
	  "machine $prefs{ftpsite} login $prefs{ftpuser} ",
	  "password $prefs{email} macdef init\n";
  } else {
	print NETRC
	  "machine $prefs{ftpgate} ",
	  "login \"$prefs{ftpuser}\@$prefs{ftpsite} $ENV{USER}\" ",
	  "password $prefs{email} macdef init\n";
  }
  
  #
  # What to do when we connect
  #
  print NETRC "hash\n";
  if ($gunzip) {
	print NETRC "binary\n";
  } else {
	print NETRC "ascii\n";
  }
  print NETRC "cd $prefs{ftpdir}\n";
  
  if (! $prefs{"pkgpath"}) {
	my($dir);
	foreach $dir (split(/\s*,\s*/,$prefs{"include"})) {
	  if (! (-d $dir)) {
		mkdir("$dir",0755) || die "Error: Could not mkdir '$dir' -- $!\n";
	  }
	  if (! (-d "$dir/$binary")) {
		mkdir("$dir/$binary",0755) || 
		  die "Error: Could not mkdir '$dir/binary' -- $!\n";
	  }
	  if (-f "$dir/$binary/Packages$dotgz") {
		unlink("$dir/$binary/Packages$dotgz");
	  }
	  print NETRC 
		"get $dir/$binary/Packages$dotgz $dir/$binary/Packages$dotgz\n";
	}
  }

  print NETRC "bye\n\n";
  close(NETRC);
  chmod(0600,"$netrc");
  
  #
  # Remove any old listing that is hanging around
  #
  unlink("$pkglist", "$pkgdesc", "$pkgselect");
  
  #
  # If no local path, do the actual FTP and keep a log
  #
  if (! $prefs{"pkgpath"}) {
	if ($prefs{"quiet"}) {
	  if (! $prefs{ftpgate}) {
		system("ftp -v $prefs{ftpsite} </dev/null 2>&1 > $pkgftplog");
	  } else {
		system("ftp -v $prefs{ftpgate} </dev/null >  $pkgftplog");
	  }
	} else {
	  if (! $prefs{ftpgate}) {
		system("ftp -v $prefs{ftpsite} </dev/null 2>&1 | tee $pkgftplog");
	  } else {
		system("ftp -v $prefs{ftpgate} </dev/null |  tee $pkgftplog");
	  }
	}
	qecho " \n";
  }
  
  #
  # Restore the .netrc file if one was saved
  #
  unlink($netrc);
  if ($usernetrc) {
	rename("$netrc.user", "$netrc");
	$usernetrc = 0;
  }
  
  #
  # Stop if could not get the listing
  #
  my($tmpdesc) = "$tmpfile.packages";
  open(TMPDESC,">$tmpdesc");
  
  my($dir);
  foreach $dir (split(/\s*,\s*/, $prefs{"include"})) {
	my $pkgfile = "$prefs{pkgpath}$dir/$binary/Packages$dotgz";
	if (! -r $pkgfile) {
	  $pkgfile = "$prefs{pkgpath}$dir/Packages$dotgz";
	}
	if (-r $pkgfile) {
	  # Open an input pipe containing the packages file.
	  if ($gunzip) {
		## Should check return
		open(PKGFILE, "$gunzip -c $pkgfile |");
	  } else {
		## Should check return.
		open(PKGFILE, "<$pkgfile");
	  }
	  my(@contents) = <PKGFILE>;
	  print TMPDESC @contents;
	  print TMPDESC "\n";
	  close(PKGFILE);
	} else {
	  print "Could not retrieve package list for '$dir' -- not included\n";
	}
  }
  close(TMPDESC);
  
  #
  # Sort directory by section, excluding any unwanted ones
  #
  
  qecho "Sorting packages by section...\n";
  
  my(@packages) = load_package_array($tmpdesc);
  @packages = sort sort_section_func @packages;
  
  if ($prefs{"exclude"}) {
	my(@exclude_list) = split(/\s*,\s*/, $prefs{exclude});
	
	@packages =
	  grep { section_excluded_p($_, @exclude_list); } @packages;
  }
  
  open(PKGDESC,">$pkgdesc") || die "Error: Could not open '$pkgdesc' -- $!\n";
  print PKGDESC @packages;
  close(PKGDESC);
  
  
  #
  # Generate a list of packages pathname from description file
  #
  open(PKGLIST, ">$pkglist") || die "Error: Could not open '$pkglist' -- $!\n";
  my($package);
  foreach $package (@packages) {
	
	$package =~ m/^filename:\s*(\S+)/imo;
	print PKGLIST "$1";
	
	$package =~ m/^package:\s*(\S+)/imo;
	print PKGLIST ";$1";
	
	$package =~ m/^version:\s*(\S+)/imo;
	print PKGLIST ";$1";
	
	if ($package =~ m/^revision:\s*(\S+)/imo) {
	  print PKGLIST "-$1";
	}
	
	$package =~ m/^size:\s*(\S+)/imo;
	print PKGLIST ";$1";
	
	$package =~ m/^md5sum:\s*(\S+)/imo;
	print PKGLIST ";$1";
	
	print PKGLIST "\n";
	
  }
  close(PKGLIST);
  
  #
  # Remove old selection file so a new one will be built with new data
  #
  unlink($pkgselect);
}


sub get_previous_packages {
  my($filename) = @_;
  my(@prev_pkgs) = split(' ', `cat $filename`);
  my(%prev_packages_hash);
  
  my($package);
  foreach $package (@prev_pkgs) {
	# Hash table is keyed on package name.
	$package =~ m/^[^;]+;([^;]+);([^;]+);/go;
	$prev_packages_hash{$1} = $2;
  }
  return %prev_packages_hash;
}


sub load_package_list {
  my($filename) = @_;
  my(@pkgs) = split(' ', `cat $filename`);
  my(%hash);
  
  my($package);
  foreach $package (@pkgs) {
	$hash{$package} = 1;
  }
  return %hash;
}


sub save_package_list {
  my($hash_r, $file) = @_;
  my $fh = new IO::File;
  $fh->open(">$file") || 
	die "Error: Could not open '$file' -- $!\n";

  print $fh join("\n", sort(keys(%$hash_r)));
  $fh->close();
}


sub make_filename_to_pkg_hash {
  my(@packages) = @_;
  my(%filename_hash);
  
  my($package);
  foreach $package (@packages) {
	$package =~ m/^filename:\s*(\S+)/imo;
	$filename_hash{$1} = $package;
  }
  return %filename_hash;
}



###############################################################################
#
# Call the editor with with the list of new/uninstalled packages so the user
# can choose what to download.
#

sub notify_ignored_upgrades {
  my(@ignored_upgrade_pkgs) = @_;
 
  my $pkg;
  foreach $pkg (@ignored_upgrade_pkgs) {
	print "Ignoring upgrade of $$pkg{name} to $$pkg{note}\n";
  }
}

sub get_user_installation_response {
  my($prompt, $default) = @_;

  my $done = 1;

  do {
	STDIN->flush();
	
	print "$prompt [?dDiyn#] ($default): ";  
	my $result = <>;
	if($result =~ /^\s*$/o) {
	  return $default;
	} else {
	  if($result =~ /^\s*y\s*$/io) {
		return "yes";
	  } elsif($result =~ /^\s*n\s*$/io) {
		return "no";
	  } elsif($result =~ /^\s*d\s*$/o) {
		return "describe";
	  } elsif($result =~ /^\s*D\s*$/o) {
		return "describe-mode";
	  } elsif($result =~ /^\s*i\s*$/io) {
		return "ignore";
	  } elsif($result =~ /^\s*(\d+)\s*$/o) {
		return "$1";
	  } else {		
		print "  Options are:\n";
		print "    y - yes, install this package\n";
		print "    n - no, don't install this package\n";
		print "    i - ignore this package and all future upgrades\n";
		print "    d - get description of this package\n";
		print "    D - toggle describe mode\n";
		print "    # - a package number to go back to\n";
		print "    ? - repeat this help message\n";
		$done = 0;
	  }
	}
  } until $done;
}

sub ask_about_installing {
  my($prompt, $package_list_ref, $default, $package_descriptions) = @_;
  my @package_actions;
  my $pkg_ref;
  my $response;
  my $describe_mode = 0;

  my $i;
  my $total = scalar(@$package_list_ref);
  
  for($i=0; $i < $total; $i++) {
	$package_actions[$i] = $default;
  }
  
  for($i=0; $i < $total; $i++) {
	$pkg_ref = @$package_list_ref[$i];
	my $done = 0;
	while(!$done) {
	  my $max = $total - 1;

	  if($describe_mode) {
		# Look up package description if desired
		my $pkg_info = $$package_descriptions{$$pkg_ref{"file"}};		
		if (! $pkg_info) {
		  die "Error: Could not find package entry for '$$pkg_ref{file}'!\n";
		}
		print "\n", $pkg_info;
	  }

	  my $query = "[$i/$max] $prompt $$pkg_ref{name} $$pkg_ref{note}";
	  $response = get_user_installation_response($query, $package_actions[$i]);

	  if($response eq "describe-mode") {
		$describe_mode = ! $describe_mode;
	  } elsif($response eq "yes" || $response eq "no" || 
			  $response eq "ignore") {
		$package_actions[$i] = $response;
		$done = 1;
	  } elsif($response =~ /(\d+)/) {
		if($1 >= 0 && $1 < $total) {
		  $i = $1 - 1;
		  $done = 1;
		} else {
		  print "Can't go back to $1.  Out of range.\n";
		}
	  } elsif($response eq "describe") {
		# Look up package description if desired
		my $pkg_info = $$package_descriptions{$$pkg_ref{"file"}};		
		if (! $pkg_info) {
		  die "Error: Could not find package entry for '$$pkg_ref{file}'!\n";
		}
		print $pkg_info;
	  }
	}		
  }

  my(@yes, @ignore);
  for($i=0; $i < $total; $i++) {
	if($package_actions[$i] eq "yes") {
	  push @yes, $$package_list_ref[$i];
	} elsif ($package_actions[$i] eq "ignore") {
	  push @ignore, $$package_list_ref[$i];
	}
  }
  
  return (\@yes, \@ignore);
}


sub sequential_install {

  # Compare each available package with installed list

  qecho "Preparing sequential install...\n";
  
  # packages new to this system, and not unwanted.
  my @new_pkgs = ();
  # packages representing upgrades to installed packages, and not unwanted.
  my @upgrade_pkgs = ();
  # Will hold incoming upgrades, currently unwanted on this system.
  my @ignored_pkgs = ();
  # packages unwanted on this system.
  my @unwanted_pkgs = ();

  newfile("$unwanted_file", 0644) if (! (-f $unwanted_file));
  newfile("$ignored_file", 0644) if (! (-f $ignored_file));
  
  # Get package info.
  my %unwanted = load_package_list($unwanted_file);
  my %ignored = load_package_list($ignored_file);

  my(%installed_vers) = find_installed_packages();
  my %pkg_desc_by_filename =
	make_filename_to_pkg_hash(load_package_array($pkgdesc));
  
  my(@packages) = split(' ', `cat $pkglist`);
  

  # Step through each package and decide what to do with it
  my($package);

  while(@packages) {

	$package = shift(@packages);
	
	my(@pkgfields) = split(';', $package);
	
	if ($#pkgfields != 4) {
	  vecho "WARNING: incomplete information for $package -- skipped\n";
	  next;
	}
	
	my %incoming = ("file" => $pkgfields[0],
					"name" => $pkgfields[1],
					"version" => $pkgfields[2],
					"size" => $pkgfields[3],
					"md5sum" => $pkgfields[4]);
	
	if ($prefs{"pkgpath"}) {
	  if (! ( -r ($prefs{"pkgpath"} . $incoming{"file"}))) {
		qecho "$incoming{file} is non-existant -- skipped\n";
		next;
	  }
	}
	
	my($installed_version) = $installed_vers{$incoming{"name"}};

	if($installed_version) { # installed
	  if($installed_version ne $incoming{"version"}) { 
		
		# --compare-versions returns 0 on success.
		my($upgrade_p) = system("dpkg --compare-versions " .
								"$incoming{version} '<' $installed_version");
		if($upgrade_p) { # upgrade
		  if(exists($unwanted{ $incoming{"name"}})) { # unwanted
			print "Found $incoming{name}, previously marked unwanted.\n";
			print "  Removing from unwanted list.\n";
			delete($unwanted{ $incoming{"name"}});
			unshift(@packages, $package);
			next;  # ugly, but effective.
		  } elsif(exists($ignored{$incoming{"name"}})) { # unwanted
			$incoming{"note"} = 
			  "$incoming{version} ($installed_version installed)";
			push(@ignored_pkgs, \%incoming);
		  } else { # wanted
			$incoming{"note"} = 
			  "$incoming{version} ($installed_version installed)";
			push(@upgrade_pkgs, \%incoming);
		  }
		} else { # already have at least this version
		  vecho "Skipping up to date $incoming{name}\n";
		}
	  } else { # already have this version
		vecho "Skipping up to date $incoming{name}\n";
	  }
	} else { # not installed
	  if (exists($unwanted{$incoming{"name"}})) { #unwanted
		$incoming{"note"} = "$incoming{version}";
		push(@unwanted_pkgs, \%incoming);
	  } else { # new
		$incoming{"note"} = "$incoming{version}";
		push(@new_pkgs, \%incoming);
	  }
	}
  }
  STDOUT->autoflush();
  
  my $ask;
  my @asklist = @ {$prefs{"ask"}};
  my @askpossibilities = ("upgrades", 
						  "new",
						  "unwanted",
						  "ignored");
  
  if($asklist[0] eq "") {
	@asklist = ("upgrades", "new");
  } elsif($asklist[0] eq "all") {
	@asklist = @askpossibilities;
  }
  
  foreach $ask (@asklist) {
	if(grep(/^$ask$/, @askpossibilities) != 1) {
	  die "Bad --ask list (@asklist)\n";
	}
  }

  # Show the user what they're missing if they aren't planning to
  # deal with the unwanted upgrades.
  notify_ignored_upgrades(@ignored_pkgs)
	if(grep(/^ignored$/, @asklist) != 1);
    
  my @install_selections = ();
  my @ignore_selections = ();
  my @unwanted_selections = ();

  foreach $ask (@asklist) {
	if($ask eq "upgrades") {
	  print "Upgrades to installed packages:\n";
	  my($install_lr, $ignore_lr) = 
		ask_about_installing("Upgrade", 
							 \@upgrade_pkgs,
							 "yes",
							 \%pkg_desc_by_filename);
	  push @install_selections, @$install_lr;
	  push @ignore_selections, @$ignore_lr;
	} elsif ($ask eq "new") {
	  print "New packages:\n";
	  my($install_lr, $ignore_lr) = 
		ask_about_installing("Install new package", 
							 \@new_pkgs,
							 "ignore",
							 \%pkg_desc_by_filename);
	  push @install_selections, @$install_lr;
	  push @unwanted_selections, @$ignore_lr;
	} elsif ($ask eq "ignored") {
	  print "Ignored upgrades to installed packages:\n";
	  my($install_lr, $ignore_lr) = 
		ask_about_installing("Upgrade", 
							 \@ignored_pkgs,
							 "no",
							 \%pkg_desc_by_filename);
	  push @install_selections, @$install_lr;
	  push @ignore_selections, @$ignore_lr;
	} elsif ($ask eq "unwanted") {
	  print "Unwanted packages:\n";
	  my($install_lr, $ignore_lr) = 
		ask_about_installing("Install", 
							 \@unwanted_pkgs,
							 "no",
							 \%pkg_desc_by_filename);
	  push @install_selections, @$install_lr;
	  push @unwanted_selections, @$ignore_lr;
	}
  }

  my $fh = new IO::File;

  # Output the list of packages selected for install.
  $fh->open(">$pkgselect") || 
	die "Error: Could not open '$pkgselect' -- $!\n";
  foreach $package (@install_selections) {
	print $fh $$package{"file"} . "\n";
	delete($unwanted{$$package{"name"}});
	delete($ignored{$$package{"name"}});
  }
  $fh->close();
  
  # Output the lists of ignored and unwanted packages (for future runs).
  foreach $package (@ignore_selections) {
	$ignored{$$package{"name"}} = 1;
  }
  foreach $package (@unwanted_selections) {
	$unwanted{$$package{"name"}} = 1;
  }
  save_package_list(\%ignored, $ignored_file);
  save_package_list(\%unwanted, $unwanted_file);
}

  
sub select_packages {
  if (! (-f $pkglist)) {
	diemsg("ERROR - Cannot find list of available packages.\n" .
		   "Use the \"getlist\" action to get list from ftp site.",
		   1);
  }
  
  if($prefs{"ask"}) {
	sequential_install();
  } else {
	#
	# Only build selection list if it is required
	#
	if (! (-f $pkgselect)) {
	  #
	  # Compare each available package with installed list
	  #
	  qecho "Building list of updated and un-installed packages...\n";
	  
	  my(@debnewupgrad)	= ();
	  my(@debignorupgrad) = ();
	  my(@debignordngrad) = ();
	  my(@debnewpkg)		= ();
	  my(@debignorpkg)	= ();
	  my $debref;
	  
	  if (! (-f $pkgprev)) {
		system("touch $pkgprev");
	  }
	  
	  #
	  # Get package info.
	  #
	  my(%prev_pkgs) = get_previous_packages($pkgprev);
	  my(%installed_vers) = find_installed_packages();
	  my(%pkg_desc_by_filename) =
		make_filename_to_pkg_hash(load_package_array($pkgdesc));
	  
	  #
	  # Step through each non-excluded package and decide what to do with it
	  #
	  my($package);
	  foreach $package (split(' ', `cat $pkglist`)) {
		my(@pkgfields) = split(';', $package);
		
		if ($#pkgfields != 4) {
		  vecho "WARNING: incomplete information for $package -- skipped\n";
		  next;
		}
		
		my($incoming_file)		= $pkgfields[0];
		my($incoming_name)		= $pkgfields[1];
		my($incoming_version)	= $pkgfields[2];
		my($incoming_size)		= $pkgfields[3];
		my($incoming_md5sum)	= $pkgfields[4];
		
		if ($prefs{"pkgpath"}) {
		  if (! ( -r ($prefs{"pkgpath"} . $incoming_file))) {
			qecho "$incoming_file is non-existant -- skipped\n";
			next;
		  }
		}
		
		my($installed_version) = $installed_vers{$incoming_name};
		my($str);
		my($pkg_type);
		
		$debref = "";
		if ($installed_version) {
		  if ($installed_version eq $incoming_version) {
			$str = "$incoming_file\n";
			$pkg_type = "installed, unchanged";
		  } else { # installed version and incoming version differ
			
			# --compare-versions returns 0 on success.
			my($upgrade_p) = 
			  system("dpkg --compare-versions " .
					 "$incoming_version '<' $installed_version");
			if ($upgrade_p) {
			  if (exists($prev_pkgs{$incoming_name}) &&
				  ($prev_pkgs{$incoming_name} eq $incoming_version)) {
				$str = "$incoming_file " .
				  "($incoming_version vs $installed_version)\n";
				push(@debignorupgrad, "#$str");
				$debref = \@debignorupgrad;
				$pkg_type = "upgrade, ignored";
			  } else {
				$str = "$incoming_file " .
				  "($incoming_version vs $installed_version)\n";
				push(@debnewupgrad, "$str");
				$debref = \@debnewupgrad;
				$pkg_type = "upgrade, unseen";
			  }
			} else {
			  $str = "$incoming_file " .
				"($incoming_version vs $installed_version)\n";
			  push(@debignordngrad, "#$str");
			  $debref = \@debignordngrad;
			  $pkg_type = "downgrade";
			}
		  }
		  
		} else { # no version installed
		  
		  # Check to see if this package is new
		  if (exists($prev_pkgs{$incoming_name}) &&
			  ($prev_pkgs{$incoming_name} eq $incoming_version)) {
			$str = "$incoming_file\n";
			push(@debignorpkg, "#$str");
			$debref = \@debignorpkg;
			$pkg_type = "uninstalled, ignored";
		  } else {
			$str = "$incoming_file\n";
			push(@debnewpkg, "#$str");
			$debref = \@debnewpkg;
			$pkg_type = "new, unseen";
		  }
		}
		vecho "$incoming_file -- $pkg_type\n";
		
		if (ref $debref eq "ARRAY") {
		  #
		  # Look up package description if desired
		  #
		  if (! $prefs{"nodesc"}) {
			my($pkg_info) = $pkg_desc_by_filename{$incoming_file};
			
			# check matched one, take first, warn about others.
			if (! $pkg_info) {
			  die "Error: Could not find package entry for ". 
				"'$incoming_file'!\n";
			}
			$pkg_info =~ s/\s*$//sg;
			$pkg_info =~ s/^/> /mog;
			
			push @$debref, "$pkg_info\n\n";
		  }
		}
	  }
	  
	  #
	  # Build selection file (with instructions)
	  #
	  
	  open(PKGSELECT, ">$pkgselect") || die "Error: Could not open '$pkgselect' -- $!\n";
	  print PKGSELECT <<__END__;
#==============================================================================
#
# LIST OF NEW UPGRADES -- a list of available packages whose versions are newer
# than the versions installed on your system.
#
# The pathname on the left shows what is available.  Within parentheses on the
# right is the newer version followed by the installed version. Comment out
# (with '#') the pathnames of any packages you do not wish to update.  Those
# not retrieved will appear under "LIST OF IGNORED UPGRADES" in future runs.
#

__END__
		print PKGSELECT @debnewupgrad;
		print PKGSELECT <<__END__;

#==============================================================================
#
# LIST OF DOWNGRADES -- The following is a list of packages available which
# represent version downgrades.
#
# Uncomment (remove the '#' from) the pathname of any package you wish to
# install.
#

__END__
		print PKGSELECT @debignordngrad;
		print PKGSELECT <<__END__;

#==============================================================================
#
# LIST OF NEW PACKAGES -- The following is a list of packages that have been
# added to the distribution since the last time you ran "$program getlist".
#
# Uncomment (remove the '#' from) the pathname of any package you wish to
# install.  Those not retrieved will appear under "LIST OF IGNORED PACKAGES" in
# future runs.
#

__END__
		print PKGSELECT @debnewpkg;
		print PKGSELECT <<__END__;

#==============================================================================
#
# LIST OF IGNORED UPGRADES -- The following is a list of package upgrades that
# are available but you have previously chosen not to install.
#
# Uncomment (remove the '#' from) the pathname of any package you wish to
# install.
#

__END__
		print PKGSELECT @debignorupgrad;
		print PKGSELECT <<__END__;

#==============================================================================
#
# LIST OF IGNORED PACKAGES -- The following is a list of packages that are
# available but you have previously chosen not to install.
#
# Uncomment (remove the '#' from) the pathname of any package you wish to
# install.
#

__END__
		print PKGSELECT @debignorpkg;
	}

	close(PKGSELECT);

	system("$ENV{EDITOR} $pkgselect");
  }
}



###############################################################################
#
#  Use FTP to get all the selected files
#

sub download_packages {
	if (! (-f $pkgselect)) {
		print "ERROR: The list of selected packages does not exist.\n";
		print "       Perhaps you have already used the \"clean\" action?\n";
		exitdftp(1);
	}

	if (! $prefs{"pkgpath"}) {
		qecho "Building script to fetch files...\n";
	}

	#
	# File in which to store FTP "get" commands
	#
	my($ftpcmds) = "$tmpfile.ftpcmds";
	open(FTPCMDS, ">$ftpcmds");
	open(PKGDLOAD, ">$pkgdload");


	# Get list of selected packages
	open(SELECTED, "<$pkgselect");
	my(@selected_files) =
		grep { (!/^\#/go) && (!/^>/go) && (!/^\s*$/go) } <SELECTED>;
	close(SELECTED);
	chop @selected_files; # Kill newlines

	#
	# Retrieve package names from the selection file and get full pathname
	#
	my($getfiles) = 0;
	my($pkg);
	foreach $pkg (@selected_files) {
		$pkg =~ m/(^\S*)/o;  # Strip anything following the filename.
		$pkg = $1;

		if ($prefs{"pkgpath"}) {
			print PKGDLOAD "$pkg\n";
		} else {
			if (! $pkg) {
				print "INTERNAL ERROR: Could not locate $pkg\n";
				exitdftp(1);
			}

			my($dir_name);
			$pkg =~ m|^([^\s]*)/[^/\s]*|o;
			$dir_name = $1;
			if (! (-d $dir_name)) {
				vecho "(mkdir $dir_name)\n";	# make local dir for FTP
				system("mkdir -p $dir_name");
			}
			print PKGDLOAD "$pkg\n";
			if (-f $pkg) {
				qecho "($pkg exists locally -- skipped)\n";
			} else {
				print FTPCMDS "get $pkg\n";
				$getfiles = 1;
				vecho "$pkg\n";
			}
		}
	}
	close(PKGDLOAD);

	#
	# If no packages have been selected, stop here.
	#
	if (-z $pkgdload) {
		print "No packages have been selected for retrieval -- exiting\n";
		if ($cmds{"getnew"}) {
			$cmds{"installed"} = 1;
			$cmds{"getnew"} = 0;
		}
	}

	#
	# Do FTP if necessary (more comments in "getlist" action, above)
	#
	if ($getfiles) {
		qecho "Using FTP to fetch selected packages...\n";

		#
		# Be kind and save any old .netrc file
		#
		my($usernetrc) = 0;
		if (-f $netrc) {
			if (! (-f "$netrc.user")) {
				rename("$netrc","$netrc.user");
			}
			$usernetrc=1;
		}

		if($prefs{"password-prompt"}) {
		  $prefs{"email"} = get_ftp_password();
		}
		
		#
		# FTP works a bit differently depending on normal or secure
		#
		open(NETRC, ">$netrc") || die "Error: Could not open '$netrc' -- $!\n";

		if (!($prefs{ftpgate})) {
			print NETRC
				"machine $prefs{ftpsite} login $prefs{ftpuser} " .
					"password $prefs{email} macdef init\n";
		} else {
			print NETRC
				"machine $prefs{ftpgate} " .
					"login \"$prefs{ftpuser}\@$prefs{ftpsite} $ENV{USER}\" " .
						"password $prefs{email} macdef init\n";
		}

		print NETRC "hash\n";
		print NETRC "binary\n";
		print NETRC "cd $prefs{ftpdir}\n\n";
		close(NETRC);
		chmod(0600,"$netrc");

		print FTPCMDS "bye\n";
		close(FTPCMDS);


		#
		# Start FTP and read commands from a separate file, keep a log
		#
		if ($prefs{"quiet"}) {
			if (! $prefs{ftpgate}) {
				system("ftp -v $prefs{ftpsite} <$ftpcmds 2>&1 > $pkgftplog");
			} else {
				system("ftp -v $prefs{ftpgate} <$ftpcmds >  $pkgftplog");
			}
		} else {
			if (! $prefs{ftpgate}) {
				system("ftp -v $prefs{ftpsite} <$ftpcmds 2>&1 | tee $pkgftplog");
			} else {
				system("ftp -v $prefs{ftpgate} <$ftpcmds |  tee $pkgftplog");
			}

		}
		qecho " \n";

		#
		# Restore the .netrc file if one was saved
		#
		unlink($netrc);
		if ($usernetrc) {
			rename("$netrc.user", "$netrc");
			$usernetrc = 0;
		}

	} else {
		if (!(-z $pkgdload) && !$prefs{"pkgpath"}) {
			qecho "All requested files exist locally -- FTP not necessary\n";
		}
	}
}



sub load_pkg_info {
	my($filename) = @_;

	# Creates a hash table indexed by filename containing references to
	# small hash tables containing the name, verion, size, and md5sum info.

	my(%fileinfo);
	my($package);
	foreach $package (split(' ', `cat $filename`)) {
		my(@pkgfields) = split(';', $package);

		if ($#pkgfields != 4) {
			vecho "WARNING: incomplete information for $package -- skipped\n";
			next;
		}

		# create an anonymous hash table and store it in the fileinfo
		# hash table.
		$fileinfo{$pkgfields[0]} = {
			"name" => $pkgfields[1],
			"version" => $pkgfields[2],
			"size" => $pkgfields[3],
			"md5sum" => $pkgfields[4]
			};
#		print_hash $fileinfo{$pkgfields[0]};
	}
	return %fileinfo;
}



###############################################################################
#
#  Because I've encountered FTP sessions that did not get all the files, make
#  sure that all files were retrieved.
#

sub verify_download {
  if (! (-f $pkgdload)) {
	print "ERROR: The list of downloaded packages does not exist.\n";
	print "       Perhaps you have already used the \"clean\" action?\n";
	exitdftp(1);
  }
  
  if (!$prefs{"pkgpath"}) {
	qecho "Verifying that FTP got all the files correctly...\n";
  } else {
	qecho "Verifying that all packages are correct...\n";
  }
  
  my(%pkginfo) = load_pkg_info($pkglist);
  
  my($missing) = 0;
  my($pkg);
  foreach $pkg (split('\n', `cat $pkgdload`)) {
	my($file) = "$prefs{pkgpath}$pkg";
	
	if (! (-f $file)) {
	  print "$pkg -- not retrieved\n";
	  $missing = 1;
	} else {
	  if ($debian_system) {
		my($fileinfo) = `md5sum <$file`;
		chop $fileinfo;
		
		# This is kind of ugly
		# $pkginfo{$pkg} returns a *pointer* to a hash table which we then
		# dereference and get the value associated with the key "md5sum"
		my($pkgsum) = $ {$pkginfo{$pkg}}{"md5sum"};
		
		if ($fileinfo ne $pkgsum) {
		  print "$pkg -- md5sum mismatch, $fileinfo/$pkgsum, removed\n";
		  unlink $pkg;
		  $missing = 1;
		} else {
		  vecho "$pkg -- okay\n";
		}
	  } else {
		my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
		   $atime,$mtime,$ctime,$blksize,$blocks)
		  = stat($file);
		
		my($origsize) = $ {$pkginfo{$pkg}}{"size"};
		if ($size != $origsize) {
		  print "$pkg -- file size mismatch ($size vs $origsize), removed\n";
		  unlink $pkg;
		  $missing = 1;
		} else {
		  vecho "$pkg -- okay\n";
		}
	  }
	}
  }
  if ($missing) {
	print "(see file $pkgftplog for more information)\n";
	exitdftp(1);
  }
}


sub dependency_sort {
  my($pkgs_ref) = @_;

  
}


###############################################################################
#
#  Unpack retrieved packages (Debian systems only)
#

sub ask_user_about_install_failure {
  my $done = 1;

  do {
	STDIN->flush();
	
	print "dpkg install failed.\nWhat now [?,d,r,q,fd,fc,p] (defer): ";  
	my $result = <>;
	if($result =~ /^\s*$/) {
	  return "defer";
	} else {
	  if($result =~ /^\s*d\s*$/i) {
		return "defer";
	  } elsif($result =~ /^\s*r\s*$/i) {
		return "retry";
	  } elsif($result =~ /^\s*q\s*$/i) {
		return "quit";
	  } elsif($result =~ /^\s*fd\s*$/i) {
		return "force-depends";
	  } elsif($result =~ /^\s*fc\s*$/i) {
		return "force-conflicts";
	  } elsif($result =~ /^\s*p\s*$/i) {
		return "purge";
	  } else {		
		print "  Options are:\n";
		print "    d - defer installation until later\n" . 
		      "        (assume the intervening installs will resolve " . 
			  "the problem)\n";
		print "    r - retry installation\n" . 
		      "        (assumes you have resolved the problem somehow " . 
			  "(think ^Z))\n";
		print "    q - quit this installation process now\n" . 
		      "        (you can re-run it later)\n";
		print "    fd - force dependencies (see man dpkg).\n";
		print "    fc - force conflicts (see man dpkg).\n";
		print "    p - purge and continue with next package (see man dpkg)\n";
		print "    ? - repeat this help message\n";
		$done = 0;
	  }
	}
  } until $done;
}


sub unpack_packages {

  if (! $debian_system) {
	print "ERROR: This is not a debian system -- cannot \"unpack\"\n";
	exitdftp(1);
  }
  
  if (! (-f $pkgdload)) {
	print "ERROR: The list of downloaded packages does not exist.\n";
	print "       Perhaps you have already used the \"clean\" action?\n";
	exitdftp(1);
  }
  
  my(@dlpkgs,@ipkgs,@npkgs,$ipkg);
  open(DLOAD,"<$pkgdload") || die "Error: Could not read '$pkgdload' -- $!\n";
  while (<DLOAD>) {
	chomp;
	push @dlpkgs,"$prefs{pkgpath}$_";
  }
  close DLOAD;
  
  my $pkgpatt = join('|',@instalone);
  @ipkgs = grep( m|/($pkgpatt)_|i,@dlpkgs);
  @npkgs = grep(!m|/($pkgpatt)_|i,@dlpkgs);
  
  qecho "Unpacking and installing packages...\n";

  @ipkgs = grep {
	if(! -s $_) {
	  print "Package file $_ invalid, skipping.\n"; 
	  0;
	} else {
	  1;
	}
  } @ipkgs;
  
  @npkgs = grep {
	if(! -s $_) {
	  print "Package file $_ invalid, skipping.\n"; 
	  0;
	} else {
	  1;
	}
  } @npkgs;

  foreach $ipkg (@ipkgs) {
	my($pkg) = ($ipkg =~ m|.*/(.*?)_[^/]*$|);
	qecho "* new $pkg is available -- installing first and by itself\n";
	system("dpkg --install $ipkg");
  }
  
  #qecho "Sorting remaining package for dependencies...\n";
  dependency_sort(\@npkgs);
  
  if(scalar(@npkgs) > 0) {
	print "* installing remaining packages\n" if @ipkgs;
	my $flags = "";
	my $action = "--install";
	while(@npkgs) {
	  $ipkg = shift(@npkgs);
	  
	  my $failed = system("dpkg $flags $action $ipkg");
	  $flags = "";
	  $action = "--install";

	  if($failed) {
		my $answer = ask_user_about_install_failure();
		if($answer eq "defer") {
		  push @npkgs, $ipkg;
		} elsif ($answer eq "quit") {
		  last;		
		} elsif ($answer eq "retry") {
		  unshift @npkgs, $ipkg;
		} elsif ($answer eq "force-depends") {
		  $flags = "--force-depends";
		  unshift @npkgs, $ipkg;
		} elsif ($answer eq "force-conflicts") {
		  $flags = "--force-conflicts";
		  unshift @npkgs, $ipkg;
		} elsif ($answer eq "purge") {
		  $action = "--purge";
		  unshift @npkgs, $ipkg;
		}
	  }
	}
  }
  print "\nPackage system state (according to dpkg):\n";
  system("dpkg --audit");
  print "End of dftp unpack.\n";
}



###############################################################################
#
#  Archive all downloaded packages (usually only non-Debian systems)
#

sub archive_packages {
  if (! (-f $pkgdload)) {
	print "ERROR: The list of downloaded packages does not exist.\n";
	print "       Perhaps you have already used the \"clean\" action?\n";
	exitdftp(1);
  }
  
  qecho "TARing retrieved packages into $prefs{tarfile} ...\n";

  unlink($prefs{tarfile});
  
  my($taropts);
  if ($prefs{"verbose"}) {
	$taropts = "v";
  } else {
	$taropts = "";
  }
  
  my($descfile) = "";
  my($dir);
  if ($prefs{"tardesc"}) {
	foreach $dir (split(/\s*,\s*/,$prefs{"include"})) {
	  $descfile = "$descfile $dir/$binary/Packages$dotgz";
	}
  }
  if ($prefs{"pkgpath"}) {
	chdir($prefs{"pkgpath"});
  }
  system("tar c${taropts}f $prefs{tarfile} `cat $pkgdload`");
  chdir $prefs{"prefix"};
  system("tar u${taropts}f $prefs{tarfile} $pkgdloadname $descfile");
}



###############################################################################
#
#  Add retrieved packages to list of installed packages
#

sub mark_installed {
  if (! (-f $pkgdload)) {
	print "ERROR: The list of downloaded packages does not exist.\n";
	print "       Perhaps you have already used the \"clean\" action?\n";
	exitdftp(1);
  }
  
  qecho "Marking files as installed (for future runs of ${program})...\n";
  
  if (-f $pkglist) {
	system("cp $pkglist $pkgprev");
  }
}


###############################################################################
#
#  Search through packages directory and remove all (presumably installed)
#  packages.
#

sub clean_packages {
  qecho("Cleaning out old (already installed) packages...\n");
  my($ftpprint);
  
  if ($prefs{"verbose"}) {
	$ftpprint = '-print';
  } else {
	$ftpprint = '';
  }
  
  system('find . -type f  \\( -name "*.deb" -o -name "Packages*" \\) ' .
		 "$ftpprint | xargs rm -f");
  unlink($pkglist, $pkgselect, $pkgdload, $pkgdesc, $pkgftplog,
		 $prefs{"tarfile"});
}


###############################################################################
#
#  Clean up after this script
#
sub exitdftp {
  my($value) = @_;
  system "rm -f ${tmpfile}*" if ${tmpfile};
  system "rm -f ${pkgdesc}~" if ${pkgdesc};
  exit $value;
}


###############################################################################
#
#  main body.
#

setup_defaults();

read_option_file($debcf);
read_option_file($debrc);

if ($#ARGV == -1) {
  print_usage();
  exitdftp(0);
}

usage_death() unless handle_cmdline();

# Display various information.

if ($prefs{"version"}) {
  print "$version\n";
  exitdftp(1);
}

if ($prefs{"whatsnew"}) {
  page_text(whats_new());
  exitdftp(1);
}

if ($prefs{"help"}) {
  page_text( help_string()); 
  exitdftp(1);
}

# Do some system set up, if neccessary.

if (! (-d $prefs{"prefix"})) {
	mkdir($prefs{"prefix"},0755) ||
		die "Couldn't create prefix directory $prefs{prefix}";
}

chdir($prefs{"prefix"});

# Update any old filename to the new convention
if (-f ".packages-prev-list") {
  rename(".packages-prev-list", "$pkgprev");
}


# Now, down to business

if ($cmds{"scaninst"}) {
  print "dftp: scaninst is no longer necessary.  Just start with getlist\n";
}

if ($cmds{"getlist"} || $cmds{"getnew"}) {
  download_package_lists();
}

if ($cmds{"select"} || $cmds{"getnew"}) {
  select_packages();
}

if ($cmds{"getselect"} || $cmds{getnew}) {
  download_packages();
}

if ($cmds{"verify"} || $cmds{"getnew"}) {
  verify_download();
}

if ($cmds{"unpack"} || ($cmds{"getnew"} && $debian_system)) {
  unpack_packages();
}

if ($cmds{"archive"} || ($cmds{"getnew"} && (! $debian_system))) {
  archive_packages();
}

if ($cmds{"installed"} || $cmds{"getnew"}) {
  mark_installed();
}

if ($cmds{"clean"}) {
  clean_packages();
}

# If we make it here.  Normal exit.
exitdftp(0);



###############################################################################
#
#  Documentation (maybe this should be at the top of the file?)
#

sub whats_new {
  return <<__END__;

           Linux "Debian Distribution" FTP Packages Maintainer $version

                         Copyright (c) 1995,1996 by
$maintainers

                          What's new in version $version

 ** Major code reorganization.

 ** New interactive mode that's (hopefully) smarter about what you want, and
    less tedious to use (see --ask).

 ** scaninst is gone.  Parsing on the fly was fast enough to eliminate
    the need.  I later realized that it does serve a purpose, so I'll
    return it in an upcoming version.

 ** Added support for describe-mode (at Brian's suggestion).  Using "D"
    during interactive selection will toggle printing of the package
    description before every action prompt.

 ** added password-prompt option which allows you to force dftp to ask you
    for your ftp password instead of making you keep it in a file.

                          What's new in version $version

 ** Fixed bug that caused warnings about "odd number of elements assigned
    to hash.

 ** Fixed bug about missing "input_record_separator" with new perl.


                          What's new in version 2.2

 ** Fixed bug with installing "downgrade" packages.  Previously, the unpack
    action called dpkg with "--refuse-downgrade".  This has been removed.

 ** Added support for installing certain packages by themselves.  This keeps
    core packages such as "ldso" and "libc5" from being unpacked but not
    configured, thus breaking the rest of the install process.


                          What's new in version 2.0

 ** New sections have been added to better organize the list of available
    packages

 ** Support for FTP non-anonymous login

 ** IT'S PERL!

__END__
}


sub usage_string {
  my($getnewdef, $getnewstart) = @_;
  return <<__END__;

Usage:  $program <action> [...] [-flag] [...] [--option parm] [...]

Actions:
    getlist     Retrieve a list of Debian packages from an FTP site
    select      Bring up an editor to select which packages to download, 
                or enter an interactive selection mode (see --ask).
                (All packages are compared against the list of installed
                packages and only those newer or not installed will be
                listed for selection under 'select'.)  --ask has some
                more sophisticated behaviors (see "dftp --help").
    getselect   Retrieve all selected packages from an FTP site
    verify      Make sure FTP got all the files correctly
    unpack      Call "dpkg" to unpack and install all the retrieved packages
    archive     Tar all retrieved packages for downloading to another machine
    installed   Mark all retrieved packages as installed (only used by 
                editor selection mode at the moment).
    clean       Remove all retrieved (and presumably installed) packages
                as well as any archive and temporary package-info files

    getnew      Do "$getnewstart" through "installed" in the listed order
                $getnewdef

    Multiple actions can be given, but it is generally unwise to skip any of
    the steps except for "archive/update", or to wait too long between steps
    as changes in the distribution could force you to restart with "getlist".

    All actions happen in the order listed regardless of how they appear on
    the command line.

Flags:
    --nodesc     Do not provide descriptions of packages in the selection list
    --tardesc    Include the packages description file in the packages archive
    --quiet      Print as little as possible during execution
    --verbose    Print extra information during execution
    --whatsnew   Print information about what is new in version $version
    --help       Display general usage information and instructions
    --password-prompt
                 dftp will ask you for your ftp password
                 instead of making you keep it in a file.


Options:
    --prefix    <pathname>  Directory where all packages will be held
                            (default = "$prefs{prefix}")
    --include   <dir[,dir]> Comma-separated list of directories to scan
                            (default = "$prefs{include}")
    --exclude   <sec[,sec]> Comma-separated list of sections not to check
                            (default = "$prefs{exclude}")
    --pkgpath   <sitename>  Local pathname where Debian packages can be found
                            (default = "$prefs{pkgpath}")
    --ftpsite   <sitename>  Site from which to get Debian distribution packages
                            (default = "$prefs{ftpsite}")
    --ftpuser   <username>  Optional username for login.
                            (default = "$prefs{ftpuser}")
    --ftpdir    <pathname>  Path name to Debian distribution on FTP site
                            (default = "$prefs{ftpdir}")
    --ftpgate   <machine>   Machine name of Eagle secure gateway to use
                            (default = "$prefs{ftpgate}" -- "" means no gateway)
    --email     <emailaddr> Your email address -- used for anonymous password
                            or a real password -- used for --ftpuser login
                            (default = "$prefs{email}")
    --arch      <machine>   The architecture of binary files to be retrieved
                            (default = "$prefs{arch}")
    --tarfile   <pathname>  Tar file in which to archive retrieved packages
                            (default = "$prefs{tarfile}")
    --ask       <type>      used with the select command to enable interactive
                            package selection.  May be specified multiple
                            times to select multiple types of packages to be
                            asked about. (legal <type>s: all, new, upgrades, 
                            ignored, and unwanted)
                            (default = --ask upgrades --ask new)

If a "--pkgpath" is specified, it will take precedence over an FTP site.

Examples:
    $program getlist select -nodesc --include development --exclude x11,tex
    $program getselect verify unpack installed -quiet
    $program getnew --pkgpath /net/debian --arch i386
    $program getnew --pkgpath /net/debian
    $program clean
    $program getnew -nodesc -verbose --prefix /packages \
        --ftpsite sunsite.unc.edu --ftpdir /pub/Linux/distributions/debian

__END__

}


sub help_string {

  return <<__END__;

          Linux "Debian Distribution" FTP Packages Maintainer $version

                         Copyright (c) 1995,1996 by
$maintainers
         This program is covered by the GNU General Public License.
           For more information, see the file "COPYING" available
                     throughout the Debian distribution.


        >>>  For a usage summary, type "$program" (with no parameters)  <<<


The purpose of this program is to make it easy to keep your local installation
of Linux consistent with the Debian distribution available on many FTP sites,
NFS mounts, or CD-ROM.  It does this by comparing the list of installed
packages with those available by FTP or at a specified directory.  A list of
packages, categorized to make selection easier, is then presented to the user
to choose what to install.  All selected packages are then fetched if
necessary (using FTP), verified for correctness, and then installed.

$program supports two modes for selecting the packages for
installation.  The first (and the oldest) brings up a list of all the
available packages in your favorite editor and allows you to comment
or uncomment the packages (their file lines) that you want installed.
This mode remembers the packages that you didn't select for
installation on the previous run and uses that information during the next run when it sorts the packages into the following categories:

  NEW UPGRADES -- available upgrade packages 
  (where this upgrade (version) hasn't been refused before).

  DOWNGRADES -- available packages which represent version downgrades.

  NEW PACKAGES -- packages that have been added to the distribution since
  the last time you ran "$program getlist".

  IGNORED UPGRADES -- available package upgrades that were previously
  refused.

  IGNORED PACKAGES -- available packages that are you have previously
  chosen not to install.

The other selection mode is the interactive mode.  It was created to
speed the process of selection by providing sensible defaults, a
(mostly) single key response interface, and (hopefully) a little more
sophistication in remebering what you want.  This mode is activiated
with the --ask option when performing a "$program select".  --ask
allows you to specify which types of packages you want to be asked
about.  These types are similar to the ones for the editor selection
mode, but there are some subtle and important differences.  The types
are:

  new: available packages that are not installed on this system, and
  which $program hasn't been explicitly told to ignore before.

  upgrades: available upgrade packages that $program hasn't been explicitly
  told to ignore in a previous --ask session.

  ignored: available upgrade packages that $program has been
  explicitly told to ignore in a previous --ask session.
  
  unwanted: available packages that are not installed on this system, and
  which $program has been explicitly told to ignore in a previous --ask
  session.  If you install a version of an unwanted package between $program
  runs.  $program will notice and move that package out of the unwanted
  state.

The default values if --ask is specified without an argument are --ask
new and --ask upgrades.  Specifying any value to --ask clears the
defaults, so "$program select --ask new" will only ask about new
packages.

You can re-run select multiple times before you run getselect, and
$program will remember which packages you told it to ignore in the
previous run.  However, It currently won't remember which packages you
selected for install or said no to.  If maintaining this extra state
is desirable then it can be added, but it will probably require much
more serious incompatibility between the --ask interface and the more
traditional editor interface.  Consider this version a trial where we
see what works and what doesn't, and what should be done next.

Once the selection process starts running, you will be prompted for
actions on each package of the types you have specified.  The prompts
should be self-explanatory, but the primary actions will be "yes"
meaning install this package, "no" meaning don't install this package,
and pretend like you never asked, and "ignore" meaning don't install
this package, and move it into the ignored or unwanted category
(depending on whether or not a version is already installed).  The
--ask selection mode has been set up to have prompt defaults that
allow you to just hit return most of the time.

$program can run on any un*x system (Linux or not) with proper access.
The retrieved packages can then be archived and moved to the Debian
system on which they are to be installed.  Once moved to a Debian
system and de-archived into a directory (usually "~/packages"),
everything can be unpacked with the "unpack" action and then
configured:

        cd ~/packages
        tar xvf <debian-archive.tar>
        $program unpack       [add "--prefix <dir>" if not ~/packages]

You will, of course, have to be 'root' for the "unpack" action and the
configuration to work properly.  This will unpack all the packages into their
proper place and then configure them all.  Alternatively, you could use the
'dselect' utility with "~/packages" as the source for new packages.  The
downloaded files can then be marked as installed and removed with:

        $program installed clean

If you are running this program on a Debian system, all of these actions are
done automatically as part of "getnew".

If you change the machine you are running this script on, the only
file you need to copy is ".installed".  This is the file that keeps a
record of all the packages retrieved from the FTP site.  If a
".installed" file is not available because the Debian system has not
yet been set up, just create an empty file by typing "touch
~/packages/.installed".

Of lesser importance is the file ".prev-avail" which contains the list
of packages from the last time packages were installed (this is only
used by the editor based selection mode).  It is used to tell if
un-installed packages are new to the distribution or just unwanted.
If this file is missing, all packages are assumed to be new.  Any
other files are wholly generated by the various actions and can be
deleted/ignored.

The interactive "--ask" selection mode depends on the two files
".unwanted" and ".ignored" instead of ".prev-avail".

Once you have decided upon the configuration (command-line options) under
which you wish to run this script, you would be wise to write these options
into the "$debcf" or "~/.${program}rc" file in your home directory like
this:

        #
        #  These are my defaults for running "$program"
        #
        tardesc
        include:    development,contrib,non-free
        exclude:    tex,hamradio,news,electronics
        email:      myname\@myhost.mycompany.com
        ftpgate:    EagleGate
        ftpsite:    sunsite.unc.edu
        ftpdir:     /pub/Linux/distributions/debian
        arch:       i386

This will ensure you do not forget an option sometime in the future and get
unpredictable results.

Any files retrieved via $program can be used as the basis of another $program
simply by pointing "--pkgpath" to the directory in which all the retrieved
file are stored (usually $ENV{HOME}/packages).

This script supports external FTP access through an "Eagle Secure Gateway".
To use this, simply provide the name of the gateway to the "--ftpgate" option
or in the ".${program}rc" file.  When FTP runs, you will be prompted to enter
your account password.

If errors should occur during the FTP stage, it will be caught by the "verify"
action.  "Getselect" automatically skips any files that already exist locally,
thus allowing an FTP session to be restarted without retrieving files
previously downloaded.  A transcript of the latest FTP session is available in
"$pkgftplog".

__END__
}

###############################################################################
#
#  Set up tab-width & mode under Emacs so this file is readable!
#
# local variables:
# perl-mode: 1
# tab-width: 4
# end:
