Your IP : 216.73.216.170
#!/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 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;