#!/usr/bin/perl -w
###############################################################################
#                                                                             #
#             Linux "Debian Distribution" FTP Packages Maintainer             #
#                                                                             #
#                          Copyright (c) 1995-1999 by                         #
#                                                                             #
#                     Brian C. White <bcwhite@verisim.com>                    #
#                                     and                                     #
#                   Robert L. Browning <osiris@cs.utexas.edu>                 #
#                                     and                                     #
#			  Roman Hodek <Roman.Hodek@informatik.uni-erlangen.de>			  #
#                                                                             #
#        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;
use Debian::Package::List;


# Globals

my $program		= "dftp";
my $version		= "4.7";
my $maintainers	= '
                    Brian C. White <bcwhite@verisim.com>
                                    and
                  Robert L. Browning <osiris@cs.utexas.edu>
                                    and
              Roman Hodek <Roman.Hodek@informatik.uni-erlangen.de>
';
my %prefs;
my $dpkg_status_file;
my $debian_system;
my $netrc;
my $tmpfile;
my $debcf;
my $debrc;
my %cmds;

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

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

my($pkgorder_ignore_headers) = "Priority Section Maintainer Architecture ".
	"Size MD5sum Description Installed-Size";

###############################################################################
#
# 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($str,$exit_value) = @_;
	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? (/var/status is the new location
  # according to FHS-2.0)
  if (-f ($dpkg_status_file = "/var/status/dpkg/status") ||
	  -f ($dpkg_status_file = "/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"}	= "dists/stable/main,dists/stable/contrib,".
					  "dists/stable/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}";
  $prefs{"correct-version-compare"} = 0;
  $prefs{"ask-recommends"} = 1;
  $prefs{"ask-suggests"}   = 0;
  $prefs{"root-cmd"} = "sudo";
  $prefs{"preinst-cmd"} = "";
  $prefs{"postinst-cmd"} = "";
  
  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]* (.*) [ \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, "correct-version-compare", $pref_lines);
		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_flag($rcfile, \%prefs, "passive",  $pref_lines);
		find_option_flag($rcfile, \%prefs, "noask-recommends", $pref_lines);
		find_option_flag($rcfile, \%prefs, "ask-suggests", $pref_lines);
		$prefs{"ask-recommends"} = 0 if $prefs{"noask-recommends"};

		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);
		find_option_value($rcfile, \%prefs, "ask", $pref_lines);
		find_option_value($rcfile, \%prefs, "root-cmd", $pref_lines);
		find_option_value($rcfile, \%prefs, "preinst-cmd", $pref_lines);
		find_option_value($rcfile, \%prefs, "postinst-cmd", $pref_lines);

		close(RESOURCE);

		# if ask has been set, convert it to an array ref
		if ($prefs{"ask"} && !ref($prefs{"ask"})) {
			$prefs{"ask"} = [ split( /,/, $prefs{"ask"} ) ];
		}
	}
}


###############################################################################
#
#  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 = 'scaninst';
  } 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",
			   "correct-version-compare",
			   "nodesc",
			   "tardesc",
			   "quiet",
			   "verbose",
			   "passive",
			   "whatsnew",
			   "help",
			   "password-prompt",
			   "ask-recommends!",
			   "ask-suggests!",
			   
			   "prefix=s",
			   "include=s",
			   "exclude=s",
			   "pkgpath=s",
			   "ftpsite=s",
			   "ftpuser=s",
			   "ftpdir=s",
			   "ftpgate=s",
			   "email=s",
			   "tarfile=s",
			   "ask:s@",
			   "arch=s",
			   "root-cmd=s",
			   "preinst-cmd=s",
			   "postinst-cmd=s");
  
  my($ok) = 1;
  
  while ($#ARGV >= 0) {
	my($option) = shift(@ARGV);
	
	my(%legal_cmds) = ("scaninst"		=> 1,
					   "getlist"		=> 1,
					   "select"			=> 1,
					   "select-only"	=> 1,
					   "check-depends"	=> 1,
					   "getselect"		=> 1,
					   "verify"			=> 1,
					   "unpack"			=> 1,
					   "archive"		=> 1,
					   "installed"		=> 1,
					   "clean"			=> 1,
					   "getnew"			=> 1);

	if ($option =~ /install=/) {
		$cmds{"install"} = $';
	}
	elsif (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
  $pkginst		= "$prefs{prefix}/.installed";
  $pkglist		= "$prefs{prefix}/.available";
  $pkgprev		= "$prefs{prefix}/.prev-avail";
  $pkgselect	= "$prefs{prefix}/.selected";
  $pkgremove	= "$prefs{prefix}/.to-remove";
  $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?", 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.

  if (!-f $pkginst && !$debian_system) {
      diemsg("ERROR - This is not a Debian system and $pkginst file\n".
			 "found. Do a 'scaninst' on your Debian system and then copy\n".
			 "the resulting $pkginst file to this machine.",
			 1);
  }

  # if there is a pkginst file, use that
  if (-f $pkginst) {
      return load_installed_packages_file($pkginst);
  }

  # otherwise fall back to reading the status file directly (works
  # only on Debian systems)
  
  my @installed = ();
  my $fh = new IO::File;
  my %result;
  
  local($/) = '';
  $fh->open("<$dpkg_status_file")
	  or die "Error: Could not read '$dpkg_status_file' -- $!";
  
  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;
}

sub create_installed_packages_file {
    my $fhi = new IO::File;
    my $fho = new IO::File;
    my $name;
  
    local($/) = '';
    $fhi->open("<$dpkg_status_file")
		or die "Error: Could not read '$dpkg_status_file' -- $!\n";
    $fho->open(">$pkginst")
		|| die "Error: Could not create '$pkginst' -- $!\n";
	
    while( <$fhi> ) {
		if (/^Status: .*\sinstalled$/mi) {
			s/^(Status|Priority|Section|Essential|Installed-Size|Maintainer|Source):.*\n//mgi;
			s/^(Description|Conffiles):.*\n(\s+.*\n)*//mgi;
			print $fho $_;
		}
    }
    $fhi->close();
    $fho->close();
}


sub load_installed_packages_file {
    #returns a hash table where the key is an installed
    #package name, and the value is the version.

    my($filename) = @_;
    my $fh = new IO::File;
    my %result;
	my($name,$version);

    $fh->open("<$filename") or
		die "Error: Could not read installed packages file $filename -- $!\n";

	# check for an old format .installed (doesn't begin with Package: xxx)
	if (scalar(<$fh>) !~ /^Package:\s*\S+\s*$/i && !eof($fh)) {
		diemsg("ERROR: Your .installed file ($filename)\n".
			   "is still in the old format used with dftp versions < 4.0.\n".
			   "Please rebuild it with 'dftp scaninst'.",
			   1);
	}
	$fh->seek( 0, 0 ); # seek back to start
	
    local($/) = ''; # use paragraph read mode
	while( <$fh> ) {
		/^Package:\s*(\S+)\s*$/mi; $name = $1;
		/^Version:\s*(\S+)\s*$/mi; $version = $1;
		$result{$name} = $version;
	}
	
    $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.
	# $s1/$s2 are the proper sections names
	# $d1/$d2 are distributions before the proper section, separated by a '/'
	#         (e.g. non-free/misc)

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

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

	if ($s1 && $s2) {
		return($d1 cmp $d2) if $d1 ne $d2;
		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 sort_out_dupes {
	my @packages = @_;
	my %phash;

	foreach (@packages) {
		my ($name, $vers);
		/Package:\s*(\S+)\s*$/mi and $name = $1;
		/Version:\s*(\S+)\s*$/mi and $vers = $1;
		if (!$name || !$vers) {
			warn "Bad package entry (no Package: and/or Version: header:\n",
				 "$_\n";
			next;
		}
		if (exists $phash{$name}) {
			my $oth_vers;
			$phash{$name} =~ /Version:\s*(\S+)\s*$/mi and $oth_vers = $1;
			print "Package $name is duplicated: have $vers and $oth_vers\n";
			if (version_cmp( $vers, '>>', $oth_vers )) {
				$phash{$name} = $_;
				print "This version is newer, overwriting entry\n";
			}
		}
		else {
			$phash{$name} = $_;
		}
	}

	return values %phash;
}



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 mkdirs {
	my($path) = @_;
	my($dir,$part);

	$dir = "";
	foreach $part (split( '/', $path )) {
		$dir .= ($dir ? "/" : "") . $part;
		mkdir( $dir, 0755 ) or die "Error: Could not mkdir '$dir' -- $!\n"
			if !-d $dir;
	}
}

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 "passive\n" if $prefs{"passive"};
  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"})) {
	  $dir =~ s/[][]//g;
	  mkdirs("$dir/$binary");
	  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".
			   ($prefs{"verbose"} ? "" : "| egrep '^(Connected|cd|get) '"));
	  } else {
		system("ftp -v $prefs{ftpgate} </dev/null | tee $pkgftplog".
			   ($prefs{"verbose"} ? "" : "| egrep '^(Connected|cd|get) '"));
	  }
	}
	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 $prefix;
	$prefix = $1 if $dir =~ /\[([^ ,]+)\]/;
	$dir =~ s/[][]//g;
	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>;
	  grep( s/^(Filename:\s*)(.*)$/$1$prefix$2/, @contents ) if $prefix;
	  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 and eliminating duplicates...\n";
  
  my(@packages) = load_package_array($tmpdesc);
  @packages = sort_out_dupes(@packages);
  @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/^[^;]+;([^;]+);([^;]+);/o;
	$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))), "\n";
  $fh->close();
}


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


sub make_pkgname_to_pkg_hash {
  my(@packages) = @_;
  my(%pkgname_hash);
  my($package);
  
  foreach $package (@packages) {
	$package =~ m/^Package:\s*(\S+)/mi;
	$pkgname_hash{$1} = $package;
  }
  return %pkgname_hash;
}

# version_cmp compares two Debian version numbers. If running on a
# Debian system, dpkg --compare-versions is the right way to do this.
# But if not, own_version_cmp() emulates the algorithm in current dpkg
# (1.4.0.19). This is not very future-proof, but there's no way around
# it...
# version_cmp(a,b) return true iff a < b
sub version_cmp {
	return $debian_system && $prefs{"correct_version_compare"}
		? dpkg_version_cmp( @_ ) : own_version_cmp( @_ );
}

sub dpkg_version_cmp {
	my($versa, $rel, $versb) = @_;
	my($rv);
	
	$rv = (system "dpkg", "--compare-versions", $versa, $rel, $versb) >> 8;
	die "Error: Bad dpkg return value ($rv) -- no dpkg available?\n"
		if $rv != 0 && $rv != 1;
	return $rv == 0;
}

sub own_version_cmp {
	my($versa, $rel, $versb) = @_;

	if ($rel eq "=") {
		return $versa eq $versb;
	}
	elsif ($rel eq "<<") {
		return do_version_cmp( $versa, $versb );
	}
	elsif ($rel eq "<" || $rel eq "<=") {
		return $versa eq $versb || do_version_cmp( $versa, $versb );
	}
	elsif ($rel eq ">" || $rel eq ">=") {
		return !do_version_cmp( $versa, $versb );
	}
	elsif ($rel eq ">>") {
		return $versa ne $versb && !do_version_cmp( $versa, $versb );
	}
	else {
		die "own_version_cmp called with bad relation '$rel'\n";
	}
}

sub do_version_cmp {
	my($versa, $versb) = @_;
	my($epocha,$upstra,$reva);
	my($epochb,$upstrb,$revb);
	my($r);

	($epocha,$upstra,$reva) = split_version($versa);
	($epochb,$upstrb,$revb) = split_version($versb);

	# compare epochs
	return 1 if $epocha < $epochb;
	return 0 if $epocha > $epochb;

	# compare upstream versions
	$r = version_cmp_single( $upstra, $upstrb );
	return $r < 0 if $r != 0;

	# compare Debian revisions
	$r = version_cmp_single( $reva, $revb );
	return $r < 0;
}

sub version_cmp_single {
	my($versa, $versb) = @_;
	my($a,$b,$lena,$lenb,$va,$vb,$i);

	for(;;) {
		# compare non-numeric parts
		$versa =~ /^([^\d]*)(.*)/; $a = $1; $versa = $2;
		$versb =~ /^([^\d]*)(.*)/; $b = $1; $versb = $2;
		$lena = length($a);
		$lenb = length($b);
		for( $i = 0; $i < $lena || $i < $lenb; ++$i ) {
			$va = $i < $lena ? ord(substr( $a, $i, 1 )) : 0;
			$vb = $i < $lenb ? ord(substr( $b, $i, 1 )) : 0;
			last if !$va && !$vb;
			$va += 256 if $va && substr( $a, $i, 1 ) !~ /[a-zA-Z]/;
			$vb += 256 if $vb && substr( $b, $i, 1 ) !~ /[a-zA-Z]/;
			return $va - $vb if $va != $vb;
		}
		# compare numeric parts
		$versa =~ /^(\d*)(.*)/; $a = $1; $a ||= 0; $versa = $2;
		$versb =~ /^(\d*)(.*)/; $b = $1; $b ||= 0; $versb = $2;
		return $a - $b if $a != $b;
		return 0 if !$versa && !$versb;
		return -1 if !$versa;
		return +1 if !$versb;
	}
}

sub split_version {
	my($vers) = @_;
	my($epoch,$revision) = (0,"");

	if ($vers =~ /^(\d+):(.*)/) {
		$epoch = $1;
		$vers = $2;
	}

	if ($vers =~ /(.*)-([^-]+)$/) {
		$revision = $2;
		$vers = $1;
	}

	return( $epoch, $vers, $revision );
}



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

sub install_packages {
  my($package, %pkgs, @install_selections);
  
  # Get package info.
  my(%installed_vers) = find_installed_packages();

  newfile("$unwanted_file", 0644) if (! (-f $unwanted_file));
  my %unwanted = load_package_list($unwanted_file);

  my %ignored;
  if (! (-f $ignored_file)) {
      # if there is no .ignored, but a .pkgs-prev, the user is
      # probably switching between the old and new methods; initialize
      # the .ignored with packages that aren't installed at all.
      if (-e $pkgprev) {
		  my %prev_pkgs = get_previous_packages($pkgprev) if -e $pkgprev;
		  foreach $package (keys %prev_pkgs) {
			  $ignored{$package} = 1 if !exists($installed_vers{$package});
		  }
      } else {
		  newfile("$ignored_file", 0644);
		  %ignored = ();
      }
  }
  else {
      %ignored = load_package_list($ignored_file);
  }

  my(@packages) = split(' ', `cat $pkglist`);
  foreach (@packages) {
	my(@pkgfields) = split(';', $_);
	if ($#pkgfields != 4) {
	  vecho "WARNING: incomplete information for $package -- skipped\n";
	  next;
	}
	
	$pkgs{$pkgfields[1]} = { "file" => $pkgfields[0],
							 "name" => $pkgfields[1],
							 "version" => $pkgfields[2] };
  }

  foreach $package (split( /\s*,\s*|\s+/, $cmds{"install"} )) {
	  if (!exists $pkgs{$package}) {
		  print "No package $package available to install\n";
		  next;
	  }
	  my $pkg = $pkgs{$package};
	  if (exists $installed_vers{$package}) {
		  my $inst_vers = $installed_vers{$package};
		  my $arch_vers = $pkg->{"version"};
		  if (version_cmp($inst_vers, ">>", $arch_vers)) {
			  vecho "Package $package already installed in newer version $inst_vers (vs. $arch_vers)\n";
			  next;
		  }
		  elsif ($inst_vers eq $arch_vers) {
			  vecho "Package $package already installed in newest version.\n";
			  next;
		  }
		  vecho "Updating $package from $inst_vers to $arch_vers\n";
	  }
	  push( @install_selections, $pkg );
  }

  my $fh = new IO::File;
  $fh->open((($cmds{"select"} || $cmds{"select-only"}) ? "" : ">") . ">$pkgselect") || 
	die "Error: Could not open '$pkgselect' -- $!\n";
  foreach $package (@install_selections) {
	print $fh $package->{"file"} . "\n";
	if (exists $unwanted{$package->{"name"}}) {
		vecho "Removing $package->{'name'} from unwanted list\n";
	}
	delete($unwanted{$package->{"name"}});
	if (exists $ignored{$package->{"name"}}) {
		vecho "Removing $package->{'name'} from ignored list\n";
	}
	delete($ignored{$package->{"name"}});
  }
  $fh->close();
  
  # Output the new lists of ignored and unwanted packages
  save_package_list(\%ignored, $ignored_file);
  save_package_list(\%unwanted, $unwanted_file);
}

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 [?dDiynr#] ($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*r\s*$/io) {
		return "remove";
	  } 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 this time\n";
		print "    i - ignore this package and all future upgrades\n";
		print "    r - remove this package when installing\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 $current_section = "";

  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;
	  # Look up package description
	  my $pkg_info = $$package_descriptions{$$pkg_ref{"file"}};		
	  if (! $pkg_info) {
		die "Error: Could not find package entry for '$$pkg_ref{file}'!\n";
	  }
	  my $this_section = package_get_section( $pkg_info );
	  if ($this_section ne $current_section) {
		  $current_section = $this_section;
		  print "Section $current_section:\n";
	  }
	
	  if($describe_mode) {
		print "\n", $pkg_info;
	  }

	  my $query = "[".($i+1)."/$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" || $response eq "remove") {
		$package_actions[$i] = $response;
		$done = 1;
	  } elsif($response =~ /(\d+)/) {
		if($1 >= 1 && $1 <= $total) {
		  $i = $1 - 2;
		  $done = 1;
		} else {
		  print "Can't go back to $1.  Out of range.\n";
		}
	  } elsif($response eq "describe") {
		print $pkg_info;
	  }
	}		
  }

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


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 = ();

  # Get package info.
  my(%installed_vers) = find_installed_packages();

  newfile("$unwanted_file", 0644) if (! (-f $unwanted_file));
  my %unwanted = load_package_list($unwanted_file);

  # load previous packages list
  my %prev_pkgs;
  %prev_pkgs = get_previous_packages($pkgprev) if -e $pkgprev;
  
  my %ignored;
  if (! (-f $ignored_file)) {
      # if there is no .ignored, but a .pkgs-prev, the user is
      # probably switching between the old and new methods; initialize
      # the .ignored with packages that aren't installed at all.
      if (-e $pkgprev) {
		  my $package;
		  foreach $package (keys %prev_pkgs) {
			  $ignored{$package} = 1 if !exists($installed_vers{$package});
		  }
      } else {
		  newfile("$ignored_file", 0644);
		  %ignored = ();
      }
  }
  else {
      %ignored = load_package_list($ignored_file);
  }
  
  my %pkg_desc_by_filename =
	make_filename_to_pkg_hash(load_package_array($pkgdesc));
  
  my(@packages) = split(' ', `cat $pkglist`);
  
  my(@install_pkgs) = ();
  @install_pkgs = split( /\s*,\s*|\s+/, $cmds{"install"} ) if $cmds{"install"};

  # 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]);
	next if grep { $incoming{"name"} eq $_ } @install_pkgs;
	
	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"} &&
		 version_cmp($installed_version, "<<", $incoming{version})) { # upgrade
		if (exists($unwanted{$incoming{"name"}})) { # unwanted
		  qecho("Found $incoming{name} installed, previously marked unwanted.\n");
		  qecho("  Removing from unwanted list.\n");
		  delete($unwanted{$incoming{"name"}});
		  unshift(@packages, $package);
		  next;  # ugly, but effective.
	    } elsif (exists($ignored{$incoming{"name"}})) { # ignored
		  $incoming{"note"} =
			  "$incoming{version} ($installed_version installed)";
		  push(@ignored_pkgs, \%incoming);
	    } else { # wanted
		  $incoming{"note"} = 
			  "$incoming{version} ($installed_version installed)";
		  push(@upgrade_pkgs, \%incoming);
		  vecho "Upgrade for $incoming{'name'}\n";
	    }
	  } else { # already have this or newer 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);
	  } elsif (exists($ignored{$incoming{"name"}})) { #ignored
		$incoming{"note"} = "$incoming{version}";
		push(@ignored_pkgs, \%incoming);
	  } elsif (exists($prev_pkgs{$incoming{"name"}})) { #already existed
		qecho "$incoming{'name'} disappeared -- making it unwanted.\n";
		$incoming{"note"} = "$incoming{version}";
		push(@unwanted_pkgs, \%incoming);
		$unwanted{$incoming{"name"}} = 1;
	  } 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 = ();
  my @remove_selections = ();

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

  my $fh = new IO::File;

  # Output the list of packages selected for install.
  $fh->open(($cmds{"install"} ? ">" : "") . ">$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, @remove_selections) {
	$unwanted{$$package{"name"}} = 1;
  }
  save_package_list(\%ignored, $ignored_file);
  save_package_list(\%unwanted, $unwanted_file);
  open( REMOVE, ">$pkgremove" )
	  or die "Error: Could not open '$pkgremove' -- $!\n";
  @remove_selections = grep( $_ ne "", @remove_selections );
  print REMOVE join( "\n", map( $_->{"name"}, @remove_selections )), "\n";
  close( REMOVE );
}

  
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, so use inverse operator
			my($upgrade_p) = version_cmp($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})) {
		      $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");
  }
}


###############################################################################
#
#  Check dependencies on selected packages
#

sub ask_user_about_dependency {
  my $type = shift;
  my $default = shift;
  my $done = 1;
  my $is_conflict = 0;
  my $is_recommends = 0;
  my $actions;

  $is_conflict = 1 if $type =~ /conflicts/i;
  $is_recommends = 1 if $type =~ /recommends/i && $type =~ /suggests/i;
  $actions = $is_conflict ? "o,n,q,r,u" : "a,o,n,q";
  $actions .= ",f" if !$is_recommends;
  
  do {
	STDIN->flush();
	
	print "What to do? [?,$actions] ($default): ";  
	my $result = <>;
	if($result =~ /^\s*$/) {
	  return $default;
	} else {
	  if($result =~ /^\s*a\s*$/i && !$is_conflict) {
		return "add";
	  } elsif($result =~ /^\s*f\s*$/i && !$is_recommends) {
		return "force";
	  } elsif($result =~ /^\s*o\s*$/i) {
		return "omit";
	  } elsif($result =~ /^\s*n\s*$/i) {
		return "no";
	  } elsif($result =~ /^\s*q\s*$/i) {
		print "You can rerun 'dftp select' later\n";
		exit( 0 );
	  } elsif($result =~ /^\s*r\s*$/i && $is_conflict) {
		return "remove";
	  } elsif($result =~ /^\s*u\s*$/i && $is_conflict) {
		return "update";
	  } else {		
		print "  Options are:\n";
		print "    a - add -- also install package needed for dependency\n"
			if !$is_conflict;
		print "    o - omit selected (first) package\n";
		print "    n - no action, try to install anyway\n";
		print "    r - remove/deselect conflicting (second) package\n"
			if $is_conflict;
		print "    u - update conflicting package to remove conflict\n"
			if $is_conflict;
		print "    q - quit this installation process now\n" . 
		      "        (you can re-run it later)\n";
		print "    f - force installation (with --force-xxx, see man dpkg).\n"
			if !$is_recommends;
		print "    ? - repeat this help message\n";
		$done = 0;
	  }
	}
  } until $done;
}

sub ask_user_about_removed_pkg {
  my $default = shift;
  my $done = 1;
  my $actions;

  do {
	STDIN->flush();
	
	print "What to do? [?,a,r,s,q] ($default): ";  
	my $result = <>;
	if($result =~ /^\s*$/) {
	  return $default;
	} else {
	  if($result =~ /^\s*a\s*$/i) {
		return "add";
	  } elsif($result =~ /^\s*r\s*$/i) {
		return "remove";
	  } elsif($result =~ /^\s*s\s*$/i) {
		return "skip";
	  } elsif($result =~ /^\s*q\s*$/i) {
		print "You can rerun 'dftp select' later\n";
		exit( 0 );
	  } else {		
		print "  Options are:\n";
		print "    a - add second package again (don't remove it)\n";
		print "    r - remove depending (first) package, too\n";
		print "    s - skip, no action to this now (except dpkg error)\n";
		print "    q - quit this installation process now\n" . 
		      "        (you can re-run it later)\n";
		print "    ? - repeat this help message\n";
		$done = 0;
	  }
	}
  } until $done;
}

sub calc_dependencies {
	my $installed = shift;
	my $candidates = shift;
	my( $result, $pkg, %result, $type, @list );

	$installed->reset_result();
	$candidates->reset_result();

	@list = ( "Pre-Depends", "Depends", "Conflicts" );
	push( @list, "Recommends" ) if $prefs{"ask-recommends"};
	push( @list, "Suggests" ) if $prefs{"ask-suggests"};
	foreach ( @list ) {
		$candidates->check_relations( Consistent => 1,
									  Installed => $installed,
									  Field => $_ );
	}

	@list = ( [ qw(Depends Pre-Depends) ], [ qw(Conflicts) ] );
	push( @list, [ qw(Recommends) ] ) if $prefs{"ask-recommends"};
	push( @list, [ qw(Suggests) ] ) if $prefs{"ask-suggests"};
	foreach ( @list ) {
		$type = (@{$_})[0];
		$result = "";
		foreach ( @{$_} ) {
			$result .=
				$candidates->result_as_string( Type => $_,
											   Category => $_ eq "Conflicts" ?
											   "Conflict" : "Failed" );
			$result .=
				$candidates->result_as_string( Type => $_,
											   Category => "Unknown" )
					if $_ ne "Conflicts";
		}
		foreach ( split( /\n/, $result ) ) {
			$pkg = $1, next if /^   Package:\s*(\S+)\s*$/;
			$result{$type}->{$pkg}->{$1} = 1 if /^   \s+(.+)$/;
		}
	}

	return %result;
}

sub dep_add_pkg {
	my $pkg = shift;
	my $installed_hash_ref = shift;
	my $installed_ref = shift;
	my $selected_hash_ref = shift;
	my $candidates_ref = shift;
	my $new_pkg_infos_ref = shift;
	my $removed_ref = shift;

	if (!exists($new_pkg_infos_ref->{$pkg})) {
		print "$pkg not available -- cannot select it\n";
		return 'repeat_ask';
	}
	if (exists($selected_hash_ref->{$pkg})) {
		print "$pkg is already selected\n";
		return 'repeat_ask';
	}
	
	$candidates_ref->add( 'Package_desc' => $new_pkg_infos_ref->{$pkg} );
	$selected_hash_ref->{$pkg} = $candidates_ref->{$pkg}->{'Version'};
	@$removed_ref = grep { $_ ne $pkg } @$removed_ref;

	# need to mark installed package as "removed" if also on candidates list
#	$installed_ref->mark( Package => $pkg, Mark => "Removed" )
#		if exists($installed_hash_ref->{$pkg});

	print "Selecting package $pkg";
	print " (update from $installed_hash_ref->{$pkg} to ",
	      "$selected_hash_ref->{$pkg})"
			  if exists($installed_hash_ref->{$pkg});
	print "\n";
	return 'repeat';
}

sub dep_del_pkg {
	my $where = shift;
	my $pkg = shift;
	my $installed_hash_ref = shift;
	my $installed_ref = shift;
	my $selected_hash_ref = shift;
	my $candidates_ref = shift;
	my $new_pkg_infos_ref = shift;
	my $removed_ref = shift;
	my($list_ref, $hash_ref);
	
	$hash_ref = $where eq 'new' ? $selected_hash_ref : $installed_hash_ref;
	$list_ref = $where eq 'new' ? $candidates_ref : $installed_ref;

	if (!exists($hash_ref->{$pkg})) {
		print "$pkg not ", $where eq 'new' ? "selected" : "installed",
		      " -- cannot ", $where eq 'new' ? "deselected" : "remove",
		      "\n";
		return 'repeat_ask';
	}
	
	$list_ref->delete( Name => $pkg );
	delete $hash_ref->{$pkg};

	push( @$removed_ref, $pkg ) if $where eq 'installed';
	# remove "removed" mark if $pkg now only installed, no candidate anymore
#	$installed_ref->unmark( Package => $pkg, Mark => "Removed" )
#		if $where eq 'new' && exists($installed_hash_ref->{$pkg});

	if ($where eq 'new') {
		print "Deselecting package $pkg\n";
	}
	else {
		print "Will remove package $pkg before installing\n";
	}
	return 'repeat';
}

sub select_providing_pkg{
	my $pkg = shift;
	my $_providing = shift;
	my $self_too = shift; # no real virtual package
	my @providing = @$_providing;
	my($i, $default, $num);
	my $n = @providing;

	# don't ask if only one package available...
	if (!$self_too && $n == 1) {
		print "Virtual package $pkg only provided by $providing[0]\n";
		return $providing[0];
	}
	
	if ($self_too) {
		print "$pkg is also provided by other packages:\n";
		unshift( @providing, $pkg );
		++$n;
		$default = 1;
	}
	else {
		print "Virtual package $pkg is provided by:\n";
		$default = 0;
	}

	for( $i = 0; $i < $n; ++$i ) {
		print "  (", $i+1, ") $providing[$i]\n";
	}
	
	for(;;) {
		STDIN->flush();
		print "Select which package? [1..$n,q]",
		      $default ? " ($default)" : "", ": ";

		my $result = <>;
		if ($result =~ /^\s*$/ && $default) {
			$num = $default;
			goto selected;
		}
		elsif ($result =~ /^\s*q\s*$/i) {
			return "";
		}
		elsif ($result =~ /^\s*(\d+)\s*$/) {
			$num = $1;
		  selected:
			return $providing[$num-1]
				if $num >= 1 && $num <= $n;
		}
	}
}

#
# This check for dependencies and conflicts between packages, with the
# help of pkg-order. The problem resolution may not be perfect yet in
# all cases, but it does the job for now.
#

sub check_dependencies {
	my %installed_pkgs;
	my %selected_pkgs;
	my %provided;
	my %inst_provided;
	my $pkg;
	my $deppkg;
	my %result;
	my @remove_pkgs;
	my %force_pkgs;
	
	print "Calculating dependencies of packages...\n";

	# read list of packages to be removed
	if (open( REMOVE, "<$pkgremove" )) {
		@remove_pkgs = <REMOVE>;
		chomp @remove_pkgs;
		close( REMOVE );
	}
	
	my $installed_file = $pkginst;
	if (!-f $installed_file) {
		if (!$debian_system) {
			diemsg("ERROR: The list of installed packages does not exist.\n".
			       "       Perhaps you have already used the 'clean' action?",
				   1);
		}
		$installed_file = $dpkg_status_file;
	}

	my $installed = Debian::Package::New->new( 'Ignored Headers' =>
											   $pkgorder_ignore_headers );
	$installed->set_compare_method( \&own_version_cmp ) if !$debian_system;
	my %inst_pkg_infos =
		make_pkgname_to_pkg_hash( load_package_array( $installed_file ));

	foreach $pkg ( keys %inst_pkg_infos ) {
		# if we loaded %inst_pkg_infos from /var/lib/dpkg/status
		# on a Debian system, we have to filter out packages with
		# Status != installed
		# also omit packages that are to be removed
		next if ($inst_pkg_infos{$pkg} =~ m/^Status:\s*.*\s(\S+)$/mi &&
				 $1 ne "installed") || grep( $_ eq $pkg, @remove_pkgs );
		$installed->add( Package_desc => $inst_pkg_infos{$pkg} );
		$inst_pkg_infos{$pkg} =~ m/^Version:\s*(\S+)\s*$/mi;
		$installed_pkgs{$pkg} = $1;
	}
	
	if (!-f $pkgselect) {
		diemsg("ERROR: The list of selected packages does not exist.\n".
			   "       Perhaps you have already used the 'clean' action?",
			   1);
	}

	# Get list of selected packages
	open(SELECTED, "<$pkgselect");
	my @selected_files = grep { !/^[\#>\$]/ && !/^\s*$/ } <SELECTED>;
	close(SELECTED);
	foreach ( @selected_files ) {
		$selected_pkgs{$1} = $2 if m,.*/([^_/]+)_(\S+)\.deb,;
	}
	return if !%selected_pkgs; # quit if no packages to upgrade
	
	# get controls infos for all available packages
	my %new_pkg_infos =
		make_pkgname_to_pkg_hash( load_package_array( $pkgdesc ) );
	my $candidates = Debian::Package::New->new( 'Ignored Headers' =>
											    $pkgorder_ignore_headers );
	$candidates->set_compare_method( \&own_version_cmp ) if !$debian_system;
	foreach $pkg ( keys %selected_pkgs ) {
		if (!exists($new_pkg_infos{$pkg})) {
			print "WARNING: No control infos for $pkg\n";
			$candidates->add( Package_desc => "Package: $pkg" );
		}
		else {
			$candidates->add( Package_desc => $new_pkg_infos{$pkg} );
		}
		# pkg-order can't handle the case where a package is on both lists
		# (installed and candidates), it gets dependencies wrong. We have to
		# mark the installed package as "removed" for dependency checking
		# purposes.
#		$installed->mark( Package => $pkg, Mark => "Removed" )
#			if exists($installed_pkgs{$pkg});
	}

	# build list of provided virtual packages
	my $info;
	while( ($pkg,$info) = each %new_pkg_infos ) {
		if ($info =~ /Provides:\s*(.*)\s*$/m) {
			foreach ( split( /\s*,\s*/, $1 ) ) {
				push( @{$provided{$_}}, $pkg );
			}
		}
	}

	# build list of packages provided by installed packages
	while( ($pkg,$info) = each %{$installed->{' _Provided'}} ) {
		@{$inst_provided{$pkg}} = split( /\s*,\s*/, $info );
	}

	# check dependencies of installed packages, after @remove_pkgs are
	# would have been removed. (Other pkgs could depend on them.)
	my $empty = Debian::Package::List->new();
	my %dontask = (); # list of packages not to ask about anymore
  repeat_rem:
	%result = calc_dependencies( $empty, $installed );
	my($type,@list);
	@list = ( "Depends" );
	push( @list, "Recommends" ) if $prefs{"ask-recommends"};
	push( @list, "Suggests" ) if $prefs{"ask-suggests"};
	foreach $type ( @list ) {
		foreach $pkg ( sort keys %{$result{$type}} ) {
			foreach $deppkg ( sort keys %{$result{$type}->{$pkg}} ) {
				my $full_deppkg = $deppkg;
				# $deppkg may have a version number, strip it for hash indexing
				$deppkg =~ s/\(.*\)//;
				next if !grep( $_ eq $deppkg, @remove_pkgs );
				my $default_answer;
				print "Package $pkg ";
			  SWITCH: foreach( $type ) {
				  /depends/i && do {
					print "depends on ";
					$default_answer = "add";
					last;
				  };
				  /recommends/i && do {
					print "recommends ";
					$default_answer = "add";
					last;
				  };
				  /suggests/i && do {
					print "suggests ";
					$default_answer = "skip";
					last;
				  };
			    };
				print "$full_deppkg\n";
				print "  $deppkg is scheduled for removal\n";
			  repeat_ask_rem:
				my $answer = ask_user_about_removed_pkg($default_answer);
				if ($answer eq "add") {
					@remove_pkgs = grep { $_ ne $deppkg } @remove_pkgs;
					$installed->add( Package_desc => $inst_pkg_infos{$deppkg});
					$inst_pkg_infos{$deppkg} =~ m/^Version:\s*(\S+)\s*$/mi;
					$installed_pkgs{$deppkg} = $1;
					print "Will not remove package $deppkg\n";

					# check if newer version available and offer to upgrade
					if (exists($new_pkg_infos{$deppkg})) {
						$new_pkg_infos{$deppkg} =~ m/^Version:\s*(\S+)\s*$/mi;
						my $newvers = $1;
						if (version_cmp( $installed_pkgs{$deppkg}, "<<",
										 $newvers )){
							print "Update available for $deppkg (from ".
								  "$installed_pkgs{$deppkg} to $newvers)\n";
							STDIN->flush();
							while(1) {
								print "Install update? [Y/n]: ";
								$answer = <>;
								last if $answer =~ /^\s*[yn]?\s*$/i;
							}
							if (!($answer =~ /n/)) {
								dep_add_pkg($deppkg,
											\%installed_pkgs, $installed,
											\%selected_pkgs, $candidates,
											\%new_pkg_infos,
											\@remove_pkgs );
							}
						}
					}
				}
				elsif  ($answer eq "remove") {
					push( @remove_pkgs, $pkg );
					$installed->delete( Name => $pkg );
					delete $installed_pkgs{$pkg};
					print "Will remove package $pkg before installing\n";
					goto repeat_rem;
				}
				elsif  ($answer eq "skip") {
					$dontask{"${pkg}_${deppkg}"} = 1;
				}
			}
		}
	}
	
  repeat:
	%result = calc_dependencies( $installed, $candidates );

	@list = ( "Depends", "Conflicts" );
	push( @list, "Recommends" ) if $prefs{"ask-recommends"};
	push( @list, "Suggests" ) if $prefs{"ask-suggests"};
	foreach $type ( @list ) {
		foreach $pkg ( sort keys %{$result{$type}} ) {
			foreach $deppkg ( sort keys %{$result{$type}->{$pkg}} ) {
				my $full_deppkg = $deppkg;
				# $deppkg may have a version number, strip it for hash indexing
				$deppkg =~ s/\(.*\)//;
				next if exists $dontask{"${pkg}_${deppkg}"};
				my $default_answer;
				print "Package $pkg ";
			  SWITCH: foreach( $type ) {
				  /depends/i && do {
					print "depends on ";
					$default_answer = "add";
					last;
				  };
				  /conflicts/i && do {
					print "conflicts with ";
					# try to omit the package which isn't selected
					# (but already installed)
					$default_answer =
						!exists($selected_pkgs{$deppkg}) ? "remove" : "omit";
					last;
				  };
				  /recommends/i && do {
					print "recommends ";
					$default_answer = "add";
					last;
				  };
				  /suggests/i && do {
					print "suggests ";
					$default_answer = "no";
					last;
				  };
			    };
				print "$full_deppkg\n";
				if ($type =~ /conflicts/i) {
					my @providers = ();
					if (exists( $provided{$deppkg} )) {
						@providers = @{$provided{$deppkg}};
					}
					elsif (exists( $inst_provided{$deppkg} )) {
						@providers = @{$inst_provided{$deppkg}};
					}
					# remove the package with the Conflicts: header from the
					# list, since it doesn't conflict with itself.
					@providers = grep( $_ ne $pkg, @providers );
					if (@providers) {
						print "  $deppkg is provided by: @providers\n";
						$deppkg = $providers[0];
						print "  (Warning: more than one provider isn't ",
							  "handled properly yet.\n"
							if @providers > 1;
					}
				}
				if (exists( $selected_pkgs{$deppkg} ) &&
					exists( $installed_pkgs{$deppkg} )) {
					print "  $deppkg is to be upgraded from version ",
						  "$installed_pkgs{$deppkg} to ",
						  "$selected_pkgs{$deppkg}\n",
				}
				elsif (exists( $selected_pkgs{$deppkg} )) {
					print "  $deppkg is to be installed in version ",
						  "$selected_pkgs{$deppkg}\n";
				}
				elsif (exists( $installed_pkgs{$deppkg} )) {
					print "  $deppkg is installed in version ",
						  "$installed_pkgs{$deppkg}\n";
				}
				else {
					print "  $deppkg is not installed\n";
					if (!exists($new_pkg_infos{$deppkg}) &&
						!exists($provided{$deppkg})) {
						print "  Warning: it seems $deppkg is not available!\n";
						$default_answer = ($type =~ /depends/i) ? "omit":"no";
					}
				}

			  repeat_ask:
				my $answer = ask_user_about_dependency($type,$default_answer);
				my $target;
				if ($answer eq "add") {
					if (exists($provided{$deppkg})) {
						# $deppkg is a virtual package or also provided
						# by other packages
						my $answer =
							select_providing_pkg($deppkg, $provided{$deppkg},
												 exists($new_pkg_infos{$deppkg}));
						goto repeat_ask if !$answer;
						$deppkg = $answer;
					}
					$target = dep_add_pkg($deppkg,
										  \%installed_pkgs, $installed,
										  \%selected_pkgs, $candidates,
										  \%new_pkg_infos,
										  \@remove_pkgs );
					goto $target;
				}
				elsif ($answer eq "omit") {
					$target = dep_del_pkg('new',$pkg,
										  \%installed_pkgs, $installed,
										  \%selected_pkgs, $candidates,
										  \%new_pkg_infos, \@remove_pkgs );
					goto $target;
				}
				elsif ($answer eq "remove") {
					if (exists($selected_pkgs{$deppkg})) {
						$target = dep_del_pkg('new',$deppkg,
											  \%installed_pkgs, $installed,
											  \%selected_pkgs, $candidates,
											  \%new_pkg_infos, \@remove_pkgs );
						goto $target if !exists($installed_pkgs{$deppkg});
					}
					if (exists($installed_pkgs{$deppkg})) {
						$target = dep_del_pkg('installed',$deppkg,
											  \%installed_pkgs, $installed,
											  \%selected_pkgs, $candidates,
											  \%new_pkg_infos, \@remove_pkgs );
						goto $target;
					}
					print "$deppkg is neither selected nor installed\n";
					goto repeat_ask;
				}
				elsif ($answer eq "update") {
					if (exists($selected_pkgs{$deppkg})) {
						print "$deppkg will already be updated to version ",
							  "$selected_pkgs{$deppkg}\n";
						goto repeat_ask;
					}
					if (!exists($installed_pkgs{$deppkg})) {
						print "$deppkg is not installed and not selected ",
							  "-- no update\n";
						goto repeat_ask;
					}
					if (!exists($new_pkg_infos{$deppkg})) {
						print "$deppkg is not available\n";
						goto repeat_ask;
					}
					$new_pkg_infos{$deppkg} =~ /Version:\s*(.*)\s*$/m;
					my $new_version = $1;
					if ($installed_pkgs{$deppkg} eq $new_version) {
						print "No newer version of $deppkg available\n";
						goto repeat_ask;
					}
					
					$target = dep_add_pkg($deppkg,
										  \%installed_pkgs, $installed,
										  \%selected_pkgs, $candidates,
										  \%new_pkg_infos, \@remove_pkgs );
					goto $target;
				}
				elsif ($answer eq "force") {
					$force_pkgs{$pkg} = $type =~ /conflicts/i ?
						"--force-conflicts" : "--force-depends";
					$dontask{"${pkg}_${deppkg}"} = 1;
					print "Will install $pkg with $force_pkgs{$pkg}\n";
				}
				elsif ($answer eq "no") {
					$dontask{"${pkg}_${deppkg}"} = 1;
				}
			}
		 }
	 }

	# don't care about critical errors, packages with --force options
	# always have them...
	$installed->set_fatal_failure_on_types( 'Type List' => ' ' );
	$candidates->set_fatal_failure_on_types( 'Type List' => ' ' );

	# build package ordering
	$candidates->order( Field => "Pre-Depends" );
	$candidates->order( Field => "Depends" );
	$candidates->order( Field => "Conflicts", Installed => $installed );
	my $order_string = $candidates->get_ordering();
	my $order_str2 = $candidates->insert_breaks('Ordered List' => $order_string);
	# get all marks that start with "--"; these are generated by pkg-order as
	# needed dpkg options on installation.
	my %new_force = $candidates->list_marks( Mark => '^--' );
	foreach (keys %new_force) {
		my $allmarks = $candidates->{$_}->show_mark();
		$force_pkgs{$_} = join( ' ', grep( /^--/, split( /\s+/, $allmarks )));
	}
	
	# write new .selected file with $$$break annotations and --force options
	open(SELECTED, ">$pkgselect");
	foreach (split( "\n", $order_str2 )) {
		if (/^END\s+-\d+/) {
			print SELECTED "\$\$\$break\n";
		}
		elsif (/^START/ || /^END/) {
			;
		}
		else {
			print SELECTED $candidates->{$_}->{'Filename'},
			      $force_pkgs{$_} ? " $force_pkgs{$_}" : "",
			      "\n";
		}
	}
	close SELECTED;

	open(REMOVE, ">$pkgremove");
	print REMOVE join( "\n", @remove_pkgs ), "\n";
	close REMOVE;

	# add removed packages to the unwanted list, and remove all selected
	# packages from it and the ignored list (a previously ignored package
	# could have been selected during the dependency check phase).
	my %ignored = load_package_list($ignored_file);
	my %unwanted = load_package_list($unwanted_file);
	foreach ( keys %selected_pkgs ) {
		delete $ignored{$_};
		delete $unwanted{$_};
	}
	foreach ( @remove_pkgs ) {
		$unwanted{$_} = 1;
	}
	save_package_list(\%ignored, $ignored_file);
	save_package_list(\%unwanted, $unwanted_file);
}


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

sub download_packages {
	if (! (-f $pkgselect)) {
		diemsg("ERROR: The list of selected packages does not exist.\n".
			   "       Perhaps you have already used the \"clean\" action?",
			   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 { !/^[#>]/ && !/^\s*$/ } <SELECTED>;
	close(SELECTED);
	chop @selected_files; # Kill newlines

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

		if ($pkg =~ m/^\$\$\$/ || $prefs{"pkgpath"}) {
			print PKGDLOAD "$pkg$options\n";
		} else {
			if (! $pkg) {
				diemsg( "INTERNAL ERROR: Could not locate $pkg", 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
				mkdirs($dir_name);
			}
			print PKGDLOAD "$pkg$options\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 "passive\n" if $prefs{"passive"};
		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".
			   ($prefs{"verbose"} ? "" : "| egrep '^(Connected|cd|150 Opening) '"));
			} else {
				system("ftp -v $prefs{ftpgate} <$ftpcmds | tee $pkgftplog".
			   ($prefs{"verbose"} ? "" : "| egrep '^(Connected|cd|150 Opening) '"));
			}

		}
		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)) {
	diemsg("ERROR: The list of downloaded packages does not exist.\n".
		   "       Perhaps you have already used the 'clean' action?",
		   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`)) {
    next if $pkg =~ m/^\$\$\$/;
	$pkg =~ m/^(\S*)/;  # Strip anything following the filename.
	$pkg = $1;
	my($file) = "$prefs{pkgpath}$pkg";
	
	if (! (-f $file)) {
	  print "$pkg -- not retrieved\n";
	  ++$missing;
	} 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;
		} 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;
		} else {
		  vecho "$pkg -- okay\n";
		}
	  }
	}
  }
  if ($missing) {
	print "($missing bad files -- see file $pkgftplog for more information)\n";
	exitdftp(1);
  }
  qecho "All files ok.\n"; 
}



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

sub ask_user_about_removing {
  my $done = 1;

  do {
	STDIN->flush();
	
	print "What to do with it? [?,d,p,r,s,D,P,R,S] (r): ";  
	my $result = <>;
	if($result =~ /^\s*$/) {
	  return "--remove";
	} else {
	  if($result =~ /^\s*[fa]?\s*d\s*$/i) {
		return ($result =~ /D/ ? "all " : "") .
			   ($result =~ /f/ ? "--force-depends " : "") .
			   ($result =~ /a/ ? "--auto-deconfigure " : "") .
			   "--deconfigure";
	  } elsif($result =~ /^\s*[fa]?\s*p\s*$/i) {
		return ($result =~ /P/ ? "all " : "") .
			   ($result =~ /f/ ? "--force-depends " : "") .
			   ($result =~ /a/ ? "--auto-deconfigure " : "") .
			   "--purge";
	  } elsif($result =~ /^\s*[fa]?\s*r\s*$/i) {
		return ($result =~ /R/ ? "all " : "") .
			   ($result =~ /f/ ? "--force-depends " : "") .
			   ($result =~ /a/ ? "--auto-deconfigure " : "") .
			    "--remove";
	  } elsif($result =~ /^\s*s\s*$/i) {
		return ($result =~ /S/ ? "all " : "") . "skip";
	  } else {		
		print "  Options are:\n";
		print "    d - deconfigure package\n";
		print "    p - purge package (i.e., remove config files, too)\n";
		print "    r - remove package (i.e., leave config file)\n";
		print "    s - skip this package (i.e., don't touch it in any way)\n";
		print "    ? - repeat this help message\n";
		print "  Prefix with 'f': use --force-depends\n";
		print "  Prefix with 'a': use --auto-deconfigure\n";
		print "  Uppercase: apply choice to all remaining packages, too.\n";
		$done = 0;
	  }
	}
  } until $done;
}

sub dpkg_command {
	my $cmd = shift;
	my $need_root = shift;
	my $strip_names = shift;
	my $root_cmd;
	my $cmd_text = $cmd;

	$cmd_text =~ s,\S+/(\S+\.deb),$1,g if $strip_names;
	qecho "dpkg ";
	if (length($cmd_text) < 75) {
		qecho "$cmd_text\n";
	}
	else {
		qecho substr($cmd_text, 0, 71 ), "...\n";
	}

	$root_cmd = ($need_root && $< != 0) ? $prefs{"root-cmd"}." " : "";
	return system( "${root_cmd}dpkg $cmd" );
}

sub unpack_packages {

  if (! $debian_system) {
	diemsg( "ERROR: This is not a debian system -- cannot 'unpack'", 1 );
  }
  
  if (! (-f $pkgdload)) {
	diemsg("ERROR: The list of downloaded packages does not exist.\n".
		   "       Perhaps you have already used the 'clean' action?",
		   1);
  }

  if ($prefs{"preinst-cmd"}) {
	  qecho "Running pre command: $prefs{'preinst-cmd'}\n";
	  system( $prefs{"preinst-cmd"} );
  }

  qecho "Updating dpkg's available list...\n";
  dpkg_command( "--update-avail $pkgdesc", 1 );
  
  my(@rempkgs);
  open(REMOVE,"<$pkgremove")
	  or die "Error: Could not read '$pkgremove' -- $!\n";
  @rempkgs = <REMOVE>;
  close REMOVE;
  chomp @rempkgs;

  qecho "Removing deselected packages...\n";

  my($pkg,$answer);
  while( defined($pkg = shift(@rempkgs)) ) {
	  next if !$pkg;
	  print "$pkg is scheduled for removal.\n";
	  $answer = ask_user_about_removing();
	  if ($answer =~ m/^all/) {
		  $pkg .= " @rempkgs";
		  @rempkgs = ();
		  $answer =~ s/^all\s*//;
	  }
	  next if $answer =~ m/skip/;
	  if (dpkg_command("$answer $pkg", 1)) {
		  print "Warning -- Removing failed!\n";
		  unshift( @rempkgs, split( /\s+/, $pkg ));
	  }
  }
  
  my(@dlpkgs,@npkgs,$ipkg,$option);
  open(DLOAD,"<$pkgdload") || die "Error: Could not read '$pkgdload' -- $!\n";
  while (<DLOAD>) {
	chomp;
	$_ = $prefs{"pkgpath"} . $_ unless /^\$\$\$/;
	push @dlpkgs, $_;
  }
  close DLOAD;

  @npkgs = @dlpkgs;
  qecho "Unpacking and installing packages...\n";

  if (@npkgs > 0) {
	my $failed = 0;
	while( @npkgs ) {

		my $this_pkgs = "";
		my $this_options = "";
		my $ignore_dpkg_errs = 0;
		my $conf_pending = 0;
		while( @npkgs ) {
			$ipkg = shift(@npkgs);
			# end of packages for this run if '$$$break' found
			last if $ipkg eq '$$$break';
			# ignore other $$$ tags
			next if $ipkg =~ m/^\$\$\$/;
			# if pkg name contains a space (i.e. options), stop this
			# run if it already contains packages; install the package with
			# options for itself
			if ($ipkg =~ m/^(\S*)\s+(.+)$/) {
				# break here if already have packages without options
				if ($this_pkgs) {
					unshift( @npkgs, $ipkg );
					last;
				}
				if (!-f $1) {
					print "(Skipping non-existant $1)\n";
					next;
				}
				$this_pkgs = $1;
				$this_options = $2;
				if ($this_options =~ /(^|\s)--ignore-errors(\S|$)/) {
					$ignore_dpkg_errs = 1;
					$this_options =~ s/--ignore-errors//g;
				}
				if ($this_options =~ /(^|\s)--configure-pending(\S|$)/) {
					$conf_pending = 1;
					$this_options =~ s/--configure-pending//g;
				}
				last;
			}
			else {
				if (!-f $ipkg) {
					print "(Skipping non-existant $ipkg)\n";
					next;
				}
				$this_pkgs .= " $ipkg";
			}
		}

		if ($this_pkgs) {
			my $err=(dpkg_command("-iE $this_options $this_pkgs", 1, 1) != 0);
			$failed += $err if !$ignore_dpkg_errs;
			dpkg_command("--pending --configure", 1, 0) if $conf_pending;
		}
	}

	print "Warning -- $failed failed dpkg run(s)!\n" if $failed;
  }

  print "\nPackage system state (according to dpkg):\n";
  my $audit = `dpkg --audit`;
  print $audit;
  if (!$audit) {
	  print "OK\n";
  }
  elsif ($audit =~ /dpkg --configure/m) {
	  print "Trying to configure remaining packages:\n";
	  dpkg_command("--pending --configure", 1, 0);
	  print "\nPackage system state now:\n";
	  dpkg_command("--audit", 0, 0);
  }
  print "End of dftp unpack.\n";

  if ($prefs{"postinst-cmd"}) {
	  qecho "Running post command: $prefs{'postinst-cmd'}\n";
	  system( $prefs{"postinst-cmd"} );
  }
}



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

sub archive_packages {
  if (! (-f $pkgdload)) {
	diemsg("ERROR: The list of downloaded packages does not exist.\n".
		   "       Perhaps you have already used the 'clean' action?",
		   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"})) {
	  $dir =~ s/[][]//g;
	  $descfile = "$descfile $dir/$binary/Packages$dotgz";
	}
  }
  if ($prefs{"pkgpath"}) {
	chdir($prefs{"pkgpath"});
  }
  # sed deletes options after the filenames, and deletes $$$ lines
  system("tar c${taropts}f $prefs{tarfile} ".
		 "`sed -e 's/[ 	].*\$//; /^\\\\\$\\\\\$\\\\\$/d' $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 (!$debian_system) {
	diemsg( "ERROR: This is not a debian system -- cannot make list of ".
			"installed packages", 1 );
  }

  qecho "Marking files as installed (for future runs of ${program})...\n";
  # Older versions of dftp used to update $pkginst here, by merging in
  # $pkgdload. But this doesn't work anymore for a $pkginst with versions etc.
  # So we simply call create_installed_packages_file again.
  create_installed_packages_file();

  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( $name, $version, %installed, @dirs );

  # get list of installed packages
  if (-f $pkginst) {
      %installed = load_installed_packages_file($pkginst);
	  foreach $name ( keys %installed ) {
		  $installed{$name} =~ s/^\d+://; # strip epoch from version
	  }
  }
  else {
	  warn "No $pkginst file found -- assuming packages are installed.\n".
		   "Better do 'dftp installed' or 'dftp scaninst' first.\n";
  }

  # find all .deb and Packages* files in $pkgpath; delete .deb files only if a
  # corresponding version is installed
  open( PIPE, 'find . -type f  \\( -name "*.deb" -o -name "Packages*" \\) |' )
	  or die "Error: Can't start find command\n";
  while( <PIPE> ) {
	  chomp;
	  if (/\.deb$/) {
		  /.*\/([^\/_]+)_([^\/]+)(_[^\/]+)?\.deb$/;
		  ($name, $version) = ($1, $2);
		  if (!exists($installed{$name}) || $installed{$name} ne $version) {
			  qecho "Keeping $_ (not installed)\n";
			  next;
		  }
	  }
	  vecho( "rm: $_\n" );
	  unlink $_ or warn "Warning: Can't delete $_: $!\n";
  }
  close( PIPE );

  # remove empty directories
  open( PIPE, 'find . -type d |' )
	  or die "Error: Can't start find command\n";
  @dirs = <PIPE>;
  close( PIPE );
  chomp @dirs;
  @dirs = reverse @dirs;
  foreach (@dirs) {
	  next if $_ eq ".";
	  if (rmdir) {
		  vecho( "rmdir: $_\n" );
	  }
	  else {
		  warn "Can't remove dir $_: $!\n" if $! !~ /not empty/i;
	  }
  }
  
  unlink($pkglist, $pkgselect, $pkgremove, $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(1);
}

usage_death() unless handle_cmdline();

# Display various information.

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

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

if ($prefs{"help"}) {
  print_usage();
  exitdftp(0);
}

# 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-installed") {
  rename(".packages-installed", "$pkginst");
}
if (-f ".packages-prev-list") {
  rename(".packages-prev-list", "$pkgprev");
}


# Now, down to business

if ($cmds{"scaninst"} || ($cmds{"getnew"} && $debian_system)) {
    if (! $debian_system) {
	diemsg("ERROR - This is not a Debian system -- cannot 'scaninst'\n".
	       "Do a 'scaninst' on your Debian system and then copy\n".
	       "the resulting $pkginst file to this machine.",
	       1);
	}
    #
    # Generate a list of installed packages from 'available' file
    #
    qecho "Creating list of installed packages...\n";
    create_installed_packages_file();
}

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

if ($cmds{"install"}) {
  install_packages();
}

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

if ($cmds{"select"} || $cmds{"check-depends"} || $cmds{"install"} ||
	$cmds{"getnew"}) {
  check_dependencies();
}

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-1999 by
$maintainers

                          What's new in version $version

 ** It now works to run 'dftp install=...' after 'dftp select'. In the
    past, the install= cleared out all previously selected packages.

 ** 'dftp clean' now also removes .debs that are installed but are named
    name_version_arch.deb (e.g. downloaded from Incoming).

 ** dftp now can handle the case that the same package appears multiple times
    in all the Packages files that are downloaded. This can happen
    errorneously (non-US is well known for this :-), or deliberately if
    more than one distribution is listed in the include path (e.g. frozen and
    unstable, when unstable isn't fully symlinked to frozen yet). dftp uses
    the newest of all the available versions of the package.

 ** dftp now uses by default its internal function to do comparisons of
    package versions. This is much faster than calling dpkg for each single
    comparison. However, this is not politically correct, since dpkg is the
    only instance that really defines the order of versions. Due to this,
    there's a new option, --correct-version-compare, which will force dftp to
    use dpkg for comparisons.

                          What's new in version 4.6

 ** New config variables (and command line options) preinst-cmd and
    postinst-cmd that are run (if non-empty) before/after installing with
    dpkg. They can be used, e.g., to remount /usr read-write before installing
    and read-only again afterwards.

                          What's new in version 4.5

 ** Don't think an empty .installed file is in old format.

 ** New command install=LIST to fetch/install a list of packages whose name is
    known.

                          What's new in version 4.4

 ** Better handle cases where no packages are to be installed/upgraded: The
    sequential install doesn't print the header for a group (upgraded, new,
    ...) if it is empty, and dependency checking/ordering isn't even tried.
    The latter is important, since calling pkg-order with an empty list
    resulted in an error.

                          What's new in version 4.3-2

 ** If dftp --audit suggested to configure remaining packages, the following
    "dpkg --pending --configure" didn't use the --root-cmd if run as non-root.

                          What's new in version 4.3

 ** Don't let pkg-order call dpkg for version comparing anymore on non-Debian
    systems (needed new pkg-order version).

 ** Avoid some warnings about non-numeric things that happened on non-Debian
    systems.

 ** Count package index in sequential install prompts from 1, not 0 (more
    intuitive).

                          What's new in version 4.2

 ** Add test for Debian system on 'dftp installed'.

 ** Fix conflict handling with provided packages. dftp now notices if a
    conflicted-with package is a virtual package and asks question (to remove
    it etc.) with respect to the provider.

 ** Mention dftp-VERSION-standalone.tar.gz in man page.

                          What's new in version 4.1

 ** Use new 'Ignored Headers' feature of pkg-order to save some memory.

                          What's new in version 4.0

 ** The format of the .installed file has changed. Before first using
     dftp 4.0, please rebuild it with dftp scaninst.

 ** dftp now checks dependencies and conflicts between packages (with
    help of pkg-order). It can also ask you if you want to install
    recommended or suggested packages.

    By default, you're asked for recommendation, but not for
    suggestions. You can change this with the --ask-suggests and/or
    --noask-recommends command line options. There are also
    corresponding flags for /etc/dftp.conf: ask-suggests and
    noask-recommends.

 ** dftp now also orders packages before installing them (also done
    via pkg-order). This should speed up dftp unpack a lot compared to
    3.x version, because dpkg isn't started separately for each
    package anymore.

 ** During package selection, you can also choose to remove a package
    before installation. This may be handy if an update reminds you
    that you have still some package installed that you aren't interested
    anymore.

 ** dftp now updates the /var/lib/dpkg/available file during the unpack
    action.

 ** Default for 'include' preference/option now is

      dists/stable/main,dists/stable/contrib,dists/stable/non-free

    instead of old "stable,contrib,non-free".

 ** New feature in 'include' preference/option for nonUS archive: This is
    usually mirrored to some subdirectory of your favorite Debian mirror, but
    the Packages files under nonUS give paths relative to the top of the nonUS
    mirror. But dftp instead needs a path relative to the whole Debian dir.
    The solution: You can put the top-dir of the nonUS mirror in brackets, so
    that dftp knows that part of the path is left out in the Packages file.
    Example: On ftp.uni-erlangen.de, the nonUS archive is in
    /pub/Linux/debian/debian-non-US. To include that dir into your include
    list, use the following:

      include: dists/unstable/main,...,[debian-non-US/]hamm

    Sourrounding "debian-non-US/" with [..] instructs dftp to add that part to
    filenames found in the Packages file in that directory. (BTW, the rest is
    "hamm" instead of unstable, because the nonUS Packages file is built that
    way, which is a bug IMHO.)

 ** 'dftp clean' now only deletes packages that have been successfully
     installed. (According to .installed file, so use 'dftp installed' first!)

 ** 'dftp clean' now also removes empty directories.

 ** FTP actions (getlist and geselect) are now less verbose if verbose
    is not set.

 ** On 'dftp unpack' the --skip-same-version flag for dpkg is used, to
    avoid unnecessary work in case someone wants to rerun that phase.

 ** In ask mode package selection, dftp prints the name of the section the
    packages are in, if the section changes. This gives a better overview.

                           What's new in version 3.3

 ** If you select 'purge' after an installation failure (during 'dftp
    unpack'), dpkg is now called with the bare package name, not the
    full pathname. dpkg groked on this...

 ** New choice after installation failures: 'give up' (g). This can be
    convenient if you still have to fetch packages the failed one
    depends on, so it can't be installed anyway in this run. 'defer'
    isn't the right choice for this, though it could be used as a
    workaround.

                          What's new in version 3.2

 ** Fixed some typos in dftp and the man page.

 ** Fix creation of directory hierarchies on dftp getlist

 ** If not running on a Debian system, dftp select can't use dpkg
	 --compare-versions. There's now an emulation for this.

 ** New option --passive to use passive mode FTP.

                          What's new in version 3.1

 ** scaninst and the .installed file are back again. They are really
    useful.

 ** In file-based selection mode, updates to not installed packages
    are now ignored, not anymore treated as new packages.

 ** Changes to package handling in interactive mode:

     * Ignored packages are also ignored if they're not installed
       (e.g. if they were manually removed)

     * The answer 'i' always moves a package into the ignore state, as
	   it should be.

     * The answer 'n' always moves a package into the unwanted state,
	   except for previously ignored packages, which stay ignored.

 ** The ask list for interactive mode can now be configured in
	dftp.conf (or .dftprc), like e.g.

	  ask: new,upgrades

	(Formely, you could select interactive mode on with --ask on the
	command line.)
		   
 ** Fixed bug with perl 5.004

 ** Added man page, help action now not needed anymore.
		   
                          What's new in version 3.0

 ** 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.

__END__
}


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

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

Actions:
    scaninst    Build list of installed packages (Debian only)
    getlist     Retrieve a list of Debian packages from an FTP site
    install=... Install some packages given by name, additionally to those
                selected interactively (if command 'select' is also given).
                This comes handy if those packages are unwanted or ignored,
                and you don't want to step through those lists by hand, and
                you know the names of the packages. The package names in the
                list are separated either by commas or whitespace.
    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 (includes scaninst)
    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.
    --passive    Use passive FTP
    --noask-recommends
                 Don't ask whether recommended packages should be installed
                 during 'dftp select'
    --ask-suggests
                 Also ask whether suggested packages should be installed
                 during 'dftp select'


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)
    --root-cmd  <cmd>       Command used to get root priviledges if running as
                            non-root user (default: sudo). dpkg must be run as
                            root, everything else not.
    --preinst-cmd  <cmd>    Command that is run before installing with dpkg.
    --postinst-cmd  <cmd>   Command that is run after installing with dpkg.

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

Examples:
    $program scaninst getlist -verbose
    $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__

}


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