| #!/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; |