Adding upstream version 1.22.4.upstream/1.22.4

Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>

5 files changed, 1056 insertions, 0 deletions

diff --git a/dselect/methods/ftp/desc.ftp b/dselect/methods/ftp/desc.ftp
new file mode 100644
index 0000000..accd994
--- /dev/null
+++ b/dselect/methods/ftp/desc.ftp
@@ -0,0 +1,2 @@
+Installation using ftp, you must know one (or more) ftp site(s) and the
+correct directories for the Debian distribution.
diff --git a/dselect/methods/ftp/install.pl b/dselect/methods/ftp/install.pl
new file mode 100755
index 0000000..ea6ea71
--- /dev/null
+++ b/dselect/methods/ftp/install.pl
@@ -0,0 +1,626 @@
+#!/usr/bin/perl
+#
+# Copyright © 1996 Andy Guy <andy@cyteen.org>
+# Copyright © 1998 Martin Schulze <joey@infodrom.north.de>
+# Copyright © 1999, 2009 Raphaël Hertzog <hertzog@debian.org>
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+use strict;
+use warnings;
+
+use File::Path qw(make_path remove_tree);
+use File::Basename;
+
+eval q{
+    use File::Find;
+    use Data::Dumper;
+
+    use Dpkg::File;
+};
+if ($@) {
+    warn "Missing Dpkg modules required by the FTP access method.\n\n";
+    exit 1;
+}
+
+use Dselect::Method;
+use Dselect::Method::Ftp;
+
+my $ftp;
+
+# exit value
+my $exit = 0;
+
+# deal with arguments
+my $vardir = $ARGV[0];
+my $method = $ARGV[1];
+my $option = $ARGV[2];
+
+if ($option eq 'manual') {
+  print "manual mode not supported yet\n";
+  exit 1;
+}
+#print "vardir: $vardir, method: $method, option: $option\n";
+
+my $methdir = "$vardir/methods/ftp";
+
+# get info from control file
+read_config("$methdir/vars");
+
+chdir "$methdir";
+make_path("$methdir/$CONFIG{dldir}", { mode => 0755 });
+
+
+#Read md5sums already calculated
+my %md5sums;
+if (-f "$methdir/md5sums") {
+  my $code = file_slurp("$methdir/md5sums");
+  my $VAR1; ## no critic (Variables::ProhibitUnusedVariables)
+  my $res = eval $code;
+  if ($@) {
+    die "couldn't eval $methdir/md5sums content: $@\n";
+  }
+  if (ref($res)) { %md5sums = %{$res} }
+}
+
+# Get a stanza.
+# returns a ref to a hash containing flds->fld contents
+# white space from the ends of lines is removed and newlines added
+# (no trailing newline).
+# die's if something unexpected happens
+sub get_stanza {
+    my $fh = shift;
+    my %flds;
+    my $fld;
+    while (<$fh>) {
+	if (length != 0) {
+	    FLDLOOP: while (1) {
+		if ( /^(\S+):\s*(.*)\s*$/ ) {
+		    $fld = lc($1);
+		    $flds{$fld} = $2;
+		    while (<$fh>) {
+			if (length == 0) {
+			    return %flds;
+			} elsif ( /^(\s.*)$/ ) {
+			    $flds{$fld} = $flds{$fld} . "\n" . $1;
+			} else {
+			    next FLDLOOP;
+			}
+		    }
+		    return %flds;
+		} else {
+		    die "expected a start of field line, but got:\n$_";
+		}
+	    }
+	}
+    }
+    return %flds;
+}
+
+# process status file
+# create curpkgs hash with version (no version implies not currently installed)
+# of packages we want
+print "Processing status file...\n";
+my %curpkgs;
+sub procstatus {
+    my (%flds, $fld);
+    open(my $status_fh, '<', "$vardir/status") or
+        die 'Could not open status file';
+    while (%flds = get_stanza($status_fh), %flds) {
+	if($flds{'status'} =~ /^install ok/) {
+	    my $cs = (split(/ /, $flds{'status'}))[2];
+	    if (($cs eq 'not-installed') ||
+	        ($cs eq 'half-installed') ||
+	        ($cs eq 'config-files')) {
+		$curpkgs{$flds{'package'}} = '';
+	    } else {
+		$curpkgs{$flds{'package'}} = $flds{'version'};
+	    }
+	}
+    }
+    close($status_fh);
+}
+procstatus();
+
+sub dcmpvers {
+    my($a, $p, $b) = @_;
+    my ($r);
+    $r = system('dpkg', '--compare-versions', "$a", "$p", "$b");
+    $r = $r/256;
+    if ($r == 0) {
+	return 1;
+    } elsif ($r == 1) {
+	return 0;
+    }
+    die "dpkg --compare-versions $a $p $b - failed with $r";
+}
+
+# process package files, looking for packages to install
+# create a hash of these packages pkgname => version, filenames...
+# filename => md5sum, size
+# for all packages
+my %pkgs;
+my %pkgfiles;
+sub procpkgfile {
+    my $fn = shift;
+    my $site = shift;
+    my $dist = shift;
+    my (@files, @sizes, @md5sums, $pkg, $ver, $nfs, $fld);
+    my(%flds);
+    open(my $pkgfile_fh, '<', $fn) or die "could not open package file $fn";
+    while (%flds = get_stanza($pkgfile_fh), %flds) {
+	$pkg = $flds{'package'};
+	$ver = $curpkgs{$pkg};
+	@files = split(/[\s\n]+/, $flds{'filename'});
+	@sizes = split(/[\s\n]+/, $flds{'size'});
+	@md5sums = split(/[\s\n]+/, $flds{'md5sum'});
+	if (defined($ver) && (($ver eq '') || dcmpvers($ver, 'lt', $flds{'version'}))) {
+	    $pkgs{$pkg} = [ $flds{'version'}, [ @files ], $site ];
+	    $curpkgs{$pkg} = $flds{'version'};
+	}
+	$nfs = scalar(@files);
+	if(($nfs != scalar(@sizes)) || ($nfs != scalar(@md5sums)) ) {
+	    print "Different number of filenames, sizes and md5sums for $flds{'package'}\n";
+	} else {
+	    my $i = 0;
+	    foreach my $fl (@files) {
+		$pkgfiles{$fl} = [ $md5sums[$i], $sizes[$i], $site, $dist ];
+		$i++;
+	    }
+	}
+    }
+    close $pkgfile_fh or die "cannot close package file $fn: $!\n";
+}
+
+print "\nProcessing Package files...\n";
+my ($i, $j);
+$i = 0;
+foreach my $site (@{$CONFIG{site}}) {
+  $j = 0;
+  foreach my $dist (@{$site->[2]}) {
+    my $fn = $dist;
+    $fn =~ tr#/#_#;
+    $fn = "Packages.$site->[0].$fn";
+    if (-f $fn) {
+	print " $site->[0] $dist...\n";
+	procpkgfile($fn,$i,$j);
+    } else {
+	print "Could not find packages file for $site->[0] $dist distribution (re-run Update)\n"
+    }
+    $j++;
+  }
+  $i++;
+}
+
+my $dldir = $CONFIG{dldir};
+# md5sum
+sub md5sum($) {
+    my $fn = shift;
+    my $m = qx(md5sum $fn);
+    $m = (split(' ', $m))[0];
+    $md5sums{"$dldir/$fn"} = $m;
+    return $m;
+}
+
+# construct list of files to get
+# hash of filenames => size of downloaded part
+# query user for each partial file
+print "\nConstructing list of files to get...\n";
+my %downloads;
+my ($dir, @info, @files, $csize, $size);
+my $totsize = 0;
+foreach my $pkg (keys(%pkgs)) {
+    @files = @{$pkgs{$pkg}[1]};
+    foreach my $fn (@files) {
+        #Look for a partial file
+	if (-f "$dldir/$fn.partial") {
+	  rename "$dldir/$fn.partial", "$dldir/$fn";
+	}
+	$dir = dirname($fn);
+	if(! -d "$dldir/$dir") {
+	    make_path("$dldir/$dir", { mode => 0755 });
+	}
+	@info = @{$pkgfiles{$fn}};
+	$csize = int($info[1]/1024)+1;
+	if(-f "$dldir/$fn") {
+	    $size = -s "$dldir/$fn";
+	    if($info[1] > $size) {
+		# partial download
+		if (yesno('y', "continue file: $fn (" . nb($size) . '/' .
+		               nb($info[1]) . ')')) {
+		    $downloads{$fn} = $size;
+		    $totsize += $csize - int($size/1024);
+		} else {
+		    $downloads{$fn} = 0;
+		    $totsize += $csize;
+		}
+	    } else {
+		# check md5sum
+		if (! exists $md5sums{"$dldir/$fn"}) {
+                  $md5sums{"$dldir/$fn"} = md5sum("$dldir/$fn");
+		}
+		if ($md5sums{"$dldir/$fn"} eq $info[0]) {
+		    print "already got: $fn\n";
+		} else {
+		    print "corrupted: $fn\n";
+		    $downloads{$fn} = 0;
+		}
+	    }
+	} else {
+	    my $ffn = $fn;
+	    $ffn =~ s/binary-[^\/]+/.../;
+	    print 'want: ' .
+	          $CONFIG{site}[$pkgfiles{$fn}[2]][0] . " $ffn (${csize}k)\n";
+	    $downloads{$fn} = 0;
+	    $totsize += $csize;
+	}
+    }
+}
+
+my $avsp = qx(df -Pk $dldir| awk '{ print \$4}' | tail -n 1);
+chomp $avsp;
+
+print "\nApproximate total space required: ${totsize}k\n";
+print "Available space in $dldir: ${avsp}k\n";
+
+#$avsp = qx(df -k $::dldir| paste -s | awk '{ print \$11});
+#chomp $avsp;
+
+if($totsize == 0) {
+    print 'Nothing to get.';
+} else {
+    if($totsize > $avsp) {
+	print "Space required is greater than available space,\n";
+	print "you will need to select which items to get.\n";
+    }
+# ask user which files to get
+    if (($totsize > $avsp) ||
+        yesno('n', 'Do you want to select the files to get')) {
+	$totsize = 0;
+	my @files = sort(keys(%downloads));
+	my $def = 'y';
+	foreach my $fn (@files) {
+	    my @info = @{$pkgfiles{$fn}};
+	    my $csize = int($info[1] / 1024) + 1;
+	    my $rsize = int(($info[1] - $downloads{$fn}) / 1024) + 1;
+	    if ($rsize + $totsize > $avsp) {
+		print "no room for: $fn\n";
+		delete $downloads{$fn};
+	    } else {
+		if(yesno($def, $downloads{$fn}
+			 ? "download: $fn ${rsize}k/${csize}k (total = ${totsize}k)"
+			 : "download: $fn ${rsize}k (total = ${totsize}k)")) {
+		    $def = 'y';
+		    $totsize += $rsize;
+		} else {
+		    $def = 'n';
+		    delete $downloads{$fn};
+		}
+	    }
+	}
+    }
+}
+
+sub download() {
+ my $i = 0;
+
+ foreach my $site (@{$CONFIG{site}}) {
+    my @getfiles = grep { $pkgfiles{$_}[2] == $i } keys %downloads;
+    my @pre_dist = (); # Directory to add before $fn
+
+    #Scan distributions for looking at "(../)+/dir/dir"
+    my ($n,$cp);
+    $cp = -1;
+    foreach (@{$site->[2]}) {
+      $cp++;
+      $pre_dist[$cp] = '';
+      $n = (s{\.\./}{../}g);
+      next if (! $n);
+      if (m<^((?:\.\./){$n}(?:[^/]+/){$n})>) {
+        $pre_dist[$cp] = $1;
+      }
+    }
+
+    if (! @getfiles) { $i++; next; }
+
+    $ftp = do_connect(ftpsite => $site->[0],
+                      ftpdir => $site->[1],
+                      passive => $site->[3],
+                      username =>  $site->[4],
+                      password => $site->[5],
+                      useproxy => $CONFIG{use_auth_proxy},
+                      proxyhost => $CONFIG{proxyhost},
+                      proxylogname => $CONFIG{proxylogname},
+                      proxypassword => $CONFIG{proxypassword});
+
+    local $SIG{INT} = sub { die "Interrupted !\n"; };
+
+    my ($rsize, $res, $pre);
+    foreach my $fn (@getfiles) {
+        $pre = $pre_dist[$pkgfiles{$fn}[3]] || '';
+	if ($downloads{$fn}) {
+	    $rsize = ${pkgfiles{$fn}}[1] - $downloads{$fn};
+	    print "getting: $pre$fn (" . nb($rsize) . '/' .
+	          nb($pkgfiles{$fn}[1]) . ")\n";
+	} else {
+	    print "getting: $pre$fn (". nb($pkgfiles{$fn}[1]) . ")\n";
+	}
+	$res = $ftp->get("$pre$fn", "$dldir/$fn", $downloads{$fn});
+	if(! $res) {
+	    my $r = $ftp->code();
+	    print $ftp->message() . "\n";
+	    if (!($r == 550 || $r == 450)) {
+		return 1;
+	    } else {
+              #Try to find another file or this package
+	      print "Looking for another version of the package...\n";
+	      my ($dir, $package) = ($fn =~ m{^(.*)/([^/]+)_[^/]+.deb$});
+	      my $list = $ftp->ls("$pre$dir");
+	      if ($ftp->ok() && ref($list)) {
+		foreach my $file (@{$list}) {
+		  if ($file =~ m/($dir\/\Q$package\E_[^\/]+.deb)/i) {
+		    print "Package found : $file\n";
+		    print "getting: $file (size not known)\n";
+		    $res = $ftp->get($file, "$dldir/$1");
+		    if (! $res) {
+                      $r = $ftp->code();
+		      print $ftp->message() . "\n";
+		      return 1 if ($r != 550 and $r != 450);
+		    }
+		  }
+		}
+	      }
+	    }
+	}
+	# fully got, remove it from list in case we have to re-download
+	delete $downloads{$fn};
+    }
+    $ftp->quit();
+    $i++;
+ }
+ return 0;
+}
+
+# download stuff (protect from ^C)
+if($totsize != 0) {
+    if (yesno('y', "\nDo you want to download the required files")) {
+      DOWNLOAD_TRY: while (1) {
+	  print "Downloading files... use ^C to stop\n";
+	  eval {
+	      if ((download() == 1) &&
+	          yesno('y', "\nDo you want to retry downloading at once")) {
+		  next DOWNLOAD_TRY;
+	      }
+	  };
+	  if($@ =~ /Interrupted|Timeout/i ) {
+	      # close the FTP connection if needed
+	      if ((ref($ftp) =~ /Net::FTP/) and ($@ =~ /Interrupted/i)) {
+	        $ftp->abort();
+	        $ftp->quit();
+	        undef $ftp;
+	      }
+	      print "FTP ERROR\n";
+              if (yesno('y', "\nDo you want to retry downloading at once")) {
+		  # get the first $fn that foreach would give:
+		  # this is the one that got interrupted.
+                my $fn;
+		MY_ITER: foreach my $ffn (keys(%downloads)) {
+		    $fn = $ffn;
+		    last MY_ITER;
+		}
+	        my $size = -s "$dldir/$fn";
+		# partial download
+		if (yesno('y', "continue file: $fn (at $size)")) {
+		    $downloads{$fn} = $size;
+		} else {
+		    $downloads{$fn} = 0;
+		}
+		next DOWNLOAD_TRY;
+	      } else {
+	        $exit = 1;
+		last DOWNLOAD_TRY;
+	      }
+	  } elsif ($@) {
+             print "An error occurred ($@) : stopping download\n";
+	  }
+	  last DOWNLOAD_TRY;
+      }
+    }
+}
+
+# remove duplicate packages (keep latest versions)
+# move half downloaded files out of the way
+# delete corrupted files
+print "\nProcessing downloaded files...(for corrupt/old/partial)\n";
+my %vers; # package => version
+my %files; # package-version => files...
+
+# check a deb or split deb file
+# return 1 if it a deb file, 2 if it is a split deb file
+# else 0
+sub chkdeb($) {
+    my ($fn) = @_;
+    # check to see if it is a .deb file
+    if (!system "dpkg-deb --info $fn >/dev/null 2>&1 && dpkg-deb --contents $fn >/dev/null 2>&1") {
+	return 1;
+    } elsif (!system "dpkg-split --info $fn >/dev/null 2>&1") {
+	return 2;
+    }
+    return 0;
+}
+sub getdebinfo($) {
+    my ($fn) = @_;
+    my $type = chkdeb($fn);
+    my ($pkg, $ver);
+    if($type == 1) {
+	open(my $pkgfile_fh, '-|', "dpkg-deb --field $fn")
+	    or die "cannot create pipe for 'dpkg-deb --field $fn'";
+	my %fields = get_stanza($pkgfile_fh);
+	close($pkgfile_fh);
+	$pkg = $fields{'package'};
+	$ver = $fields{'version'};
+	return $pkg, $ver;
+    } elsif ( $type == 2) {
+	open(my $pkgfile_fh, '-|', "dpkg-split --info $fn")
+	    or die "cannot create pipe for 'dpkg-split --info $fn'";
+	while (<$pkgfile_fh>) {
+	    /Part of package:\s*(\S+)/ and $pkg = $1;
+	    /\.\.\. version:\s*(\S+)/ and $ver = $1;
+	}
+	close($pkgfile_fh);
+	return $pkg, $ver;
+    }
+    print "could not figure out type of $fn\n";
+    return $pkg, $ver;
+}
+
+# process deb file to make sure we only keep latest versions
+sub prcdeb($$) {
+    my ($dir, $fn) = @_;
+    my ($pkg, $ver) = getdebinfo($fn);
+    if(!defined($pkg) || !defined($ver)) {
+	print "could not get package info from file\n";
+	return 0;
+    }
+    if($vers{$pkg}) {
+	if (dcmpvers($vers{$pkg}, 'eq', $ver)) {
+	    $files{$pkg . $ver} = [ $files{$pkg . $ver }, "$dir/$fn" ];
+	} elsif (dcmpvers($vers{$pkg}, 'gt', $ver)) {
+	    print "old version\n";
+	    unlink $fn;
+	} else { # else $ver is gt current version
+	    foreach my $c (@{$files{$pkg . $vers{$pkg}}}) {
+		print "replaces: $c\n";
+		unlink "$vardir/methods/ftp/$dldir/$c";
+	    }
+	    $vers{$pkg} = $ver;
+	    $files{$pkg . $ver} = [ "$dir/$fn" ];
+	}
+    } else {
+	$vers{$pkg} = $ver;
+	$files{$pkg . $ver} = [ "$dir/$fn" ];
+    }
+}
+
+sub prcfile() {
+    my ($fn) = $_;
+    if (-f $fn and $fn ne '.') {
+        my $dir = '.';
+	if (length($File::Find::dir) > length($dldir)) {
+            $dir = substr($File::Find::dir, length($dldir)+1);
+	}
+	print "$dir/$fn\n";
+	if(defined($pkgfiles{"$dir/$fn"})) {
+	    my @info = @{$pkgfiles{"$dir/$fn"}};
+	    my $size = -s $fn;
+	    if($size == 0) {
+		print "zero length file\n";
+		unlink $fn;
+	    } elsif($size < $info[1]) {
+		print "partial file\n";
+		rename $fn, "$fn.partial";
+	    } elsif(( (exists $md5sums{"$dldir/$fn"})
+	              and ($md5sums{"$dldir/$fn"} ne $info[0]) )
+		     or
+	            (md5sum($fn) ne $info[0])) {
+		print "corrupt file\n";
+		unlink $fn;
+	    } else {
+		prcdeb($dir, $fn);
+	    }
+	} elsif($fn =~ /.deb$/) {
+	    if(chkdeb($fn)) {
+		prcdeb($dir, $fn);
+	    } else {
+		print "corrupt file\n";
+		unlink $fn;
+	    }
+	} else {
+	    print "non-debian file\n";
+	}
+    }
+}
+find(\&prcfile, "$dldir/");
+
+# install .debs
+if (yesno('y', "\nDo you want to install the files fetched")) {
+    print "Installing files...\n";
+    #Installing pre-dependent package before !
+    my (@flds, $package, @filename, $r);
+    while (@flds = qx(dpkg --predep-package), $? == 0) {
+      foreach my $field (@flds) {
+        $field =~ s/\s*\n//;
+        $package = $field if $field =~ s/^Package: //i;
+        @filename = split / +/, $field if $field =~ s/^Filename: //i;
+      }
+      @filename = map { "$dldir/$_" } @filename;
+      next if (! @filename);
+      $r = system('dpkg', '-iB', '--', @filename);
+      if ($r) { print "DPKG ERROR\n"; $exit = 1; }
+    }
+    #Installing other packages after
+    $r = system('dpkg', '-iGREOB', $dldir);
+    if($r) {
+	print "DPKG ERROR\n";
+	$exit = 1;
+    }
+}
+
+sub removeinstalled {
+    my $fn = $_;
+    if (-f $fn and $fn ne '.') {
+        my $dir = '.';
+	if (length($File::Find::dir) > length($dldir)) {
+            $dir = substr($File::Find::dir, length($dldir)+1);
+	}
+	if($fn =~ /.deb$/) {
+	    my($pkg, $ver) = getdebinfo($fn);
+	    if(!defined($pkg) || !defined($ver)) {
+		print "Could not get info for: $dir/$fn\n";
+	    } else {
+		if ($curpkgs{$pkg} and dcmpvers($ver, 'le', $curpkgs{$pkg})) {
+		    print "deleting: $dir/$fn\n";
+		    unlink $fn;
+		} else {
+		    print "leaving: $dir/$fn\n";
+		}
+	    }
+	} else {
+	    print "non-debian: $dir/$fn\n";
+	}
+    }
+}
+
+# remove .debs that have been installed (query user)
+# first need to reprocess status file
+if (yesno('y', "\nDo you wish to delete the installed package (.deb) files?")) {
+    print "Removing installed files...\n";
+    %curpkgs = ();
+    procstatus();
+    find(\&removeinstalled, "$dldir/");
+}
+
+# remove whole ./debian directory if user wants to
+if (yesno('n', "\nDo you want to remove $dldir directory?")) {
+    remove_tree($dldir);
+}
+
+#Store useful md5sums
+foreach my $file (keys %md5sums) {
+  next if -f $file;
+  delete $md5sums{$file};
+}
+file_dump("$methdir/md5sums", Dumper(\%md5sums));
+
+exit $exit;
diff --git a/dselect/methods/ftp/names b/dselect/methods/ftp/names
new file mode 100644
index 0000000..6499279
--- /dev/null
+++ b/dselect/methods/ftp/names
@@ -0,0 +1 @@
+60 ftp Install using ftp.
diff --git a/dselect/methods/ftp/setup.pl b/dselect/methods/ftp/setup.pl
new file mode 100755
index 0000000..b9e8e27
--- /dev/null
+++ b/dselect/methods/ftp/setup.pl
@@ -0,0 +1,177 @@
+#!/usr/bin/perl
+#
+# Copyright © 1996 Andy Guy <andy@cyteen.org>
+# Copyright © 1998 Martin Schulze <joey@infodrom.north.de>
+# Copyright © 1999, 2009 Raphaël Hertzog <hertzog@debian.org>
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+use strict;
+use warnings;
+
+eval q{
+    use Dpkg; # Dummy import to require the presence of Dpkg::*.
+};
+if ($@) {
+    warn "Missing Dpkg modules required by the FTP access method.\n\n";
+    exit 1;
+}
+
+use Dselect::Method;
+use Dselect::Method::Ftp;
+
+# deal with arguments
+my $vardir = $ARGV[0];
+my $method = $ARGV[1];
+my $option = $ARGV[2];
+
+if ($option eq 'manual') {
+    print "Manual package installation.\n";
+    exit 0;
+}
+#print "vardir: $vardir, method: $method, option: $option\n";
+
+#Defaults
+my $arch = qx(dpkg --print-architecture);
+$arch = 'i386' if $?;
+chomp $arch;
+
+my $logname = qx(whoami);
+chomp $logname;
+my $host = qx(cat /etc/mailname || dnsdomainname);
+chomp $host;
+
+$CONFIG{dldir} = 'debian';
+$CONFIG{use_auth_proxy} = 0;
+$CONFIG{proxyhost} = '';
+$CONFIG{proxylogname} = $logname;
+$CONFIG{proxypassword} = '';
+
+my $methdir = "$vardir/methods/ftp";
+my $exit = 0;
+my $problem = 0;
+
+if (-f "$methdir/vars") {
+  read_config("$methdir/vars");
+}
+
+chdir "$methdir";
+if (! -d 'debian') {
+    mkdir 'debian', 0755;
+}
+# get info from user
+
+$| = 1;
+
+print <<"EOM";
+
+You must supply an ftp site, use of passive mode, username, password,
+path to the debian directory,list of distributions you are interested
+in and place to download the binary package files to (relative to
+/var/lib/dpkg/methods/ftp). You can add as much sites as you like. Later
+entries will always override older ones.
+
+Supply "?" as a password to be asked each time you connect.
+
+Eg:      ftp site: ftp.debian.org
+          passive: y
+         username: anonymous
+         password: $logname\@$host
+          ftp dir: /debian
+    distributions: dists/stable/main dists/stable/contrib
+     download dir: debian
+
+You may have to use an authenticated FTP proxy in order to reach the
+FTP site:
+
+Eg:  use auth proxy: y
+              proxy: proxy.isp.com
+      proxy account: $CONFIG{proxylogname}
+     proxy password: ?
+EOM
+
+if (! $CONFIG{done}) {
+  view_mirrors() if (yesno('y', 'Would you like to see a list of ftp mirrors'));
+  add_site('ftp');
+}
+edit_config('ftp', $methdir);
+
+my $ftp;
+sub download() {
+ foreach (@{$CONFIG{site}}) {
+    $ftp = do_connect(ftpsite => $_->[0],
+                      ftpdir => $_->[1],
+                      passive => $_->[3],
+                      username => $_->[4],
+                      password => $_->[5],
+                      useproxy => $CONFIG{use_auth_proxy},
+                      proxyhost => $CONFIG{proxyhost},
+                      proxylogname => $CONFIG{proxylogname},
+                      proxypassword => $CONFIG{proxypassword});
+
+    my @dists = @{$_->[2]};
+
+    foreach my $dist (@dists) {
+	my $dir = "$dist/binary-$arch";
+	print "Checking $dir...\n";
+#	if (!$ftp->pasv()) { print $ftp->message . "\n"; die 'error'; }
+	my @dirlst = $ftp->ls("$dir/");
+	my $got_pkgfile = 0;
+
+	foreach my $line (@dirlst) {
+	    if($line =~ /Packages/) {
+		$got_pkgfile = 1;
+	    }
+	}
+	if( !$got_pkgfile) {
+	    print "Warning: Could not find a Packages file in $dir\n",
+	    "This may not be a problem if the directory is a symbolic link\n";
+	    $problem = 1;
+	}
+    }
+    print "Closing ftp connection...\n";
+    $ftp->quit();
+  }
+}
+
+# download stuff (protect from ^C)
+print "\nUsing FTP to check directories...(stop with ^C)\n\n";
+eval {
+    local $SIG{INT} = sub {
+	die "interrupted!\n";
+    };
+    download();
+};
+if($@) {
+    $ftp->quit();
+    print 'FTP ERROR - ';
+    if ($@ eq 'connect') {
+	print "config was untested\n";
+    } else {
+	print "$@\n";
+    }
+    $exit = 1;
+};
+
+# output new vars file
+$CONFIG{done} = 1;
+store_config("$methdir/vars");
+chmod  0600, "$methdir/vars";
+
+if($exit || $problem) {
+    print "Press <enter> to continue\n";
+    <STDIN>;
+}
+
+exit $exit;
diff --git a/dselect/methods/ftp/update.pl b/dselect/methods/ftp/update.pl
new file mode 100755
index 0000000..8fcd7b1
--- /dev/null
+++ b/dselect/methods/ftp/update.pl
@@ -0,0 +1,250 @@
+#!/usr/bin/perl
+#
+# Copyright © 1996 Andy Guy <andy@cyteen.org>
+# Copyright © 1998 Martin Schulze <joey@infodrom.north.de>
+# Copyright © 1999, 2009 Raphaël Hertzog <hertzog@debian.org>
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+use strict;
+use warnings;
+
+eval q{
+    use Dpkg; # Dummy import to require the presence of Dpkg::*.
+};
+if ($@) {
+    warn "Missing Dpkg modules required by the FTP access method.\n\n";
+    exit 1;
+}
+
+use Dselect::Method;
+use Dselect::Method::Ftp;
+
+# deal with arguments
+my $vardir = $ARGV[0];
+my $method = $ARGV[1];
+my $option = $ARGV[2];
+
+if ($option eq 'manual') {
+    print "Enter package file names or a blank line to finish\n";
+    while(1) {
+	print 'Enter package file name:';
+	my $fn = <STDIN>;
+	chomp $fn;
+	if ($fn eq '') {
+	    exit 0;
+	}
+	if ( -f $fn ) {
+	    system('dpkg', '--merge-avail', $fn);
+	} else {
+	    print "Could not find $fn, try again\n";
+	}
+    };
+};
+
+#print "vardir: $vardir, method: $method, option: $option\n";
+
+my $arch = qx(dpkg --print-architecture);
+$arch = 'i386' if $?;
+chomp $arch;
+my $exit = 0;
+
+# get info from control file
+read_config("$vardir/methods/ftp/vars");
+
+chdir "$vardir/methods/ftp";
+
+print "Getting Packages files...(stop with ^C)\n\n";
+
+my @pkgfiles;
+my $ftp;
+my $packages_modified = 0;
+
+sub download {
+foreach (@{$CONFIG{site}}) {
+   my $site = $_;
+
+        $ftp = do_connect(ftpsite => $_->[0],
+                          ftpdir => $_->[1],
+                          passive => $_->[3],
+                          username => $_->[4],
+                          password => $_->[5],
+                          useproxy => $CONFIG{use_auth_proxy},
+                          proxyhost => $CONFIG{proxyhost},
+                          proxylogname => $CONFIG{proxylogname},
+                          proxypassword => $CONFIG{proxypassword});
+
+    my @dists = @{$_->[2]};
+    PACKAGE:
+    foreach my $dist (@dists) {
+	my $dir = "$dist/binary-$arch";
+	my $must_get = 0;
+	my $newest_pack_date;
+
+	# check existing Packages on remote site
+	print "\nChecking for Packages file... ";
+	$newest_pack_date = do_mdtm ($ftp, "$dir/Packages.gz");
+	if (defined $newest_pack_date) {
+	    print "$dir/Packages.gz\n";
+	} else {
+	    $dir = "$dist";
+	    $newest_pack_date = do_mdtm ($ftp, "$dir/Packages.gz");
+	    if (defined $newest_pack_date) {
+		print "$dir/Packages.gz\n";
+	    } else {
+		print "Couldn't find Packages.gz in $dist/binary-$arch or $dist; ignoring.\n";
+		print "Your setup is probably wrong, check the distributions directories,\n";
+		print "and try with passive mode enabled/disabled (if you use a proxy/firewall)\n";
+		next PACKAGE;
+	    }
+	}
+
+	# we now have $dir set to point to an existing Packages.gz file
+
+	# check if we already have a Packages file (and get its date)
+	$dist =~ tr/\//_/;
+	my $file = "Packages.$site->[0].$dist";
+
+	# if not
+	if (! -f $file) {
+	    # must get one
+#	    print "No Packages here; must get it.\n";
+	    $must_get = 1;
+	} else {
+	    # else check last modification date
+            my @pack_stat = stat($file);
+	    if($newest_pack_date > $pack_stat[9]) {
+#		print "Packages has changed; must get it.\n";
+		$must_get = 1;
+	    } elsif ($newest_pack_date < $pack_stat[9]) {
+		print " Our file is newer than theirs; skipping.\n";
+	    } else {
+		print " Already up-to-date; skipping.\n";
+	    }
+	}
+
+	if ($must_get) {
+	    -f 'Packages.gz' and unlink 'Packages.gz';
+	    -f 'Packages' and unlink 'Packages';
+	    my $size = 0;
+
+	  TRY_GET_PACKAGES:
+	    while (1) {
+		if ($size) {
+		    print ' Continuing ';
+		} else {
+		    print ' Getting ';
+		}
+		print "Packages file from $dir...\n";
+		eval {
+		    if ($ftp->get("$dir/Packages.gz", 'Packages.gz', $size)) {
+			if (system('gunzip', 'Packages.gz')) {
+			    print "  Couldn't gunzip Packages.gz, stopped";
+			    die 'error';
+			}
+		    } else {
+			print "  Couldn't get Packages.gz from $dir !!! Stopped.";
+			die 'error';
+		    }
+		};
+		if ($@) {
+		    $size = -s 'Packages.gz';
+		    if (ref($ftp)) {
+		      $ftp->abort();
+		      $ftp->quit();
+		    };
+		    if (yesno ('y', "Transfer failed at $size: retry at once")) {
+                         $ftp = do_connect(ftpsite => $site->[0],
+                                           ftpdir => $site->[1],
+                                           passive => $site->[3],
+                                           username => $site->[4],
+                                           password => $site->[5],
+                                           useproxy => $CONFIG{use_auth_proxy},
+                                           proxyhost => $CONFIG{proxyhost},
+                                           proxylogname => $CONFIG{proxylogname},
+                                           proxypassword => $CONFIG{proxypassword});
+
+			if ($newest_pack_date != do_mdtm ($ftp, "$dir/Packages.gz")) {
+			    print ("Packages file has changed !\n");
+			    $size = 0;
+			}
+			next TRY_GET_PACKAGES;
+		    } else {
+			die 'error';
+		    }
+		}
+		last TRY_GET_PACKAGES;
+	    }
+
+	    if (!rename 'Packages', "Packages.$site->[0].$dist") {
+		print "  Couldn't rename Packages to Packages.$site->[0].$dist";
+		die 'error';
+	    } else {
+		# set local Packages file to same date as the one it mirrors
+		# to allow comparison to work.
+		utime $newest_pack_date, $newest_pack_date, "Packages.$site->[0].$dist";
+		$packages_modified = 1;
+	    }
+	}
+	push @pkgfiles, "Packages.$site->[0].$dist";
+    }
+    $ftp->quit();
+ }
+}
+
+eval {
+    local $SIG{INT} = sub {
+	die "interrupted!\n";
+    };
+    download();
+};
+if($@) {
+    $ftp->quit() if (ref($ftp));
+    if($@ =~ /timeout/i) {
+	print "FTP TIMEOUT\n";
+    } else {
+	print "FTP ERROR - $@\n";
+    }
+    $exit = 1;
+};
+
+# Don't clear if nothing changed.
+if ($packages_modified) {
+    print <<'EOM';
+
+It is a good idea to clear the available list of old packages.
+However if you have only downloaded a Package files from non-main
+distributions you might not want to do this.
+
+EOM
+    if (yesno ('y', 'Do you want to clear available list')) {
+	print "Clearing...\n";
+	if (system('dpkg', '--clear-avail')) {
+	    print 'dpkg --clear-avail failed.';
+	    die 'error';
+	}
+    }
+}
+
+if (!$packages_modified) {
+    print "No Packages files was updated.\n";
+} else {
+    foreach my $file (@pkgfiles) {
+	if (system('dpkg', '--merge-avail', $file)) {
+	    print "Dpkg merge available failed on $file";
+	    $exit = 1;
+	}
+    }
+}
+exit $exit;