FM / CPAN

/usr/share/perl5/CPAN

Name	Size	Mode	Actions
API/	-	0755	rm
Exception/	-	0755	rm
FTP/	-	0755	rm
HTTP/	-	0755	rm
Kwalify/	-	0755	rm
LWP/	-	0755	rm
Meta/	-	0755	rm
Plugin/	-	0755	rm
Admin.pm	7780	0444	edit dl rm
Author.pm	6762	0644	edit dl rm
Bundle.pm	9246	0644	edit dl rm
CacheMgr.pm	7537	0644	edit dl rm
Complete.pm	5987	0644	edit dl rm
Config.pm	9890	0644	edit dl rm
Config.pm.1434977693	8985	0644	edit dl rm
Config.pm.1444819868	9124	0644	edit dl rm
Config.pm.1444888049	8987	0644	edit dl rm
Config.pm.1461727960	8987	0644	edit dl rm
Config.pm.1461729994	9151	0644	edit dl rm
Config.pm.1461731967	9151	0644	edit dl rm
Config.pm.1495429294	9151	0644	edit dl rm
Config.pm.1495430169	10263	0644	edit dl rm
Config.pm.1495430701	10263	0644	edit dl rm
Config.pm.1495431258	10263	0644	edit dl rm
Config.pm.1504457527	10263	0644	edit dl rm
Config.pm.1504459141	9493	0644	edit dl rm
Config.pm.1504459628	9493	0644	edit dl rm
Config.pm.1552234956	9493	0644	edit dl rm
Config.pm.1552237737	9891	0644	edit dl rm
Debug.pm	1998	0644	edit dl rm
DeferredCode.pm	189	0644	edit dl rm
Distribution.pm	144125	0644	edit dl rm
Distroprefs.pm	11107	0644	edit dl rm
Distrostatus.pm	972	0644	edit dl rm
FirstTime.pm	57496	0644	edit dl rm
FTP.pm	39868	0644	edit dl rm
HandleConfig.pm	21521	0644	edit dl rm
Index.pm	21662	0644	edit dl rm
InfoObj.pm	6909	0644	edit dl rm
Kwalify.pm	3428	0644	edit dl rm
Mirrors.pm	16687	0444	edit dl rm
Module.pm	21721	0644	edit dl rm
Nox.pm	928	0644	edit dl rm
Plugin.pm	3204	0444	edit dl rm
Prompt.pm	567	0644	edit dl rm
Queue.pm	6369	0644	edit dl rm
Shell.pm	68763	0644	edit dl rm
Tarzip.pm	13889	0644	edit dl rm
URL.pm	588	0644	edit dl rm
Version.pm	4322	0644	edit dl rm

Edit: /usr/share/perl5/CPAN/FTP.pm (39868B)

# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
# vim: ts=4 sts=4 sw=4:
package CPAN::FTP;
use strict;

use Fcntl qw(:flock);
use File::Basename qw(dirname);
use File::Path qw(mkpath);
use CPAN::FTP::netrc;
use vars qw($connect_to_internet_ok $Ua $Thesite $ThesiteURL $Themethod);
@CPAN::FTP::ISA = qw(CPAN::Debug);

use vars qw(
            $VERSION
);
$VERSION = "5.5001";

#-> sub CPAN::FTP::ftp_statistics
# if they want to rewrite, they need to pass in a filehandle
sub _ftp_statistics {
    my($self,$fh) = @_;
    my $locktype = $fh ? LOCK_EX : LOCK_SH;
    $fh ||= FileHandle->new;
    my $file = File::Spec->catfile($CPAN::Config->{cpan_home},"FTPstats.yml");
    mkpath dirname $file;
    open $fh, "+>>$file" or $CPAN::Frontend->mydie("Could not open '$file': $!");
    my $sleep = 1;
    my $waitstart;
    while (!CPAN::_flock($fh, $locktype|LOCK_NB)) {
        $waitstart ||= localtime();
        if ($sleep>3) {
            $CPAN::Frontend->mywarn("Waiting for a read lock on '$file' (since $waitstart)\n");
        }
        $CPAN::Frontend->mysleep($sleep);
        if ($sleep <= 3) {
            $sleep+=0.33;
        } elsif ($sleep <=6) {
            $sleep+=0.11;
        }
    }
    my $stats = eval { CPAN->_yaml_loadfile($file); };
    if ($@) {
        if (ref $@) {
            if (ref $@ eq "CPAN::Exception::yaml_not_installed") {
                $CPAN::Frontend->myprint("Warning (usually harmless): $@");
                return;
            } elsif (ref $@ eq "CPAN::Exception::yaml_process_error") {
                $CPAN::Frontend->mydie($@);
            }
        } else {
            $CPAN::Frontend->mydie($@);
        }
    }
    return $stats->[0];
}

#-> sub CPAN::FTP::_mytime
sub _mytime () {
    if (CPAN->has_inst("Time::HiRes")) {
        return Time::HiRes::time();
    } else {
        return time;
    }
}

#-> sub CPAN::FTP::_new_stats
sub _new_stats {
    my($self,$file) = @_;
    my $ret = {
               file => $file,
               attempts => [],
               start => _mytime,
              };
    $ret;
}

#-> sub CPAN::FTP::_add_to_statistics
sub _add_to_statistics {
    my($self,$stats) = @_;
    my $yaml_module = CPAN::_yaml_module();
    $self->debug("yaml_module[$yaml_module]") if $CPAN::DEBUG;
    if ($CPAN::META->has_inst($yaml_module)) {
        $stats->{thesiteurl} = $ThesiteURL;
        $stats->{end} = CPAN::FTP::_mytime();
        my $fh = FileHandle->new;
        my $time = time;
        my $sdebug = 0;
        my @debug;
        @debug = $time if $sdebug;
        my $fullstats = $self->_ftp_statistics($fh);
        close $fh;
        $fullstats->{history} ||= [];
        push @debug, scalar @{$fullstats->{history}} if $sdebug;
        push @debug, time if $sdebug;
        push @{$fullstats->{history}}, $stats;
        # YAML.pm 0.62 is unacceptably slow with 999;
        # YAML::Syck 0.82 has no noticable performance problem with 999;
        my $ftpstats_size = $CPAN::Config->{ftpstats_size} || 99;
        my $ftpstats_period = $CPAN::Config->{ftpstats_period} || 14;
        while (
               @{$fullstats->{history}} > $ftpstats_size
               || $time - $fullstats->{history}[0]{start} > 86400*$ftpstats_period
              ) {
            shift @{$fullstats->{history}}
        }
        push @debug, scalar @{$fullstats->{history}} if $sdebug;
        push @debug, time if $sdebug;
        push @debug, scalar localtime($fullstats->{history}[0]{start}) if $sdebug;
        # need no eval because if this fails, it is serious
        my $sfile = File::Spec->catfile($CPAN::Config->{cpan_home},"FTPstats.yml");
        CPAN->_yaml_dumpfile("$sfile.$$",$fullstats);
        if ( $sdebug ) {
            local $CPAN::DEBUG = 512; # FTP
            push @debug, time;
            CPAN->debug(sprintf("DEBUG history: before_read[%d]before[%d]at[%d]".
                                "after[%d]at[%d]oldest[%s]dumped backat[%d]",
                                @debug,
                               ));
        }
        # Win32 cannot rename a file to an existing filename
        unlink($sfile) if ($^O eq 'MSWin32');
	_copy_stat($sfile, "$sfile.$$") if -e $sfile;
        rename "$sfile.$$", $sfile
            or $CPAN::Frontend->mydie("Could not rename '$sfile.$$' to '$sfile': $!\n");
    }
}

# Copy some stat information (owner, group, mode and) from one file to
# another.
# This is a utility function which might be moved to a utility repository.
#-> sub CPAN::FTP::_copy_stat
sub _copy_stat {
    my($src, $dest) = @_;
    my @stat = stat($src);
    if (!@stat) {
	$CPAN::Frontend->mywarn("Can't stat '$src': $!\n");
	return;
    }

eval {
	chmod $stat[2], $dest
	    or $CPAN::Frontend->mywarn("Can't chmod '$dest' to " . sprintf("0%o", $stat[2]) . ": $!\n");
    };
    warn $@ if $@;
    eval {
	chown $stat[4], $stat[5], $dest
	    or do {
		my $save_err = $!; # otherwise it's lost in the get... calls
		$CPAN::Frontend->mywarn("Can't chown '$dest' to " .
					(getpwuid($stat[4]))[0] . "/" .
					(getgrgid($stat[5]))[0] . ": $save_err\n"
				       );
	    };
    };
    warn $@ if $@;
}

# if file is CHECKSUMS, suggest the place where we got the file to be
# checked from, maybe only for young files?
#-> sub CPAN::FTP::_recommend_url_for
sub _recommend_url_for {
    my($self, $file) = @_;
    my $urllist = $self->_get_urllist;
    if ($file =~ s|/CHECKSUMS(.gz)?$||) {
        my $fullstats = $self->_ftp_statistics();
        my $history = $fullstats->{history} || [];
        while (my $last = pop @$history) {
            last if $last->{end} - time > 3600; # only young results are interesting
            next unless $last->{file}; # dirname of nothing dies!
            next unless $file eq dirname($last->{file});
            return $last->{thesiteurl};
        }
    }
    if ($CPAN::Config->{randomize_urllist}
        &&
        rand(1) < $CPAN::Config->{randomize_urllist}
       ) {
        $urllist->[int rand scalar @$urllist];
    } else {
        return ();
    }
}

#-> sub CPAN::FTP::_get_urllist
sub _get_urllist {
    my($self) = @_;
    $CPAN::Config->{urllist} ||= [];
    unless (ref $CPAN::Config->{urllist} eq 'ARRAY') {
        $CPAN::Frontend->mywarn("Malformed urllist; ignoring.  Configuration file corrupt?\n");
        $CPAN::Config->{urllist} = [];
    }
    my @urllist = grep { defined $_ and length $_ } @{$CPAN::Config->{urllist}};
    for my $u (@urllist) {
        CPAN->debug("u[$u]") if $CPAN::DEBUG;
        if (UNIVERSAL::can($u,"text")) {
            $u->{TEXT} .= "/" unless substr($u->{TEXT},-1) eq "/";
        } else {
            $u .= "/" unless substr($u,-1) eq "/";
            $u = CPAN::URL->new(TEXT => $u, FROM => "USER");
        }
    }
    \@urllist;
}

#-> sub CPAN::FTP::ftp_get ;
sub ftp_get {
    my($class,$host,$dir,$file,$target) = @_;
    $class->debug(
                  qq[Going to fetch file [$file] from dir [$dir]
        on host [$host] as local [$target]\n]
                 ) if $CPAN::DEBUG;
    my $ftp = Net::FTP->new($host);
    unless ($ftp) {
        $CPAN::Frontend->mywarn("  Could not connect to host '$host' with Net::FTP\n");
        return;
    }
    return 0 unless defined $ftp;
    $ftp->debug(1) if $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG;
    $class->debug(qq[Going to login("anonymous","$Config::Config{cf_email}")]);
    unless ( $ftp->login("anonymous",$Config::Config{'cf_email'}) ) {
        my $msg = $ftp->message;
        $CPAN::Frontend->mywarn("  Couldn't login on $host: $msg");
        return;
    }
    unless ( $ftp->cwd($dir) ) {
        my $msg = $ftp->message;
        $CPAN::Frontend->mywarn("  Couldn't cwd $dir: $msg");
        return;
    }
    $ftp->binary;
    $class->debug(qq[Going to ->get("$file","$target")\n]) if $CPAN::DEBUG;
    unless ( $ftp->get($file,$target) ) {
        my $msg = $ftp->message;
        $CPAN::Frontend->mywarn("  Couldn't fetch $file from $host: $msg");
        return;
    }
    $ftp->quit; # it's ok if this fails
    return 1;
}

# If more accuracy is wanted/needed, Chris Leach sent me this patch...

# > *** /install/perl/live/lib/CPAN.pm- Wed Sep 24 13:08:48 1997
 # > --- /tmp/cp Wed Sep 24 13:26:40 1997
 # > ***************
 # > *** 1562,1567 ****
 # > --- 1562,1580 ----
 # >       return 1 if substr($url,0,4) eq "file";
 # >       return 1 unless $url =~ m|://([^/]+)|;
 # >       my $host = $1;
 # > +     my $proxy = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'};
 # > +     if ($proxy) {
 # > +         $proxy =~ m|://([^/:]+)|;
 # > +         $proxy = $1;
 # > +         my $noproxy = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'};
 # > +         if ($noproxy) {
 # > +             if ($host !~ /$noproxy$/) {
 # > +                 $host = $proxy;
 # > +             }
 # > +         } else {
 # > +             $host = $proxy;
 # > +         }
 # > +     }
 # >       require Net::Ping;
 # >       return 1 unless $Net::Ping::VERSION >= 2;
 # >       my $p;

#-> sub CPAN::FTP::localize ;
sub localize {
    my($self,$file,$aslocal,$force) = @_;
    $force ||= 0;
    Carp::croak( "Usage: ->localize(cpan_file,as_local_file[,$force])" )
        unless defined $aslocal;
    if ($CPAN::DEBUG){
        require Carp;
        my $longmess = Carp::longmess();
        $self->debug("file[$file] aslocal[$aslocal] force[$force] carplongmess[$longmess]");
    }
    if ($^O eq 'MacOS') {
        # Comment by AK on 2000-09-03: Uniq short filenames would be
        # available in CHECKSUMS file
        my($name, $path) = File::Basename::fileparse($aslocal, '');
        if (length($name) > 31) {
            $name =~ s/(
                        \.(
                           readme(\.(gz|Z))? |
                           (tar\.)?(gz|Z) |
                           tgz |
                           zip |
                           pm\.(gz|Z)
                          )
                       )$//x;
            my $suf = $1;
            my $size = 31 - length($suf);
            while (length($name) > $size) {
                chop $name;
            }
            $name .= $suf;
            $aslocal = File::Spec->catfile($path, $name);
        }
    }

if (-f $aslocal && -r _ && !($force & 1)) {
        my $size;
        if ($size = -s $aslocal) {
            $self->debug("aslocal[$aslocal]size[$size]") if $CPAN::DEBUG;
            return $aslocal;
        } else {
            # empty file from a previous unsuccessful attempt to download it
            unlink $aslocal or
                $CPAN::Frontend->mydie("Found a zero-length '$aslocal' that I ".
                                       "could not remove.");
        }
    }
    my($maybe_restore) = 0;
    if (-f $aslocal) {
        rename $aslocal, "$aslocal.bak$$";
        $maybe_restore++;
    }

my($aslocal_dir) = dirname($aslocal);
    # Inheritance is not easier to manage than a few if/else branches
    if ($CPAN::META->has_usable('LWP::UserAgent')) {
        unless ($Ua) {
            CPAN::LWP::UserAgent->config;
            eval {$Ua = CPAN::LWP::UserAgent->new;}; # Why is has_usable still not fit enough?
            if ($@) {
                $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n")
                    if $CPAN::DEBUG;
            } else {
                my($var);
                $Ua->proxy('ftp',  $var)
                    if $var = $CPAN::Config->{ftp_proxy} || $ENV{ftp_proxy};
                $Ua->proxy('http', $var)
                    if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
                $Ua->no_proxy($var)
                    if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
            }
        }
    }
    for my $prx (qw(ftp_proxy http_proxy no_proxy)) {
        $ENV{$prx} = $CPAN::Config->{$prx} if $CPAN::Config->{$prx};
    }

# Try the list of urls for each single object. We keep a record
    # where we did get a file from
    my(@reordered,$last);
    my $ccurllist = $self->_get_urllist;
    $last = $#$ccurllist;
    if ($force & 2) { # local cpans probably out of date, don't reorder
        @reordered = (0..$last);
    } else {
        @reordered =
            sort {
                (substr($ccurllist->[$b],0,4) eq "file")
                    <=>
                (substr($ccurllist->[$a],0,4) eq "file")
                    or
                defined($ThesiteURL)
                    and
                ($ccurllist->[$b] eq $ThesiteURL)
                    <=>
                ($ccurllist->[$a] eq $ThesiteURL)
            } 0..$last;
    }
    my(@levels);
    $Themethod ||= "";
    $self->debug("Themethod[$Themethod]reordered[@reordered]") if $CPAN::DEBUG;
    my @all_levels = (
                      ["dleasy",   "file"],
                      ["dleasy"],
                      ["dlhard"],
                      ["dlhardest"],
                      ["dleasy",   "http","defaultsites"],
                      ["dlhard",   "http","defaultsites"],
                      ["dleasy",   "ftp", "defaultsites"],
                      ["dlhard",   "ftp", "defaultsites"],
                      ["dlhardest","",    "defaultsites"],
                     );
    if ($Themethod) {
        @levels = grep {$_->[0] eq $Themethod} @all_levels;
        push @levels, grep {$_->[0] ne $Themethod} @all_levels;
    } else {
        @levels = @all_levels;
    }
    @levels = qw/dleasy/ if $^O eq 'MacOS';
    my($levelno);
    local $ENV{FTP_PASSIVE} =
        exists $CPAN::Config->{ftp_passive} ?
        $CPAN::Config->{ftp_passive} : 1;
    my $ret;
    my $stats = $self->_new_stats($file);
    for ($CPAN::Config->{connect_to_internet_ok}) {
        $connect_to_internet_ok = $_ if not defined $connect_to_internet_ok and defined $_;
    }
  LEVEL: for $levelno (0..$#levels) {
        my $level_tuple = $levels[$levelno];
        my($level,$scheme,$sitetag) = @$level_tuple;
        $self->mymkpath($aslocal_dir) unless $scheme && "file" eq $scheme;
        my $defaultsites = $sitetag && $sitetag eq "defaultsites";
        my @urllist;
        if ($defaultsites) {
            unless (defined $connect_to_internet_ok) {
                $CPAN::Frontend->myprint(sprintf qq{
I would like to connect to one of the following sites to get '%s':

%s
},
                                         $file,
                                         join("",map { " ".$_->text."\n" } @CPAN::Defaultsites),
                                        );
                my $answer = CPAN::Shell::colorable_makemaker_prompt("Is it OK to try to connect to the Internet?", "yes");
                if ($answer =~ /^y/i) {
                    $connect_to_internet_ok = 1;
                } else {
                    $connect_to_internet_ok = 0;
                }
            }
            if ($connect_to_internet_ok) {
                @urllist = @CPAN::Defaultsites;
            } else {
                my $sleep = 2;
                # the tricky thing about dying here is that everybody
                # believes that calls to exists() or all_objects() are
                # safe.
                require CPAN::Exception::blocked_urllist;
                die CPAN::Exception::blocked_urllist->new;
            }
        } else {
            my @host_seq = $level =~ /dleasy/ ?
                @reordered : 0..$last;  # reordered has file and $Thesiteurl first
            @urllist = map { $ccurllist->[$_] } @host_seq;
        }
        $self->debug("synth. urllist[@urllist]") if $CPAN::DEBUG;
        my $aslocal_tempfile = $aslocal . ".tmp" . $$;
        if (my $recommend = $self->_recommend_url_for($file)) {
            @urllist = grep { $_ ne $recommend } @urllist;
            unshift @urllist, $recommend;
        }
        $self->debug("synth. urllist[@urllist]") if $CPAN::DEBUG;
        $ret = $self->hostdlxxx($level,$scheme,\@urllist,$file,$aslocal_tempfile,$stats);
        if ($ret) {
            CPAN->debug("ret[$ret]aslocal[$aslocal]") if $CPAN::DEBUG;
            if ($ret eq $aslocal_tempfile) {
                # if we got it exactly as we asked for, only then we
                # want to rename
                rename $aslocal_tempfile, $aslocal
                    or $CPAN::Frontend->mydie("Error while trying to rename ".
                                              "'$ret' to '$aslocal': $!");
                $ret = $aslocal;
            }
            $Themethod = $level;
            my $now = time;
            # utime $now, $now, $aslocal; # too bad, if we do that, we
                                          # might alter a local mirror
            $self->debug("level[$level]") if $CPAN::DEBUG;
            last LEVEL;
        } else {
            unlink $aslocal_tempfile;
            last if $CPAN::Signal; # need to cleanup
        }
    }
    if ($ret) {
        $stats->{filesize} = -s $ret;
    }
    $self->debug("before _add_to_statistics") if $CPAN::DEBUG;
    $self->_add_to_statistics($stats);
    $self->debug("after _add_to_statistics") if $CPAN::DEBUG;
    if ($ret) {
        unlink "$aslocal.bak$$";
        return $ret;
    }
    unless ($CPAN::Signal) {
        my(@mess);
        local $" = " ";
        if (@{$CPAN::Config->{urllist}}) {
            push @mess,
                qq{Please check, if the URLs I found in your configuration file $}.
                    join(", ", @{$CPAN::Config->{urllist}}).
                        qq{$ are valid.};
        } else {
            push @mess, qq{Your urllist is empty!};
        }
        push @mess, qq{The urllist can be edited.},
            qq{E.g. with 'o conf urllist push ftp://myurl/'};
        $CPAN::Frontend->mywarn(Text::Wrap::wrap("","","@mess"). "\n\n");
        $CPAN::Frontend->mydie("Could not fetch $file\n");
    }
    if ($maybe_restore) {
        rename "$aslocal.bak$$", $aslocal;
        $CPAN::Frontend->myprint("Trying to get away with old file:\n" .
                                 $self->ls($aslocal));
        return $aslocal;
    }
    return;
}

sub mymkpath {
    my($self, $aslocal_dir) = @_;
    mkpath($aslocal_dir);
    $CPAN::Frontend->mywarn(qq{Warning: You are not allowed to write into }.
                            qq{directory "$aslocal_dir".
    I\'ll continue, but if you encounter problems, they may be due
    to insufficient permissions.\n}) unless -w $aslocal_dir;
}

sub hostdlxxx {
    my $self = shift;
    my $level = shift;
    my $scheme = shift;
    my $h = shift;
    $h = [ grep /^\Q$scheme\E:/, @$h ] if $scheme;
    my $method = "host$level";
    $self->$method($h, @_);
}

sub _set_attempt {
    my($self,$stats,$method,$url) = @_;
    push @{$stats->{attempts}}, {
                                 method => $method,
                                 start => _mytime,
                                 url => $url,
                                };
}

# package CPAN::FTP;
sub hostdleasy { #called from hostdlxxx
    my($self,$host_seq,$file,$aslocal,$stats) = @_;
    my($ro_url);
  HOSTEASY: for $ro_url (@$host_seq) {
        $self->_set_attempt($stats,"dleasy",$ro_url);
        my $url .= "$ro_url$file";
        $self->debug("localizing perlish[$url]") if $CPAN::DEBUG;
        if ($url =~ /^file:/) {
            my $l;
            if ($CPAN::META->has_inst('URI::URL')) {
                my $u =  URI::URL->new($url);
                $l = $u->path;
            } else { # works only on Unix, is poorly constructed, but
                # hopefully better than nothing.
                # RFC 1738 says fileurl BNF is
                # fileurl = "file://" [ host | "localhost" ] "/" fpath
                # Thanks to "Mark D. Baushke" <mdb@cisco.com> for
                # the code
                ($l = $url) =~ s|^file://[^/]*/|/|; # discard the host part
                $l =~ s|^file:||;                   # assume they
                                                    # meant
                                                    # file://localhost
                $l =~ s|^/||s
                    if ! -f $l && $l =~ m|^/\w:|;   # e.g. /P:
            }
            $self->debug("local file[$l]") if $CPAN::DEBUG;
            if ( -f $l && -r _) {
                $ThesiteURL = $ro_url;
                return $l;
            }
            if ($l =~ /(.+)\.gz$/) {
                my $ungz = $1;
                if ( -f $ungz && -r _) {
                    $ThesiteURL = $ro_url;
                    return $ungz;
                }
            }
            # Maybe mirror has compressed it?
            if (-f "$l.gz") {
                $self->debug("found compressed $l.gz") if $CPAN::DEBUG;
                eval { CPAN::Tarzip->new("$l.gz")->gunzip($aslocal) };
                if ( -f $aslocal) {
                    $ThesiteURL = $ro_url;
                    return $aslocal;
                }
            }
            $CPAN::Frontend->mywarn("Could not find '$l'\n");
        }
        $self->debug("it was not a file URL") if $CPAN::DEBUG;
        if ($CPAN::META->has_usable('LWP')) {
            $CPAN::Frontend->myprint("Fetching with LWP:
  $url
");
            unless ($Ua) {
                CPAN::LWP::UserAgent->config;
                eval { $Ua = CPAN::LWP::UserAgent->new; };
                if ($@) {
                    $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n");
                }
            }
            my $res = $Ua->mirror($url, $aslocal);
            if ($res->is_success) {
                $ThesiteURL = $ro_url;
                my $now = time;
                utime $now, $now, $aslocal; # download time is more
                                            # important than upload
                                            # time
                return $aslocal;
            } elsif ($url !~ /\.gz(?!\n)\Z/) {
                my $gzurl = "$url.gz";
                $CPAN::Frontend->myprint("Fetching with LWP:
  $gzurl
");
                $res = $Ua->mirror($gzurl, "$aslocal.gz");
                if ($res->is_success) {
                    if (eval {CPAN::Tarzip->new("$aslocal.gz")->gunzip($aslocal)}) {
                        $ThesiteURL = $ro_url;
                        return $aslocal;
                    }
                }
            } else {
                $CPAN::Frontend->myprint(sprintf(
                                                 "LWP failed with code[%s] message[%s]\n",
                                                 $res->code,
                                                 $res->message,
                                                ));
                # Alan Burlison informed me that in firewall environments
                # Net::FTP can still succeed where LWP fails. So we do not
                # skip Net::FTP anymore when LWP is available.
            }
        } else {
            $CPAN::Frontend->mywarn("  LWP not available\n");
        }
        return if $CPAN::Signal;
        if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
            # that's the nice and easy way thanks to Graham
            $self->debug("recognized ftp") if $CPAN::DEBUG;
            my($host,$dir,$getfile) = ($1,$2,$3);
            if ($CPAN::META->has_usable('Net::FTP')) {
                $dir =~ s|/+|/|g;
                $CPAN::Frontend->myprint("Fetching with Net::FTP:
  $url
");
                $self->debug("getfile[$getfile]dir[$dir]host[$host]" .
                             "aslocal[$aslocal]") if $CPAN::DEBUG;
                if (CPAN::FTP->ftp_get($host,$dir,$getfile,$aslocal)) {
                    $ThesiteURL = $ro_url;
                    return $aslocal;
                }
                if ($aslocal !~ /\.gz(?!\n)\Z/) {
                    my $gz = "$aslocal.gz";
                    $CPAN::Frontend->myprint("Fetching with Net::FTP
  $url.gz
");
                    if (CPAN::FTP->ftp_get($host,
                                           $dir,
                                           "$getfile.gz",
                                           $gz) &&
                        eval{CPAN::Tarzip->new($gz)->gunzip($aslocal)}
                    ) {
                        $ThesiteURL = $ro_url;
                        return $aslocal;
                    }
                }
                # next HOSTEASY;
            } else {
                CPAN->debug("Net::FTP does not count as usable atm") if $CPAN::DEBUG;
            }
        }
        if (
            UNIVERSAL::can($ro_url,"text")
            and
            $ro_url->{FROM} eq "USER"
           ) {
            ##address #17973: default URLs should not try to override
            ##user-defined URLs just because LWP is not available
            my $ret = $self->hostdlhard([$ro_url],$file,$aslocal,$stats);
            return $ret if $ret;
        }
        return if $CPAN::Signal;
    }
}

# package CPAN::FTP;
sub hostdlhard {
    my($self,$host_seq,$file,$aslocal,$stats) = @_;

# Came back if Net::FTP couldn't establish connection (or
    # failed otherwise) Maybe they are behind a firewall, but they
    # gave us a socksified (or other) ftp program...

my($ro_url);
    my($devnull) = $CPAN::Config->{devnull} || "";
    # < /dev/null ";
    my($aslocal_dir) = dirname($aslocal);
    mkpath($aslocal_dir);
    my $some_dl_success = 0;
 HOSTHARD: for $ro_url (@$host_seq) {
        $self->_set_attempt($stats,"dlhard",$ro_url);
        my $url = "$ro_url$file";
        my($proto,$host,$dir,$getfile);

# Courtesy Mark Conty mark_conty@cargill.com change from
        # if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
        # to
        if ($url =~ m|^([^:]+)://(.*?)/(.*)/(.*)|) {
            # proto not yet used
            ($proto,$host,$dir,$getfile) = ($1,$2,$3,$4);
        } else {
            next HOSTHARD; # who said, we could ftp anything except ftp?
        }
        next HOSTHARD if $proto eq "file"; # file URLs would have had
                                           # success above. Likely a bogus URL

$self->debug("localizing funkyftpwise[$url]") if $CPAN::DEBUG;

# Try the most capable first and leave ncftp* for last as it only
        # does FTP.
        my $proxy_vars = $self->_proxy_vars($ro_url);
      DLPRG: for my $f (qw(curl wget lynx ncftpget ncftp)) {
            my $funkyftp = CPAN::HandleConfig->safe_quote($CPAN::Config->{$f});
            next DLPRG unless defined $funkyftp;
            next DLPRG if $funkyftp =~ /^\s*$/;

my($asl_ungz, $asl_gz);
            ($asl_ungz = $aslocal) =~ s/\.gz//;
                $asl_gz = "$asl_ungz.gz";

my($src_switch) = "";
            my($chdir) = "";
            my($stdout_redir) = " > $asl_ungz";
            if ($f eq "lynx") {
                $src_switch = " -source";
            } elsif ($f eq "ncftp") {
                $src_switch = " -c";
            } elsif ($f eq "wget") {
                $src_switch = " -O $asl_ungz";
                $stdout_redir = "";
            } elsif ($f eq 'curl') {
                $src_switch = ' -L -f -s -S --netrc-optional';
                if ($proxy_vars->{http_proxy}) {
                    $src_switch .= qq{ -U "$proxy_vars->{proxy_user}:$proxy_vars->{proxy_pass}" -x "$proxy_vars->{http_proxy}"};
                }
            }

if ($f eq "ncftpget") {
                $chdir = "cd $aslocal_dir && ";
                $stdout_redir = "";
            }
            $CPAN::Frontend->myprint(
                                     qq[
Trying with "$funkyftp$src_switch" to get
    "$url"
]);
            my($system) =
                "$chdir$funkyftp$src_switch \"$url\" $devnull$stdout_redir";
            $self->debug("system[$system]") if $CPAN::DEBUG;
            my($wstatus) = system($system);
            if ($f eq "lynx") {
                # lynx returns 0 when it fails somewhere
                if (-s $asl_ungz) {
                    my $content = do { local *FH;
                                       open FH, $asl_ungz or die;
                                       local $/;
                                       <FH> };
                    if ($content =~ /^<.*(<title>[45]|Error [45])/si) {
                        $CPAN::Frontend->mywarn(qq{
No success, the file that lynx has downloaded looks like an error message:
$content
});
                        $CPAN::Frontend->mysleep(1);
                        next DLPRG;
                    }
                    $some_dl_success++;
                } else {
                    $CPAN::Frontend->myprint(qq{
No success, the file that lynx has downloaded is an empty file.
});
                    next DLPRG;
                }
            }
            if ($wstatus == 0) {
                if (-s $aslocal) {
                    # Looks good
                    $some_dl_success++;
                } elsif ($asl_ungz ne $aslocal) {
                    # test gzip integrity
                    if (eval{CPAN::Tarzip->new($asl_ungz)->gtest}) {
                        # e.g. foo.tar is gzipped --> foo.tar.gz
                        rename $asl_ungz, $aslocal;
                        $some_dl_success++;
                    } else {
                        eval{CPAN::Tarzip->new($asl_gz)->gzip($asl_ungz)};
                        if ($@) {
                            warn "Warning: $@";
                        } else {
                            $some_dl_success++;
                        }
                    }
                }
                $ThesiteURL = $ro_url;
                return $aslocal;
            } elsif ($url !~ /\.gz(?!\n)\Z/) {
                unlink $asl_ungz if
                    -f $asl_ungz && -s _ == 0;
                my $gz = "$aslocal.gz";
                my $gzurl = "$url.gz";
                $CPAN::Frontend->myprint(
                                        qq[
    Trying with "$funkyftp$src_switch" to get
    "$url.gz"
    ]);
                my($system) = "$funkyftp$src_switch \"$url.gz\" $devnull > $asl_gz";
                $self->debug("system[$system]") if $CPAN::DEBUG;
                my($wstatus);
                if (($wstatus = system($system)) == 0
                    &&
                    -s $asl_gz
                ) {
                    # test gzip integrity
                    my $ct = eval{CPAN::Tarzip->new($asl_gz)};
                    if ($ct && $ct->gtest) {
                        $ct->gunzip($aslocal);
                    } else {
                        # somebody uncompressed file for us?
                        rename $asl_ungz, $aslocal;
                    }
                    $ThesiteURL = $ro_url;
                    return $aslocal;
                } else {
                    unlink $asl_gz if -f $asl_gz;
                }
            } else {
                my $estatus = $wstatus >> 8;
                my $size = -f $aslocal ?
                    ", left\n$aslocal with size ".-s _ :
                    "\nWarning: expected file [$aslocal] doesn't exist";
                $CPAN::Frontend->myprint(qq{
    Function system("$system")
    returned status $estatus (wstat $wstatus)$size
    });
            }
            return if $CPAN::Signal;
        } # download/transfer programs (DLPRG)
    } # host
    require Carp;
    if ($some_dl_success) {
        Carp::carp("Warning: doesn't seem we had substantial success downloading '$aslocal'. Don't know how to proceed.");
    } else {
        Carp::carp("Warning: no success downloading '$aslocal'. Giving up on it.");
    }
    $CPAN::Frontend->mysleep(5);
    return;
}

#-> CPAN::FTP::_proxy_vars
sub _proxy_vars {
    my($self,$url) = @_;
    my $ret = +{};
    my $http_proxy = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'};
    if ($http_proxy) {
        my($host) = $url =~ m|://([^/:]+)|;
        my $want_proxy = 1;
        my $noproxy = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'} || "";
        my @noproxy = split /\s*,\s*/, $noproxy;
        if ($host) {
          DOMAIN: for my $domain (@noproxy) {
                if ($host =~ /\Q$domain\E$/) { # cf. LWP::UserAgent
                    $want_proxy = 0;
                    last DOMAIN;
                }
            }
        } else {
            $CPAN::Frontend->mywarn("  Could not determine host from http_proxy '$http_proxy'\n");
        }
        if ($want_proxy) {
            my($user, $pass) =
                &CPAN::LWP::UserAgent::get_proxy_credentials();
            $ret = {
                    proxy_user => $user,
                    proxy_pass => $pass,
                    http_proxy => $http_proxy
                  };
        }
    }
    return $ret;
}

# package CPAN::FTP;
sub hostdlhardest {
    my($self,$host_seq,$file,$aslocal,$stats) = @_;

return unless @$host_seq;
    my($ro_url);
    my($aslocal_dir) = dirname($aslocal);
    mkpath($aslocal_dir);
    my $ftpbin = $CPAN::Config->{ftp};
    unless ($ftpbin && length $ftpbin && MM->maybe_command($ftpbin)) {
        $CPAN::Frontend->myprint("No external ftp command available\n\n");
        return;
    }
    $CPAN::Frontend->mywarn(qq{
As a last resort we now switch to the external ftp command '$ftpbin'
to get '$aslocal'.

Doing so often leads to problems that are hard to diagnose.

If you're the victim of such problems, please consider unsetting the
ftp config variable with

o conf ftp ""
    o conf commit

});
    $CPAN::Frontend->mysleep(2);
  HOSTHARDEST: for $ro_url (@$host_seq) {
        $self->_set_attempt($stats,"dlhardest",$ro_url);
        my $url = "$ro_url$file";
        $self->debug("localizing ftpwise[$url]") if $CPAN::DEBUG;
        unless ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
            next;
        }
        my($host,$dir,$getfile) = ($1,$2,$3);
        my $timestamp = 0;
        my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
            $ctime,$blksize,$blocks) = stat($aslocal);
        $timestamp = $mtime ||= 0;
        my($netrc) = CPAN::FTP::netrc->new;
        my($netrcfile) = $netrc->netrc;
        my($verbose) = $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG ? " -v" : "";
        my $targetfile = File::Basename::basename($aslocal);
        my(@dialog);
        push(
             @dialog,
             "lcd $aslocal_dir",
             "cd /",
             map("cd $_", split /\//, $dir), # RFC 1738
             "bin",
             "get $getfile $targetfile",
             "quit"
        );
        if (! $netrcfile) {
            CPAN->debug("No ~/.netrc file found") if $CPAN::DEBUG;
        } elsif ($netrc->hasdefault || $netrc->contains($host)) {
            CPAN->debug(sprintf("hasdef[%d]cont($host)[%d]",
                                $netrc->hasdefault,
                                $netrc->contains($host))) if $CPAN::DEBUG;
            if ($netrc->protected) {
                my $dialog = join "", map { "    $_\n" } @dialog;
                my $netrc_explain;
                if ($netrc->contains($host)) {
                    $netrc_explain = "Relying that your .netrc entry for '$host' ".
                        "manages the login";
                } else {
                    $netrc_explain = "Relying that your default .netrc entry ".
                        "manages the login";
                }
                $CPAN::Frontend->myprint(qq{
  Trying with external ftp to get
    '$url'
  $netrc_explain
  Going to send the dialog
$dialog
}
                );
                $self->talk_ftp("$ftpbin$verbose $host",
                                @dialog);
                ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
                    $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
                $mtime ||= 0;
                if ($mtime > $timestamp) {
                    $CPAN::Frontend->myprint("GOT $aslocal\n");
                    $ThesiteURL = $ro_url;
                    return $aslocal;
                } else {
                    $CPAN::Frontend->myprint("Hmm... Still failed!\n");
                }
                    return if $CPAN::Signal;
            } else {
                $CPAN::Frontend->mywarn(qq{Your $netrcfile is not }.
                                        qq{correctly protected.\n});
            }
        } else {
            $CPAN::Frontend->mywarn("Your ~/.netrc neither contains $host
  nor does it have a default entry\n");
        }

# OK, they don't have a valid ~/.netrc. Use 'ftp -n'
        # then and login manually to host, using e-mail as
        # password.
        $CPAN::Frontend->myprint(qq{Issuing "$ftpbin$verbose -n"\n});
        unshift(
                @dialog,
                "open $host",
                "user anonymous $Config::Config{'cf_email'}"
        );
        my $dialog = join "", map { "    $_\n" } @dialog;
        $CPAN::Frontend->myprint(qq{
  Trying with external ftp to get
    $url
  Going to send the dialog
$dialog
}
        );
        $self->talk_ftp("$ftpbin$verbose -n", @dialog);
        ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
            $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
        $mtime ||= 0;
        if ($mtime > $timestamp) {
            $CPAN::Frontend->myprint("GOT $aslocal\n");
            $ThesiteURL = $ro_url;
            return $aslocal;
        } else {
            $CPAN::Frontend->myprint("Bad luck... Still failed!\n");
        }
        return if $CPAN::Signal;
        $CPAN::Frontend->mywarn("Can't access URL $url.\n\n");
        $CPAN::Frontend->mysleep(2);
    } # host
}

# package CPAN::FTP;
sub talk_ftp {
    my($self,$command,@dialog) = @_;
    my $fh = FileHandle->new;
    $fh->open("|$command") or die "Couldn't open ftp: $!";
    foreach (@dialog) { $fh->print("$_\n") }
    $fh->close; # Wait for process to complete
    my $wstatus = $?;
    my $estatus = $wstatus >> 8;
    $CPAN::Frontend->myprint(qq{
Subprocess "|$command"
  returned status $estatus (wstat $wstatus)
}) if $wstatus;
}

# find2perl needs modularization, too, all the following is stolen
# from there
# CPAN::FTP::ls
sub ls {
    my($self,$name) = @_;
    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm,
     $atime,$mtime,$ctime,$blksize,$blocks) = lstat($name);

my($perms,%user,%group);
    my $pname = $name;

if ($blocks) {
        $blocks = int(($blocks + 1) / 2);
    }
    else {
        $blocks = int(($sizemm + 1023) / 1024);
    }

if    (-f _) { $perms = '-'; }
    elsif (-d _) { $perms = 'd'; }
    elsif (-c _) { $perms = 'c'; $sizemm = &sizemm; }
    elsif (-b _) { $perms = 'b'; $sizemm = &sizemm; }
    elsif (-p _) { $perms = 'p'; }
    elsif (-S _) { $perms = 's'; }
    else         { $perms = 'l'; $pname .= ' -> ' . readlink($_); }

my(@rwx) = ('---','--x','-w-','-wx','r--','r-x','rw-','rwx');
    my(@moname) = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
    my $tmpmode = $mode;
    my $tmp = $rwx[$tmpmode & 7];
    $tmpmode >>= 3;
    $tmp = $rwx[$tmpmode & 7] . $tmp;
    $tmpmode >>= 3;
    $tmp = $rwx[$tmpmode & 7] . $tmp;
    substr($tmp,2,1) =~ tr/-x/Ss/ if -u _;
    substr($tmp,5,1) =~ tr/-x/Ss/ if -g _;
    substr($tmp,8,1) =~ tr/-x/Tt/ if -k _;
    $perms .= $tmp;

my $user = $user{$uid} || $uid;   # too lazy to implement lookup
    my $group = $group{$gid} || $gid;

my($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime);
    my($timeyear);
    my($moname) = $moname[$mon];
    if (-M _ > 365.25 / 2) {
        $timeyear = $year + 1900;
    }
    else {
        $timeyear = sprintf("%02d:%02d", $hour, $min);
    }

sprintf "%5lu %4ld %-10s %2d %-8s %-8s %8s %s %2d %5s %s\n",
             $ino,
                  $blocks,
                       $perms,
                             $nlink,
                                 $user,
                                      $group,
                                           $sizemm,
                                               $moname,
                                                  $mday,
                                                      $timeyear,
                                                          $pname;
}

cmd: