1#!/usr/bin/perl 2# 3# Copyright © 1996 Andy Guy <awpguy@acs.ucalgary.ca> 4# Copyright © 1998 Martin Schulze <joey@infodrom.north.de> 5# Copyright © 1999, 2009 Raphaël Hertzog <hertzog@debian.org> 6# 7# This program is free software; you can redistribute it and/or modify 8# it under the terms of the GNU General Public License as published by 9# the Free Software Foundation; version 2 of the License. 10# 11# This program is distributed in the hope that it will be useful, 12# but WITHOUT ANY WARRANTY; without even the implied warranty of 13# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14# GNU General Public License for more details. 15# 16# You should have received a copy of the GNU General Public License 17# along with this program. If not, see <https://www.gnu.org/licenses/>. 18 19use strict; 20use warnings; 21 22eval q{ 23 pop @INC if $INC[-1] eq '.'; 24 use Net::FTP; 25}; 26if ($@) { 27 warn "Please install the 'perl' package if you want to use the\n" . 28 "FTP access method of dselect.\n\n"; 29 exit 1; 30} 31use Dselect::Ftp; 32 33# deal with arguments 34my $vardir = $ARGV[0]; 35my $method = $ARGV[1]; 36my $option = $ARGV[2]; 37 38if ($option eq 'manual') { 39 print "Manual package installation.\n"; 40 exit 0; 41} 42#print "vardir: $vardir, method: $method, option: $option\n"; 43 44#Defaults 45my $arch = qx(dpkg --print-architecture); 46$arch='i386' if $?; 47chomp $arch; 48 49my $logname = qx(whoami); 50chomp $logname; 51my $host = qx(cat /etc/mailname || dnsdomainname); 52chomp $host; 53 54$CONFIG{dldir} = 'debian'; 55$CONFIG{use_auth_proxy} = 0; 56$CONFIG{proxyhost} = ''; 57$CONFIG{proxylogname} = $logname; 58$CONFIG{proxypassword} = ''; 59 60my $methdir = "$vardir/methods/ftp"; 61my $exit = 0; 62my $problem = 0; 63 64if (-f "$methdir/vars") { 65 read_config("$methdir/vars"); 66} 67 68chdir "$methdir"; 69if (! -d 'debian') { 70 mkdir 'debian', 0755; 71} 72# get info from user 73 74$| = 1; 75 76print <<"EOM"; 77 78You must supply an ftp site, use of passive mode, username, password, 79path to the debian directory,list of distributions you are interested 80in and place to download the binary package files to (relative to 81/var/lib/dpkg/methods/ftp). You can add as much sites as you like. Later 82entries will always override older ones. 83 84Supply "?" as a password to be asked each time you connect. 85 86Eg: ftp site: ftp.debian.org 87 passive: y 88 username: anonymous 89 password: $logname\@$host 90 ftp dir: /debian 91 distributions: dists/stable/main dists/stable/contrib 92 download dir: debian 93 94You may have to use an authenticated FTP proxy in order to reach the 95FTP site: 96 97Eg: use auth proxy: y 98 proxy: proxy.isp.com 99 proxy account: $CONFIG{proxylogname} 100 proxy password: ? 101EOM 102 103if (! $CONFIG{done}) { 104 view_mirrors() if (yesno('y', 'Would you like to see a list of ftp mirrors')); 105 add_site(); 106} 107edit_config($methdir); 108 109my $ftp; 110sub download() { 111 foreach (@{$CONFIG{site}}) { 112 113 $ftp = do_connect(ftpsite => $_->[0], 114 ftpdir => $_->[1], 115 passive => $_->[3], 116 username => $_->[4], 117 password => $_->[5], 118 useproxy => $CONFIG{use_auth_proxy}, 119 proxyhost => $CONFIG{proxyhost}, 120 proxylogname => $CONFIG{proxylogname}, 121 proxypassword => $CONFIG{proxypassword}); 122 123 my @dists = @{$_->[2]}; 124 125 foreach my $dist (@dists) { 126 my $dir = "$dist/binary-$arch"; 127 print "Checking $dir...\n"; 128# if (!$ftp->pasv()) { print $ftp->message . "\n"; die 'error'; } 129 my @dirlst = $ftp->ls("$dir/"); 130 my $got_pkgfile = 0; 131 132 foreach my $line (@dirlst) { 133 if($line =~ /Packages/) { 134 $got_pkgfile=1; 135 } 136 } 137 if( !$got_pkgfile) { 138 print "Warning: Could not find a Packages file in $dir\n", 139 "This may not be a problem if the directory is a symbolic link\n"; 140 $problem=1; 141 } 142 } 143 print "Closing ftp connection...\n"; 144 $ftp->quit(); 145 } 146} 147 148# download stuff (protect from ^C) 149print "\nUsing FTP to check directories...(stop with ^C)\n\n"; 150eval { 151 local $SIG{INT} = sub { 152 die "interrupted!\n"; 153 }; 154 download(); 155}; 156if($@) { 157 $ftp->quit(); 158 print 'FTP ERROR - '; 159 if ($@ eq 'connect') { 160 print "config was untested\n"; 161 } else { 162 print "$@\n"; 163 } 164 $exit = 1; 165}; 166 167# output new vars file 168$CONFIG{done} = 1; 169store_config("$methdir/vars"); 170chmod 0600, "$methdir/vars"; 171 172if($exit || $problem) { 173 print "Press <enter> to continue\n"; 174 <STDIN>; 175} 176 177exit $exit; 178