Integrate dpkg-ftp into dselect

It requires perl to work but don't add it as a dependency
but only as a suggests and instead have a nice error
message to invite the user to install the perl package.

Other minor changes include removal of latin1 characters,
moving the README.mirrors file inside the method directory
and renaming the Dpkg::Ftp module to Dselect::Ftp.

debian/changelog

@@ -27,6 +27,7 @@ dpkg (1.15.5) UNRELEASED; urgency=low
     updated to use the new Dpkg::Control interface.
   * Create Launchpad-Bugs-Fixed directly in the changelog parsing code thanks
     to a new vendor hook post-process-changelog-entry. Closes: #536066
+  * Integrate dpkg-ftp into dselect. Add the required Replaces and Conflicts.
 
   [ Updated dpkg translations ]
   * German (Sven Joachim).

debian/control

@@ -57,7 +57,9 @@ Package: dselect
 Priority: optional
 Architecture: any
 Depends: ${shlibs:Depends}, dpkg (>= 1.13.1)
-Replaces: dpkg (<< 1.10.3)
+Suggests: perl
+Conflicts: dpkg-ftp
+Replaces: dpkg (<< 1.10.3), dpkg-ftp
 Description: Debian package management front-end
  dselect is a high-level interface for managing the installation and
  removal of Debian software packages.

debian/dselect.install

@@ -6,4 +6,5 @@ usr/lib/dpkg/methods
 usr/share/locale/*/LC_MESSAGES/dselect.mo
 usr/share/man/{*/*,*}/dselect.cfg.5
 usr/share/man/{*/*,*}/dselect.1
+usr/share/perl5/Debian
 var/lib/dpkg/methods

dselect/methods/Debian/Dselect/Ftp.pm

@@ -0,0 +1,362 @@
+# -*-perl-*-
+
+use Net::FTP;
+use Exporter;
+use Data::Dumper;
+
+use strict;
+use vars qw(@EXPORT %config $VAR1);
+
+@EXPORT = qw(yesno do_connect do_mdtm add_site edit_site
+             edit_config read_config store_config view_mirrors nb);
+
+sub nb {
+  my $nb = shift;
+  if ($nb > 1024**2) {
+    return sprintf("%.2fM", $nb / 1024**2);
+  } elsif ($nb > 1024) {
+    return sprintf("%.2fk", $nb / 1024);
+  } else {
+    return sprintf("%.2fb", $nb);
+  }
+
+}
+
+sub read_config {
+  my $vars = shift;
+  my ($code, $conf);
+
+  local($/);
+  open(VARS, $vars) || die "Couldn't open $vars : $!\nTry to relaunch the 'Access' step in dselect, thanks.\n";
+  $code = <VARS>;
+  close VARS;
+
+  $conf = eval $code;
+  die "Couldn't eval $vars content : $@\n" if ($@);
+  if (ref($conf) =~ /HASH/) {
+    foreach (keys %{$conf}) {
+      $config{$_} = $conf->{$_};
+    }
+  } else {
+    print "Bad $vars file : removing it.\n";
+    print "Please relaunch the 'Access' step in dselect. Thanks.\n";
+    unlink $vars;
+    exit 0;
+  }
+}
+
+sub store_config {
+  my $vars = shift;
+
+  # Check that config is completed
+  return if not $config{'done'};
+
+  open(VARS, ">$vars") || die "Couldn't open $vars in write mode : $!\n";
+  print VARS Dumper(\%config);
+  close VARS;
+}
+
+sub view_mirrors {
+  if (-f '/usr/lib/dpkg/methods/ftp/README.mirrors.txt') {
+    system('/usr/bin/pager', '/usr/lib/dpkg/methods/ftp/README.mirrors.txt');
+  } elsif (-f '/usr/lib/dpkg/methods/ftp/README.mirrors.txt.gz') {
+    system('gzip -dc /usr/lib/dpkg/methods/ftp/README.mirrors.txt.gz | pager');
+  } else {
+    print "/usr/lib/dpkg/methods/ftp/README.mirrors.txt(.gz): file not found.\n";
+  }
+}
+
+sub edit_config {
+  my $methdir = shift;
+  my $i;
+
+  #Get a config for ftp sites
+  while(1) {
+    $i = 1;
+    print "\n\nList of selected ftp sites :\n";
+    foreach (@{$config{'site'}}) {
+      print "$i. ftp://$_->[0]$_->[1] @{$_->[2]}\n";
+      $i++;
+    }
+    print "\nEnter a command (a=add e=edit d=delete q=quit m=mirror list) \n";
+    print "eventually followed by a site number : ";
+    chomp($_ = <STDIN>);
+    /q/i && last;
+    /a/i && add_site();
+    /d\s*(\d+)/i &&
+    do { splice(@{$config{'site'}}, $1-1, 1) if ($1 <= @{$config{'site'}});
+         next;};
+    /e\s*(\d+)/i &&
+    do { edit_site($config{'site'}[$1-1]) if ($1 <= @{$config{'site'}});
+         next; };
+    m#m#i && view_mirrors();
+  }
+
+  print "\n";
+  $config{'use_auth_proxy'} = yesno($config{'use_auth_proxy'} ? "y" : "n",
+                                      "Go through an authenticated proxy");
+
+  if ($config{'use_auth_proxy'}) {
+    print "\nEnter proxy hostname [$config{'proxyhost'}] : ";
+    chomp($_ = <STDIN>);
+    $config{'proxyhost'} = $_ || $config{'proxyhost'};
+
+    print "\nEnter proxy log name [$config{'proxylogname'}] : ";
+    chomp($_ = <STDIN>);
+    $config{'proxylogname'} = $_ || $config{'proxylogname'};
+
+    print "\nEnter proxy password [$config{'proxypassword'}] : ";
+    chomp ($_ = <STDIN>);
+    $config{'proxypassword'} = $_ || $config{'proxypassword'};
+  }
+
+  print "\nEnter directory to download binary package files to\n";
+  print "(relative to $methdir)\n";
+  while(1) {
+    print "[$config{'dldir'}] : ";
+    chomp($_ = <STDIN>);
+    s{/$}{};
+    $config{'dldir'} = $_ if ($_);
+    last if -d "$methdir/$config{'dldir'}";
+    print "$methdir/$config{'dldir'} is not a directory !\n";
+  }
+}
+
+sub add_site {
+  my $pas = 1;
+  my $user = "anonymous";
+  my $email = `whoami`;
+  chomp $email;
+  $email .= '@' . `cat /etc/mailname || dnsdomainname`;
+  chomp $email;
+  my $dir = "/debian";
+
+  push (@{$config{'site'}}, [ "", $dir, [ "dists/stable/main",
+                                          "dists/stable/contrib",
+					  "dists/stable/non-free" ],
+                               $pas, $user, $email ]);
+  edit_site($config{'site'}[@{$config{'site'}} - 1]);
+}
+
+sub edit_site {
+  my $site = shift;
+
+  local($_);
+
+  print "\nEnter ftp site [$site->[0]] : ";
+  chomp($_ = <STDIN>);
+  $site->[0] = $_ || $site->[0];
+
+  print "\nUse passive mode [" . ($site->[3] ? "y" : "n") ."] : ";
+  chomp($_ = <STDIN>);
+  $site->[3] = (/y/i ? 1 : 0) if ($_);
+
+  print "\nEnter username [$site->[4]] : ";
+  chomp($_ = <STDIN>);
+  $site->[4] = $_ || $site->[4];
+
+  print <<EOF;
+
+If you're using anonymous ftp to retrieve files, enter your email
+address for use as a password. Otherwise enter your password,
+or "?" if you want dselect-ftp to prompt you each time.
+
+EOF
+
+  print "Enter password [$site->[5]] : ";
+  chomp($_ = <STDIN>);
+  $site->[5] = $_ || $site->[5];
+
+  print "\nEnter debian directory [$site->[1]] : ";
+  chomp($_ = <STDIN>);
+  $site->[1] = $_ || $site->[1];
+
+  print "\nEnter space separated list of distributions to get\n";
+  print "[@{$site->[2]}] : ";
+  chomp($_ = <STDIN>);
+  $site->[2] = [ split(/\s+/) ] if $_;
+}
+
+sub yesno($$) {
+  my ($d, $msg) = @_;
+
+  my ($res, $r);
+  $r = -1;
+  $r = 0 if $d eq "n";
+  $r = 1 if $d eq "y";
+  die "Incorrect usage of yesno, stopped" if $r == -1;
+  while (1) {
+    print $msg, " [$d]: ";
+    $res = <STDIN>;
+    $res =~ /^[Yy]/ and return 1;
+    $res =~ /^[Nn]/ and return 0;
+    $res =~ /^[ \t]*$/ and return $r;
+    print "Please enter one of the letters `y' or `n'\n";
+  }
+}
+
+##############################
+
+sub do_connect {
+    my($ftpsite,$username,$pass,$ftpdir,$passive,
+       $useproxy,$proxyhost,$proxylogname,$proxypassword) = @_;
+
+    my($rpass,$remotehost,$remoteuser,$ftp);
+
+  TRY_CONNECT:
+    while(1) {
+	my $exit = 0;
+
+	if ($useproxy) {
+	    $remotehost = $proxyhost;
+	    $remoteuser = $username . "@" . $ftpsite;
+	} else {
+	    $remotehost = $ftpsite;
+	    $remoteuser = $username;
+	}
+	print "Connecting to $ftpsite...\n";
+	$ftp = Net::FTP->new($remotehost, Passive => $passive);
+	if(!$ftp || !$ftp->ok) {
+	  print "Failed to connect\n";
+	  $exit=1;
+	}
+	if (!$exit) {
+#    $ftp->debug(1);
+	    if ($useproxy) {
+		print "Login on $proxyhost...\n";
+		$ftp->_USER($proxylogname);
+		$ftp->_PASS($proxypassword);
+	    }
+	    print "Login as $username...\n";
+	    if ($pass eq "?") {
+		    print "Enter password for ftp: ";
+		    system("stty", "-echo");
+		    $rpass = <STDIN>;
+		    chomp $rpass;
+		    print "\n";
+		    system("stty", "echo");
+	    } else {
+		    $rpass = $pass;
+	    }
+	    if(!$ftp->login($remoteuser, $rpass))
+	    { print $ftp->message() . "\n"; $exit=1; }
+	}
+	if (!$exit) {
+	    print "Setting transfer mode to binary...\n";
+	    if(!$ftp->binary()) { print $ftp->message . "\n"; $exit=1; }
+	}
+	if (!$exit) {
+	    print "Cd to `$ftpdir'...\n";
+	    if(!$ftp->cwd($ftpdir)) { print $ftp->message . "\n"; $exit=1; }
+	}
+
+	if ($exit) {
+	    if (yesno ("y", "Retry connection at once")) {
+		next TRY_CONNECT;
+	    } else {
+		die "error";
+	    }
+	}
+
+	last TRY_CONNECT;
+    }
+
+#    if(!$ftp->pasv()) { print $ftp->message . "\n"; die "error"; }
+
+    return $ftp;
+}
+
+##############################
+
+# assume server supports MDTM - will be adjusted if needed
+my $has_mdtm = 1;
+
+my %months = ('Jan', 0,
+	      'Feb', 1,
+	      'Mar', 2,
+	      'Apr', 3,
+	      'May', 4,
+	      'Jun', 5,
+	      'Jul', 6,
+	      'Aug', 7,
+	      'Sep', 8,
+	      'Oct', 9,
+	      'Nov', 10,
+	      'Dec', 11);
+
+sub do_mdtm {
+    my ($ftp, $file) = @_;
+    my ($time);
+
+    #if ($has_mdtm) {
+	$time = $ftp->mdtm($file);
+#	my $code=$ftp->code();	my $message=$ftp->message();
+#	print " [ $code: $message ] ";
+	if ($ftp->code() == 502		      # MDTM not implemented
+	    || $ftp->code() == 500	      # command not understood (SUN firewall)
+	    ) {
+	    $has_mdtm = 0;
+	} elsif (!$ftp->ok()) {
+	    return undef;
+	}
+    #}
+
+    if (! $has_mdtm) {
+	use Time::Local;
+
+	my @files = $ftp->dir($file);
+	if (($#files == -1) || ($ftp->code == 550)) { # No such file or directory
+	    return undef;
+	}
+
+#	my $code=$ftp->code();	my $message=$ftp->message();
+#	print " [ $code: $message ] ";
+
+#	print "[$#files]";
+
+	# get the date components from the output of "ls -l"
+	if ($files[0] =~
+	    /([^ ]+ *){5}[^ ]+ ([A-Z][a-z]{2}) ([ 0-9][0-9]) ([0-9 ][0-9][:0-9][0-9]{2})/) {
+
+            my($month_name, $day, $yearOrTime, $month, $hours, $minutes,
+	       $year);
+
+	    # what we can read
+	    $month_name = $2;
+	    $day = 0 + $3;
+	    $yearOrTime = $4;
+
+	    # translate the month name into number
+	    $month = $months{$month_name};
+
+	    # recognize time or year, and compute missing one
+	    if ($yearOrTime =~ /([0-9]{2}):([0-9]{2})/) {
+		$hours = 0 + $1; $minutes = 0 + $2;
+		my @this_date = gmtime(time());
+		my $this_month = $this_date[4];
+		my $this_year = $this_date[5];
+		if ($month > $this_month) {
+		    $year = $this_year - 1;
+		} else {
+		    $year = $this_year;
+		}
+	    } elsif ($yearOrTime =~ / [0-9]{4}/) {
+		$hours = 0; $minutes = 0;
+		$year = $yearOrTime - 1900;
+	    } else {
+		die "Cannot parse year-or-time";
+	    }
+
+	    # build a system time
+	    $time = timegm (0, $minutes, $hours, $day, $month, $year);
+	} else {
+	    die "Regexp match failed on LIST output";
+	}
+    }
+
+    return $time;
+}
+
+1;
+
+__END__

dselect/methods/Makefile.am

@@ -9,7 +9,10 @@ nobase_dist_methods_DATA = \
 	disk/desc.harddisk \
 	disk/desc.mounted \
 	floppy/names \
-	floppy/desc.floppy
+	floppy/desc.floppy \
+	ftp/names \
+	ftp/desc.ftp \
+	ftp/README.mirrors.txt
 
 nobase_dist_methods_SCRIPTS = \
 	disk/setup \
@@ -17,10 +20,16 @@ nobase_dist_methods_SCRIPTS = \
 	disk/install \
 	floppy/setup \
 	floppy/update \
-	floppy/install
+	floppy/install \
+	ftp/setup \
+	ftp/update \
+	ftp/install
 
+perllibdir = $(PERL_LIBDIR)
+nobase_dist_perllib_DATA = Debian/Dselect/Ftp.pm
 
 install-data-local:
 	$(mkdir_p) $(DESTDIR)$(admindir)/methods/mnt
 	$(mkdir_p) $(DESTDIR)$(admindir)/methods/disk
 	$(mkdir_p) $(DESTDIR)$(admindir)/methods/floppy
+	$(mkdir_p) $(DESTDIR)$(admindir)/methods/ftp

dselect/methods/ftp/README.mirrors.txt

@@ -0,0 +1,259 @@
+Debian GNU/Linux - worldwide mirror sites
+
+This file is broken up into two separate mirror listings:
+primary and Secondary mirror sites.  The definitions are as follows:
+
+A Primary mirror site has good bandwidth, is available 24 hours a day,
+and has an easy to remember names of the form ftp.<country>.debian.org.
+Additionally, most of them are updated automatically after updates to the
+Debian archive.
+
+A Secondary mirror site may have restrictions on what they
+mirror (due to space restrictions). Just because a site is Secondary doesn't
+necessarily mean it'll be any slower or less up to date than a Primary site.
+
+Use the site closest to you for the fastest downloads possible whether is be
+a primary or secondary site. The program <em>netselect</em> can be used to
+determine the fastest of a list of sites.
+
+If you know of any mirrors that are missing from this list,
+please have the site maintainer fill out
+http://www.debian.org/mirror/submit
+To contact the maintainer of this page, write to
+mirrors@debian.org
+
+Primary ISO Mirror Sites
+------------------------         	/debian?	/debian-non-US?
+Australia     -   ftp.au.debian.org	Yes		Yes
+Austria       -   ftp.at.debian.org	Yes		Yes
+Germany       -   ftp.de.debian.org	Yes		Yes
+Japan         -   ftp.jp.debian.org	Yes		No
+Korea         -   ftp.kr.debian.org	Yes		No
+United States -   ftp.debian.org   	Yes		No
+
+Secondary FTP and HTTP mirrors of the Debian archive
+----------------------------------------------------
+HOSTNAME                      FTP                                               HTTP
+--------                      ---                                               ----
+
+Australia
+---------
+ftp.au.debian.org             /pub/debian/                                      /debian/
+ftp.wa.au.debian.org          /pub/linux/debian/                                /debian/
+ftp.monash.edu.au             /pub/linux/distributions/debian                   /pub/linux/distributions/debian
+linux.org.au                  /pub/debian/                                      /mirrors/debian/
+ftp.uwa.edu.au                /mirrors/linux/debian/
+ftp.tower.net.au              /debian/
+
+Austria
+-------
+ftp.at.debian.org             /debian/                                          /debian/
+
+Belgium
+-------
+ftp.linkline.be               /debian/
+ftp.kulnet.kuleuven.ac.be     /pub/mirror/ftp.debian.org/debian/
+
+Brazil
+------
+linux.if.usp.br               /debian/                                          /ftpmaster/debian/
+ftp.br.debian.org             /debian/
+ftp.unioeste-foz.br           /pub/debian/
+
+Bulgaria
+--------
+ftp.bg.debian.org             /debian/
+
+Canada
+------
+ftp.ca.debian.org             /debian/                                          /debian/
+ftp.crc.ca                    /pub/systems/linux/debian/
+conan.eecg.toronto.edu        /debian/                                          /debian/
+mirror.direct.ca              /linux/debian/                                    /linux/debian/
+
+China
+-----
+freesoft.cei.gov.cn           /pub/mirrors/ftp.debian.org/                      /pub/mirrors/ftp.debian.org/
+
+Costa Rica
+----------
+debian.efis.ucr.ac.cr         /debian/                                          /debian/
+
+Czech Republic
+--------------
+ftp.debian.cz                 /debian/                                          /debian/
+
+Denmark
+-------
+ftp.sunsite.auc.dk            /pub/os/linux/debian/                             /ftp/pub/os/linux/debian/
+ftp.uni-c.dk                  /mirror/ftp.debian.org/pub/debian/                /mirror/ftp.debian.org/pub/debian/
+ftp.dk.debian.org             /debian/                                          /debian/
+ftp.dkuug.dk                  /pub/debian/
+
+Finland
+-------
+sunsite.tut.fi                /debian/                                          /debian/
+
+France
+------
+ftp.iut-bm.univ-fcomte.fr     /pub/linux/distributions/debian/                  /pub/linux/distributions/debian/
+ftp.eudil.fr                  /debian/
+ftp.proxad.net                /mirrors/ftp.debian.org/
+ftp.minet.net                 /pub/distrib/debian
+
+Germany
+-------
+ftp.tu-clausthal.de           /pub/linux/debian
+ftp.de.debian.org             /debian/                                          /debian/
+source.rfc822.org             /debian/
+
+Germany (de)
+------------
+debian.uni-essen.de           /debian/                                          /debian/
+
+Hong Kong
+---------
+sunsite.ust.hk                /pub/debian/                                      /pub/debian/
+
+Hungary
+-------
+sunsite.math.klte.hu          /pub/debian/
+ftp.index.hu                  /pub/debian
+mlf.linux.rulez.org           /debian/                                          /debian/
+
+Indonesia
+---------
+debian-mirror.piksi.itb.ac.id /debian/
+
+Ireland
+-------
+ftp.esat.net                  /mirrors/ftp.debian.org/debian/                   /mirrors/ftp.debian.org/debian/
+
+Israel
+------
+ftp.tls.co.il                 /debian/                                          /debian/
+
+Italy
+-----
+ftp3.linux.it                 /debian/                                          /debian/
+palmaria.garda-access.com     /pub/linux/debian
+ftp.students.cs.unibo.it      /Mirrors/ftp.debian.org
+freedom.dicea.unifi.it        /ftp/pub/linux/debian/                            /ftp/pub/linux/debian/
+
+JP
+--
+ftp.dti.ad.jp                 /pub/Linux/debian/
+
+Japan
+-----
+mirror.nucba.ac.jp            /mirror/debian/                                   /mirror/debian/
+ftp.jp.debian.org             /debian/
+ring.asahi-net.or.jp          /pub/linux/debian/debian/                         /archives/linux/debian/debian/
+SunSITE.sut.ac.jp             /pub/archives/linux/debian                        /pub/archives/linux/debian
+
+Mexico
+------
+ftp.iteso.mx                  ftp://ftp.iteso.mx/pub/Linux/distributions/debian/http://ftp.iteso.mx/Linux/distributions/debian/
+
+NZ
+--
+ftp.clear.net.nz              /debian/
+
+Netherlands
+-----------
+ftp.cistron.nl                /pub/debian/
+ftp.nluug.nl                  /pub/os/Linux/distr/Debian
+ftp.demon.nl                  /pub/mirrors/linux/debian/
+
+New Zealand
+-----------
+
+Norway
+------
+ftp.nvg.ntnu.no               /mirror/debian/
+
+Poland
+------
+ftp.pl.debian.org             /pub/debian/                                      /debian/
+ftp.fnet.pl                   /pub/debian
+ftp.nvg.ntnu.no               /mirror/debian/
+
+Portugal
+--------
+ftp.uevora.pt                 /debian/                                          /debian/
+
+Russia
+------
+ftp.chg.ru                    /pub/Linux/debian/
+
+Slovak Republic
+---------------
+ftp.tuke.sk                   /pub/debian                                       /debian
+
+Slovenia
+--------
+ftp.arnes.si                  /software/unix/linux/debian/
+ftp.camtp.uni-mb.si           /debian/                                          /debian/
+
+South Africa
+------------
+ftp.is.co.za                  /linux/distributions/debian/
+ftp.linux.co.za               /pub/distributions/debian/
+
+Spain
+-----
+ftp.es.debian.org             /debian/
+ceu.fi.udc.es                 /debian/                                          /debian/
+
+Sweden
+------
+nowhere.campus.luth.se        /debian/                                          /debian/
+ftp.lh.umu.se                 /debian/                                          /debian/
+ftp.sunet.se                  /pub/os/Linux/distributions/debian/               /pub/os/Linux/distributions/debian/
+ftp.du.se                     /debian/
+
+Switzerland
+-----------
+sunsite.cnlab-switch.ch       /mirror/debian/                                   /ftp/mirror/debian/
+ftp.urbanet.ch                /mirror/debian/
+
+Thailand
+--------
+debian.linuxchat.org          /debian/                                          /debian/
+
+UK
+--
+ftp.uk.debian.org             /debian/                                          /debian/
+ftp.demon.co.uk               /pub/mirrors/linux/debian
+sunsite.org.uk                /Mirrors/ftp.debian.org/pub/debian/               /Mirrors/ftp.debian.org/pub/debian/
+ftp.mcc.ac.uk                 /pub/linux/distributions/Debian
+www.hensa.ac.uk               /mirrors/ftp.debian.org/debian/                   /mirrors/ftp.debian.org/debian/
+
+US
+--
+http.us.debian.org            /debian/                                          /debian/
+ftp.debian.org                /debian/                                          /debian/
+ftp.netgod.net                                                                  /debian/
+debian.midco.net              /debian/                                          /debian/
+ftp.eecs.umich.edu            /debian/                                          /debian/
+debian.terrabox.com           /debian/                                          /debian/
+llug.sep.bnl.gov              /debian/                                          /debian/
+debian.crosslink.net          /pub/debian/                                      /debian/
+debian.crosslink.net          /pub/debian/                                      /debian/
+ftp-mirror.internap.com       /pub/debian/                                      /pub/debian/
+ftp.us.debian.org             /debian/
+ftp.fuller.edu                /debian/                                          /debian/
+santanni.cc.gatech.edu        /pub/linux/distributions/debian/
+ftp.cdrom.com                 /pub/linux/debian
+debian.egr.msu.edu            /debian/
+ftp.tux.org                   /pub/distributions/debian/                        /pub/distributions/debian/
+debian.ssc.com                /pub/debian/
+sunsite.unc.edu               /pub/Linux/distributions/debian/                  /pub/Linux/distributions/debian/
+debian.law.miami.edu          /debian/                                          /debian/
+ftp.opensource.captech.com    /debian/                                          /debian/
+ftp-mirror.internap.com       /pub/debian/                                      /pub/debian/
+csociety-ftp.ecn.purdue.edu   /pub/debian/
+ftp.linuxberg.com             /pub/distributions/Debian/
+ftp.cs.unm.edu                /mirrors/debian                                   /mirrors/debian
+debian.gimp.dyndns.org        /debian/                                          /debian/
+ftp.cs.wisc.edu               /pub/mirrors/linux/debian

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.

dselect/methods/ftp/install

@@ -0,0 +1,626 @@
+#!/usr/bin/perl -w
+# -*-perl-*-
+
+# Copyright (C) 1996 Andy Guy <awpguy@acs.ucalgary.ca>
+#               1998 Martin Schulze <joey@infodrom.north.de>
+#               1999 Raphaël Hertzog <rhertzog@hrnet.fr>
+#
+# This program has been distributed under the terms of the GNU GPL.
+
+use strict;
+use vars qw(%config $ftp);
+#use diagnostics;
+
+use lib '/usr/lib/perl5/Debian';
+use lib '/usr/share/perl5/Debian';
+
+eval q{
+    use Net::FTP;
+    use File::Path;
+    use File::Basename;
+    use File::Find;
+    use Data::Dumper;
+};
+if ($@) {
+    print STDERR "Please install the 'perl' package if you want to use the\n" .
+                 "FTP access method of dselect.\n\n";
+    exit 1;
+}
+
+use Dselect::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";
+mkpath(["$methdir/$config{'dldir'}"], 0, 0755);
+
+
+#Read md5sums already calculated
+my %md5sums;
+if (-f "$methdir/md5sums") {
+  local $/;
+  open(MD5SUMS, "$methdir/md5sums") ||
+    die "Couldn't read file $methdir/md5sums";
+  my $code = <MD5SUMS>;
+  close MD5SUMS;
+  use vars qw($VAL1);
+  my $res = eval $code;
+  if ($@) {
+    die "Couldn't eval $methdir/md5sums content: $@\n";
+  }
+  if (ref($res)) { %md5sums = %{$res} }
+}
+
+# get a block
+# 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 getblk {
+    my $fh = shift;
+    my %flds;
+    my $fld;
+    while (<$fh>) {
+	if ( ! /^$/ ) {
+	    FLDLOOP: while (1) {
+		if ( /^(\S+):\s*(.*)\s*$/ ) {
+		    $fld = lc($1);
+		    $flds{$fld} = $2;
+		    while (<$fh>) {
+			if ( /^$/ ) {
+			    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 (STATUS, "$vardir/status") or die "Could not open status file";
+    while (%flds = getblk(\*STATUS), %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);
+}
+procstatus();
+
+sub dcmpvers {
+    my($a, $p, $b) = @_;
+    my ($r);
+    $r = system("/usr/bin/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,$fl,$nfs,$fld);
+    my(%flds);
+    open(PKGFILE, "$fn") or die "Could not open package file $fn";
+    while(%flds = getblk(\*PKGFILE), %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 $fl (@files) {
+		$pkgfiles{$fl} = [ $md5sums[$i], $sizes[$i], $site, $dist ];
+		$i++;
+	    }
+	}
+    }
+}
+
+print "\nProcessing Package files...\n";
+my ($dist,$site,$fn,$i,$j);
+$i = 0;
+foreach $site (@{$config{'site'}}) {
+  $j = 0;
+  foreach $dist (@{$site->[2]}) {
+    $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 = `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 paritial file
+print "\nConstructing list of files to get...\n";
+my %downloads;
+my ($pkg, $dir, @info, @files, $csize, $size);
+my $totsize = 0;
+foreach $pkg (keys(%pkgs)) {
+    @files = @{$pkgs{$pkg}[1]};
+    foreach $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") {
+	    mkpath(["$dldir/$dir"], 0, 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 = `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 = `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 $fn;
+	my $def = "y";
+	foreach $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;
+ my ($site, $ftp);
+
+ foreach $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 ($site->[0], #$::ftpsite,
+                       $site->[4], #$::username,
+		       $site->[5], #$::password,
+		       $site->[1], #$::ftpdir,
+		       $site->[3], #$::passive,
+		       $config{'use_auth_proxy'},
+		       $config{'proxyhost'},
+		       $config{'proxylogname'},
+		       $config{'proxypassword'});
+
+    $::ftp = $ftp;
+    local $SIG{'INT'} = sub { die "Interrupted !\n"; };
+
+    my ($fn,$rsize,$res,$pre);
+    foreach $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 $protected = $package;
+	      $protected =~ s/\+/\\\+/g;
+	      my $list = $ftp->ls("$pre$dir");
+	      if ($ftp->ok() && ref($list)) {
+                foreach (@{$list}) {
+                  if (m/($dir\/${protected}_[^\/]+.deb)/i) {
+		    print "Package found : $_\n";
+		    print "getting: $_ (size not known)\n";
+                    $res = $ftp->get($_, "$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 $ffn;
+		MY_ITER: foreach $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 occured ($@) : 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 2>&1 >/dev/null && dpkg-deb --contents $fn 2>&1 >/dev/null")) {
+	return 1;
+    } elsif(!system("dpkg-split --info $fn 2>&1 >/dev/null")) {
+	return 2;
+    }
+    return 0;
+}
+sub getdebinfo($) {
+    my ($fn) = @_;
+    my $type = chkdeb($fn);
+    my ($pkg, $ver);
+    if($type == 1) {
+	open(PKGFILE, "dpkg-deb --field $fn |");
+	my %fields = getblk(\*PKGFILE);
+	close(PKGFILE);
+	$pkg = $fields{'package'};
+	$ver = $fields{'version'};
+	if($fields{'package_revision'}) { $ver .= '-' . $fields{'package_revision'}; }
+	return $pkg, $ver;
+    } elsif ( $type == 2) {
+	open(PKGFILE, "dpkg-split --info $fn|");
+	while(<PKGFILE>) {
+	    /Part of package:\s*(\S+)/ and $pkg = $+;
+	    /\.\.\. version:\s*(\S+)/ and $ver = $+;
+	}
+	close(PKGFILE);
+	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
+	    my ($c);
+	    foreach $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 = `dpkg --predep-package`, $? == 0) {
+      foreach (@flds) {
+        s/\s*\n//;
+	$package= $_ if s/^Package: //i;
+	@filename= split(/ +/,$_) if 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?")) {
+    rmtree("$dldir");
+}
+
+#Store useful md5sums
+foreach (keys %md5sums) {
+  next if (-f $_);
+  delete $md5sums{$_};
+}
+open(MD5SUMS, ">$methdir/md5sums") ||
+  die "Can't open $methdir/md5sums in write mode : $!\n";
+print MD5SUMS Dumper(\%md5sums);
+close MD5SUMS;
+
+exit $exit;

dselect/methods/ftp/names

@@ -0,0 +1,2 @@
+60 ftp Install using ftp.
+

dselect/methods/ftp/setup

@@ -0,0 +1,174 @@
+#!/usr/bin/perl -w
+# -*-perl-*-
+
+# Copyright (C) 1996 Andy Guy <awpguy@acs.ucalgary.ca>
+#               1998 Martin Schulze <joey@infodrom.north.de>
+#               1999 Raphaël Hertzog <rhertzog@hrnet.fr>
+#
+# This program has been distributed under the terms of the GNU GPL.
+
+use strict;
+use vars qw(%config);
+#use diagnostics;
+
+use lib '/usr/lib/perl5/Debian';
+use lib '/usr/share/perl5/Debian';
+
+eval 'use Net::FTP;';
+if ($@) {
+    print STDERR "Please install the 'perl' package if you want to use the\n" .
+                 "FTP access method of dselect.\n\n";
+    exit 1;
+}
+use Dselect::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=`dpkg --print-installation-architecture`;
+$arch='i386' if $?;
+chomp $arch;
+
+my $logname = `whoami`;
+chomp $logname;
+my $host = `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
+
+If you want to install package from non-US consider adding a second ftp site
+with "debian-non-US" as debian directory and "dists/stable/non-US" as
+distribution.
+
+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();
+}
+edit_config($methdir);
+
+my $ftp;
+sub download() {
+ foreach (@{$config{'site'}}) {
+
+    $ftp = do_connect ($_->[0], # Ftp server
+                       $_->[4], # username
+		       $_->[5], # password
+		       $_->[1], # ftp dir
+		       $_->[3], # passive
+		       $config{'use_auth_proxy'},
+		       $config{'proxyhost'},
+		       $config{'proxylogname'},
+		       $config{'proxypassword'});
+
+    my @dists = @{$_->[2]};
+
+    my $dist;
+    foreach $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;
+	my $line = "";
+	foreach $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 return to continue\n";
+    <STDIN>;
+}
+
+exit $exit;

dselect/methods/ftp/update

@@ -0,0 +1,251 @@
+#!/usr/bin/perl -w
+# -*-perl-*-
+
+# Copyright (C) 1996 Andy Guy <awpguy@acs.ucalgary.ca>
+#               1998 Martin Schulze <joey@infodrom.north.de>
+#               1999 Raphaël Hertzog <rhertzog@hrnet.fr>
+#
+# This program has been distributed under the terms of the GNU GPL.
+
+use strict;
+#use diagnostics;
+
+use lib '/usr/lib/perl5/Debian';
+use lib '/usr/share/perl5/Debian';
+
+eval 'use Net::FTP;';
+if ($@) {
+    print STDERR "Please install the 'perl' package if you want to use the\n" .
+                 "FTP access method of dselect.\n\n";
+    exit 1;
+}
+
+use Dselect::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 == "") {
+	    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=`dpkg --print-installation-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 ($_->[0], # Ftp server
+                           $_->[4], # username
+                           $_->[5], # password
+                           $_->[1], # ftp dir
+                           $_->[3], # passive
+                           $config{'use_auth_proxy'},
+                           $config{'proxyhost'},
+                           $config{'proxylogname'},
+                           $config{'proxypassword'});
+
+    my @dists = @{$_->[2]};
+    my $dist;
+    PACKAGE:
+    foreach $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 ($site->[0], # Ftp server
+                           $site->[4], # username
+                           $site->[5], # password
+                           $site->[1], # ftp dir
+                           $site->[3], # passive
+                           $config{'use_auth_proxy'},
+                           $config{'proxyhost'},
+                           $config{'proxylogname'},
+                           $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;
+};
+
+my $ans;
+
+if ($packages_modified) {	# don't clear if nothing changed
+    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 {
+    my $file;
+
+    foreach $file (@pkgfiles) {
+	if(system ("dpkg", "--merge-avail", $file)) {
+	    print "Dpkg merge available failed on $file";
+	    $exit = 1;
+	}
+    }
+
+    if(system("dpkg", "--forget-old-unavail")) {
+	print "dpkg --forget-old-unavail failed";
+	die "error";
+    }
+}
+exit $exit;