home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 February / PCWorld_2000-02_cd.bin / live / usr / lib / dpkg / methods / ftp / install < prev    next >
Text File  |  1998-12-28  |  12KB  |  481 lines
  1. #!/usr/bin/perl 
  2. # -*-perl-*-
  3.  
  4. #use strict;
  5. #use diagnostics;
  6.  
  7. use Net::FTP;
  8. use File::Path;
  9. use File::Basename;
  10. use File::Find;
  11.  
  12. use Debian::DpkgFtp;
  13.  
  14. # exit value
  15. my $exit = 0;
  16.  
  17. # deal with arguments
  18. my $vardir = $ARGV[0];
  19. my $method = $ARGV[1];
  20. my $option = $ARGV[2];
  21.  
  22. if ($option eq "manual" ) {
  23.   print "manual mode not supported yet\n";
  24.   exit 1;
  25. }
  26. #print "vardir: $vardir, method: $method, option: $option\n";
  27.  
  28. # get info from control file
  29. $::dldir="debian";
  30. do "$vardir/methods/ftp/vars" or die "Could not find state file (re-run Access method)";
  31. mkpath(["$vardir/methods/ftp/debian"], 0, 0755);
  32. my @dists = split(/ +/, $::distribs);
  33. chdir "$vardir/methods/ftp";
  34.  
  35. # get a block
  36. # returns a ref to a hash containing flds->fld contents
  37. # white space from the ends of lines is removed and newlines added
  38. # (no trailing newline).
  39. # die's if something unexpected happens
  40. sub getblk {
  41.     my $fh = shift;
  42.     my %flds;
  43.     my $fld;
  44.     while (<$fh>) {
  45.     if ( ! /^$/ ) {
  46.         FLDLOOP: while (1) {
  47.         if ( /^([^ \t]+):[ \t]*(.*)[ \t]*$/ ) {
  48.             $fld = lc($1);
  49.             $flds{$fld} = $2;
  50.             while (<$fh>) {
  51.             if ( /^$/ ) {
  52.                 return %flds;
  53.             } elsif ( /^([ \t].*)$/ ) {
  54.                 $flds{$fld} = $flds{$fld} . "\n" . $1;
  55.             } else {
  56.                 next FLDLOOP;
  57.             }
  58.             }
  59.             return %flds;
  60.         } else {
  61.             die "Expected a start of field line, but got:\n$_";
  62.         }
  63.         }
  64.     }
  65.     }
  66.     return %flds;
  67. }
  68.  
  69. # process status file
  70. # create curpkgs hash with version (no version implies not currently installed)
  71. # of packages we want
  72. print "Processing status file...\n";
  73. my %curpkgs;
  74. sub procstatus {
  75.     my (%flds, $fld);
  76.     open (STATUS, "$vardir/status") or die "Could not open status file";
  77.     while (%flds = getblk(\*STATUS), %flds) {
  78.     if($flds{'status'} =~ /^install ok/) {
  79.         my $cs = (split(/ /, $flds{'status'}))[2];
  80.         if(($cs eq "not-installed") || 
  81.            ($cs eq "half-installed") ||
  82.            ($cs eq "config-files")) {
  83.         $curpkgs{$flds{'package'}} = "";
  84.         } else {
  85.         $curpkgs{$flds{'package'}} = $flds{'version'};
  86.         }
  87.     }
  88.     }
  89.     close(STATUS);
  90. }
  91. procstatus();
  92.  
  93. sub dcmpvers {
  94.     my($a, $p, $b) = @_;
  95.     my ($r);
  96.     $r = system("/usr/bin/dpkg", "--compare-versions", "$a", "$p", "$b");
  97.     $r = $r/256;
  98.     if( $r == 0) {
  99.     return 1;
  100.     } if( $r == 1) {
  101.     return 0;
  102.     }
  103.     die "dpkg --compare-versions $a $p $b - failed with $r"
  104. }
  105.  
  106. # process package files, looking for packages to install
  107. # create a hash of these packages pkgname => version, filenames...
  108. # filename => md5sum, size
  109. # for all packages
  110. my %pkgs;
  111. my %pkgfiles;
  112.  
  113. sub procpkgfile {
  114.     my $fn = shift @_;
  115.     my(%flds, $fld);
  116.     open(PKGFILE, "$fn") or die "Could not open package file $fn";
  117.     while(%flds = getblk(\*PKGFILE), %flds) {
  118.     my $pkg = $flds{'package'};
  119.     my $ver = $curpkgs{$pkg};
  120.     my @files = split(/[ \t\n]+/, $flds{'filename'});
  121.     my @sizes = split(/[ \t\n]+/, $flds{'size'});
  122.     my @md5sums = split(/[ \t\n]+/, $flds{'md5sum'});
  123.     my ($fl,$nfs);
  124.     if ( defined($ver) && ( ($ver eq "") || dcmpvers( $ver, "lt", $flds{'version'} ) )) {
  125.         $pkgs{$pkg} = [ $flds{'version'}, @files ];
  126.         $curpkgs{$pkg} = $flds{'version'};
  127.     }
  128.     $nfs = scalar(@files);
  129.     if(($nfs != scalar(@sizes)) || ($nfs != scalar(@md5sums)) ) {
  130.         print "Different number of filenames, sizes and md5sums for $flds{'package'}\n";
  131.     } else {
  132.         my $i = 0;
  133.         foreach $fl (@files) {
  134.         $pkgfiles{$fl} = [ $md5sums[$i], $sizes[$i] ];
  135.         $i++;
  136.         }
  137.     }
  138.     }
  139. }
  140.  
  141. print "\nProcessing Package files...\n";
  142. my $dist;
  143. foreach $dist (@dists) {
  144.     $dist =~ tr/\//_/;
  145.     my $fn = "Packages.$dist";
  146.     if (-f $fn) {
  147.     print " $dist...\n";
  148.     procpkgfile($fn);
  149.     } else {
  150.     print "Could not find packages file for $dist distribution (re-run Update)\n";
  151.     }
  152. }
  153.  
  154. # md5sum
  155. sub md5sum($) {
  156.     my $fn = shift;
  157.     my $m = `md5sum $fn`;
  158.     $m = (split(" ", $m))[0];
  159.     return $m;
  160. }
  161.  
  162. # rename partial files back
  163. sub renamepartial {
  164.     if ( /^(.+).partial$/ ) {
  165.     rename $_, $1;
  166.     }
  167. }
  168. if (-d $::dldir) {
  169.     find(\&renamepartial, $::dldir);
  170. }
  171.  
  172. # construct list of files to get
  173. # hash of filenames => size of downloaded part
  174. # query user for each paritial file
  175. print "\nConstructing list of files to get...\n";
  176. my %downloads;
  177. my ($pkg, $fn);
  178. my $totsize = 0;
  179. foreach $pkg (keys(%pkgs)) {
  180.     my @files = pop(@{$pkgs{$pkg}});
  181.     foreach $fn (@files) {
  182.     my $dir = dirname($fn);
  183.     if(!-d "$dir") {
  184.         mkpath(["$::dldir/$dir"], 0, 0755);
  185.     }
  186.     my @info = @{$pkgfiles{$fn}};
  187.     my $csize = int($info[1]/1024)+1;
  188.     if(-f "$::dldir/$fn") {
  189.         my $size = -s "$::dldir/$fn";
  190.         if($info[1] > $size) {
  191.         # partial download
  192.         if(yesno("y", "continue file: $fn ($size/$info[1])")) {
  193.             $downloads{$fn} = $size;
  194.             $totsize += $csize - int($size/1024);
  195.         } else {
  196.             $downloads{$fn} = 0;
  197.             $totsize += $csize;
  198.         }
  199.         } else {
  200.         # check md5sum
  201.         if(md5sum("$::dldir/$fn") eq $info[0]) {
  202.             print "already got: $fn\n";
  203.         } else {
  204.             print "corrupted: $fn\n";
  205.             $downloads{$fn} = 0;
  206.         }
  207.         }
  208.     } else {
  209.         print "want: $fn (${csize}k)\n";
  210.         $downloads{$fn} = 0;
  211.         $totsize += $csize;
  212.     }
  213.     }
  214. }
  215.  
  216. my $avsp = `df -Pk $::dldir| awk '{ print \$4}' | tail -n 1`;
  217. chomp $avsp;
  218.  
  219. print "\nApproximate total space required: ${totsize}k\n";
  220. print "Available space in $::dldir: ${avsp}k\n";
  221.  
  222. #$avsp = `df -k $::dldir| paste -s | awk '{ print \$11}'`;
  223. #chomp $avsp;
  224.  
  225. if($totsize == 0) {
  226.     print "Nothing to get.";
  227. } else {
  228.     if($totsize > $avsp) {
  229.     print "Space required is greater than available space,\n";
  230.     print "you will need to select which items to get.\n";
  231.     }
  232. # ask user which files to get
  233.     if(($totsize > $avsp) || yesno("n", "Do you want to select the files to get")) {
  234.     $totsize = 0;
  235.     my @files = sort(keys(%downloads));
  236.     my $fn;
  237.     my $def = "y";
  238.     foreach $fn (@files) {
  239.         my @info = @{$pkgfiles{$fn}};
  240.         my $csize = int($info[1] / 1024) + 1;
  241.         my $rsize = int(($info[1] - $downloads{$fn}) / 1024) + 1;
  242.         if ($rsize + $totsize > $avsp) {
  243.         print "no room for: $fn\n";
  244.         delete $downloads{$fn};
  245.         } else {
  246.         if(yesno($def, $downloads{$fn}
  247.              ? "download: $fn ${rsize}k/${csize}k (total = ${totsize}k)"
  248.              : "download: $fn ${rsize}k (total = ${totsize}k)")) {
  249.             $def = "y";
  250.             $totsize += $rsize;
  251.         } else {
  252.             $def = "n";
  253.             delete $downloads{$fn};
  254.         }
  255.         }
  256.     }
  257.     }
  258. }
  259.  
  260. sub download() {
  261.     $ftp = do_connect ($::ftpsite,$::username,$::password,$::ftpdir,$::passive,
  262.                $::useproxy,$::proxyhost,$::proxylogname,$::proxypassword);
  263.  
  264.     my $fn;
  265.     foreach $fn (keys(%downloads)) {
  266.     if ($downloads{$fn}) {
  267.         my $rsize = ${pkgfiles{$fn}}[1] - $downloads{$fn};
  268.         print "getting: $fn ($rsize/${$pkgfiles{$fn}}[1])\n";
  269.     } else {
  270.         print "getting: $fn (${$pkgfiles{$fn}}[1])\n";
  271.     }
  272.     if(!$ftp->get($fn, "$::dldir/$fn", $downloads{$fn})) {
  273.         my $r = $ftp->code();
  274.         print $ftp->message . "\n";
  275.         if (!($r == 550 || $r == 450)) {
  276.         return 1;
  277.         }
  278.     }
  279.     # fully got, remove it from list in case we have to re-download
  280.     delete $downloads{$fn};
  281.     }
  282.     $ftp->quit();
  283.     return 0;
  284. }
  285.  
  286. # download stuff (protect from ^C)
  287. if($totsize != 0) {
  288.     if(yesno("y", "\nDo you want to download the required files")) {
  289.       DOWNLOAD_TRY: while (1) {
  290.       print "Downloading files... use ^C to stop\n";
  291.       eval {
  292.           local $SIG{INT} = sub {
  293.           die "Interrupted!\n";
  294.           };
  295.           if ((download() == 1) && yesno("y", "\nDo you want to retry downloading at once")) {
  296.           next DOWNLOAD_TRY;
  297.           }
  298.       };
  299.       if($@) {
  300.           print "FTP ERROR\n";
  301.            if (yesno("y", "\nDo you want to retry downloading at once")) {
  302.           # get the first $fn that foreach would give:
  303.           # this is the one that got interrupted.
  304.         MY_ITER: foreach $ffn (keys(%downloads)) {
  305.             $fn = $ffn;
  306.             last MY_ITER;
  307.         }
  308.           my $size = -s "$::dldir/$fn";
  309.           # partial download
  310.           if(yesno("y", "continue file: $fn (at $size)")) {
  311.               $downloads{$fn} = $size;
  312.           } else {
  313.               $downloads{$fn} = 0;
  314.           }
  315.           next DOWNLOAD_TRY;
  316.           } else {
  317.           $exit = 1;
  318.           last DOWNLOAD_TRY;
  319.           }
  320.       } else {
  321.           last DOWNLOAD_TRY;
  322.       }
  323.       }
  324.     }
  325. }
  326.  
  327. # remove duplicate packages (keep latest versions)
  328. # move half downloaded files out of the way
  329. # delete corrupted files
  330. print "\nProcessing downloaded files...(for corrupt/old/partial)\n";
  331. my %vers; # package => version
  332. my %files; # package-version => files...
  333.  
  334. # check a deb or split deb file
  335. # return 1 if it a deb file, 2 if it is a split deb file
  336. # else 0
  337. sub chkdeb($) {
  338.     my ($fn) = @_;
  339.     # check to see if it is a .deb file
  340.     if(!system("dpkg-deb --info $fn 2>&1 >/dev/null && dpkg-deb --contents $fn 2>&1 >/dev/null")) {
  341.     return 1;
  342.     } elsif(!system("dpkg-split --info $fn 2>&1 >/dev/null")) {
  343.     return 2;
  344.     } 
  345.     return 0;
  346. }
  347. sub getdebinfo($) {
  348.     my ($fn) = @_;
  349.     my $type = chkdeb($fn);
  350.     my ($pkg, $ver);
  351.     if($type == 1) {
  352.     open(PKGFILE, "dpkg-deb --field $fn |");
  353.     my %fields = getblk(\*PKGFILE);
  354.     close(PKGFILE);
  355.     $pkg = $fields{'package'};
  356.     $ver = $fields{'version'};
  357.     if($fields{'package_revision'}) { $ver .= '-' . $fields{'package_revision'}; }
  358.     return $pkg, $ver;
  359.     } elsif ( $type == 2) {
  360.     open(PKGFILE, "dpkg-split --info $fn|");
  361.     while(<PKGFILE>) {
  362.         /Part of package:[ \t]*([^ \t]+)/ and $pkg = $+;
  363.         /\.\.\. version:[ \t]*([^ \t]+)/ and $ver = $+;
  364.     }
  365.     close(PKGFILE);
  366.     return $pkg, $ver;
  367.     }
  368.     print "could not figure out type of $fn\n";
  369.     return $pkg, $ver;
  370. }
  371.  
  372. # process deb file to make sure we only keep latest versions
  373. sub prcdeb($$) {
  374.     my ($dir, $fn) = @_;
  375.     my ($pkg, $ver) = getdebinfo($fn);
  376.     if(!defined($pkg) || !defined($ver)) {
  377.     print "could not get package info from file\n";
  378.     return 0;
  379.     }
  380.     if($vers{$pkg}) {
  381.     if(dcmpvers($vers{$pkg}, "eq", $ver)) {
  382.         $files{$pkg . $ver} = [ $files{$pkg . $ver }, "$dir/$fn" ];
  383.     } elsif (dcmpvers($vers{$pkg}, "gt", $ver)) {
  384.         print "old version\n";
  385.         unlink $fn;
  386.     } else { # else $ver is gt current version
  387.         my ($c);
  388.         foreach $c (@{$files{$pkg . $vers{$pkg}}}) {
  389.         print "replaces: $c\n";
  390.         unlink "$vardir/methods/ftp/$::dldir/$c";
  391.         }
  392.         $vers{$pkg} = $ver;
  393.         $files{$pkg . $ver} = [ "$dir/$fn" ];
  394.     }
  395.     } else {
  396.     $vers{$pkg} = $ver;
  397.     $files{$pkg . $ver} = [ "$dir/$fn" ];
  398.     }
  399. }
  400.  
  401. sub prcfile() {
  402.     my ($fn) = $_;
  403.     if (-f $fn) {
  404.     my $dir = substr($File::Find::dir, index($File::Find::dir, "::dldir")+length($::dldir)+2);
  405.     print "$dir/$fn\n";
  406.     if(defined($pkgfiles{"$dir/$fn"})) {
  407.         my @info = @{$pkgfiles{"$dir/$fn"}};
  408.         my $size = -s $fn;
  409.         if($size == 0) {
  410.         print "zero length file\n";
  411.         unlink $fn;
  412.         } elsif($size < $info[1]) {
  413.         print "partial file\n";
  414.         rename $fn, "$fn.partial";
  415.         } elsif(md5sum($fn) ne $info[0]) {
  416.         print "corrupt file\n";
  417.         unlink $fn;
  418.         } else {
  419.         prcdeb($dir, $fn);
  420.         }
  421.     } elsif($fn =~ /.deb$/) {
  422.         if(chkdeb($fn)) {
  423.         prcdeb($dir, $fn);
  424.         } else {
  425.         print "corrupt file\n";
  426.         unlink $fn;
  427.         }
  428.     } else {
  429.         print "non-debian file\n";
  430.     }
  431.     }
  432. }
  433. find(\&prcfile, "$::dldir");
  434.  
  435. # install .debs
  436. if(yesno("y", "\nDo you want to install the files fetched")) {
  437.     print "Installing files...\n";
  438.     my $r = system("dpkg", "-iGREOB", "$::dldir");
  439.     if($r) {
  440.     print "DPKG ERROR\n";
  441.     $exit = 1;
  442.     }
  443. }
  444.  
  445. sub removeinstalled {
  446.     my $fn = $_;
  447.     if (-f $fn) {
  448.     my $dir = substr($File::Find::dir, index($File::Find::dir, $::dldir)+length($::dldir)+2);
  449.     if($fn =~ /.deb$/) {
  450.         my($pkg, $ver) = getdebinfo($fn);
  451.         if(!defined($pkg) || !defined($ver)) {
  452.         print "Could not get info for: $dir/$fn\n";
  453.         } else {
  454.         if($curpkgs{$pkg} and dcmpvers($ver, "le", $curpkgs{$pkg})) {
  455.             print "deleting: $dir/$fn\n";
  456.             unlink $fn;
  457.         } else {
  458.             print "leaving: $dir/$fn\n";
  459.         }
  460.         }
  461.     } else {
  462.         print "non-debian: $dir/$fn\n";
  463.     }
  464.     }
  465. }
  466.  
  467. # remove .debs that have been installed (query user)
  468. # first need to reprocess status file
  469. if(yesno("y", "\nDo you wish to delete the installed package (.deb) files?")) {
  470.     print "Removing installed files...\n";
  471.     %curpkgs = ();
  472.     procstatus();
  473.     find(\&removeinstalled, "$::dldir");
  474. }
  475.  
  476. # remove whole ./debian directory if user wants to
  477. if(yesno("n", "\nDo you want to remove $::dldir directory?")) {
  478.     rmtree("$::dldir");
  479. }
  480. exit $exit;
  481.