home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 February / PCWorld_2000-02_cd.bin / live / usr / lib / dpkg / methods / ftp / update < prev   
Text File  |  1998-12-28  |  6KB  |  218 lines
  1. #!/usr/bin/perl
  2. # -*-perl-*-
  3.  
  4. #use strict;
  5. #use diagnostics;
  6.  
  7. use Net::FTP;
  8.  
  9. use Debian::DpkgFtp;
  10.  
  11. # deal with arguments
  12. my $vardir = $ARGV[0];
  13. my $method = $ARGV[1];
  14. my $option = $ARGV[2];
  15.  
  16. if ($option eq "manual") {
  17.     print "Enter package file names or a blank line to finish\n";
  18.     while(1) {
  19.     print "Enter package file name:";
  20.     my $fn = <STDIN>;
  21.     chomp $fn;
  22.     if ( $fn == "") {
  23.         exit 0;
  24.     }
  25.     if ( -f $fn ) {
  26.         system ("dpkg", "--merge-avail", $fn);
  27.     } else {
  28.         print "Could not find $fn, try again\n";
  29.     }
  30.     };
  31. };
  32.  
  33. #print "vardir: $vardir, method: $method, option: $option\n";
  34.  
  35. my $arch=`dpkg --print-installation-architecture`;
  36. $arch='i386' if $?;
  37. chomp $arch;
  38. my $exit = 0;
  39.  
  40. # get info from control file
  41. do "$vardir/methods/ftp/vars" or die "Could not find state file (re-run Access method)";
  42.  
  43. chdir "$vardir/methods/ftp";
  44.  
  45. print "Getting Packages files...(stop with ^C)\n\n";
  46.  
  47. my @pkgfiles;
  48. my $ftp;
  49. my $packages_modified = 0;
  50.  
  51. sub download {
  52.     $ftp = do_connect ($::ftpsite,$::username,$::password,$::ftpdir,$::passive,
  53.                $::useproxy,$::proxyhost,$::proxylogname,$::proxypassword);
  54.  
  55.     my @dists = split(/ +/, $::distribs);
  56.     my $dist;
  57.     PACKAGE:
  58.     foreach $dist (@dists) {
  59.     my $dir = "$dist/binary-$arch";
  60.     my $must_get = 0;
  61.     my $newest_pack_date;
  62.  
  63.     # check existing Packages on remote site
  64.     print "\nChecking for Packages file... ";
  65.     $newest_pack_date = do_mdtm ($ftp, "$dir/Packages.gz");
  66.     if (defined $newest_pack_date) {
  67.         print "$dir/Packages.gz\n";
  68.     } else {
  69.         $dir = "$dist";
  70.         $newest_pack_date = do_mdtm ($ftp, "$dir/Packages.gz");
  71.         if (defined $newest_pack_date) {
  72.         print "$dir/Packages.gz\n";
  73.         } else {
  74.         print "Couldn't find Packages.gz in $dist/binary-$arch or $dist; ignoring.\n";
  75.         next PACKAGE;
  76.         }
  77.     }
  78.  
  79.     # we now have $dir set to point to an existing Packages.gz file
  80.  
  81.     # check if we already have a Packages file (and get its date)
  82.     $dist =~ tr/\//_/;
  83.     my @pack_stat = stat("Packages.$dist");
  84.     # if not
  85.     if (@pack_stat == ()) {
  86.         # must get one
  87. #        print "No Packages here; must get it.\n";
  88.         $must_get = 1;
  89.     } else {
  90.         # else check last modification date
  91.  
  92. #        ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($newest_pack_date);
  93. #        print "Distant: " . $mday . "/" . $mon . "/" . $year . ", " . $hour . ":" . $min . ":" . $sec . "\n";
  94. #        ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($pack_stat[9]);
  95. #        print "Local:   " . $mday . "/" . $mon . "/" . $year . ", " . $hour . ":" . $min . ":" . $sec . "\n";
  96.  
  97.         if($newest_pack_date > $pack_stat[9]) {
  98. #        print "Packages has changed; must get it.\n";
  99.         $must_get = 1; 
  100.         } elsif ($newest_pack_date < $pack_stat[9]) {
  101.         print " Our file is newer than theirs; skipping.\n";
  102.         } else {
  103.         print " Already up-to-date; skipping.\n";
  104.         }
  105.     }
  106.  
  107.     if ($must_get) {
  108.         -f "Packages.gz" and unlink "Packages.gz";
  109.         -f "Packages" and unlink "Packages";
  110.         my $size = 0;
  111.  
  112.       TRY_GET_PACKAGES: 
  113.         while (1) {
  114.         if ($size) {
  115.             print " Continuing ";
  116.         } else {
  117.             print " Getting ";
  118.         }
  119.         print "Packages file from $dir...\n";
  120.         eval {
  121.             if ($ftp->get("$dir/Packages.gz", "Packages.gz", $size)) {
  122.             if (system("gunzip", "Packages.gz")) {
  123.                 print "  Couldn't gunzip Packages.gz, stopped";
  124.                 die "error";
  125.             }
  126.             } else {
  127.             print "  Couldn't get Packages.gz from $dir !!! Stopped.";
  128.             die "error";
  129.             }
  130.         };
  131.         if ($@) {
  132.             $size = -s "Packages.gz";
  133.             if (yesno ("y", "Transfer failed at $size: retry at once")) {
  134.             # maybe we could test if the old $ftp still works ?
  135.             $ftp = do_connect ($::ftpsite,$::username,$::password,$::ftpdir,$::passive,
  136.                        $::useproxy,$::proxyhost,$::proxylogname,$::proxypassword);
  137.             if ($newest_pack_date != do_mdtm ($ftp, "$dir/Packages.gz")) {
  138.                 print ("Packages file has changed !\n");
  139.                 $size = 0;
  140.             }
  141.             next TRY_GET_PACKAGES;
  142.             } else {
  143.             die "error";
  144.             }
  145.         }
  146.         last TRY_GET_PACKAGES;
  147.         }
  148.  
  149.         if(!rename "Packages", "Packages.$dist") {
  150.         print "  Couldn't rename Packages to Packages.$dist";
  151.         die "error";
  152.         } else {
  153.         # set local Packages file to same date as the one it mirrors
  154.         # to allow comparison to work.
  155. #        ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($newest_pack_date);
  156. #        print "Setting mtime to: " . $mday . "/" . $mon . "/" . $year . ", " . $hour . ":" . $min . ":" . $sec . "\n";
  157.         utime $newest_pack_date, $newest_pack_date, "Packages.$dist";
  158.         $packages_modified = 1;
  159.         }
  160.     }
  161.     push @pkgfiles, "Packages.$dist";
  162.     }
  163.     $ftp->quit();
  164. }
  165.  
  166. eval {
  167.     local $SIG{INT} = sub {
  168.     die "Interrupted!\n";
  169.     };
  170.     download();
  171. };
  172. if($@) {
  173.     if($@ =~ /timeout/i) {
  174.     print "FTP TIMEOUT\n";
  175.     } else {
  176.     print "FTP ERROR - $@\n";
  177.     }
  178.     $exit = 1;
  179. };
  180.  
  181. my $ans;
  182.  
  183. if ($packages_modified) {    # don't clear if nothing changed
  184.     print <<EOM;
  185.  
  186. It is a good idea to clear the available list of old packages.
  187. However if you have only downloaded a Package files from non-main
  188. distributions you might not want to do this.
  189.  
  190. EOM
  191.     if (yesno ("y", "Do you want to clear available list")) {
  192.     print "Clearing...\n";
  193.     if(system("dpkg", "--clear-avail")) {
  194.         print "dpkg --clear-avail failed.";
  195.         die "error";
  196.     }
  197.     }
  198. }
  199.  
  200. if (!$packages_modified) {
  201.     print "No Packages files was updated.\n";
  202. } else {
  203.     my $file;
  204.  
  205.     foreach $file (@pkgfiles) {
  206.     if(system ("dpkg", "--merge-avail", $file)) {
  207.         print "Dpkg merge available failed on $file";
  208.         $exit = 1;
  209.     }
  210.     }
  211.  
  212.     if(system("dpkg", "--forget-old-unavail")) {
  213.     print "dpkg --forget-old-unavail failed";
  214.     die "error";
  215.     }
  216. }
  217. exit $exit;
  218.