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