diff options
Diffstat (limited to 'dselect/methods/ftp/setup.pl')
| -rwxr-xr-x | dselect/methods/ftp/setup.pl | 177 |
1 files changed, 177 insertions, 0 deletions
diff --git a/dselect/methods/ftp/setup.pl b/dselect/methods/ftp/setup.pl new file mode 100755 index 0000000..3376b48 --- /dev/null +++ b/dselect/methods/ftp/setup.pl @@ -0,0 +1,177 @@ +#!/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 Dpkg; # Dummy import to require the presence of Dpkg::*. +}; +if ($@) { + warn "Missing Dpkg modules required by the FTP access method.\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 = qx(dpkg --print-architecture); +$arch = 'i386' if $?; +chomp $arch; + +my $logname = qx(whoami); +chomp $logname; +my $host = qx(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 <<"EOM"; + +You must supply an ftp site, use of passive mode, username, password, +path to the debian directory,list of distributions you are interested +in and place to download the binary package files to (relative to +/var/lib/dpkg/methods/ftp). You can add as much sites as you like. Later +entries will always override older ones. + +Supply "?" as a password to be asked each time you connect. + +Eg: ftp site: ftp.debian.org + passive: y + username: anonymous + password: $logname\@$host + ftp dir: /debian + distributions: dists/stable/main dists/stable/contrib + download dir: debian + +You may have to use an authenticated FTP proxy in order to reach the +FTP site: + +Eg: use auth proxy: y + proxy: proxy.isp.com + proxy account: $CONFIG{proxylogname} + proxy password: ? +EOM + +if (! $CONFIG{done}) { + view_mirrors() if (yesno('y', 'Would you like to see a list of ftp mirrors')); + add_site(); +} +edit_config($methdir); + +my $ftp; +sub download() { + foreach (@{$CONFIG{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]}; + + foreach my $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; + + foreach my $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 <enter> to continue\n"; + <STDIN>; +} + +exit $exit; |