dselect/methods/ftp/setup.pl

   1 #!/usr/bin/perl
   2 #
   3 # Copyright © 1996 Andy Guy <andy@cyteen.org>
   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; either version 2 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # This program is distributed in the hope that it will be useful,
  13 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with this program.  If not, see <https://www.gnu.org/licenses/>.
  19
  20 use strict;
  21 use warnings;
  22
  23 eval q{
  24     use Dpkg; # Dummy import to require the presence of Dpkg::*.
  25 };
  26 if ($@) {
  27     warn "Missing Dpkg modules required by the FTP access method.\n\n";
  28     exit 1;
  29 }
  30
  31 use Dselect::Method;
  32 use Dselect::Method::Ftp;
  33
  34 # deal with arguments
  35 my $vardir = $ARGV[0];
  36 my $method = $ARGV[1];
  37 my $option = $ARGV[2];
  38
  39 if ($option eq 'manual') {
  40     print "Manual package installation.\n";
  41     exit 0;
  42 }
  43 #print "vardir: $vardir, method: $method, option: $option\n";
  44
  45 #Defaults
  46 my $arch = qx(dpkg --print-architecture);
  47 $arch = 'i386' if $?;
  48 chomp $arch;
  49
  50 my $logname = qx(whoami);
  51 chomp $logname;
  52 my $host = qx(cat /etc/mailname || dnsdomainname);
  53 chomp $host;
  54
  55 $CONFIG{dldir} = 'debian';
  56 $CONFIG{use_auth_proxy} = 0;
  57 $CONFIG{proxyhost} = '';
  58 $CONFIG{proxylogname} = $logname;
  59 $CONFIG{proxypassword} = '';
  60
  61 my $methdir = "$vardir/methods/ftp";
  62 my $exit = 0;
  63 my $problem = 0;
  64
  65 if (-f "$methdir/vars") {
  66   read_config("$methdir/vars");
  67 }
  68
  69 chdir "$methdir";
  70 if (! -d 'debian') {
  71     mkdir 'debian', 0755;
  72 }
  73 # get info from user
  74
  75 $| = 1;
  76
  77 print <<"EOM";
  78
  79 You must supply an ftp site, use of passive mode, username, password,
  80 path to the debian directory,list of distributions you are interested
  81 in and place to download the binary package files to (relative to
  82 /var/lib/dpkg/methods/ftp). You can add as much sites as you like. Later
  83 entries will always override older ones.
  84
  85 Supply "?" as a password to be asked each time you connect.
  86
  87 Eg:      ftp site: ftp.debian.org
  88           passive: y
  89          username: anonymous
  90          password: $logname\@$host
  91           ftp dir: /debian
  92     distributions: dists/stable/main dists/stable/contrib
  93      download dir: debian
  94
  95 You may have to use an authenticated FTP proxy in order to reach the
  96 FTP site:
  97
  98 Eg:  use auth proxy: y
  99               proxy: proxy.isp.com
 100       proxy account: $CONFIG{proxylogname}
 101      proxy password: ?
 102 EOM
 103
 104 if (! $CONFIG{done}) {
 105   view_mirrors() if (yesno('y', 'Would you like to see a list of ftp mirrors'));
 106   add_site('ftp');
 107 }
 108 edit_config('ftp', $methdir);
 109
 110 my $ftp;
 111 sub download() {
 112  foreach (@{$CONFIG{site}}) {
 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)
 149 print "\nUsing FTP to check directories...(stop with ^C)\n\n";
 150 eval {
 151     local $SIG{INT} = sub {
 152         die "interrupted!\n";
 153     };
 154     download();
 155 };
 156 if($@) {
 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;
 169 store_config("$methdir/vars");
 170 chmod  0600, "$methdir/vars";
 171
 172 if($exit || $problem) {
 173     print "Press <enter> to continue\n";
 174     <STDIN>;
 175 }
 176
 177 exit $exit;