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