File Coverage

blib/lib/CPAN/FTP.pm

Criterion	Covered	Total	%
statement	158	615	25.6
branch	54	398	13.5
condition	15	133	11.2
subroutine	17	25	68.0
pod	0	9	0.0
total	244	1180	20.6

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