File Coverage

blib/lib/CPAN/FTP.pm
Criterion Covered Total %
statement 161 625 25.7
branch 54 396 13.6
condition 15 133 11.2
subroutine 18 27 66.6
pod 0 9 0.0
total 248 1190 20.8


line stmt bran cond sub pod time code
1             # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
2             # vim: ts=4 sts=4 sw=4:
3             package CPAN::FTP;
4 13     13   99 use strict;
  13         26  
  13         482  
5              
6 13     13   2893 use Errno ();
  13         8853  
  13         352  
7 13     13   75 use Fcntl qw(:flock);
  13         27  
  13         2469  
8 13     13   98 use File::Basename qw(dirname);
  13         36  
  13         1108  
9 13     13   98 use File::Path qw(mkpath);
  13         24  
  13         864  
10 13     13   5660 use CPAN::FTP::netrc;
  13         31  
  13         471  
11 13     13   81 use vars qw($connect_to_internet_ok $Ua $Thesite $ThesiteURL $Themethod);
  13         23  
  13         925  
12              
13             @CPAN::FTP::ISA = qw(CPAN::Debug);
14              
15 13         101284 use vars qw(
16             $VERSION
17 13     13   76 );
  13         32  
18             $VERSION = "5.5011";
19              
20             sub _plus_append_open {
21 0     0   0 my($fh, $file) = @_;
22 0         0 my $parent_dir = dirname $file;
23 0         0 mkpath $parent_dir;
24 0         0 my($cnt);
25 0         0 until (open $fh, "+>>$file") {
26 0 0       0 next if $! == Errno::EAGAIN; # don't increment on EAGAIN
27 0 0       0 $CPAN::Frontend->mydie("Could not open '$file' after 10000 tries: $!") if ++$cnt > 100000;
28 0         0 sleep 0.0001;
29 0         0 mkpath $parent_dir;
30             }
31             }
32              
33             #-> sub CPAN::FTP::ftp_statistics
34             # if they want to rewrite, they need to pass in a filehandle
35             sub _ftp_statistics {
36 0     0   0 my($self,$fh) = @_;
37 0 0       0 my $locktype = $fh ? LOCK_EX : LOCK_SH;
38             # XXX On Windows flock() implements mandatory locking, so we can
39             # XXX only use shared locking to still allow _yaml_load_file() to
40             # XXX read from the file using a different filehandle.
41 0 0       0 $locktype = LOCK_SH if $^O eq "MSWin32";
42              
43 0   0     0 $fh ||= FileHandle->new;
44 0         0 my $file = File::Spec->catfile($CPAN::Config->{cpan_home},"FTPstats.yml");
45 0         0 _plus_append_open($fh,$file);
46 0         0 my $sleep = 1;
47 0         0 my $waitstart;
48 0         0 while (!CPAN::_flock($fh, $locktype|LOCK_NB)) {
49 0   0     0 $waitstart ||= localtime();
50 0 0       0 if ($sleep>3) {
51 0         0 my $now = localtime();
52 0         0 $CPAN::Frontend->mywarn("$now: waiting for read lock on '$file' (since $waitstart)\n");
53             }
54 0         0 sleep($sleep); # this sleep must not be overridden;
55             # Frontend->mysleep with AUTOMATED_TESTING has
56             # provoked complete lock contention on my NFS
57 0 0       0 if ($sleep <= 6) {
58 0         0 $sleep+=0.5;
59             } else {
60             # retry to get a fresh handle. If it is NFS and the handle is stale, we will never get an flock
61 0         0 _plus_append_open($fh, $file);
62             }
63             }
64 0         0 my $stats = eval { CPAN->_yaml_loadfile($file); };
  0         0  
65 0 0       0 if ($@) {
66 0 0       0 if (ref $@) {
67 0 0       0 if (ref $@ eq "CPAN::Exception::yaml_not_installed") {
    0          
68 0         0 chomp $@;
69 0         0 $CPAN::Frontend->myprintonce("Warning (usually harmless): $@\n");
70 0         0 return;
71             } elsif (ref $@ eq "CPAN::Exception::yaml_process_error") {
72 0         0 my $time = time;
73 0         0 my $to = "$file.$time";
74 0         0 $CPAN::Frontend->mywarn("Error reading '$file': $@
75             Trying to stash it away as '$to' to prevent further interruptions.
76             You may want to remove that file later.\n");
77             # may fail because somebody else has moved it away in the meantime:
78 0 0       0 rename $file, $to or $CPAN::Frontend->mywarn("Could not rename '$file' to '$to': $!\n");
79 0         0 return;
80             }
81             } else {
82 0         0 $CPAN::Frontend->mydie($@);
83             }
84             }
85 0         0 CPAN::_flock($fh, LOCK_UN);
86 0         0 return $stats->[0];
87             }
88              
89             #-> sub CPAN::FTP::_mytime
90             sub _mytime () {
91 6 50   6   28 if (CPAN->has_inst("Time::HiRes")) {
92 6         60 return Time::HiRes::time();
93             } else {
94 0         0 return time;
95             }
96             }
97              
98             #-> sub CPAN::FTP::_new_stats
99             sub _new_stats {
100 3     3   12 my($self,$file) = @_;
101 3         15 my $ret = {
102             file => $file,
103             attempts => [],
104             start => _mytime,
105             };
106 3         10 $ret;
107             }
108              
109             #-> sub CPAN::FTP::_add_to_statistics
110             sub _add_to_statistics {
111 3     3   10 my($self,$stats) = @_;
112 3         13 my $yaml_module = CPAN::_yaml_module();
113 3 50       10 $self->debug("yaml_module[$yaml_module]") if $CPAN::DEBUG;
114 3 50       12 if ($CPAN::META->has_inst($yaml_module)) {
115 0         0 $stats->{thesiteurl} = $ThesiteURL;
116 0         0 $stats->{end} = CPAN::FTP::_mytime();
117 0         0 my $fh = FileHandle->new;
118 0         0 my $time = time;
119 0         0 my $sdebug = 0;
120 0         0 my @debug;
121 0 0       0 @debug = $time if $sdebug;
122 0         0 my $fullstats = $self->_ftp_statistics($fh);
123 0         0 close $fh;
124 0   0     0 $fullstats->{history} ||= [];
125 0 0       0 push @debug, scalar @{$fullstats->{history}} if $sdebug;
  0         0  
126 0 0       0 push @debug, time if $sdebug;
127 0         0 push @{$fullstats->{history}}, $stats;
  0         0  
128             # YAML.pm 0.62 is unacceptably slow with 999;
129             # YAML::Syck 0.82 has no noticable performance problem with 999;
130 0   0     0 my $ftpstats_size = $CPAN::Config->{ftpstats_size} || 99;
131 0   0     0 my $ftpstats_period = $CPAN::Config->{ftpstats_period} || 14;
132 0   0     0 while (
133 0         0 @{$fullstats->{history}} > $ftpstats_size
134             || $time - $fullstats->{history}[0]{start} > 86400*$ftpstats_period
135             ) {
136 0         0 shift @{$fullstats->{history}}
  0         0  
137             }
138 0 0       0 push @debug, scalar @{$fullstats->{history}} if $sdebug;
  0         0  
139 0 0       0 push @debug, time if $sdebug;
140 0 0       0 push @debug, scalar localtime($fullstats->{history}[0]{start}) if $sdebug;
141             # need no eval because if this fails, it is serious
142 0         0 my $sfile = File::Spec->catfile($CPAN::Config->{cpan_home},"FTPstats.yml");
143 0         0 CPAN->_yaml_dumpfile("$sfile.$$",$fullstats);
144 0 0       0 if ( $sdebug ) {
145 0         0 local $CPAN::DEBUG = 512; # FTP
146 0         0 push @debug, time;
147 0         0 CPAN->debug(sprintf("DEBUG history: before_read[%d]before[%d]at[%d]".
148             "after[%d]at[%d]oldest[%s]dumped backat[%d]",
149             @debug,
150             ));
151             }
152             # Win32 cannot rename a file to an existing filename
153 0 0 0     0 unlink($sfile) if ($^O eq 'MSWin32' or $^O eq 'os2');
154 0 0       0 _copy_stat($sfile, "$sfile.$$") if -e $sfile;
155 0 0       0 rename "$sfile.$$", $sfile
156             or $CPAN::Frontend->mywarn("Could not rename '$sfile.$$' to '$sfile': $!\nGiving up\n");
157             }
158             }
159              
160             # Copy some stat information (owner, group, mode and) from one file to
161             # another.
162             # This is a utility function which might be moved to a utility repository.
163             #-> sub CPAN::FTP::_copy_stat
164             sub _copy_stat {
165 0     0   0 my($src, $dest) = @_;
166 0         0 my @stat = stat($src);
167 0 0       0 if (!@stat) {
168 0         0 $CPAN::Frontend->mywarn("Can't stat '$src': $!\n");
169 0         0 return;
170             }
171              
172 0         0 eval {
173 0 0       0 chmod $stat[2], $dest
174             or $CPAN::Frontend->mywarn("Can't chmod '$dest' to " . sprintf("0%o", $stat[2]) . ": $!\n");
175             };
176 0 0       0 warn $@ if $@;
177 0         0 eval {
178             chown $stat[4], $stat[5], $dest
179 0 0       0 or do {
180 0         0 my $save_err = $!; # otherwise it's lost in the get... calls
181 0         0 $CPAN::Frontend->mywarn("Can't chown '$dest' to " .
182             (getpwuid($stat[4]))[0] . "/" .
183             (getgrgid($stat[5]))[0] . ": $save_err\n"
184             );
185             };
186             };
187 0 0       0 warn $@ if $@;
188             }
189              
190             # if file is CHECKSUMS, suggest the place where we got the file to be
191             # checked from, maybe only for young files?
192             #-> sub CPAN::FTP::_recommend_url_for
193             sub _recommend_url_for {
194 3     3   14 my($self, $file, $urllist) = @_;
195 3 50       16 if ($file =~ s|/CHECKSUMS(.gz)?$||) {
196 0         0 my $fullstats = $self->_ftp_statistics();
197 0   0     0 my $history = $fullstats->{history} || [];
198 0         0 while (my $last = pop @$history) {
199 0 0       0 last if $last->{end} - time > 3600; # only young results are interesting
200 0 0       0 next unless $last->{file}; # dirname of nothing dies!
201 0 0       0 next unless $file eq dirname($last->{file});
202 0         0 return $last->{thesiteurl};
203             }
204             }
205 3 50 33     16 if ($CPAN::Config->{randomize_urllist}
206             &&
207             rand(1) < $CPAN::Config->{randomize_urllist}
208             ) {
209 0         0 $urllist->[int rand scalar @$urllist];
210             } else {
211 3         14 return ();
212             }
213             }
214              
215             #-> sub CPAN::FTP::_get_urllist
216             sub _get_urllist {
217 3     3   10 my($self, $with_defaults) = @_;
218 3   50     24 $with_defaults ||= 0;
219 3 50       8 CPAN->debug("with_defaults[$with_defaults]") if $CPAN::DEBUG;
220              
221 3   50     14 $CPAN::Config->{urllist} ||= [];
222 3 50       20 unless (ref $CPAN::Config->{urllist} eq 'ARRAY') {
223 0         0 $CPAN::Frontend->mywarn("Malformed urllist; ignoring. Configuration file corrupt?\n");
224 0         0 $CPAN::Config->{urllist} = [];
225             }
226 3 50       7 my @urllist = grep { defined $_ and length $_ } @{$CPAN::Config->{urllist}};
  3         29  
  3         12  
227 3 50       17 push @urllist, @CPAN::Defaultsites if $with_defaults;
228 3         13 for my $u (@urllist) {
229 3 50       13 CPAN->debug("u[$u]") if $CPAN::DEBUG;
230 3 50       61 if (UNIVERSAL::can($u,"text")) {
231 0 0       0 $u->{TEXT} .= "/" unless substr($u->{TEXT},-1) eq "/";
232             } else {
233 3 50       24 $u .= "/" unless substr($u,-1) eq "/";
234 3         36 $u = CPAN::URL->new(TEXT => $u, FROM => "USER");
235             }
236             }
237 3         10 \@urllist;
238             }
239              
240             #-> sub CPAN::FTP::ftp_get ;
241             sub ftp_get {
242 0     0 0 0 my($class,$host,$dir,$file,$target) = @_;
243 0 0       0 $class->debug(
244             qq[Going to fetch file [$file] from dir [$dir]
245             on host [$host] as local [$target]\n]
246             ) if $CPAN::DEBUG;
247 0         0 my $ftp = Net::FTP->new($host);
248 0 0       0 unless ($ftp) {
249 0         0 $CPAN::Frontend->mywarn(" Could not connect to host '$host' with Net::FTP\n");
250 0         0 return;
251             }
252 0 0       0 return 0 unless defined $ftp;
253 0 0       0 $ftp->debug(1) if $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG;
254 0         0 $class->debug(qq[Going to login("anonymous","$Config::Config{cf_email}")]);
255 0 0       0 unless ( $ftp->login("anonymous",$Config::Config{'cf_email'}) ) {
256 0         0 my $msg = $ftp->message;
257 0         0 $CPAN::Frontend->mywarn(" Couldn't login on $host: $msg\n");
258 0         0 return;
259             }
260 0 0       0 unless ( $ftp->cwd($dir) ) {
261 0         0 my $msg = $ftp->message;
262 0         0 $CPAN::Frontend->mywarn(" Couldn't cwd $dir: $msg\n");
263 0         0 return;
264             }
265 0         0 $ftp->binary;
266 0 0       0 $class->debug(qq[Going to ->get("$file","$target")\n]) if $CPAN::DEBUG;
267 0 0       0 unless ( $ftp->get($file,$target) ) {
268 0         0 my $msg = $ftp->message;
269 0         0 $CPAN::Frontend->mywarn(" Couldn't fetch $file from $host: $msg\n");
270 0         0 return;
271             }
272 0         0 $ftp->quit; # it's ok if this fails
273 0         0 return 1;
274             }
275              
276             # If more accuracy is wanted/needed, Chris Leach sent me this patch...
277              
278             # > *** /install/perl/live/lib/CPAN.pm- Wed Sep 24 13:08:48 1997
279             # > --- /tmp/cp Wed Sep 24 13:26:40 1997
280             # > ***************
281             # > *** 1562,1567 ****
282             # > --- 1562,1580 ----
283             # > return 1 if substr($url,0,4) eq "file";
284             # > return 1 unless $url =~ m|://([^/]+)|;
285             # > my $host = $1;
286             # > + my $proxy = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'};
287             # > + if ($proxy) {
288             # > + $proxy =~ m|://([^/:]+)|;
289             # > + $proxy = $1;
290             # > + my $noproxy = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'};
291             # > + if ($noproxy) {
292             # > + if ($host !~ /$noproxy$/) {
293             # > + $host = $proxy;
294             # > + }
295             # > + } else {
296             # > + $host = $proxy;
297             # > + }
298             # > + }
299             # > require Net::Ping;
300             # > return 1 unless $Net::Ping::VERSION >= 2;
301             # > my $p;
302              
303              
304             #-> sub CPAN::FTP::localize ;
305             sub localize {
306 3     3 0 13 my($self,$file,$aslocal,$force,$with_defaults) = @_;
307 3   50     11 $force ||= 0;
308 3 50       10 Carp::croak( "Usage: ->localize(cpan_file,as_local_file[,\$force])" )
309             unless defined $aslocal;
310 3 50       10 if ($CPAN::DEBUG){
311 0         0 require Carp;
312 0         0 my $longmess = Carp::longmess();
313 0         0 $self->debug("file[$file] aslocal[$aslocal] force[$force] carplongmess[$longmess]");
314             }
315 3 50       30 if ($^O eq 'MacOS') {
316             # Comment by AK on 2000-09-03: Uniq short filenames would be
317             # available in CHECKSUMS file
318 0         0 my($name, $path) = File::Basename::fileparse($aslocal, '');
319 0 0       0 if (length($name) > 31) {
320 0         0 $name =~ s/(
321             \.(
322             readme(\.(gz|Z))? |
323             (tar\.)?(gz|Z) |
324             tgz |
325             zip |
326             pm\.(gz|Z)
327             )
328             )$//x;
329 0         0 my $suf = $1;
330 0         0 my $size = 31 - length($suf);
331 0         0 while (length($name) > $size) {
332 0         0 chop $name;
333             }
334 0         0 $name .= $suf;
335 0         0 $aslocal = File::Spec->catfile($path, $name);
336             }
337             }
338              
339 3 0 33     38 if (-f $aslocal && -r _ && !($force & 1)) {
      33        
340 0         0 my $size;
341 0 0       0 if ($size = -s $aslocal) {
342 0 0       0 $self->debug("aslocal[$aslocal]size[$size]") if $CPAN::DEBUG;
343 0         0 return $aslocal;
344             } else {
345             # empty file from a previous unsuccessful attempt to download it
346 0 0       0 unlink $aslocal or
347             $CPAN::Frontend->mydie("Found a zero-length '$aslocal' that I ".
348             "could not remove.");
349             }
350             }
351 3         12 my($maybe_restore) = 0;
352 3 50       33 if (-f $aslocal) {
353 0         0 rename $aslocal, "$aslocal.bak$$";
354 0         0 $maybe_restore++;
355             }
356              
357 3         265 my($aslocal_dir) = dirname($aslocal);
358             # Inheritance is not easier to manage than a few if/else branches
359 3 50       28 if ($CPAN::META->has_usable('LWP::UserAgent')) {
360 0 0       0 unless ($Ua) {
361 0         0 CPAN::LWP::UserAgent->config;
362 0         0 eval {$Ua = CPAN::LWP::UserAgent->new;}; # Why is has_usable still not fit enough?
  0         0  
363 0 0       0 if ($@) {
364 0 0       0 $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n")
365             if $CPAN::DEBUG;
366             } else {
367 0         0 my($var);
368             $Ua->proxy('ftp', $var)
369 0 0 0     0 if $var = $CPAN::Config->{ftp_proxy} || $ENV{ftp_proxy};
370             $Ua->proxy('http', $var)
371 0 0 0     0 if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
372             $Ua->no_proxy($var)
373 0 0 0     0 if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
374             }
375             }
376             }
377 3         16 for my $prx (qw(ftp_proxy http_proxy no_proxy)) {
378 9 50       25 $ENV{$prx} = $CPAN::Config->{$prx} if $CPAN::Config->{$prx};
379             }
380              
381             # Try the list of urls for each single object. We keep a record
382             # where we did get a file from
383 3         7 my(@reordered,$last);
384 3         16 my $ccurllist = $self->_get_urllist($with_defaults);
385 3         9 $last = $#$ccurllist;
386 3 50       11 if ($force & 2) { # local cpans probably out of date, don't reorder
387 3         13 @reordered = (0..$last);
388             } else {
389             @reordered =
390             sort {
391 0 0 0     0 (substr($ccurllist->[$b],0,4) eq "file")
  0         0  
392             <=>
393             (substr($ccurllist->[$a],0,4) eq "file")
394             or
395             defined($ThesiteURL)
396             and
397             ($ccurllist->[$b] eq $ThesiteURL)
398             <=>
399             ($ccurllist->[$a] eq $ThesiteURL)
400             } 0..$last;
401             }
402 3         5 my(@levels);
403 3   100     21 $Themethod ||= "";
404 3 50       14 $self->debug("Themethod[$Themethod]reordered[@reordered]") if $CPAN::DEBUG;
405 3         47 my @all_levels = (
406             ["dleasy", "file"],
407             ["dleasy"],
408             ["dlhard"],
409             ["dlhardest"],
410             ["dleasy", "http","defaultsites"],
411             ["dlhard", "http","defaultsites"],
412             ["dleasy", "ftp", "defaultsites"],
413             ["dlhard", "ftp", "defaultsites"],
414             ["dlhardest","", "defaultsites"],
415             );
416 3 100       12 if ($Themethod) {
417 2         5 @levels = grep {$_->[0] eq $Themethod} @all_levels;
  18         32  
418 2         7 push @levels, grep {$_->[0] ne $Themethod} @all_levels;
  18         35  
419             } else {
420 1         3 @levels = @all_levels;
421             }
422 3 50       23 @levels = qw/dleasy/ if $^O eq 'MacOS';
423 3         8 my($levelno);
424             local $ENV{FTP_PASSIVE} =
425             exists $CPAN::Config->{ftp_passive} ?
426 3 50       42 $CPAN::Config->{ftp_passive} : 1;
427 3         8 my $ret;
428 3         23 my $stats = $self->_new_stats($file);
429 3         12 for ($CPAN::Config->{connect_to_internet_ok}) {
430 3 50 33     29 $connect_to_internet_ok = $_ if not defined $connect_to_internet_ok and defined $_;
431             }
432 3         13 LEVEL: for $levelno (0..$#levels) {
433 3         11 my $level_tuple = $levels[$levelno];
434 3         14 my($level,$scheme,$sitetag) = @$level_tuple;
435 3 50 33     34 $self->mymkpath($aslocal_dir) unless $scheme && "file" eq $scheme;
436 3   33     12 my $defaultsites = $sitetag && $sitetag eq "defaultsites" && !@$ccurllist;
437 3         5 my @urllist;
438 3 50       10 if ($defaultsites) {
439 0 0       0 unless (defined $connect_to_internet_ok) {
440             $CPAN::Frontend->myprint(sprintf qq{
441             I would like to connect to one of the following sites to get '%s':
442              
443             %s
444             },
445             $file,
446 0         0 join("",map { " ".$_->text."\n" } @CPAN::Defaultsites),
  0         0  
447             );
448 0         0 my $answer = CPAN::Shell::colorable_makemaker_prompt("Is it OK to try to connect to the Internet?", "yes");
449 0 0       0 if ($answer =~ /^y/i) {
450 0         0 $connect_to_internet_ok = 1;
451             } else {
452 0         0 $connect_to_internet_ok = 0;
453             }
454             }
455 0 0       0 if ($connect_to_internet_ok) {
456 0         0 @urllist = @CPAN::Defaultsites;
457             } else {
458 0         0 my $sleep = 2;
459             # the tricky thing about dying here is that everybody
460             # believes that calls to exists() or all_objects() are
461             # safe.
462 0         0 require CPAN::Exception::blocked_urllist;
463 0         0 die CPAN::Exception::blocked_urllist->new;
464             }
465             } else { # ! $defaultsites
466 3 50       28 my @host_seq = $level =~ /dleasy/ ?
467             @reordered : 0..$last; # reordered has file and $Thesiteurl first
468 3         8 @urllist = map { $ccurllist->[$_] } @host_seq;
  3         25  
469             }
470 3 50       10 $self->debug("synth. urllist[@urllist]") if $CPAN::DEBUG;
471 3         17 my $aslocal_tempfile = $aslocal . ".tmp" . $$;
472 3 50       19 if (my $recommend = $self->_recommend_url_for($file,\@urllist)) {
473 0         0 @urllist = grep { $_ ne $recommend } @urllist;
  0         0  
474 0         0 unshift @urllist, $recommend;
475             }
476 3 50       9 $self->debug("synth. urllist[@urllist]") if $CPAN::DEBUG;
477 3         22 $ret = $self->hostdlxxx($level,$scheme,\@urllist,$file,$aslocal_tempfile,$stats);
478 3 50       10 if ($ret) {
479 3 50       11 CPAN->debug("ret[$ret]aslocal[$aslocal]") if $CPAN::DEBUG;
480 3 50 33     68 if ($ret eq $aslocal_tempfile) {
    50          
481             # if we got it exactly as we asked for, only then we
482             # want to rename
483 0 0       0 rename $aslocal_tempfile, $aslocal
484             or $CPAN::Frontend->mydie("Error while trying to rename ".
485             "'$ret' to '$aslocal': $!");
486 0         0 $ret = $aslocal;
487             }
488             elsif (-f $ret && $scheme eq 'file' ) {
489             # it's a local file, so there's nothing left to do, we
490             # let them read from where it is
491             }
492 3         9 $Themethod = $level;
493 3         8 my $now = time;
494             # utime $now, $now, $aslocal; # too bad, if we do that, we
495             # might alter a local mirror
496 3 50       8 $self->debug("level[$level]") if $CPAN::DEBUG;
497 3         13 last LEVEL;
498             } else {
499 0         0 unlink $aslocal_tempfile;
500 0 0       0 last if $CPAN::Signal; # need to cleanup
501             }
502             }
503 3 50       9 if ($ret) {
504 3         43 $stats->{filesize} = -s $ret;
505             }
506 3 50       14 $self->debug("before _add_to_statistics") if $CPAN::DEBUG;
507 3         18 $self->_add_to_statistics($stats);
508 3 50       11 $self->debug("after _add_to_statistics") if $CPAN::DEBUG;
509 3 50       10 if ($ret) {
510 3         40 unlink "$aslocal.bak$$";
511 3         53 return $ret;
512             }
513 0 0       0 unless ($CPAN::Signal) {
514 0         0 my(@mess);
515 0         0 local $" = " ";
516 0 0       0 if (@{$CPAN::Config->{urllist}}) {
  0         0  
517             push @mess,
518             qq{Please check, if the URLs I found in your configuration file \(}.
519 0         0 join(", ", @{$CPAN::Config->{urllist}}).
  0         0  
520             qq{\) are valid.};
521             } else {
522 0         0 push @mess, qq{Your urllist is empty!};
523             }
524 0         0 push @mess, qq{The urllist can be edited.},
525             qq{E.g. with 'o conf urllist push ftp://myurl/'};
526 0         0 $CPAN::Frontend->mywarn(Text::Wrap::wrap("","","@mess"). "\n\n");
527 0         0 $CPAN::Frontend->mydie("Could not fetch $file\n");
528             }
529 0 0       0 if ($maybe_restore) {
530 0         0 rename "$aslocal.bak$$", $aslocal;
531 0         0 $CPAN::Frontend->myprint("Trying to get away with old file:\n" .
532             $self->ls($aslocal) . "\n");
533 0         0 return $aslocal;
534             }
535 0         0 return;
536             }
537              
538             sub mymkpath {
539 0     0 0 0 my($self, $aslocal_dir) = @_;
540 0         0 mkpath($aslocal_dir);
541 0 0       0 $CPAN::Frontend->mywarn(qq{Warning: You are not allowed to write into }.
542             qq{directory "$aslocal_dir".
543             I\'ll continue, but if you encounter problems, they may be due
544             to insufficient permissions.\n}) unless -w $aslocal_dir;
545             }
546              
547             sub hostdlxxx {
548 3     3 0 7 my $self = shift;
549 3         7 my $level = shift;
550 3         6 my $scheme = shift;
551 3         5 my $h = shift;
552 3 50       85 $h = [ grep /^\Q$scheme\E:/, @$h ] if $scheme;
553 3         8 my $method = "host$level";
554 3         24 $self->$method($h, @_);
555             }
556              
557             sub _set_attempt {
558 3     3   18 my($self,$stats,$method,$url) = @_;
559 3         6 push @{$stats->{attempts}}, {
  3         13  
560             method => $method,
561             start => _mytime,
562             url => $url,
563             };
564             }
565              
566             # package CPAN::FTP;
567             sub hostdleasy { #called from hostdlxxx
568 3     3 0 13 my($self,$host_seq,$file,$aslocal,$stats) = @_;
569 3         10 my($ro_url);
570 3         22 HOSTEASY: for $ro_url (@$host_seq) {
571 3         19 $self->_set_attempt($stats,"dleasy",$ro_url);
572 3         13 my $url = "$ro_url$file";
573 3 50       11 $self->debug("localizing perlish[$url]") if $CPAN::DEBUG;
574 3 50       16 if ($url =~ /^file:/) {
575 3         5 my $l;
576 3 50       10 if ($CPAN::META->has_inst('URI::URL')) {
577 3         28 my $u = URI::URL->new($url);
578 3         6894 $l = $u->file;
579             } else { # works only on Unix, is poorly constructed, but
580             # hopefully better than nothing.
581             # RFC 1738 says fileurl BNF is
582             # fileurl = "file://" [ host | "localhost" ] "/" fpath
583             # Thanks to "Mark D. Baushke" for
584             # the code
585 0         0 ($l = $url) =~ s|^file://[^/]*/|/|; # discard the host part
586 0         0 $l =~ s|^file:||; # assume they
587             # meant
588             # file://localhost
589 0 0 0     0 $l =~ s|^/||s
590             if ! -f $l && $l =~ m|^/\w:|; # e.g. /P:
591             }
592 3 50       2788 $self->debug("local file[$l]") if $CPAN::DEBUG;
593 3 50 33     106 if ( -f $l && -r _) {
594 0         0 $ThesiteURL = $ro_url;
595 0         0 return $l;
596             }
597             # If request is for a compressed file and we can find the
598             # uncompressed file also, return the path of the uncompressed file
599             # otherwise, decompress it and return the resulting path
600 3 50 0     35 if ($l =~ /(.+)\.gz$/) {
    0          
    0          
601 3         13 my $ungz = $1;
602 3 50 33     85 if ( -f $ungz && -r _) {
    0 0        
603 3         11 $ThesiteURL = $ro_url;
604 3         36 return $ungz;
605             }
606             elsif (-f $l && -r _) {
607 0         0 eval { CPAN::Tarzip->new($l)->gunzip($aslocal) };
  0         0  
608 0 0 0     0 if ( -f $aslocal && -s _) {
    0          
    0          
609 0         0 $ThesiteURL = $ro_url;
610 0         0 return $aslocal;
611             }
612             elsif (! -s $aslocal) {
613 0         0 unlink $aslocal;
614             }
615             elsif (-f $l) {
616 0 0       0 $CPAN::Frontend->mywarn("Error decompressing '$l': $@\n")
617             if $@;
618 0         0 return;
619             }
620             }
621             }
622             # Otherwise, return the local file path if it exists
623             elsif ( -f $l && -r _) {
624 0         0 $ThesiteURL = $ro_url;
625 0         0 return $l;
626             }
627             # If we can't find it, but there is a compressed version
628             # of it, then decompress it
629             elsif (-f "$l.gz") {
630 0 0       0 $self->debug("found compressed $l.gz") if $CPAN::DEBUG;
631 0         0 eval { CPAN::Tarzip->new("$l.gz")->gunzip($aslocal) };
  0         0  
632 0 0       0 if ( -f $aslocal) {
633 0         0 $ThesiteURL = $ro_url;
634 0         0 return $aslocal;
635             }
636             else {
637 0 0       0 $CPAN::Frontend->mywarn("Error decompressing '$l': $@\n")
638             if $@;
639 0         0 return;
640             }
641             }
642 0         0 $CPAN::Frontend->mywarn("Could not find '$l'\n");
643             }
644 0 0       0 $self->debug("it was not a file URL") if $CPAN::DEBUG;
645 0 0 0     0 if ($CPAN::META->has_usable('LWP')) {
    0          
646 0         0 $CPAN::Frontend->myprint("Fetching with LWP:\n$url\n");
647 0 0       0 unless ($Ua) {
648 0         0 CPAN::LWP::UserAgent->config;
649 0         0 eval { $Ua = CPAN::LWP::UserAgent->new; };
  0         0  
650 0 0       0 if ($@) {
651 0         0 $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n");
652             }
653             }
654 0         0 my $res = $Ua->mirror($url, $aslocal);
655 0 0       0 if ($res->is_success) {
    0          
656 0         0 $ThesiteURL = $ro_url;
657 0         0 my $now = time;
658 0         0 utime $now, $now, $aslocal; # download time is more
659             # important than upload
660             # time
661 0         0 return $aslocal;
662             } elsif ($url !~ /\.gz(?!\n)\Z/) {
663 0         0 my $gzurl = "$url.gz";
664 0         0 $CPAN::Frontend->myprint("Fetching with LWP:\n$gzurl\n");
665 0         0 $res = $Ua->mirror($gzurl, "$aslocal.gz");
666 0 0       0 if ($res->is_success) {
667 0 0       0 if (eval {CPAN::Tarzip->new("$aslocal.gz")->gunzip($aslocal)}) {
  0         0  
668 0         0 $ThesiteURL = $ro_url;
669 0         0 return $aslocal;
670             }
671             }
672             } else {
673 0         0 $CPAN::Frontend->myprint(sprintf(
674             "LWP failed with code[%s] message[%s]\n",
675             $res->code,
676             $res->message,
677             ));
678             # Alan Burlison informed me that in firewall environments
679             # Net::FTP can still succeed where LWP fails. So we do not
680             # skip Net::FTP anymore when LWP is available.
681             }
682             } elsif ($url =~ /^http:/i && $CPAN::META->has_usable('HTTP::Tiny')) {
683 0         0 require CPAN::HTTP::Client;
684             my $chc = CPAN::HTTP::Client->new(
685             proxy => $CPAN::Config->{http_proxy} || $ENV{http_proxy},
686             no_proxy => $CPAN::Config->{no_proxy} || $ENV{no_proxy},
687 0   0     0 );
      0        
688 0 0       0 for my $try ( $url, ( $url !~ /\.gz(?!\n)\Z/ ? "$url.gz" : () ) ) {
689 0         0 $CPAN::Frontend->myprint("Fetching with HTTP::Tiny:\n$try\n");
690 0         0 my $res = eval { $chc->mirror($try, $aslocal) };
  0         0  
691 0 0 0     0 if ( $res && $res->{success} ) {
    0 0        
    0 0        
692 0         0 $ThesiteURL = $ro_url;
693 0         0 my $now = time;
694 0         0 utime $now, $now, $aslocal; # download time is more
695             # important than upload
696             # time
697 0         0 return $aslocal;
698             }
699             elsif ( $res && $res->{status} ne '599') {
700             $CPAN::Frontend->myprint(sprintf(
701             "HTTP::Tiny failed with code[%s] message[%s]\n",
702             $res->{status},
703             $res->{reason},
704             )
705 0         0 );
706             }
707             elsif ( $res && $res->{status} eq '599') {
708             $CPAN::Frontend->myprint(sprintf(
709             "HTTP::Tiny failed with an internal error: %s\n",
710             $res->{content},
711             )
712 0         0 );
713             }
714             else {
715 0   0     0 my $err = $@ || 'Unknown error';
716 0         0 $CPAN::Frontend->myprint(sprintf(
717             "Error downloading with HTTP::Tiny: %s\n", $err
718             )
719             );
720             }
721             }
722             }
723 0 0       0 return if $CPAN::Signal;
724 0 0       0 if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
725             # that's the nice and easy way thanks to Graham
726 0 0       0 $self->debug("recognized ftp") if $CPAN::DEBUG;
727 0         0 my($host,$dir,$getfile) = ($1,$2,$3);
728 0 0       0 if ($CPAN::META->has_usable('Net::FTP')) {
729 0         0 $dir =~ s|/+|/|g;
730 0         0 $CPAN::Frontend->myprint("Fetching with Net::FTP:\n$url\n");
731 0 0       0 $self->debug("getfile[$getfile]dir[$dir]host[$host]" .
732             "aslocal[$aslocal]") if $CPAN::DEBUG;
733 0 0       0 if (CPAN::FTP->ftp_get($host,$dir,$getfile,$aslocal)) {
734 0         0 $ThesiteURL = $ro_url;
735 0         0 return $aslocal;
736             }
737 0 0       0 if ($aslocal !~ /\.gz(?!\n)\Z/) {
738 0         0 my $gz = "$aslocal.gz";
739 0         0 $CPAN::Frontend->myprint("Fetching with Net::FTP\n$url.gz\n");
740 0 0 0     0 if (CPAN::FTP->ftp_get($host,
741             $dir,
742             "$getfile.gz",
743             $gz) &&
744 0         0 eval{CPAN::Tarzip->new($gz)->gunzip($aslocal)}
745             ) {
746 0         0 $ThesiteURL = $ro_url;
747 0         0 return $aslocal;
748             }
749             }
750             # next HOSTEASY;
751             } else {
752 0 0       0 CPAN->debug("Net::FTP does not count as usable atm") if $CPAN::DEBUG;
753             }
754             }
755 0 0 0     0 if (
756             UNIVERSAL::can($ro_url,"text")
757             and
758             $ro_url->{FROM} eq "USER"
759             ) {
760             ##address #17973: default URLs should not try to override
761             ##user-defined URLs just because LWP is not available
762 0         0 my $ret = $self->hostdlhard([$ro_url],$file,$aslocal,$stats);
763 0 0       0 return $ret if $ret;
764             }
765 0 0       0 return if $CPAN::Signal;
766             }
767             }
768              
769             # package CPAN::FTP;
770             sub hostdlhard {
771 0     0 0 0 my($self,$host_seq,$file,$aslocal,$stats) = @_;
772              
773             # Came back if Net::FTP couldn't establish connection (or
774             # failed otherwise) Maybe they are behind a firewall, but they
775             # gave us a socksified (or other) ftp program...
776              
777 0         0 my($ro_url);
778 0   0     0 my($devnull) = $CPAN::Config->{devnull} || "";
779             # < /dev/null ";
780 0         0 my($aslocal_dir) = dirname($aslocal);
781 0         0 mkpath($aslocal_dir);
782 0         0 my $some_dl_success = 0;
783 0         0 my $any_attempt = 0;
784 0         0 HOSTHARD: for $ro_url (@$host_seq) {
785 0         0 $self->_set_attempt($stats,"dlhard",$ro_url);
786 0         0 my $url = "$ro_url$file";
787 0         0 my($proto,$host,$dir,$getfile);
788              
789             # Courtesy Mark Conty mark_conty@cargill.com change from
790             # if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
791             # to
792 0 0       0 if ($url =~ m|^([^:]+)://(.*?)/(.*)/(.*)|) {
793             # proto not yet used
794 0         0 ($proto,$host,$dir,$getfile) = ($1,$2,$3,$4);
795             } else {
796 0         0 next HOSTHARD; # who said, we could ftp anything except ftp?
797             }
798 0 0       0 next HOSTHARD if $proto eq "file"; # file URLs would have had
799             # success above. Likely a bogus URL
800              
801             # making at least one attempt against a host
802 0         0 $any_attempt++;
803              
804 0 0       0 $self->debug("localizing funkyftpwise[$url]") if $CPAN::DEBUG;
805              
806             # Try the most capable first and leave ncftp* for last as it only
807             # does FTP.
808 0         0 my $proxy_vars = $self->_proxy_vars($ro_url);
809 0         0 DLPRG: for my $f (qw(curl wget lynx ncftpget ncftp)) {
810 0         0 my $funkyftp = CPAN::HandleConfig->safe_quote($CPAN::Config->{$f});
811 0 0       0 next DLPRG unless defined $funkyftp;
812 0 0       0 next DLPRG if $funkyftp =~ /^\s*$/;
813              
814 0         0 my($src_switch) = "";
815 0         0 my($chdir) = "";
816 0         0 my($stdout_redir) = " > \"$aslocal\"";
817 0 0       0 if ($f eq "lynx") {
    0          
    0          
    0          
    0          
818 0         0 $src_switch = " -source";
819             } elsif ($f eq "ncftp") {
820 0 0       0 next DLPRG unless $url =~ m{\Aftp://};
821 0         0 $src_switch = " -c";
822             } elsif ($f eq "wget") {
823 0         0 $src_switch = " -O \"$aslocal\"";
824 0         0 $stdout_redir = "";
825             } elsif ($f eq 'curl') {
826 0         0 $src_switch = ' -L -f -s -S --netrc-optional';
827 0 0       0 if ($proxy_vars->{http_proxy}) {
828 0         0 $src_switch .= qq{ -U "$proxy_vars->{proxy_user}:$proxy_vars->{proxy_pass}" -x "$proxy_vars->{http_proxy}"};
829             }
830             } elsif ($f eq "ncftpget") {
831 0 0       0 next DLPRG unless $url =~ m{\Aftp://};
832 0         0 $chdir = "cd $aslocal_dir && ";
833 0         0 $stdout_redir = "";
834             }
835             $CPAN::Frontend->myprint(
836 0         0 qq[
837             Trying with
838             $funkyftp$src_switch
839             to get
840             $url
841             ]);
842 0         0 my($system) =
843             "$chdir$funkyftp$src_switch \"$url\" $devnull$stdout_redir";
844 0 0       0 $self->debug("system[$system]") if $CPAN::DEBUG;
845 0         0 my($wstatus) = system($system);
846 0 0       0 if ($f eq "lynx") {
847             # lynx returns 0 when it fails somewhere
848 0 0       0 if (-s $aslocal) {
849 0         0 my $content = do { local *FH;
  0         0  
850 0 0       0 open FH, $aslocal or die;
851 0         0 local $/;
852 0         0 };
853 0 0       0 if ($content =~ /^<.*([45]|Error [45])/si) { </td> </tr> <tr> <td class="h" > <a name="854">854</a> </td> <td class="c0" > <a href="#858"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> $CPAN::Frontend->mywarn(qq{ </td> </tr> <tr> <td class="h" > <a name="855">855</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> No success, the file that lynx has downloaded looks like an error message: </td> </tr> <tr> <td class="h" > <a name="856">856</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $content </td> </tr> <tr> <td class="h" > <a name="857">857</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> }); </td> </tr> <tr> <td class="h" > <a name="858">858</a> </td> <td class="c0" > <a href="#859"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> $CPAN::Frontend->mysleep(1); </td> </tr> <tr> <td class="h" > <a name="859">859</a> </td> <td class="c0" > <a href="#861"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> next DLPRG; </td> </tr> <tr> <td class="h" > <a name="860">860</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="861">861</a> </td> <td class="c0" > <a href="#863"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> $some_dl_success++; </td> </tr> <tr> <td class="h" > <a name="862">862</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } else { </td> </tr> <tr> <td class="h" > <a name="863">863</a> </td> <td class="c0" > <a href="#866"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> $CPAN::Frontend->myprint(qq{ </td> </tr> <tr> <td class="h" > <a name="864">864</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> No success, the file that lynx has downloaded is an empty file. </td> </tr> <tr> <td class="h" > <a name="865">865</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> }); </td> </tr> <tr> <td class="h" > <a name="866">866</a> </td> <td class="c0" > <a href="#869"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> next DLPRG; </td> </tr> <tr> <td class="h" > <a name="867">867</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="868">868</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="869">869</a> </td> <td class="c0" > <a href="#870"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#869-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> if ($wstatus == 0) { </td> </tr> <tr> <td class="h" > <a name="870">870</a> </td> <td class="c0" > <a href="#872"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#870-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> if (-s $aslocal) { </td> </tr> <tr> <td class="h" > <a name="871">871</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # Looks good </td> </tr> <tr> <td class="h" > <a name="872">872</a> </td> <td class="c0" > <a href="#874"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> $some_dl_success++; </td> </tr> <tr> <td class="h" > <a name="873">873</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="874">874</a> </td> <td class="c0" > <a href="#875"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> $ThesiteURL = $ro_url; </td> </tr> <tr> <td class="h" > <a name="875">875</a> </td> <td class="c0" > <a href="#877"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> return $aslocal; </td> </tr> <tr> <td class="h" > <a name="876">876</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } else { </td> </tr> <tr> <td class="h" > <a name="877">877</a> </td> <td class="c0" > <a href="#878"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> my $estatus = $wstatus >> 8; </td> </tr> <tr> <td class="h" > <a name="878">878</a> </td> <td class="c0" > <a href="#881"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#878-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> my $size = -f $aslocal ? </td> </tr> <tr> <td class="h" > <a name="879">879</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ", left\n$aslocal with size ".-s _ : </td> </tr> <tr> <td class="h" > <a name="880">880</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> "\nWarning: expected file [$aslocal] doesn't exist"; </td> </tr> <tr> <td class="h" > <a name="881">881</a> </td> <td class="c0" > <a href="#886"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> $CPAN::Frontend->myprint(qq{ </td> </tr> <tr> <td class="h" > <a name="882">882</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Function system("$system") </td> </tr> <tr> <td class="h" > <a name="883">883</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> returned status $estatus (wstat $wstatus)$size </td> </tr> <tr> <td class="h" > <a name="884">884</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> }); </td> </tr> <tr> <td class="h" > <a name="885">885</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="886">886</a> </td> <td class="c0" > <a href="#889"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#886-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> return if $CPAN::Signal; </td> </tr> <tr> <td class="h" > <a name="887">887</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } # download/transfer programs (DLPRG) </td> </tr> <tr> <td class="h" > <a name="888">888</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } # host </td> </tr> <tr> <td class="h" > <a name="889">889</a> </td> <td class="c0" > <a href="#890"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#889-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> return unless $any_attempt; </td> </tr> <tr> <td class="h" > <a name="890">890</a> </td> <td class="c0" > <a href="#891"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#890-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> if ($some_dl_success) { </td> </tr> <tr> <td class="h" > <a name="891">891</a> </td> <td class="c0" > <a href="#893"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> $CPAN::Frontend->mywarn("Warning: doesn't seem we had substantial success downloading '$aslocal'. Don't know how to proceed.\n"); </td> </tr> <tr> <td class="h" > <a name="892">892</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } else { </td> </tr> <tr> <td class="h" > <a name="893">893</a> </td> <td class="c0" > <a href="#895"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> $CPAN::Frontend->mywarn("Warning: no success downloading '$aslocal'. Giving up on it.\n"); </td> </tr> <tr> <td class="h" > <a name="894">894</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="895">895</a> </td> <td class="c0" > <a href="#916"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> return; </td> </tr> <tr> <td class="h" > <a name="896">896</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="897">897</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="898">898</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> #-> CPAN::FTP::_proxy_vars </td> </tr> <tr> <td class="h" > <a name="899">899</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> sub _proxy_vars { </td> </tr> <tr> <td class="h" > <a name="900">900</a> </td> <td class="c3" > 2 </td> <td >   </td> <td >   </td> <td class="c3" > <a href="blib-lib-CPAN-FTP-pm--subroutine.html#900-1"> 2 </a> </td> <td >   </td> <td > 4863 </td> <td class="s"> my($self,$url) = @_; </td> </tr> <tr> <td class="h" > <a name="901">901</a> </td> <td class="c3" > 2 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 5 </td> <td class="s"> my $ret = +{}; </td> </tr> <tr> <td class="h" > <a name="902">902</a> </td> <td class="c3" > 2 </td> <td >   </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--condition.html#902-1"> 33 </a> </td> <td >   </td> <td >   </td> <td > 9 </td> <td class="s"> my $http_proxy = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'}; </td> </tr> <tr> <td class="h" > <a name="903">903</a> </td> <td class="c3" > 2 </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#903-1"> 50 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td > 7 </td> <td class="s"> if ($http_proxy) { </td> </tr> <tr> <td class="h" > <a name="904">904</a> </td> <td class="c3" > 2 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 16 </td> <td class="s"> my($host) = $url =~ m|://([^/:]+)|; </td> </tr> <tr> <td class="h" > <a name="905">905</a> </td> <td class="c3" > 2 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 6 </td> <td class="s"> my $want_proxy = 1; </td> </tr> <tr> <td class="h" > <a name="906">906</a> </td> <td class="c3" > 2 </td> <td >   </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--condition.html#906-1"> 0 </a> </td> <td >   </td> <td >   </td> <td > 6 </td> <td class="s"> my $noproxy = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'} || ""; </td> </tr> <tr> <td class="h" > <a name="907">907</a> </td> <td class="c3" > 2 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 9 </td> <td class="s"> my @noproxy = split /\s*,\s*/, $noproxy; </td> </tr> <tr> <td class="h" > <a name="908">908</a> </td> <td class="c3" > 2 </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#908-1"> 50 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td > 5 </td> <td class="s"> if ($host) { </td> </tr> <tr> <td class="h" > <a name="909">909</a> </td> <td class="c3" > 2 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 10 </td> <td class="s"> DOMAIN: for my $domain (@noproxy) { </td> </tr> <tr> <td class="h" > <a name="910">910</a> </td> <td class="c3" > 2 </td> <td class="c3" > <a href="blib-lib-CPAN-FTP-pm--branch.html#910-1"> 100 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td > 48 </td> <td class="s"> if ($host =~ /\Q$domain\E$/) { # cf. LWP::UserAgent </td> </tr> <tr> <td class="h" > <a name="911">911</a> </td> <td class="c3" > 1 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 5 </td> <td class="s"> $want_proxy = 0; </td> </tr> <tr> <td class="h" > <a name="912">912</a> </td> <td class="c3" > 1 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 3 </td> <td class="s"> last DOMAIN; </td> </tr> <tr> <td class="h" > <a name="913">913</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="914">914</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="915">915</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } else { </td> </tr> <tr> <td class="h" > <a name="916">916</a> </td> <td class="c0" > <a href="#933"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> $CPAN::Frontend->mywarn(" Could not determine host from http_proxy '$http_proxy'\n"); </td> </tr> <tr> <td class="h" > <a name="917">917</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="918">918</a> </td> <td class="c3" > 2 </td> <td class="c3" > <a href="blib-lib-CPAN-FTP-pm--branch.html#918-1"> 100 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td > 7 </td> <td class="s"> if ($want_proxy) { </td> </tr> <tr> <td class="h" > <a name="919">919</a> </td> <td class="c3" > 1 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 15 </td> <td class="s"> my($user, $pass) = </td> </tr> <tr> <td class="h" > <a name="920">920</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> CPAN::HTTP::Credentials->get_proxy_credentials(); </td> </tr> <tr> <td class="h" > <a name="921">921</a> </td> <td class="c3" > 1 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 6 </td> <td class="s"> $ret = { </td> </tr> <tr> <td class="h" > <a name="922">922</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> proxy_user => $user, </td> </tr> <tr> <td class="h" > <a name="923">923</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> proxy_pass => $pass, </td> </tr> <tr> <td class="h" > <a name="924">924</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> http_proxy => $http_proxy </td> </tr> <tr> <td class="h" > <a name="925">925</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> }; </td> </tr> <tr> <td class="h" > <a name="926">926</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="927">927</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="928">928</a> </td> <td class="c3" > 2 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 7 </td> <td class="s"> return $ret; </td> </tr> <tr> <td class="h" > <a name="929">929</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="930">930</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="931">931</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # package CPAN::FTP; </td> </tr> <tr> <td class="h" > <a name="932">932</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> sub hostdlhardest { </td> </tr> <tr> <td class="h" > <a name="933">933</a> </td> <td class="c0" > <a href="#935"> 0 </a> </td> <td >   </td> <td >   </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--subroutine.html#933-1"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--subroutine.html#933-1"> 0 </a> </td> <td >   </td> <td class="s"> my($self,$host_seq,$file,$aslocal,$stats) = @_; </td> </tr> <tr> <td class="h" > <a name="934">934</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="935">935</a> </td> <td class="c0" > <a href="#936"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#935-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> return unless @$host_seq; </td> </tr> <tr> <td class="h" > <a name="936">936</a> </td> <td class="c0" > <a href="#937"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my($ro_url); </td> </tr> <tr> <td class="h" > <a name="937">937</a> </td> <td class="c0" > <a href="#938"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my($aslocal_dir) = dirname($aslocal); </td> </tr> <tr> <td class="h" > <a name="938">938</a> </td> <td class="c0" > <a href="#939"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> mkpath($aslocal_dir); </td> </tr> <tr> <td class="h" > <a name="939">939</a> </td> <td class="c0" > <a href="#940"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $ftpbin = $CPAN::Config->{ftp}; </td> </tr> <tr> <td class="h" > <a name="940">940</a> </td> <td class="c0" > <a href="#941"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#940-1"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--condition.html#940-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> unless ($ftpbin && length $ftpbin && MM->maybe_command($ftpbin)) { </td> </tr> <tr> <td class="h" > <a > </a> </td> <td >   </td> <td >   </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--condition.html#-2"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="941">941</a> </td> <td class="c0" > <a href="#942"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $CPAN::Frontend->myprint("No external ftp command available\n\n"); </td> </tr> <tr> <td class="h" > <a name="942">942</a> </td> <td class="c0" > <a href="#944"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> return; </td> </tr> <tr> <td class="h" > <a name="943">943</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="944">944</a> </td> <td class="c0" > <a href="#957"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $CPAN::Frontend->mywarn(qq{ </td> </tr> <tr> <td class="h" > <a name="945">945</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> As a last resort we now switch to the external ftp command '$ftpbin' </td> </tr> <tr> <td class="h" > <a name="946">946</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> to get '$aslocal'. </td> </tr> <tr> <td class="h" > <a name="947">947</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="948">948</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Doing so often leads to problems that are hard to diagnose. </td> </tr> <tr> <td class="h" > <a name="949">949</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="950">950</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> If you're the victim of such problems, please consider unsetting the </td> </tr> <tr> <td class="h" > <a name="951">951</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ftp config variable with </td> </tr> <tr> <td class="h" > <a name="952">952</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="953">953</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> o conf ftp "" </td> </tr> <tr> <td class="h" > <a name="954">954</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> o conf commit </td> </tr> <tr> <td class="h" > <a name="955">955</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="956">956</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> }); </td> </tr> <tr> <td class="h" > <a name="957">957</a> </td> <td class="c0" > <a href="#958"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $CPAN::Frontend->mysleep(2); </td> </tr> <tr> <td class="h" > <a name="958">958</a> </td> <td class="c0" > <a href="#959"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> HOSTHARDEST: for $ro_url (@$host_seq) { </td> </tr> <tr> <td class="h" > <a name="959">959</a> </td> <td class="c0" > <a href="#960"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $self->_set_attempt($stats,"dlhardest",$ro_url); </td> </tr> <tr> <td class="h" > <a name="960">960</a> </td> <td class="c0" > <a href="#961"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $url = "$ro_url$file"; </td> </tr> <tr> <td class="h" > <a name="961">961</a> </td> <td class="c0" > <a href="#962"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#961-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $self->debug("localizing ftpwise[$url]") if $CPAN::DEBUG; </td> </tr> <tr> <td class="h" > <a name="962">962</a> </td> <td class="c0" > <a href="#963"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#962-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> unless ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) { </td> </tr> <tr> <td class="h" > <a name="963">963</a> </td> <td class="c0" > <a href="#965"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> next; </td> </tr> <tr> <td class="h" > <a name="964">964</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="965">965</a> </td> <td class="c0" > <a href="#966"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my($host,$dir,$getfile) = ($1,$2,$3); </td> </tr> <tr> <td class="h" > <a name="966">966</a> </td> <td class="c0" > <a href="#967"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $timestamp = 0; </td> </tr> <tr> <td class="h" > <a name="967">967</a> </td> <td class="c0" > <a href="#969"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime, </td> </tr> <tr> <td class="h" > <a name="968">968</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $ctime,$blksize,$blocks) = stat($aslocal); </td> </tr> <tr> <td class="h" > <a name="969">969</a> </td> <td class="c0" > <a href="#970"> 0 </a> </td> <td >   </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--condition.html#969-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $timestamp = $mtime ||= 0; </td> </tr> <tr> <td class="h" > <a name="970">970</a> </td> <td class="c0" > <a href="#971"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my($netrc) = CPAN::FTP::netrc->new; </td> </tr> <tr> <td class="h" > <a name="971">971</a> </td> <td class="c0" > <a href="#972"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my($netrcfile) = $netrc->netrc; </td> </tr> <tr> <td class="h" > <a name="972">972</a> </td> <td class="c0" > <a href="#973"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#972-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my($verbose) = $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG ? " -v" : ""; </td> </tr> <tr> <td class="h" > <a name="973">973</a> </td> <td class="c0" > <a href="#974"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $targetfile = File::Basename::basename($aslocal); </td> </tr> <tr> <td class="h" > <a name="974">974</a> </td> <td class="c0" > <a href="#975"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my(@dialog); </td> </tr> <tr> <td class="h" > <a name="975">975</a> </td> <td class="c0" > <a href="#985"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> push( </td> </tr> <tr> <td class="h" > <a name="976">976</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> @dialog, </td> </tr> <tr> <td class="h" > <a name="977">977</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> "lcd $aslocal_dir", </td> </tr> <tr> <td class="h" > <a name="978">978</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> "cd /", </td> </tr> <tr> <td class="h" > <a name="979">979</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> map("cd $_", split /\//, $dir), # RFC 1738 </td> </tr> <tr> <td class="h" > <a name="980">980</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> "bin", </td> </tr> <tr> <td class="h" > <a name="981">981</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> "passive", </td> </tr> <tr> <td class="h" > <a name="982">982</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> "get $getfile $targetfile", </td> </tr> <tr> <td class="h" > <a name="983">983</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> "quit" </td> </tr> <tr> <td class="h" > <a name="984">984</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ); </td> </tr> <tr> <td class="h" > <a name="985">985</a> </td> <td class="c0" > <a href="#986"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#985-1"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--condition.html#985-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if (! $netrcfile) { </td> </tr> <tr> <td class="h" > <a > </a> </td> <td >   </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#-2"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="986">986</a> </td> <td class="c0" > <a href="#988"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#986-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> CPAN->debug("No ~/.netrc file found") if $CPAN::DEBUG; </td> </tr> <tr> <td class="h" > <a name="987">987</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } elsif ($netrc->hasdefault || $netrc->contains($host)) { </td> </tr> <tr> <td class="h" > <a name="988">988</a> </td> <td class="c0" > <a href="#991"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#988-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> CPAN->debug(sprintf("hasdef[%d]cont($host)[%d]", </td> </tr> <tr> <td class="h" > <a name="989">989</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $netrc->hasdefault, </td> </tr> <tr> <td class="h" > <a name="990">990</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $netrc->contains($host))) if $CPAN::DEBUG; </td> </tr> <tr> <td class="h" > <a name="991">991</a> </td> <td class="c0" > <a href="#992"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#991-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if ($netrc->protected) { </td> </tr> <tr> <td class="h" > <a name="992">992</a> </td> <td class="c0" > <a href="# "> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $dialog = join "", map { " $_\n" } @dialog; </td> </tr> <tr> <td class="h" > <a > </a> </td> <td class="c0" > <a href="#993"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="993">993</a> </td> <td class="c0" > <a href="#994"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $netrc_explain; </td> </tr> <tr> <td class="h" > <a name="994">994</a> </td> <td class="c0" > <a href="#995"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#994-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if ($netrc->contains($host)) { </td> </tr> <tr> <td class="h" > <a name="995">995</a> </td> <td class="c0" > <a href="#998"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $netrc_explain = "Relying that your .netrc entry for '$host' ". </td> </tr> <tr> <td class="h" > <a name="996">996</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> "manages the login"; </td> </tr> <tr> <td class="h" > <a name="997">997</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } else { </td> </tr> <tr> <td class="h" > <a name="998">998</a> </td> <td class="c0" > <a href="#1001"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $netrc_explain = "Relying that your default .netrc entry ". </td> </tr> <tr> <td class="h" > <a name="999">999</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> "manages the login"; </td> </tr> <tr> <td class="h" > <a name="1000">1000</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="1001">1001</a> </td> <td class="c0" > <a href="#1009"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $CPAN::Frontend->myprint(qq{ </td> </tr> <tr> <td class="h" > <a name="1002">1002</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Trying with external ftp to get </td> </tr> <tr> <td class="h" > <a name="1003">1003</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> '$url' </td> </tr> <tr> <td class="h" > <a name="1004">1004</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $netrc_explain </td> </tr> <tr> <td class="h" > <a name="1005">1005</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Sending the dialog </td> </tr> <tr> <td class="h" > <a name="1006">1006</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $dialog </td> </tr> <tr> <td class="h" > <a name="1007">1007</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="1008">1008</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ); </td> </tr> <tr> <td class="h" > <a name="1009">1009</a> </td> <td class="c0" > <a href="#1011"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $self->talk_ftp("$ftpbin$verbose $host", </td> </tr> <tr> <td class="h" > <a name="1010">1010</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> @dialog); </td> </tr> <tr> <td class="h" > <a name="1011">1011</a> </td> <td class="c0" > <a href="#1013"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, </td> </tr> <tr> <td class="h" > <a name="1012">1012</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal); </td> </tr> <tr> <td class="h" > <a name="1013">1013</a> </td> <td class="c0" > <a href="#1014"> 0 </a> </td> <td >   </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--condition.html#1013-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $mtime ||= 0; </td> </tr> <tr> <td class="h" > <a name="1014">1014</a> </td> <td class="c0" > <a href="#1015"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#1014-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if ($mtime > $timestamp) { </td> </tr> <tr> <td class="h" > <a name="1015">1015</a> </td> <td class="c0" > <a href="#1016"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $CPAN::Frontend->myprint("GOT $aslocal\n"); </td> </tr> <tr> <td class="h" > <a name="1016">1016</a> </td> <td class="c0" > <a href="#1017"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $ThesiteURL = $ro_url; </td> </tr> <tr> <td class="h" > <a name="1017">1017</a> </td> <td class="c0" > <a href="#1019"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> return $aslocal; </td> </tr> <tr> <td class="h" > <a name="1018">1018</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } else { </td> </tr> <tr> <td class="h" > <a name="1019">1019</a> </td> <td class="c0" > <a href="#1021"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $CPAN::Frontend->myprint("Hmm... Still failed!\n"); </td> </tr> <tr> <td class="h" > <a name="1020">1020</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="1021">1021</a> </td> <td class="c0" > <a href="#1023"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#1021-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> return if $CPAN::Signal; </td> </tr> <tr> <td class="h" > <a name="1022">1022</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } else { </td> </tr> <tr> <td class="h" > <a name="1023">1023</a> </td> <td class="c0" > <a href="#1027"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $CPAN::Frontend->mywarn(qq{Your $netrcfile is not }. </td> </tr> <tr> <td class="h" > <a name="1024">1024</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> qq{correctly protected.\n}); </td> </tr> <tr> <td class="h" > <a name="1025">1025</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="1026">1026</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } else { </td> </tr> <tr> <td class="h" > <a name="1027">1027</a> </td> <td class="c0" > <a href="#1034"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $CPAN::Frontend->mywarn("Your ~/.netrc neither contains $host </td> </tr> <tr> <td class="h" > <a name="1028">1028</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> nor does it have a default entry\n"); </td> </tr> <tr> <td class="h" > <a name="1029">1029</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="1030">1030</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1031">1031</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # OK, they don't have a valid ~/.netrc. Use 'ftp -n' </td> </tr> <tr> <td class="h" > <a name="1032">1032</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # then and login manually to host, using e-mail as </td> </tr> <tr> <td class="h" > <a name="1033">1033</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # password. </td> </tr> <tr> <td class="h" > <a name="1034">1034</a> </td> <td class="c0" > <a href="#1035"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $CPAN::Frontend->myprint(qq{Issuing "$ftpbin$verbose -n"\n}); </td> </tr> <tr> <td class="h" > <a name="1035">1035</a> </td> <td class="c0" > <a href="#1040"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> unshift( </td> </tr> <tr> <td class="h" > <a name="1036">1036</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> @dialog, </td> </tr> <tr> <td class="h" > <a name="1037">1037</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> "open $host", </td> </tr> <tr> <td class="h" > <a name="1038">1038</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> "user anonymous $Config::Config{'cf_email'}" </td> </tr> <tr> <td class="h" > <a name="1039">1039</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ); </td> </tr> <tr> <td class="h" > <a name="1040">1040</a> </td> <td class="c0" > <a href="# "> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $dialog = join "", map { " $_\n" } @dialog; </td> </tr> <tr> <td class="h" > <a > </a> </td> <td class="c0" > <a href="#1041"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1041">1041</a> </td> <td class="c0" > <a href="#1048"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $CPAN::Frontend->myprint(qq{ </td> </tr> <tr> <td class="h" > <a name="1042">1042</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Trying with external ftp to get </td> </tr> <tr> <td class="h" > <a name="1043">1043</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $url </td> </tr> <tr> <td class="h" > <a name="1044">1044</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Sending the dialog </td> </tr> <tr> <td class="h" > <a name="1045">1045</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $dialog </td> </tr> <tr> <td class="h" > <a name="1046">1046</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="1047">1047</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ); </td> </tr> <tr> <td class="h" > <a name="1048">1048</a> </td> <td class="c0" > <a href="#1049"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $self->talk_ftp("$ftpbin$verbose -n", @dialog); </td> </tr> <tr> <td class="h" > <a name="1049">1049</a> </td> <td class="c0" > <a href="#1051"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, </td> </tr> <tr> <td class="h" > <a name="1050">1050</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal); </td> </tr> <tr> <td class="h" > <a name="1051">1051</a> </td> <td class="c0" > <a href="#1052"> 0 </a> </td> <td >   </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--condition.html#1051-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $mtime ||= 0; </td> </tr> <tr> <td class="h" > <a name="1052">1052</a> </td> <td class="c0" > <a href="#1053"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#1052-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if ($mtime > $timestamp) { </td> </tr> <tr> <td class="h" > <a name="1053">1053</a> </td> <td class="c0" > <a href="#1054"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $CPAN::Frontend->myprint("GOT $aslocal\n"); </td> </tr> <tr> <td class="h" > <a name="1054">1054</a> </td> <td class="c0" > <a href="#1055"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $ThesiteURL = $ro_url; </td> </tr> <tr> <td class="h" > <a name="1055">1055</a> </td> <td class="c0" > <a href="#1057"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> return $aslocal; </td> </tr> <tr> <td class="h" > <a name="1056">1056</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } else { </td> </tr> <tr> <td class="h" > <a name="1057">1057</a> </td> <td class="c0" > <a href="#1059"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $CPAN::Frontend->myprint("Bad luck... Still failed!\n"); </td> </tr> <tr> <td class="h" > <a name="1058">1058</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="1059">1059</a> </td> <td class="c0" > <a href="#1060"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#1059-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> return if $CPAN::Signal; </td> </tr> <tr> <td class="h" > <a name="1060">1060</a> </td> <td class="c0" > <a href="#1061"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $CPAN::Frontend->mywarn("Can't access URL $url.\n\n"); </td> </tr> <tr> <td class="h" > <a name="1061">1061</a> </td> <td class="c0" > <a href="#1067"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $CPAN::Frontend->mysleep(2); </td> </tr> <tr> <td class="h" > <a name="1062">1062</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } # host </td> </tr> <tr> <td class="h" > <a name="1063">1063</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="1064">1064</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1065">1065</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # package CPAN::FTP; </td> </tr> <tr> <td class="h" > <a name="1066">1066</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> sub talk_ftp { </td> </tr> <tr> <td class="h" > <a name="1067">1067</a> </td> <td class="c0" > <a href="#1068"> 0 </a> </td> <td >   </td> <td >   </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--subroutine.html#1067-1"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--subroutine.html#1067-1"> 0 </a> </td> <td >   </td> <td class="s"> my($self,$command,@dialog) = @_; </td> </tr> <tr> <td class="h" > <a name="1068">1068</a> </td> <td class="c0" > <a href="#1069"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $fh = FileHandle->new; </td> </tr> <tr> <td class="h" > <a name="1069">1069</a> </td> <td class="c0" > <a href="#1070"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#1069-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $fh->open("|$command") or die "Couldn't open ftp: $!"; </td> </tr> <tr> <td class="h" > <a name="1070">1070</a> </td> <td class="c0" > <a href="# "> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> foreach (@dialog) { $fh->print("$_\n") } </td> </tr> <tr> <td class="h" > <a > </a> </td> <td class="c0" > <a href="#1071"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1071">1071</a> </td> <td class="c0" > <a href="#1072"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $fh->close; # Wait for process to complete </td> </tr> <tr> <td class="h" > <a name="1072">1072</a> </td> <td class="c0" > <a href="#1073"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $wstatus = $?; </td> </tr> <tr> <td class="h" > <a name="1073">1073</a> </td> <td class="c0" > <a href="#1074"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $estatus = $wstatus >> 8; </td> </tr> <tr> <td class="h" > <a name="1074">1074</a> </td> <td class="c0" > <a href="#1084"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#1074-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $CPAN::Frontend->myprint(qq{ </td> </tr> <tr> <td class="h" > <a name="1075">1075</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Subprocess "|$command" </td> </tr> <tr> <td class="h" > <a name="1076">1076</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> returned status $estatus (wstat $wstatus) </td> </tr> <tr> <td class="h" > <a name="1077">1077</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> }) if $wstatus; </td> </tr> <tr> <td class="h" > <a name="1078">1078</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="1079">1079</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1080">1080</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # find2perl needs modularization, too, all the following is stolen </td> </tr> <tr> <td class="h" > <a name="1081">1081</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # from there </td> </tr> <tr> <td class="h" > <a name="1082">1082</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # CPAN::FTP::ls </td> </tr> <tr> <td class="h" > <a name="1083">1083</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> sub ls { </td> </tr> <tr> <td class="h" > <a name="1084">1084</a> </td> <td class="c0" > <a href="#1085"> 0 </a> </td> <td >   </td> <td >   </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--subroutine.html#1084-1"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--subroutine.html#1084-1"> 0 </a> </td> <td >   </td> <td class="s"> my($self,$name) = @_; </td> </tr> <tr> <td class="h" > <a name="1085">1085</a> </td> <td class="c0" > <a href="#1088"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm, </td> </tr> <tr> <td class="h" > <a name="1086">1086</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $atime,$mtime,$ctime,$blksize,$blocks) = lstat($name); </td> </tr> <tr> <td class="h" > <a name="1087">1087</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1088">1088</a> </td> <td class="c0" > <a href="#1089"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my($perms,%user,%group); </td> </tr> <tr> <td class="h" > <a name="1089">1089</a> </td> <td class="c0" > <a href="#1091"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $pname = $name; </td> </tr> <tr> <td class="h" > <a name="1090">1090</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1091">1091</a> </td> <td class="c0" > <a href="#1092"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#1091-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if ($blocks) { </td> </tr> <tr> <td class="h" > <a name="1092">1092</a> </td> <td class="c0" > <a href="#1095"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $blocks = int(($blocks + 1) / 2); </td> </tr> <tr> <td class="h" > <a name="1093">1093</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="1094">1094</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> else { </td> </tr> <tr> <td class="h" > <a name="1095">1095</a> </td> <td class="c0" > <a href="#1098"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $blocks = int(($sizemm + 1023) / 1024); </td> </tr> <tr> <td class="h" > <a name="1096">1096</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="1097">1097</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1098">1098</a> </td> <td class="c0" > <a href="# "> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#1098-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if (-f _) { $perms = '-'; } </td> </tr> <tr> <td class="h" > <a > </a> </td> <td class="c0" > <a href="#1099"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#-2"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a > </a> </td> <td >   </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#-3"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a > </a> </td> <td >   </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#-4"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a > </a> </td> <td >   </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#-5"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a > </a> </td> <td >   </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#-6"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1099">1099</a> </td> <td class="c0" > <a href="#1100"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> elsif (-d _) { $perms = 'd'; } </td> </tr> <tr> <td class="h" > <a name="1100">1100</a> </td> <td class="c0" > <a href="# "> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> elsif (-c _) { $perms = 'c'; $sizemm = &sizemm; } </td> </tr> <tr> <td class="h" > <a > </a> </td> <td class="c0" > <a href="#1101"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1101">1101</a> </td> <td class="c0" > <a href="# "> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> elsif (-b _) { $perms = 'b'; $sizemm = &sizemm; } </td> </tr> <tr> <td class="h" > <a > </a> </td> <td class="c0" > <a href="#1102"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1102">1102</a> </td> <td class="c0" > <a href="#1103"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> elsif (-p _) { $perms = 'p'; } </td> </tr> <tr> <td class="h" > <a name="1103">1103</a> </td> <td class="c0" > <a href="#1104"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> elsif (-S _) { $perms = 's'; } </td> </tr> <tr> <td class="h" > <a name="1104">1104</a> </td> <td class="c0" > <a href="# "> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> else { $perms = 'l'; $pname .= ' -> ' . readlink($_); } </td> </tr> <tr> <td class="h" > <a > </a> </td> <td class="c0" > <a href="#1106"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1105">1105</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1106">1106</a> </td> <td class="c0" > <a href="#1107"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my(@rwx) = ('---','--x','-w-','-wx','r--','r-x','rw-','rwx'); </td> </tr> <tr> <td class="h" > <a name="1107">1107</a> </td> <td class="c0" > <a href="#1108"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my(@moname) = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); </td> </tr> <tr> <td class="h" > <a name="1108">1108</a> </td> <td class="c0" > <a href="#1109"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $tmpmode = $mode; </td> </tr> <tr> <td class="h" > <a name="1109">1109</a> </td> <td class="c0" > <a href="#1110"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $tmp = $rwx[$tmpmode & 7]; </td> </tr> <tr> <td class="h" > <a name="1110">1110</a> </td> <td class="c0" > <a href="#1111"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $tmpmode >>= 3; </td> </tr> <tr> <td class="h" > <a name="1111">1111</a> </td> <td class="c0" > <a href="#1112"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $tmp = $rwx[$tmpmode & 7] . $tmp; </td> </tr> <tr> <td class="h" > <a name="1112">1112</a> </td> <td class="c0" > <a href="#1113"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $tmpmode >>= 3; </td> </tr> <tr> <td class="h" > <a name="1113">1113</a> </td> <td class="c0" > <a href="#1114"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $tmp = $rwx[$tmpmode & 7] . $tmp; </td> </tr> <tr> <td class="h" > <a name="1114">1114</a> </td> <td class="c0" > <a href="#1115"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#1114-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> substr($tmp,2,1) =~ tr/-x/Ss/ if -u _; </td> </tr> <tr> <td class="h" > <a name="1115">1115</a> </td> <td class="c0" > <a href="#1116"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#1115-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> substr($tmp,5,1) =~ tr/-x/Ss/ if -g _; </td> </tr> <tr> <td class="h" > <a name="1116">1116</a> </td> <td class="c0" > <a href="#1117"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#1116-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> substr($tmp,8,1) =~ tr/-x/Tt/ if -k _; </td> </tr> <tr> <td class="h" > <a name="1117">1117</a> </td> <td class="c0" > <a href="#1119"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $perms .= $tmp; </td> </tr> <tr> <td class="h" > <a name="1118">1118</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1119">1119</a> </td> <td class="c0" > <a href="#1120"> 0 </a> </td> <td >   </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--condition.html#1119-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $user = $user{$uid} || $uid; # too lazy to implement lookup </td> </tr> <tr> <td class="h" > <a name="1120">1120</a> </td> <td class="c0" > <a href="#1122"> 0 </a> </td> <td >   </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--condition.html#1120-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $group = $group{$gid} || $gid; </td> </tr> <tr> <td class="h" > <a name="1121">1121</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1122">1122</a> </td> <td class="c0" > <a href="#1123"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime); </td> </tr> <tr> <td class="h" > <a name="1123">1123</a> </td> <td class="c0" > <a href="#1124"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my($timeyear); </td> </tr> <tr> <td class="h" > <a name="1124">1124</a> </td> <td class="c0" > <a href="#1125"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my($moname) = $moname[$mon]; </td> </tr> <tr> <td class="h" > <a name="1125">1125</a> </td> <td class="c0" > <a href="#1126"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#1125-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if (-M _ > 365.25 / 2) { </td> </tr> <tr> <td class="h" > <a name="1126">1126</a> </td> <td class="c0" > <a href="#1129"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $timeyear = $year + 1900; </td> </tr> <tr> <td class="h" > <a name="1127">1127</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="1128">1128</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> else { </td> </tr> <tr> <td class="h" > <a name="1129">1129</a> </td> <td class="c0" > <a href="#1132"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $timeyear = sprintf("%02d:%02d", $hour, $min); </td> </tr> <tr> <td class="h" > <a name="1130">1130</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="1131">1131</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1132">1132</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> sprintf "%5lu %4ld %-10s %2d %-8s %-8s %8s %s %2d %5s %s\n", </td> </tr> <tr> <td class="h" > <a name="1133">1133</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $ino, </td> </tr> <tr> <td class="h" > <a name="1134">1134</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $blocks, </td> </tr> <tr> <td class="h" > <a name="1135">1135</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $perms, </td> </tr> <tr> <td class="h" > <a name="1136">1136</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $nlink, </td> </tr> <tr> <td class="h" > <a name="1137">1137</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $user, </td> </tr> <tr> <td class="h" > <a name="1138">1138</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $group, </td> </tr> <tr> <td class="h" > <a name="1139">1139</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $sizemm, </td> </tr> <tr> <td class="h" > <a name="1140">1140</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $moname, </td> </tr> <tr> <td class="h" > <a name="1141">1141</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $mday, </td> </tr> <tr> <td class="h" > <a name="1142">1142</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $timeyear, </td> </tr> <tr> <td class="h" > <a name="1143">1143</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $pname; </td> </tr> <tr> <td class="h" > <a name="1144">1144</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="1145">1145</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1146">1146</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> 1; </td> </tr> </table> </body> </html>