#!/usr/bin/perl # -*-perl-*- # # Copyright © 1996 Andy Guy # Copyright © 1998 Martin Schulze # Copyright © 1999, 2009 Raphaël Hertzog # # This program has been distributed under the terms of the GNU GPL. use strict; use warnings; use vars qw(%config); #use diagnostics; use lib '/usr/lib/perl5/Debian'; use lib '/usr/share/perl5/Debian'; eval 'use Net::FTP;'; 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; # deal with arguments my $vardir = $ARGV[0]; my $method = $ARGV[1]; my $option = $ARGV[2]; if ($option eq "manual") { print "Manual package installation.\n"; exit 0; } #print "vardir: $vardir, method: $method, option: $option\n"; #Defaults my $arch=`dpkg --print-architecture`; $arch='i386' if $?; chomp $arch; my $logname = `whoami`; chomp $logname; my $host = `cat /etc/mailname || dnsdomainname`; chomp $host; $config{'dldir'} = "debian"; $config{'use_auth_proxy'} = 0; $config{'proxyhost'} = ""; $config{'proxylogname'} = $logname; $config{'proxypassword'} = ""; my $methdir = "$vardir/methods/ftp"; my $exit = 0; my $problem = 0; if (-f "$methdir/vars") { read_config("$methdir/vars"); } chdir "$methdir"; if (! -d "debian") { mkdir "debian", 0755; } # get info from user $| = 1; print <[0], # Ftp server $_->[4], # username $_->[5], # password $_->[1], # ftp dir $_->[3], # passive $config{'use_auth_proxy'}, $config{'proxyhost'}, $config{'proxylogname'}, $config{'proxypassword'}); my @dists = @{$_->[2]}; my $dist; foreach $dist (@dists) { my $dir = "$dist/binary-$arch"; print "Checking $dir...\n"; # if(!$ftp->pasv()) { print $ftp->message . "\n"; die "error"; } my @dirlst = $ftp->ls("$dir/"); my $got_pkgfile = 0; my $line = ""; foreach $line (@dirlst) { if($line =~ /Packages/) { $got_pkgfile=1; } } if( !$got_pkgfile) { print "Warning: Could not find a Packages file in $dir\n", "This may not be a problem if the directory is a symbolic link\n"; $problem=1; } } print "Closing ftp connection...\n"; $ftp->quit(); } } # download stuff (protect from ^C) print "\nUsing FTP to check directories...(stop with ^C)\n\n"; eval { local $SIG{INT} = sub { die "Interrupted!\n"; }; download(); }; if($@) { $ftp->quit(); print "FTP ERROR - "; if ($@ eq "connect") { print "config was untested\n"; } else { print "$@\n"; } $exit = 1; }; # output new vars file $config{'done'} = 1; store_config("$methdir/vars"); chmod 0600, "$methdir/vars"; if($exit || $problem) { print "Press return to continue\n"; ; } exit $exit;