#! /usr/bin/perl -w
# $Id: dftp,v 2.2 1996/11/18 19:22:35 bcwhite Exp bcwhite $
###############################################################################
#                                                                             #
#             Linux "Debian Distribution" FTP Packages Maintainer             #
#                                                                             #
#                          Copyright (c) 1995,1996 by                         #
#                                                                             #
#                     Brian C. White <bcwhite@verisim.com>                    #
#                                     and                                     #
#                   Robert L. Browning <osiris@cs.utexas.edu>                 #
#                                                                             #
#        This program is covered by the GNU General Public License.           #
#          For more information, see the file "COPYING" available             #
#        throughout the Debian distribution or /usr/doc/copyright/GPL         #
#                            on a Debian system.                              #
#                                                                             #
###############################################################################
#
# ToDo:
# Check all system() return values and die if appropriate
# Mention problem with netrc.
# document sectionless
#
# 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 FileHandle;

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



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

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

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


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


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


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


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


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



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

# Is this a Debian system?
my($debian_system);
if (-f "/var/lib/dpkg/status") {
	$debian_system = 1;
} else {
	$debian_system = 0;
}

# Preferred temp directory?
if (! exists($ENV{TMPDIR})) {
	$ENV{TMPDIR}="/tmp";
}

# Preferred editor?
if (! exists($ENV{EDITOR})) {
	if ($debian_system) {
		$ENV{EDITOR} = "ae";
	} else {
		$ENV{EDITOR} = "vi";
	}
}

# Preferred pager?
if (! exists($ENV{PAGER})) {
	$ENV{PAGER} = "more";
}

# Does this machine have a name?
if (! exists($ENV{HOST})) {
	$ENV{HOST} = `hostname -f`;
}

# Does this user have a name?
if (! exists($ENV{USER})) {
	if (exists($ENV{LOGNAME})) {
		$ENV{USER} = $ENV{LOGNAME};
	} else {
		$ENV{USER} = "anonymous";
	}
}

my($netrc)   = "$ENV{HOME}/.netrc";
my($tmpfile) = "$ENV{TMPDIR}/${program}${PID}";



################################################################################
#
#  Program defaults -- don't change them here -- add them to your .dftprc!

$prefs{"prefix"}	= "$ENV{HOME}/packages";
$prefs{"include"}	= "stable,contrib,non-free";
$prefs{"exclude"}	= "";
$prefs{"pkgpath"}	= "";
$prefs{"ftpsite"}	= "ftp.debian.org";
$prefs{"ftpuser"}	= "anonymous";
$prefs{"ftpdir"}	= "/debian";
$prefs{"ftpgate"}	= "";
$prefs{"arch"}		= "i386";
$prefs{"tarfile"}	= "$ENV{HOME}/debian.tar";
$prefs{"email"}		= "$ENV{USER}\@$ENV{HOST}";

if ($debian_system) {
	chomp($prefs{"arch"} = `dpkg --print-installation-architecture`);
}



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

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


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

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

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

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


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

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

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

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


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

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

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

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

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

		close(RESOURCE);
	}
}


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


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

if ($#ARGV == -1) {
	#
	# 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';
	}

	open(PAGER, "| $ENV{PAGER}") or die "Couldn't open your pager ($ENV{PAGER})";

	print PAGER <<__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
    select      Bring up an editor to select which packages to download
                (All packages are compared against the list of installed
                packages and only those newer or not installed will be
                listed for selection under 'select'.)
    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
    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

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}")

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__

	close(PAGER);
	exitdftp(0);
}



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

my($result) =
	GetOptions(\%prefs,
			   "nodesc",
			   "tardesc",
			   "quiet",
			   "verbose",
			   "whatsnew",
			   "help",

			   "prefix=s",
			   "include=s",
			   "exclude=s",
			   "pkgpath=s",
			   "ftpsite=s",
			   "ftpuser=s",
			   "ftpdir=s",
			   "ftpgate=s",
			   "email=s",
			   "tarfile=s",
			   "arch=s");

my(%cmds);
my($doexit) = 0;

while ($#ARGV >= 0) {
	my($option) = shift(@ARGV);

	my(%legal_cmds) = ("scaninst"	=> 1,
					   "getlist"	=> 1,
					   "select"		=> 1,
					   "getselect"	=> 1,
					   "verify"		=> 1,
					   "unpack"		=> 1,
					   "archive"	=> 1,
					   "installed"	=> 1,
					   "clean"		=> 1,
					   "getnew"		=> 1);

	if (exists($legal_cmds{$option})) {
		$cmds{$option} = $option;
	} else {
		print "ERROR: Unrecognized parameter $option\n";
		$doexit = 1;
	}
}

# Diagnostics.

#print "Prefs: \n";
#print_hash(\%prefs);

#print "Commands: \n";
#print_hash(\%cmds);



###############################################################################
#
# Do some configuration based on parameters given
#

my($pkginst)		= "$prefs{prefix}/.installed";
my($pkglist)		= "$prefs{prefix}/.available";
my($pkgprev)		= "$prefs{prefix}/.prev-avail";
my($pkgselect)		= "$prefs{prefix}/.selected";
my($pkgdloadname)	= ".downloaded";
my($pkgdload)		= "$prefs{prefix}/$pkgdloadname";
my($pkgftplog)		= "$prefs{prefix}/.ftplog";
my($pkgdesc)		= "$prefs{prefix}/.packages";
my($binary)			= "binary-$prefs{arch}";
my($gunzip)			= `bash -c "type -p gunzip"`;

chop($gunzip);

my($dotgz);
if ($gunzip) {
	$dotgz=".gz";
} else {
	$dotgz="";
}

if ($prefs{"pkgpath"}) {
	$prefs{"pkgpath"} = "$prefs{pkgpath}/";
}



###############################################################################
#
#  If one or more parameters was not recognized, exit with a message
#
usage_death() if $doexit;



###############################################################################
#
#  Catch people trying to be clever
#
if ($prefs{"quiet"} && $prefs{"verbose"}) {
	diemsg("Quiet AND Verbose!  Is this some kind of test?\n", 1);
}



###############################################################################
#
#  Display "what's new" information.  It's long, so use PAGER

if ($prefs{"whatsnew"}) {

	open(PAGER, "| $ENV{PAGER}") or die "Couldn't open your pager ($ENV{PAGER})";

	print PAGER <<__END__;

           Linux "Debian Distribution" FTP Packages Maintainer $version

                         Copyright (c) 1995,1996 by
$maintainers

                          What's new in version $version

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

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


                          What's new in version 2.2

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

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


                          What's new in version 2.0

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

 ** Support for FTP non-anonymous login

 ** IT'S PERL!

__END__

	close PAGER;
	exitdftp(1);
}



###############################################################################
#
#  Display help information.  It's long, so use PAGER
#
if ($prefs{"help"}) {

	open(PAGER, "| $ENV{PAGER}") or die "Couldn't open your pager ($ENV{PAGER})";

	print PAGER <<__END__;

          Linux "Debian Distribution" FTP Packages Maintainer $version

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


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


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

If your Debian machine does not have FTP access, run "$program scaninst" and
copy the generated '.installed' file onto whatever (FTP ready) machine you
plan to run this script from in the future.  This file is needed to do
intelligent package selection.


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

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

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

        $program installed clean

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

If you change the machine you are running this script on, the only file you
need to copy is ".installed".  This is the file that keeps a record of all the
packages retrieved from the FTP site.  If a ".installed" file is not available
because the Debian system has not yet been set up, just create an empty file
by typing "touch ~/packages/.installed".  Of lesser importance is the file
".prev-avail" which contains the list of packages from the last time packages
were installed.  It is used to tell if un-installed packages are new to the
distribution or just unwanted.  If this file is missing, all packages are
assumed to be new.  Any other files are wholly generated by the various
actions and can be deleted/ignored.

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

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

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


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

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

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

__END__

	close PAGER;
	exitdftp(1);
}



###############################################################################
#
#  Do some system set up, if neccessary.
#

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



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



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



sub create_installed_packages_file {
	my($filename) = @_;
	my($cmd) = '\
      sed </var/lib/dpkg/status -n \
	  -e    \'/^[Pp]ackage:/ {\'						\
	  -e    \'	s|^[Pp]ackage: *\([^ ]*\) *.*$|\1 |\'	\
	  -e    \'	h\'										\
	  -e    \'}\'										\
	  -e    \'/^[Ss]tatus: [^ ]* [^ ]* installed/ {\'	\
	  -e    \'	s|^.*$|#|\'								\
	  -e    \'	H\'										\
	  -e    \'}\'										\
	  -e    \'/^[Vv]ersion:/ {\'						\
	  -e    \'	s|^[Vv]ersion: *\([^ ]*\) *.*$|\1|\'	\
	  -e    \'	H\'										\
	  -e    \'}\'										\
	  -e    \'/^[Rr]evision:/ {\'						\
	  -e    \'	s|^[Rr]evision: *\([^ ]*\) *.*$|-\1|\'	\
	  -e    \'	H\'										\
	  -e    \'}\'										\
	  -e    \'/^$/ {\'									\
	  -e    \'	x\'										\
	  -e    \'	/#/ {\'									\
	  -e    \'		s|\n||g\'							\
	  -e    \'		s|#||g\'							\
	  -e    \'		p\'									\
	  -e    \'	}\'										\
	  -e    \'}\'' . "| sort -r >$filename";
	system $cmd;
}


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) = @_;

	open(PKGS, "<$filename") ||
		die "Error: Could not read installed packages file $filename -- $!\n";

	my(%result);

	while(<PKGS>) {
		my(@fields) = split;
		if ($#fields != 1) {
			die "Error: Bad line ($_) in installed package file $filename\n";
		}
		$result{$fields[0]} = $fields[1];
	}

	close(PKGS);
	return %result;
}



##############################################################################
#
#  Scan through the list of packages on a Debian system to build
#  initial install list.  This chooses the version number based on the
#  FTP file list and may not be entirely accurate.

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($pkginst);
}



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

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

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

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

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


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

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

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


sub section_excluded_p {
	my($package_text, @exclude_list) = @_;

	# return true if the section name on the section line in
	# package_text is not in exclude_list

	my($package_section) = package_get_section($package_text);
	my($excluded_section);
	foreach $excluded_section (@exclude_list) {
		if ($package_section eq $excluded_section) {
			return 0;
		}
	}
	return 1;
}



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

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

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

	return @packages;
}


if ($cmds{"getlist"} || $cmds{"getnew"}) {
	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;
	}

	#
	# FTP works a bit differently depending on normal or secure
	#
	open(NETRC, ">$netrc") || die "Error: Could not open '$netrc' -- $!";
	if (!($prefs{ftpgate})) {
		print NETRC
			"machine $prefs{ftpsite} login $prefs{ftpuser} ",
			"password $prefs{email} macdef init\n";
	} else {
		print NETRC
			"machine $prefs{ftpgate} ",
			"login \"$prefs{ftpuser}\@$prefs{ftpsite} $ENV{USER}\" ",
			"password $prefs{email} macdef init\n";
	}

	#
	# What to do when we connect
	#
	print NETRC "hash\n";
	if ($gunzip) {
		print NETRC "binary\n";
	} else {
		print NETRC "ascii\n";
	}
	print NETRC "cd $prefs{ftpdir}\n";

	if (! $prefs{"pkgpath"}) {
		my($dir);
		foreach $dir (split(/\s*,\s*/,$prefs{"include"})) {
			if (! (-d $dir)) {
				mkdir("$dir",0755) || die "Error: Could not mkdir '$dir' -- $!\n";
			}
			if (! (-d "$dir/$binary")) {
				mkdir("$dir/$binary",0755) || die "Error: Could not mkdir '$dir/binary' -- $!\n";
			}
			if (-f "$dir/$binary/Packages$dotgz") {
				unlink("$dir/$binary/Packages$dotgz");
			}
			print NETRC "get $dir/$binary/Packages$dotgz $dir/$binary/Packages$dotgz\n";
		}
	}

	print NETRC "bye\n\n";
	close(NETRC);
	chmod(0600,"$netrc");

	#
	# Remove any old listing that is hanging around
	#
	unlink("$pkglist", "$pkgdesc", "$pkgselect");

	#
	# If no local path, do the actual FTP and keep a log
	#
	if (! $prefs{"pkgpath"}) {
		if ($prefs{"quiet"}) {
			if (! $prefs{ftpgate}) {
				system("ftp -v $prefs{ftpsite} </dev/null 2>&1 > $pkgftplog");
			} else {
				system("ftp -v $prefs{ftpgate} </dev/null >  $pkgftplog");
			}
		} else {
			if (! $prefs{ftpgate}) {
				system("ftp -v $prefs{ftpsite} </dev/null 2>&1 | tee $pkgftplog");
			} else {
				system("ftp -v $prefs{ftpgate} </dev/null |  tee $pkgftplog");
			}
		}
		qecho " \n";
	}

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

	#
	# Stop if could not get the listing
	#
	my($tmpdesc) = "$tmpfile.packages";
	open(TMPDESC,">$tmpdesc");

	my($dir);
	foreach $dir (split(/\s*,\s*/, $prefs{"include"})) {
		my $pkgfile = "$prefs{pkgpath}$dir/$binary/Packages$dotgz";
		if (! -r $pkgfile) {
			$pkgfile = "$prefs{pkgpath}$dir/Packages$dotgz";
		}
		if (-r $pkgfile) {
			# Open an input pipe containing the packages file.
			if ($gunzip) {
				## Should check return
				open(PKGFILE, "$gunzip -c $pkgfile |");
			} else {
				## Should check return.
				open(PKGFILE, "<$pkgfile");
			}
			my(@contents) = <PKGFILE>;
			print TMPDESC @contents;
			print TMPDESC "\n";
			close(PKGFILE);
		} else {
			print "Could not retrieve package list for '$dir' -- not included\n";
		}
	}
	close(TMPDESC);

	#
	# Sort directory by section, excluding any unwanted ones
	#

	qecho "Sorting packages by section...\n";

	my(@packages) = load_package_array($tmpdesc);
	@packages = sort sort_section_func @packages;

	if ($prefs{"exclude"}) {
		my(@exclude_list) = split(/\s*,\s*/, $prefs{exclude});

		@packages =
			grep { section_excluded_p($_, @exclude_list); } @packages;
	}

	open(PKGDESC,">$pkgdesc") || die "Error: Could not open '$pkgdesc' -- $!\n";
	print PKGDESC @packages;
	close(PKGDESC);


	#
	# Generate a list of packages pathname from description file
	#
	open(PKGLIST, ">$pkglist") || die "Error: Could not open '$pkglist' -- $!\n";
	my($package);
	foreach $package (@packages) {

		$package =~ m/^filename:\s*(\S+)/imo;
		print PKGLIST "$1";

		$package =~ m/^package:\s*(\S+)/imo;
		print PKGLIST ";$1";

		$package =~ m/^version:\s*(\S+)/imo;
		print PKGLIST ";$1";

		if ($package =~ m/^revision:\s*(\S+)/imo) {
			print PKGLIST "-$1";
		}

		$package =~ m/^size:\s*(\S+)/imo;
		print PKGLIST ";$1";

		$package =~ m/^md5sum:\s*(\S+)/imo;
		print PKGLIST ";$1";

		print PKGLIST "\n";

	}
	close(PKGLIST);

	#
	# Remove old selection file so a new one will be built with new data
	#
	unlink($pkgselect);
}


sub get_previous_packages {
	my($filename) = @_;
	my(@prev_pkgs) = split(' ', `cat $filename`);
	my(%prev_packages_hash);

	my($package);
	foreach $package (@prev_pkgs) {
		# Hash table is keyed on package name.
		$package =~ m/^[^;]+;([^;]+);([^;]+);/go;
		$prev_packages_hash{$1} = $2;
	}
	return %prev_packages_hash;
}


sub make_filename_to_pkg_hash {
	my(@packages) = @_;
	my(%filename_hash);

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



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

if ($cmds{"select"} || $cmds{"getnew"}) {
	if (! (-f $pkglist)) {
		diemsg("ERROR - Cannot find list of available packages.\n" .
			   "Use the \"getlist\" action to get list from ftp site.",
			   1);
	}
	if (!(-f $pkginst)) {
		diemsg("ERROR - Cannot find list of installed packages.\n" .
			   "Use the \"scaninst\" action to generate this list.",
			   1);
	}

	#
	# 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) = load_installed_packages_file($pkginst);
		my(%pkg_desc_by_filename) =
			make_filename_to_pkg_hash(load_package_array($pkgdesc));

		#
		# Step through each non-excluded package and decide what to do with it
		#
		my($package);
		foreach $package (split(' ', `cat $pkglist`)) {
			my(@pkgfields) = split(';', $package);

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

			my($incoming_file)		= $pkgfields[0];
			my($incoming_name)		= $pkgfields[1];
			my($incoming_version)	= $pkgfields[2];
			my($incoming_size)		= $pkgfields[3];
			my($incoming_md5sum)	= $pkgfields[4];

			if ($prefs{"pkgpath"}) {
				if (! ( -r ($prefs{"pkgpath"} . $incoming_file))) {
					qecho "$incoming_file is non-existant -- skipped\n";
					next;
				}
			}

			my($installed_version) = $installed_vers{$incoming_name};
			my($str);
			my($pkg_type);

			$debref = "";
			if ($installed_version) {
				if ($installed_version eq $incoming_version) {
					$str = "$incoming_file\n";
					$pkg_type = "installed, unchanged";
				} else { # installed version and incoming version differ

					# --compare-versions returns 0 on success.
					my($upgrade_p) = system("dpkg --compare-versions " .
											"$incoming_version '<' $installed_version");
					if ($upgrade_p) {
						if (exists($prev_pkgs{$incoming_name}) &&
						   ($prev_pkgs{$incoming_name} eq $incoming_version)) {
							$str = "$incoming_file " .
								"($incoming_version vs $installed_version)\n";
							push(@debignorupgrad, "#$str");
							$debref = \@debignorupgrad;
							$pkg_type = "upgrade, ignored";
						} else {
							$str = "$incoming_file " .
								"($incoming_version vs $installed_version)\n";
							push(@debnewupgrad, "$str");
							$debref = \@debnewupgrad;
							$pkg_type = "upgrade, unseen";
						}
					} else {
						$str = "$incoming_file " .
							"($incoming_version vs $installed_version)\n";
						push(@debignordngrad, "#$str");
						$debref = \@debignordngrad;
						$pkg_type = "downgrade";
					}
				}

			} else { # no version installed

				# Check to see if this package is new
				if (exists($prev_pkgs{$incoming_name}) &&
				   ($prev_pkgs{$incoming_name} eq $incoming_version)) {
					$str = "$incoming_file\n";
					push(@debignorpkg, "#$str");
					$debref = \@debignorpkg;
					$pkg_type = "uninstalled, ignored";
				} else {
					$str = "$incoming_file\n";
					push(@debnewpkg, "#$str");
					$debref = \@debnewpkg;
					$pkg_type = "new, unseen";
				}
			}
			vecho "$incoming_file -- $pkg_type\n";

			if (ref $debref eq "ARRAY") {
				#
				# Look up package description if desired
				#
				if (! $prefs{"nodesc"}) {
					my($pkg_info) = $pkg_desc_by_filename{$incoming_file};

					# check matched one, take first, warn about others.
					if (! $pkg_info) {
						die "Error: Could not find package entry for '$incoming_file'!\n";
					}
					$pkg_info =~ s/\s*$//sg;
					$pkg_info =~ s/^/> /mog;

					push @$debref, "$pkg_info\n\n";
				}
			}
		}

		#
		# Build selection file (with instructions)
		#

		open(PKGSELECT, ">$pkgselect") || die "Error: Could not open '$pkgselect' -- $!\n";
		print PKGSELECT <<__END__;
#==============================================================================
#
# LIST OF NEW UPGRADES -- a list of available packages whose versions are newer
# than the versions installed on your system.
#
# The pathname on the left shows what is available.  Within parentheses on the
# right is the newer version followed by the installed version. Comment out
# (with '#') the pathnames of any packages you do not wish to update.  Those
# not retrieved will appear under "LIST OF IGNORED UPGRADES" in future runs.
#

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

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

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

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

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

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

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

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

__END__
		print PKGSELECT @debignorpkg;
	}

	close(PKGSELECT);

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



###############################################################################
#
#  Use FTP to get all the selected files
#
if ($cmds{"getselect"} || $cmds{getnew}) {
	if (! (-f $pkgselect)) {
		print "ERROR: The list of selected packages does not exist.\n";
		print "       Perhaps you have already used the \"clean\" action?\n";
		exitdftp(1);
	}

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

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


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

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

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

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

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

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

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

		#
		# FTP works a bit differently depending on normal or secure
		#
		open(NETRC, ">$netrc") || die "Error: Could not open '$netrc' -- $!\n";

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

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

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


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

		}
		qecho " \n";

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

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



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

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

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

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

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



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

if ($cmds{"verify"} || $cmds{"getnew"}) {
	if (! (-f $pkgdload)) {
		print "ERROR: The list of downloaded packages does not exist.\n";
		print "       Perhaps you have already used the \"clean\" action?\n";
		exitdftp(1);
	}

	if (!$prefs{"pkgpath"}) {
		qecho "Verifying that FTP got all the files correctly...\n";
	} else {
		qecho "Verifying that all packages are correct...\n";
	}

	my(%pkginfo) = load_pkg_info($pkglist);

	my($missing) = 0;
	my($pkg);
	foreach $pkg (split('\n', `cat $pkgdload`)) {
		my($file) = "$prefs{pkgpath}$pkg";

		if (! (-f $file)) {
			print "$pkg -- not retrieved\n";
			$missing = 1;
		} else {
			if ($debian_system) {
				my($fileinfo) = `md5sum <$file`;
				chop $fileinfo;

				# This is kind of ugly
				# $pkginfo{$pkg} returns a *pointer* to a hash table which we then
				# dereference and get the value associated with the key "md5sum"
				my($pkgsum) = $ {$pkginfo{$pkg}}{"md5sum"};

				if ($fileinfo ne $pkgsum) {
					print "$pkg -- md5sum mismatch, $fileinfo/$pkgsum, removed\n";
					unlink $pkg;
					$missing = 1;
				} else {
					vecho "$pkg -- okay\n";
				}
			} else {
				my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
				   $atime,$mtime,$ctime,$blksize,$blocks)
					= stat($file);

				my($origsize) = $ {$pkginfo{$pkg}}{"size"};
				if ($size != $origsize) {
					print "$pkg -- file size mismatch ($size vs $origsize), removed\n";
					unlink $pkg;
					$missing = 1;
				} else {
					vecho "$pkg -- okay\n";
				}
			}
		}
	}
	if ($missing) {
		print "(see file $pkgftplog for more information)\n";
		exitdftp(1);
	}
}



###############################################################################
#
#  Unpack retrieved packages (Debian systems only)
#
if ($cmds{"unpack"} || ($cmds{"getnew"} && $debian_system)) {
	if (! $debian_system) {
		print "ERROR: This is not a debian system -- cannot \"unpack\"\n";
		exitdftp(1);
	}

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

	my(@dlpkgs,@ipkgs,@npkgs,$ipkg);
	open(DLOAD,"<$pkgdload") || die "Error: Could not read '$pkgdload' -- $!\n";
	while (<DLOAD>) {
		chomp;
		push @dlpkgs,"$prefs{pkgpath}$_";
	}
	close DLOAD;

	my $pkgpatt = join('|',@instalone);
	@ipkgs = grep( m|/($pkgpatt)_|i,@dlpkgs);
	@npkgs = grep(!m|/($pkgpatt)_|i,@dlpkgs);

	qecho "Unpacking and installing packages...\n";

	foreach $ipkg (@ipkgs) {
		my($pkg) = ($ipkg =~ m|.*/(.*?)_[^/]*$|);
		qecho "* new $pkg is available -- installing first and by itself\n";
		system("dpkg --install $ipkg");
	}

	print "* installing remaining packages\n" if @ipkgs;
	system("dpkg --install @npkgs");
}



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

if ($cmds{"archive"} || ($cmds{"getnew"} && (! $debian_system))) {
	if (! (-f $pkgdload)) {
		print "ERROR: The list of downloaded packages does not exist.\n";
		print "       Perhaps you have already used the \"clean\" action?\n";
		exitdftp(1);
	}

	qecho "TARing retrieved packages into $prefs{tarfile} ...\n";

	unlink($prefs{tarfile});

	my($taropts);
	if ($prefs{"verbose"}) {
		$taropts = "v";
	} else {
		$taropts = "";
	}

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



###############################################################################
#
#  Add retrieved packages to list of installed packages
#
if ($cmds{"installed"} || $cmds{"getnew"}) {
	if (! (-f $pkgdload)) {
		print "ERROR: The list of downloaded packages does not exist.\n";
		print "       Perhaps you have already used the \"clean\" action?\n";
		exitdftp(1);
	}

	qecho "Marking files as installed (for future runs of ${program})...\n";

	system("cat $pkginst >$tmpfile");

	my($file);
	foreach $file (split('\n', `cat $pkgdload`)) {
		system("grep $file $pkglist | " .
			   'sed -e \'s|^[^;]*;\([^;]*\);\([^;]*\).*$|\1 \2|\' ' .
			   ">>$tmpfile");
	}
	system("sort -ru <$tmpfile >$pkginst");

	if (-f $pkglist) {
		system("cp $pkglist $pkgprev");
	}
}



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

if ($cmds{"clean"}) {
	qecho("Cleaning out old (already installed) packages...\n");
	my($ftpprint);

	if ($prefs{"verbose"}) {
		$ftpprint = '-print';
	} else {
		$ftpprint = '';
	}

	system('find . -type f  \\( -name "*.deb" -o -name "Packages*" \\) ' .
		   "$ftpprint | xargs rm -f");
	unlink($pkglist, $pkgselect, $pkgdload, $pkgdesc, $pkgftplog,
		   $prefs{"tarfile"});
}



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

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



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