dpkg-1.16.1.1/dselect/methods/ftp/install - nest-learning-thermostat/5.1/dpkg - Git at Google

 #!/usr/bin/perl
 # -*-perl-*-
 #
 # Copyright © 1996 Andy Guy <awpguy@acs.ucalgary.ca>
 # Copyright © 1998 Martin Schulze <joey@infodrom.north.de>
 # Copyright © 1999, 2009 Raphaël Hertzog <hertzog@debian.org>
 #
 # This program has been distributed under the terms of the GNU GPL.

 use strict;
 use warnings;

 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 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 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;
	#!/usr/bin/perl
	# --perl--
	#
	# Copyright © 1996 Andy Guy <awpguy@acs.ucalgary.ca>
	# Copyright © 1998 Martin Schulze <joey@infodrom.north.de>
	# Copyright © 1999, 2009 Raphaël Hertzog <hertzog@debian.org>
	#
	# This program has been distributed under the terms of the GNU GPL.

	use strict;
	use warnings;

	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 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 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;