summaryrefslogtreecommitdiffstats
path: root/dselect/methods/ftp/update.pl
diff options
context:
space:
mode:
Diffstat (limited to 'dselect/methods/ftp/update.pl')
-rwxr-xr-xdselect/methods/ftp/update.pl251
1 files changed, 251 insertions, 0 deletions
diff --git a/dselect/methods/ftp/update.pl b/dselect/methods/ftp/update.pl
new file mode 100755
index 0000000..a40f6f0
--- /dev/null
+++ b/dselect/methods/ftp/update.pl
@@ -0,0 +1,251 @@
+#!/usr/bin/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 is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; version 2 of the License.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+use strict;
+use warnings;
+
+eval q{
+ pop @INC if $INC[-1] eq '.';
+ use Net::FTP;
+};
+if ($@) {
+ warn "Please install the 'perl' package if you want to use the\n" .
+ "FTP access method of dselect.\n\n";
+ exit 1;
+}
+
+use Dselect::Ftp;
+
+# deal with arguments
+my $vardir = $ARGV[0];
+my $method = $ARGV[1];
+my $option = $ARGV[2];
+
+if ($option eq 'manual') {
+ print "Enter package file names or a blank line to finish\n";
+ while(1) {
+ print 'Enter package file name:';
+ my $fn = <STDIN>;
+ chomp $fn;
+ if ($fn eq '') {
+ exit 0;
+ }
+ if ( -f $fn ) {
+ system('dpkg', '--merge-avail', $fn);
+ } else {
+ print "Could not find $fn, try again\n";
+ }
+ };
+};
+
+#print "vardir: $vardir, method: $method, option: $option\n";
+
+my $arch = qx(dpkg --print-architecture);
+$arch='i386' if $?;
+chomp $arch;
+my $exit = 0;
+
+# get info from control file
+read_config("$vardir/methods/ftp/vars");
+
+chdir "$vardir/methods/ftp";
+
+print "Getting Packages files...(stop with ^C)\n\n";
+
+my @pkgfiles;
+my $ftp;
+my $packages_modified = 0;
+
+sub download {
+foreach (@{$CONFIG{site}}) {
+
+ my $site = $_;
+
+ $ftp = do_connect(ftpsite => $_->[0],
+ ftpdir => $_->[1],
+ passive => $_->[3],
+ username => $_->[4],
+ password => $_->[5],
+ useproxy => $CONFIG{use_auth_proxy},
+ proxyhost => $CONFIG{proxyhost},
+ proxylogname => $CONFIG{proxylogname},
+ proxypassword => $CONFIG{proxypassword});
+
+ my @dists = @{$_->[2]};
+ PACKAGE:
+ foreach my $dist (@dists) {
+ my $dir = "$dist/binary-$arch";
+ my $must_get = 0;
+ my $newest_pack_date;
+
+ # check existing Packages on remote site
+ print "\nChecking for Packages file... ";
+ $newest_pack_date = do_mdtm ($ftp, "$dir/Packages.gz");
+ if (defined $newest_pack_date) {
+ print "$dir/Packages.gz\n";
+ } else {
+ $dir = "$dist";
+ $newest_pack_date = do_mdtm ($ftp, "$dir/Packages.gz");
+ if (defined $newest_pack_date) {
+ print "$dir/Packages.gz\n";
+ } else {
+ print "Couldn't find Packages.gz in $dist/binary-$arch or $dist; ignoring.\n";
+ print "Your setup is probably wrong, check the distributions directories,\n";
+ print "and try with passive mode enabled/disabled (if you use a proxy/firewall)\n";
+ next PACKAGE;
+ }
+ }
+
+ # we now have $dir set to point to an existing Packages.gz file
+
+ # check if we already have a Packages file (and get its date)
+ $dist =~ tr/\//_/;
+ my $file = "Packages.$site->[0].$dist";
+
+ # if not
+ if (! -f $file) {
+ # must get one
+# print "No Packages here; must get it.\n";
+ $must_get = 1;
+ } else {
+ # else check last modification date
+ my @pack_stat = stat($file);
+ if($newest_pack_date > $pack_stat[9]) {
+# print "Packages has changed; must get it.\n";
+ $must_get = 1;
+ } elsif ($newest_pack_date < $pack_stat[9]) {
+ print " Our file is newer than theirs; skipping.\n";
+ } else {
+ print " Already up-to-date; skipping.\n";
+ }
+ }
+
+ if ($must_get) {
+ -f 'Packages.gz' and unlink 'Packages.gz';
+ -f 'Packages' and unlink 'Packages';
+ my $size = 0;
+
+ TRY_GET_PACKAGES:
+ while (1) {
+ if ($size) {
+ print ' Continuing ';
+ } else {
+ print ' Getting ';
+ }
+ print "Packages file from $dir...\n";
+ eval {
+ if ($ftp->get("$dir/Packages.gz", 'Packages.gz', $size)) {
+ if (system('gunzip', 'Packages.gz')) {
+ print " Couldn't gunzip Packages.gz, stopped";
+ die 'error';
+ }
+ } else {
+ print " Couldn't get Packages.gz from $dir !!! Stopped.";
+ die 'error';
+ }
+ };
+ if ($@) {
+ $size = -s 'Packages.gz';
+ if (ref($ftp)) {
+ $ftp->abort();
+ $ftp->quit();
+ };
+ if (yesno ('y', "Transfer failed at $size: retry at once")) {
+ $ftp = do_connect(ftpsite => $site->[0],
+ ftpdir => $site->[1],
+ passive => $site->[3],
+ username => $site->[4],
+ password => $site->[5],
+ useproxy => $CONFIG{use_auth_proxy},
+ proxyhost => $CONFIG{proxyhost},
+ proxylogname => $CONFIG{proxylogname},
+ proxypassword => $CONFIG{proxypassword});
+
+ if ($newest_pack_date != do_mdtm ($ftp, "$dir/Packages.gz")) {
+ print ("Packages file has changed !\n");
+ $size = 0;
+ }
+ next TRY_GET_PACKAGES;
+ } else {
+ die 'error';
+ }
+ }
+ last TRY_GET_PACKAGES;
+ }
+
+ if (!rename 'Packages', "Packages.$site->[0].$dist") {
+ print " Couldn't rename Packages to Packages.$site->[0].$dist";
+ die 'error';
+ } else {
+ # set local Packages file to same date as the one it mirrors
+ # to allow comparison to work.
+ utime $newest_pack_date, $newest_pack_date, "Packages.$site->[0].$dist";
+ $packages_modified = 1;
+ }
+ }
+ push @pkgfiles, "Packages.$site->[0].$dist";
+ }
+ $ftp->quit();
+ }
+}
+
+eval {
+ local $SIG{INT} = sub {
+ die "interrupted!\n";
+ };
+ download();
+};
+if($@) {
+ $ftp->quit() if (ref($ftp));
+ if($@ =~ /timeout/i) {
+ print "FTP TIMEOUT\n";
+ } else {
+ print "FTP ERROR - $@\n";
+ }
+ $exit = 1;
+};
+
+# Don't clear if nothing changed.
+if ($packages_modified) {
+ print <<'EOM';
+
+It is a good idea to clear the available list of old packages.
+However if you have only downloaded a Package files from non-main
+distributions you might not want to do this.
+
+EOM
+ if (yesno ('y', 'Do you want to clear available list')) {
+ print "Clearing...\n";
+ if (system('dpkg', '--clear-avail')) {
+ print 'dpkg --clear-avail failed.';
+ die 'error';
+ }
+ }
+}
+
+if (!$packages_modified) {
+ print "No Packages files was updated.\n";
+} else {
+ foreach my $file (@pkgfiles) {
+ if (system('dpkg', '--merge-avail', $file)) {
+ print "Dpkg merge available failed on $file";
+ $exit = 1;
+ }
+ }
+}
+exit $exit;