From: Andreas König Date: Sat, 29 Jul 2006 22:06:31 +0000 (+0200) Subject: [PAUSE] CPAN Upload: A/AN/ANDK/CPAN-1.87_55.tar.gz X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ed84aac994553b92aff03a46f3a7be7248eb5fab;p=p5sagit%2Fp5-mst-13.2.git [PAUSE] CPAN Upload: A/AN/ANDK/CPAN-1.87_55.tar.gz Message-ID: <877j1w2n20.fsf@k75.linux.bogus> p4raw-id: //depot/perl@28631 --- diff --git a/lib/CPAN.pm b/lib/CPAN.pm index bb92e5d..22c9b59 100644 --- a/lib/CPAN.pm +++ b/lib/CPAN.pm @@ -1,6 +1,6 @@ # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*- package CPAN; -$VERSION = '1.87'; +$VERSION = '1.87_55'; $VERSION = eval $VERSION; use strict; @@ -43,9 +43,6 @@ $CPAN::Defaultdocs ||= "http://search.cpan.org/perldoc?"; $CPAN::Defaultrecent ||= "http://search.cpan.org/recent"; -package CPAN; -use strict; - use vars qw($VERSION @EXPORT $AUTOLOAD $DEBUG $META $HAS_USABLE $term $Signal $Suppress_readline $Frontend @Defaultsites $Have_warned $Defaultdocs $Defaultrecent @@ -73,6 +70,7 @@ use vars qw($VERSION @EXPORT $AUTOLOAD $DEBUG $META $HAS_USABLE $term recompile shell test + upgrade ); sub soft_chdir_with_alternatives ($); @@ -136,6 +134,9 @@ sub shell { close $fh; }} # $term->OUT is autoflushed anyway + for ($CPAN::Config->{term_ornaments}) { + $term->ornaments($_) if defined; + } my $odef = select STDERR; $| = 1; select STDOUT; @@ -212,7 +213,7 @@ ReadLine support %s my $command = shift @line; eval { CPAN::Shell->$command(@line) }; warn $@ if $@; - if ($command =~ /^(make|test|install|force|notest|clean)$/) { + if ($command =~ /^(make|test|install|force|notest|clean|upgrade)$/) { CPAN::Shell->failed($CPAN::CurrentCommandId,1); } soft_chdir_with_alternatives(\@cwd); @@ -296,7 +297,9 @@ use strict; recent recompile reload + scripts test + upgrade ); package CPAN::Index; @@ -561,6 +564,22 @@ $META ||= CPAN->new; # In case we re-eval ourselves we need the || # from here on only subs. ################################################################################ +sub suggest_myconfig () { + SUGGEST_MYCONFIG: if(!$INC{'CPAN/MyConfig.pm'}) { + $CPAN::Frontend->myprint("You don't seem to have a user ". + "configuration (MyConfig.pm) yet.\n"); + my $new = ExtUtils::MakeMaker::prompt("Do you want to create a ". + "user configuration now? (Y/n)", + "yes"); + if($new =~ m{^y}i) { + CPAN::Shell->mkmyconfig(); + return &checklock; + } else { + $CPAN::Frontend->mydie("OK, giving up."); + } + } +} + #-> sub CPAN::all_objects ; sub all_objects { my($mgr,$class) = @_; @@ -638,36 +657,37 @@ You may want to kill it and delete the lockfile, maybe. On UNIX try: my $dotcpan = $CPAN::Config->{cpan_home}; eval { File::Path::mkpath($dotcpan);}; if ($@) { - # A special case at least for Jarkko. - my $firsterror = $@; - my $seconderror; - my $symlinkcpan; - if (-l $dotcpan) { - $symlinkcpan = readlink $dotcpan; - die "readlink $dotcpan failed: $!" unless defined $symlinkcpan; - eval { File::Path::mkpath($symlinkcpan); }; - if ($@) { - $seconderror = $@; - } else { - $CPAN::Frontend->mywarn(qq{ + # A special case at least for Jarkko. + my $firsterror = $@; + my $seconderror; + my $symlinkcpan; + if (-l $dotcpan) { + $symlinkcpan = readlink $dotcpan; + die "readlink $dotcpan failed: $!" unless defined $symlinkcpan; + eval { File::Path::mkpath($symlinkcpan); }; + if ($@) { + $seconderror = $@; + } else { + $CPAN::Frontend->mywarn(qq{ Working directory $symlinkcpan created. }); - } - } - unless (-d $dotcpan) { - my $diemess = qq{ + } + } + unless (-d $dotcpan) { + my $mess = qq{ Your configuration suggests "$dotcpan" as your CPAN.pm working directory. I could not create this directory due to this error: $firsterror\n}; - $diemess .= qq{ + $mess .= qq{ As "$dotcpan" is a symlink to "$symlinkcpan", I tried to create that, but I failed with this error: $seconderror } if $seconderror; - $diemess .= qq{ + $mess .= qq{ Please make sure the directory exists and is writable. }; - $CPAN::Frontend->mydie($diemess); - } + $CPAN::Frontend->myprint($mess); + return suggest_myconfig; + } } # $@ after eval mkpath $dotcpan my $fh; unless ($fh = FileHandle->new(">$lockfile")) { @@ -687,19 +707,8 @@ points to a directory where you can write a .lock file. You can set this variable in either a CPAN/MyConfig.pm or a CPAN/Config.pm in your \@INC path; }); - if(!$INC{'CPAN/MyConfig.pm'}) { - $CPAN::Frontend->myprint("You don't seem to have a user ". - "configuration (MyConfig.pm) yet.\n"); - my $new = ExtUtils::MakeMaker::prompt("Do you want to create a ". - "user configuration now? (Y/n)", - "yes"); - if($new =~ m{^y}i) { - CPAN::Shell->mkmyconfig(); - return &checklock; - } - } + return suggest_myconfig; } - $CPAN::Frontend->mydie("Could not open >$lockfile: $!"); } $fh->print($$, "\n"); $fh->print(hostname(), "\n"); @@ -837,7 +846,7 @@ sub has_usable { sub {require File::HomeDir; unless (File::HomeDir->VERSION >= 0.52){ for ("Will not use File::HomeDir, need 0.52\n") { - warn $_; + $CPAN::Frontend->mywarn($_); die $_; } } @@ -916,11 +925,18 @@ sub has_inst { sleep 2; } } elsif ($mod eq "Module::Signature"){ - unless ($Have_warned->{"Module::Signature"}++) { + if (not $CPAN::Config->{check_sigs}) { + # they do not want us:-( + } elsif (not $Have_warned->{"Module::Signature"}++) { # No point in complaining unless the user can # reasonably install and use it. if (eval { require Crypt::OpenPGP; 1 } || - defined $CPAN::Config->{'gpg'}) { + ( + defined $CPAN::Config->{'gpg'} + && + $CPAN::Config->{'gpg'} =~ /\S/ + ) + ) { $CPAN::Frontend->myprint(qq{ CPAN: Module::Signature security checks disabled because Module::Signature not installed. Please consider installing the Module::Signature module. @@ -1211,7 +1227,6 @@ Display Information $filler (ver $CPAN::VERSION) command argument description a,b,d,m WORD or /REGEXP/ about authors, bundles, distributions, modules i WORD or /REGEXP/ about any of the above - r NONE report updatable modules ls AUTHOR or GLOB about files in the author's directory (with WORD being a module, bundle or author name or a distribution name of the form AUTHOR/DISTRIBUTION) @@ -1228,6 +1243,7 @@ Pragmas Other h,? display this menu ! perl-code eval a perl command + r report module updates upgrade upgrade all modules o conf [opt] set and query options q quit the cpan shell reload cpan load CPAN.pm again reload index load newer indices autobundle Snapshot recent latest CPAN uploads}); @@ -1404,13 +1420,15 @@ sub o { if ($o_type eq 'conf') { if (!@o_what) { # print all things, "o conf" my($k,$v); - $CPAN::Frontend->myprint("CPAN::Config options"); + $CPAN::Frontend->myprint("\$CPAN::Config options from "); + my @from; if (exists $INC{'CPAN/Config.pm'}) { - $CPAN::Frontend->myprint(" from $INC{'CPAN/Config.pm'}"); + push @from, $INC{'CPAN/Config.pm'}; } if (exists $INC{'CPAN/MyConfig.pm'}) { - $CPAN::Frontend->myprint(" and $INC{'CPAN/MyConfig.pm'}"); + push @from, $INC{'CPAN/MyConfig.pm'}; } + $CPAN::Frontend->myprint(join " and ", map {"'$_'"} @from); $CPAN::Frontend->myprint(":\n"); for $k (sort keys %CPAN::HandleConfig::can) { $v = $CPAN::HandleConfig::can{$k}; @@ -1623,6 +1641,73 @@ sub recompile { } } +#-> sub CPAN::Shell::scripts ; +sub scripts { + my($self, $arg) = @_; + $CPAN::Frontend->mywarn(">>>> experimental command, currently unsupported <<<<\n\n"); + + require HTML::LinkExtor; + require Sort::Versions; + require List::Util; + my $p = HTML::LinkExtor->new(); + my $indexfile = "/home/ftp/pub/PAUSE/scripts/new/index.html"; + unless (-f $indexfile) { + $CPAN::Frontend->mydie("found no indexfile[$indexfile]\n"); + } + $p->parse_file($indexfile); + my @hrefs; + my $qrarg; + if ($arg =~ s|^/(.+)/$|$1|) { + $qrarg = qr/$arg/; + } + for my $l ($p->links) { + my $tag = shift @$l; + next unless $tag eq "a"; + my %att = @$l; + my $href = $att{href}; + next unless $href =~ s|^\.\./authors/id/./../||; + if ($arg) { + if ($qrarg) { + if ($href =~ $qrarg) { + push @hrefs, $href; + } + } else { + if ($href =~ /\Q$arg\E/) { + push @hrefs, $href; + } + } + } else { + push @hrefs, $href; + } + } + # now filter for the latest version if there is more than one of a name + my %stems; + for (sort @hrefs) { + my $href = $_; + s/-v?\d.*//; + my $stem = $_; + $stems{$stem} ||= []; + push @{$stems{$stem}}, $href; + } + for (sort keys %stems) { + my $highest; + if (@{$stems{$_}} > 1) { + $highest = List::Util::reduce { + Sort::Versions::versioncmp($a,$b) > 0 ? $a : $b + } @{$stems{$_}}; + } else { + $highest = $stems{$_}[0]; + } + $CPAN::Frontend->myprint("$highest\n"); + } +} + +#-> sub CPAN::Shell::upgrade ; +sub upgrade { + my($self) = shift @_; + $self->install($self->r); +} + #-> sub CPAN::Shell::_u_r_common ; sub _u_r_common { my($self) = shift @_; @@ -2352,31 +2437,78 @@ sub config { sub get_basic_credentials { my($self, $realm, $uri, $proxy) = @_; - return unless $proxy; if ($USER && $PASSWD) { - } elsif (defined $CPAN::Config->{proxy_user} && - defined $CPAN::Config->{proxy_pass}) { - $USER = $CPAN::Config->{proxy_user}; - $PASSWD = $CPAN::Config->{proxy_pass}; + return ($USER, $PASSWD); + } + if ( $proxy ) { + ($USER,$PASSWD) = $self->get_proxy_credentials(); } else { - ExtUtils::MakeMaker->import(qw(prompt)); - $USER = prompt("Proxy authentication needed! + ($USER,$PASSWD) = $self->get_non_proxy_credentials(); + } + return($USER,$PASSWD); +} + +sub get_proxy_credentials { + my $self = shift; + my ($user, $password); + if ( defined $CPAN::Config->{proxy_user} && + defined $CPAN::Config->{proxy_pass}) { + $user = $CPAN::Config->{proxy_user}; + $password = $CPAN::Config->{proxy_pass}; + return ($user, $password); + } + my $username_prompt = "\nProxy authentication needed! (Note: to permanently configure username and password run o conf proxy_user your_username o conf proxy_pass your_password - )\nUsername:"); + )\nUsername:"; + ($user, $password) = + _get_username_and_password_from_user($username_prompt); + return ($user,$password); +} + +sub get_non_proxy_credentials { + my $self = shift; + my ($user,$password); + if ( defined $CPAN::Config->{username} && + defined $CPAN::Config->{password}) { + $user = $CPAN::Config->{username}; + $password = $CPAN::Config->{password}; + return ($user, $password); + } + my $username_prompt = "\nAuthentication needed! + (Note: to permanently configure username and password run + o conf username your_username + o conf password your_password + )\nUsername:"; + + ($user, $password) = + _get_username_and_password_from_user($username_prompt); + return ($user,$password); +} + +sub _get_username_and_password_from_user { + my $self = shift; + my $username_message = shift; + my ($username,$password); + + ExtUtils::MakeMaker->import(qw(prompt)); + $username = prompt($username_message); if ($CPAN::META->has_inst("Term::ReadKey")) { Term::ReadKey::ReadMode("noecho"); - } else { - $CPAN::Frontend->mywarn("Warning: Term::ReadKey seems not to be available, your password will be echoed to the terminal!\n"); } - $PASSWD = prompt("Password:"); + else { + $CPAN::Frontend->mywarn( + "Warning: Term::ReadKey seems not to be available, your password will be echoed to the terminal!\n" + ); + } + $password = prompt("Password:"); + if ($CPAN::META->has_inst("Term::ReadKey")) { Term::ReadKey::ReadMode("restore"); } $CPAN::Frontend->myprint("\n\n"); - } - return($USER,$PASSWD); + return ($username,$password); } # mirror(): Its purpose is to deal with proxy authentication. When we @@ -2528,7 +2660,8 @@ sub localize { } 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."); + $CPAN::Frontend->mydie("Found a zero-length '$aslocal' that I ". + "could not remove."); } } my($restore) = 0; @@ -2824,7 +2957,7 @@ sub hosthard { # Try the most capable first and leave ncftp* for last as it only # does FTP. DLPRG: for my $f (qw(curl wget lynx ncftpget ncftp)) { - my $funkyftp = $CPAN::Config->{$f}; + my $funkyftp = CPAN::HandleConfig->safe_quote($CPAN::Config->{$f}); next unless defined $funkyftp; next if $funkyftp =~ /^\s*$/; @@ -3589,13 +3722,14 @@ happen.\a local($^W)= 0; if ($version > $CPAN::VERSION){ $CPAN::Frontend->myprint(qq{ - There's a new CPAN.pm version (v$version) available! - [Current version is v$CPAN::VERSION] + New CPAN.pm version (v$version) available. + [Currently running version is v$CPAN::VERSION] You might want to try install CPAN reload cpan - without quitting the current session. It should be a seamless upgrade - while we are running... + to both upgrade CPAN.pm and run the new version without leaving + the current session. + }); #}); sleep 2; $CPAN::Frontend->myprint(qq{\n}); @@ -3803,8 +3937,8 @@ sub ro { sub cpan_userid { my $self = shift; - my $ro = $self->ro or return; - return $ro->{CPAN_USERID}; + my $ro = $self->ro or return "N/A"; # N/A for bundles found locally + return $ro->{CPAN_USERID} || "N/A"; } sub id { shift->{ID}; } @@ -4398,14 +4532,15 @@ EOF $self->untar_me($ct); } elsif ( $local_file =~ /\.zip(?!\n)\Z/i ) { $self->unzip_me($ct); - } elsif ( $local_file =~ /\.pm(\.(gz|Z))?(?!\n)\Z/) { - $self->{was_uncompressed}++ unless $ct->gtest(); - $self->debug("calling pm2dir for local_file[$local_file]") if $CPAN::DEBUG; - $self->pm2dir_me($local_file); } else { - $self->{archived} = "NO"; - $self->safe_chdir($sub_wd); - return; + $self->{was_uncompressed}++ unless $ct->gtest(); + $self->debug("calling pm2dir for local_file[$local_file]") + if $CPAN::DEBUG; + $local_file = $self->handle_singlefile($local_file); +# } else { +# $self->{archived} = "NO"; +# $self->safe_chdir($sub_wd); +# return; } # we are still in the tmp directory! @@ -4469,25 +4604,26 @@ EOF File::Path::rmtree("tmp"); $self->safe_chdir($packagedir); - if ($CPAN::META->has_inst("Module::Signature")) { - if (-f "SIGNATURE") { - $self->debug("Module::Signature is installed, verifying") if $CPAN::DEBUG; - my $rv = Module::Signature::verify(); - if ($rv != Module::Signature::SIGNATURE_OK() and - $rv != Module::Signature::SIGNATURE_MISSING()) { - $CPAN::Frontend->myprint( - qq{\nSignature invalid for }. - qq{distribution file. }. - qq{Please investigate.\n\n}. - $self->as_string, - $CPAN::META->instance( - 'CPAN::Author', - $self->cpan_userid, - )->as_string - ); - - my $wrap = - sprintf(qq{I'd recommend removing %s. Its signature + if ($CPAN::Config->{check_sigs}) { + if ($CPAN::META->has_inst("Module::Signature")) { + if (-f "SIGNATURE") { + $self->debug("Module::Signature is installed, verifying") if $CPAN::DEBUG; + my $rv = Module::Signature::verify(); + if ($rv != Module::Signature::SIGNATURE_OK() and + $rv != Module::Signature::SIGNATURE_MISSING()) { + $CPAN::Frontend->myprint( + qq{\nSignature invalid for }. + qq{distribution file. }. + qq{Please investigate.\n\n}. + $self->as_string, + $CPAN::META->instance( + 'CPAN::Author', + $self->cpan_userid, + )->as_string + ); + + my $wrap = + sprintf(qq{I'd recommend removing %s. Its signature is invalid. Maybe you have configured your 'urllist' with a bad URL. Please check this array with 'o conf urllist', and retry. For more information, try opening a subshell with @@ -4495,20 +4631,22 @@ retry. For more information, try opening a subshell with and there run cpansign -v }, - $self->{localfile}, - $self->pretty_id, - ); - $self->{signature_verify} = CPAN::Distrostatus->new("NO"); - $CPAN::Frontend->mywarn(Text::Wrap::wrap("","",$wrap)); - $CPAN::Frontend->mysleep(5) if $CPAN::Frontend->can("mysleep"); + $self->{localfile}, + $self->pretty_id, + ); + $self->{signature_verify} = CPAN::Distrostatus->new("NO"); + $CPAN::Frontend->mywarn(Text::Wrap::wrap("","",$wrap)); + $CPAN::Frontend->mysleep(5) if $CPAN::Frontend->can("mysleep"); + } else { + $self->{signature_verify} = CPAN::Distrostatus->new("YES"); + $self->debug("Module::Signature has verified") if $CPAN::DEBUG; + } } else { - $self->{signature_verify} = CPAN::Distrostatus->new("YES"); + $CPAN::Frontend->myprint(qq{Package came without SIGNATURE\n\n}); } } else { - $CPAN::Frontend->myprint(qq{Package came without SIGNATURE\n\n}); + $self->debug("Module::Signature is NOT installed") if $CPAN::DEBUG; } - } else { - $self->debug("Module::Signature is NOT installed") if $CPAN::DEBUG; } $self->safe_chdir($builddir); return if $CPAN::Signal; @@ -4570,6 +4708,70 @@ We\'ll try to build it with that Makefile then. # Writing our own Makefile.PL + my $script = ""; + if ($self->{archived} eq "maybe_pl"){ + my $fh = FileHandle->new; + my $script_file = File::Spec->catfile($packagedir,$local_file); + $fh->open($script_file) + or Carp::croak("Could not open $script_file: $!"); + local $/ = "\n"; + # name parsen und prereq + my($state) = "poddir"; + my($name, $prereq) = ("", ""); + while (<$fh>){ + if ($state eq "poddir" && /^=head\d\s+(\S+)/) { + if ($1 eq 'NAME') { + $state = "name"; + } elsif ($1 eq 'PREREQUISITES') { + $state = "prereq"; + } + } elsif ($state =~ m{^(name|prereq)$}) { + if (/^=/) { + $state = "poddir"; + } elsif (/^\s*$/) { + # nop + } elsif ($state eq "name") { + if ($name eq "") { + ($name) = /^(\S+)/; + $state = "poddir"; + } + } elsif ($state eq "prereq") { + $prereq .= $_; + } + } elsif (/^=cut\b/) { + last; + } + } + $fh->close; + + for ($name) { + s{.*<}{}; # strip X<...> + s{>.*}{}; + } + chomp $prereq; + $prereq = join " ", split /\s+/, $prereq; + my($PREREQ_PM) = join("\n", map { + s{.*<}{}; # strip X<...> + s{>.*}{}; + if (/[\s\'\"]/) { # prose? + } else { + s/[^\w:]$//; # period? + " "x28 . "'$_' => 0,"; + } + } split /\s*,\s*/, $prereq); + + $script = " + EXE_FILES => ['$name'], + PREREQ_PM => { +$PREREQ_PM + }, +"; + + my $to_file = File::Spec->catfile($packagedir, $name); + rename $script_file, $to_file + or die "Can't rename $script_file to $to_file: $!"; + } + my $fh = FileHandle->new; $fh->open(">$mpl") or Carp::croak("Could not open >$mpl: $!"); @@ -4579,8 +4781,9 @@ qq{# This Makefile.PL has been autogenerated by the module CPAN.pm # Autogenerated on: }.scalar localtime().qq{ use ExtUtils::MakeMaker; -WriteMakefile(NAME => q[$cf]); - +WriteMakefile( + NAME => q[$cf],$script + ); }); $fh->close; } @@ -4612,9 +4815,15 @@ sub unzip_me { return; } -sub pm2dir_me { +sub handle_singlefile { my($self,$local_file) = @_; - $self->{archived} = "pm"; + + if ( $local_file =~ /\.pm(\.(gz|Z))?(?!\n)\Z/ ){ + $self->{archived} = "pm"; + } else { + $self->{archived} = "maybe_pl"; + } + my $to = File::Basename::basename($local_file); if ($to =~ s/\.(gz|Z)(?!\n)\Z//) { if (CPAN::Tarzip->new($local_file)->gunzip($to)) { @@ -4626,6 +4835,7 @@ sub pm2dir_me { File::Copy::cp($local_file,"."); $self->{unwrapped} = "YES"; } + return $to; } #-> sub CPAN::Distribution::new ; @@ -4675,7 +4885,8 @@ Could not determine which directory to use for looking at $dist. { local $ENV{CPAN_SHELL_LEVEL} = $ENV{CPAN_SHELL_LEVEL}||0; $ENV{CPAN_SHELL_LEVEL} += 1; - unless (system($CPAN::Config->{'shell'}) == 0) { + my $shell = CPAN::HandleConfig->safe_quote($CPAN::Config->{'shell'}); + unless (system($shell) == 0) { my $code = $? >> 8; $CPAN::Frontend->mywarn("Subprocess shell exit code $code\n"); } @@ -4706,6 +4917,7 @@ sub cvs_import { } my $cvs_log = qq{"imported $package $version sources"}; $version =~ s/\./_/g; + # XXX cvs my @cmd = ('cvs', '-d', $cvs_root, 'import', '-m', $cvs_log, "$cvs_dir", $userid, "v$version"); @@ -4716,6 +4928,7 @@ sub cvs_import { $CPAN::Frontend->myprint(qq{@cmd\n}); system(@cmd) == 0 or + # XXX cvs $CPAN::Frontend->mydie("cvs import failed"); chdir($pwd) or $CPAN::Frontend->mydie(qq{Could not chdir to "$pwd": $!}); } @@ -4746,15 +4959,16 @@ sub readme { my $fh_pager = FileHandle->new; local($SIG{PIPE}) = "IGNORE"; - $fh_pager->open("|$CPAN::Config->{'pager'}") - or die "Could not open pager $CPAN::Config->{'pager'}: $!"; + my $pager = $CPAN::Config->{'pager'} || "cat"; + $fh_pager->open("|$pager") + or die "Could not open pager $pager\: $!"; my $fh_readme = FileHandle->new; $fh_readme->open($local_file) or $CPAN::Frontend->mydie(qq{Could not open "$local_file": $!}); $CPAN::Frontend->myprint(qq{ Displaying file $local_file -with pager "$CPAN::Config->{'pager'}" +with pager "$pager" }); sleep 2; $fh_pager->print(<$fh_readme>); @@ -4841,11 +5055,13 @@ sub CHECKSUM_check_file { $sloppy ||= 0; $self->debug("chk_file[$chk_file]sloppy[$sloppy]") if $CPAN::DEBUG; - if ($CPAN::META->has_inst("Module::Signature") and Module::Signature->VERSION >= 0.26) { - $self->debug("Module::Signature is installed, verifying"); - $self->SIG_check_file($chk_file); - } else { - $self->debug("Module::Signature is NOT installed"); + if ($CPAN::Config->{check_sigs}) { + if ($CPAN::META->has_inst("Module::Signature") and Module::Signature->VERSION >= 0.26) { + $self->debug("Module::Signature is installed, verifying"); + $self->SIG_check_file($chk_file); + } else { + $self->debug("Module::Signature is NOT installed"); + } } $file = $self->{localfile}; @@ -5017,7 +5233,7 @@ sub isa_perl { ( \d{3}(_[0-4][0-9])? | - \d*[24680]\.\d+ + \d+\.\d+ ) \.tar[._-]gz (?!\n)\Z @@ -5033,7 +5249,12 @@ sub isa_perl { #-> sub CPAN::Distribution::perl ; sub perl { - return $CPAN::Perl; + my ($self) = @_; + if (! $self) { + use Carp qw(carp); + carp __PACKAGE__ . "::perl was called without parameters."; + } + return CPAN::HandleConfig->safe_quote($CPAN::Perl); } @@ -5065,7 +5286,9 @@ or $self->isa_perl, $self->called_for, $self->id); - sleep 5; return; + $self->{make} = CPAN::Distrostatus->new("NO isa perl"); + sleep 2; + return; } } $self->get; @@ -5112,8 +5335,14 @@ or if (exists $self->{later} and length($self->{later})) { if ($self->unsat_prereq) { push @e, $self->{later}; - } else { - delete $self->{later}; +# RT ticket 18438 raises doubts if the deletion of {later} is valid. +# YAML-0.53 triggered the later hodge-podge here, but my margin notes +# are not sufficient to be sure if we really must/may do the delete +# here. SO I accept the suggested patch for now. If we trigger a bug +# again, I must go into deep contemplation about the {later} flag. + +# } else { +# delete $self->{later}; } } @@ -5208,10 +5437,11 @@ or if (my @prereq = $self->unsat_prereq){ return 1 if $self->follow_prereqs(@prereq); # signal success to the queuerunner } + # XXX modulebuild / make if ($self->{modulebuild}) { $system = sprintf "%s %s", $self->_build_command(), $CPAN::Config->{mbuild_arg}; } else { - $system = join " ", _make_command(), $CPAN::Config->{make_arg}; + $system = join " ", $self->_make_command(), $CPAN::Config->{make_arg}; } if (system($system) == 0) { $CPAN::Frontend->myprint(" $system -- OK\n"); @@ -5224,7 +5454,19 @@ or } sub _make_command { - return $CPAN::Config->{make} || $Config::Config{make} || 'make'; + my ($self) = @_; + if ($self) { + return + CPAN::HandleConfig + ->safe_quote( + $CPAN::Config->{make} || $Config::Config{make} || 'make' + ); + } else { + # Old style call, without object. Deprecated + Carp::confess("CPAN::_make_command() used as function. Don't Do That."); + return + safe_quote(undef, $CPAN::Config->{make} || $Config::Config{make} || 'make'); + } } #-> sub CPAN::Distribution::follow_prereqs ; @@ -5349,6 +5591,11 @@ sub read_yaml { $CPAN::Frontend->mywarn("Error while parsing META.yml: $@"); return; } + if (not exists $self->{yaml_content}{dynamic_config} + or $self->{yaml_content}{dynamic_config} + ) { + $self->{yaml_content} = undef; + } } $self->debug("yaml_content[$self->{yaml_content}]") if $CPAN::DEBUG; return $self->{yaml_content}; @@ -5524,7 +5771,7 @@ sub test { if ($self->{modulebuild}) { $system = sprintf "%s test", $self->_build_command(); } else { - $system = join " ", _make_command(), "test"; + $system = join " ", $self->_make_command(), "test"; } if (system($system) == 0) { $CPAN::Frontend->myprint(" $system -- OK\n"); @@ -5570,7 +5817,7 @@ sub clean { if ($self->{modulebuild}) { $system = sprintf "%s clean", $self->_build_command(); } else { - $system = join " ", _make_command(), "clean"; + $system = join " ", $self->_make_command(), "clean"; } if (system($system) == 0) { $CPAN::Frontend->myprint(" $system -- OK\n"); @@ -5686,7 +5933,7 @@ sub install { ); } else { my($make_install_make_command) = $CPAN::Config->{make_install_make_command} || - _make_command(); + $self->_make_command(); $system = sprintf("%s install %s", $make_install_make_command, $CPAN::Config->{make_install_arg}, @@ -5784,7 +6031,7 @@ sub _display_url { if ($web_browser_out) { # web browser found, run the action - my $browser = $CPAN::Config->{'lynx'}; + my $browser = CPAN::HandleConfig->safe_quote($CPAN::Config->{'lynx'}); $CPAN::Frontend->myprint(qq{system[$browser $url]}) if $CPAN::DEBUG; $CPAN::Frontend->myprint(qq{ @@ -5799,6 +6046,7 @@ with browser $browser # web browser not found, let's try text only my $html_converter_out = CPAN::Distribution->_check_binary($self,$html_converter); + $html_converter_out = CPAN::HandleConfig->safe_quote($html_converter_out); if ($html_converter_out ) { # html2text found, run it @@ -5842,13 +6090,14 @@ saved output to %s\n}, or $CPAN::Frontend->mydie(qq{Could not open "$tmpin": $!}); my $fh_pager = FileHandle->new; local($SIG{PIPE}) = "IGNORE"; - $fh_pager->open("|$CPAN::Config->{'pager'}") + my $pager = $CPAN::Config->{'pager'} || "cat"; + $fh_pager->open("|pager") or $CPAN::Frontend->mydie(qq{ -Could not open pager $CPAN::Config->{'pager'}: $!}); +Could not open pager $pager\: $!}); $CPAN::Frontend->myprint(qq{ Displaying URL $url -with pager "$CPAN::Config->{'pager'}" +with pager "$pager" }); sleep 2; $fh_pager->print(); @@ -5930,6 +6179,7 @@ sub _build_command { if ($^O eq "MSWin32") { # special code needed at least up to # Module::Build 0.2611 and 0.2706; a fix # in M:B has been promised 2006-01-30 + my($perl) = $self->perl or $CPAN::Frontend->mydie("Couldn't find executable perl\n"); return "$perl ./Build"; } @@ -6334,12 +6584,23 @@ sub as_glimpse { $color_on = Term::ANSIColor::color("green"); $color_off = Term::ANSIColor::color("reset"); } - push @m, sprintf("%-8s %s%-22s%s (%s)\n", + my $uptodateness = " "; + if ($class eq "Bundle") { + } elsif ($self->uptodate) { + $uptodateness = "="; + } elsif ($self->inst_version) { + $uptodateness = "<"; + } + push @m, sprintf("%-7s %1s %s%-22s%s (%s)\n", $class, + $uptodateness, $color_on, $self->id, $color_off, - $self->distribution ? $self->distribution->pretty_id : $self->id, + ($self->distribution ? + $self->distribution->pretty_id : + $self->cpan_userid + ), ); join "", @m; } @@ -6434,11 +6695,12 @@ sub as_string { $sprintf3, 'DSLIP_STATUS', @{$dslip}{qw(D S L I P DV SV LV IV PV)}, - ); + ) if $dslip->{D}; my $local_file = $self->inst_file; unless ($self->{MANPAGE}) { + my $manpage; if ($local_file) { - $self->{MANPAGE} = $self->manpage_headline($local_file); + $manpage = $self->manpage_headline($local_file); } else { # If we have already untarred it, we should look there my $dist = $CPAN::META->instance('CPAN::Distribution', @@ -6474,10 +6736,11 @@ sub as_string { my $lfl_abs = File::Spec->catfile($dist->{build_dir},$lfl); # warn "lfl_abs[$lfl_abs]"; if (-f $lfl_abs) { - $self->{MANPAGE} = $self->manpage_headline($lfl_abs); + $manpage = $self->manpage_headline($lfl_abs); } } } + $self->{MANPAGE} = $manpage if $manpage; } my($item); for $item (qw/MANPAGE/) { @@ -6763,6 +7026,7 @@ use strict; 1; + __END__ =head1 NAME @@ -7040,6 +7304,11 @@ perl breaks binary compatibility. If one of the modules that CPAN uses is in turn depending on binary compatibility (so you cannot run CPAN commands), then you should try the CPAN::Nox module for recovery. +=head2 upgrade + +The C command first runs an C command and then installs +the newest versions of all modules that were listed by that. + =head2 mkmyconfig mkmyconfig() writes your own CPAN::MyConfig file into your ~/.cpan/ @@ -7403,7 +7672,13 @@ internal and thus subject to change without notice. =item CPAN::Module::as_glimpse() -Returns a one-line description of the module +Returns a one-line description of the module in four columns: The +first column contains the word C, the second column consists +of one character: an equals sign if this module is already installed +and uptodate, a less-than sign if this module is installed but can be +upgraded, and a space if the module is not installed. The third column +is the name of the module and the fourth column gives maintainer or +distribution information. =item CPAN::Module::as_string() @@ -7693,6 +7968,11 @@ defined: build_cache size of cache for directories to build modules build_dir locally accessible directory to build modules cache_metadata use serializer to cache metadata + commands_quote prefered character to use for quoting external + commands when running them. Defaults to double + quote on Windows, single tick everywhere else; + can be set to space to disable quoting + check_sigs if signatures should be verified cpan_home local directory reserved for this package dontload_list arrayref: modules in the list will not be loaded by the CPAN::has_inst() routine @@ -7840,6 +8120,9 @@ command-line F tool installed. You will also need to be able to connect over the Internet to the public keyservers, like pgp.mit.edu, and their port 11731 (the HKP protocol). +The configuration parameter check_sigs is there to turn signature +checking on or off. + =head1 EXPORT Most functions in package CPAN are exported per default. The reason @@ -8199,9 +8482,8 @@ nice about obeying that variable as well): =item 14) -I only know the usual options for ExtUtils::MakeMaker(Module::Build), -how do I find out the corresponding options in -Module::Build(ExtUtils::MakeMaker)? +How do I create a Module::Build based Build.PL derived from an +ExtUtils::MakeMaker focused Makefile.PL? http://search.cpan.org/search?query=Module::Build::Convert @@ -8219,6 +8501,13 @@ of building a Perl module package from a shell by following the installation instructions of that package still works in your environment. +=head1 SECURITY ADVICE + +This software enables you to upgrade software on your computer and so +is inherently dangerous because the newly installed software may +contain bugs and may alter the way your computer works or even make it +unusable. Please consider backing up your data before every upgrade. + =head1 AUTHOR Andreas Koenig C<< >> diff --git a/lib/CPAN/FirstTime.pm b/lib/CPAN/FirstTime.pm index 3d24c9c..9d39282 100644 --- a/lib/CPAN/FirstTime.pm +++ b/lib/CPAN/FirstTime.pm @@ -2,7 +2,7 @@ package CPAN::Mirrored::By; use strict; use vars qw($VERSION); -$VERSION = sprintf "%.6f", substr(q$Rev: 657 $,4)/1000000 + 5.4; +$VERSION = sprintf "%.6f", substr(q$Rev: 742 $,4)/1000000 + 5.4; sub new { my($self,@arg) = @_; @@ -21,7 +21,7 @@ use File::Basename (); use File::Path (); use File::Spec; use vars qw($VERSION); -$VERSION = sprintf "%.6f", substr(q$Rev: 657 $,4)/1000000 + 5.4; +$VERSION = sprintf "%.6f", substr(q$Rev: 742 $,4)/1000000 + 5.4; =head1 NAME @@ -240,6 +240,17 @@ Shall we use it as the general CPAN build and cache directory? # + # Module::Signature + # + $CPAN::Frontend->myprint($prompts{check_sigs_intro}); + + defined($default = $CPAN::Config->{check_sigs}) or + $default = 0; + $ans = prompt($prompts{check_sigs}, + ($default ? 'yes' : 'no')); + $CPAN::Config->{check_sigs} = ($ans =~ /^y/i ? 1 : 0); + + # # External programs # @@ -264,7 +275,7 @@ Shall we use it as the general CPAN build and cache directory? my $progcall = $progname; # we don't need ncftp if we have ncftpget next if $progname eq "ncftp" && $CPAN::Config->{ncftpget} gt " "; - my $path = $CPAN::Config->{$progname} + my $path = $CPAN::Config->{$progname} || $Config::Config{$progname} || ""; if (File::Spec->file_name_is_absolute($path)) { @@ -273,6 +284,8 @@ Shall we use it as the general CPAN build and cache directory? # warn "Warning: configured $path does not exist\n" unless -e $path; # $path = ""; + } elsif ($path =~ /^\s+$/) { + # preserve disabled programs } else { $path = ''; } @@ -409,6 +422,7 @@ Shall we use it as the general CPAN build and cache directory? $CPAN::Config->{inhibit_startup_message} = 0; $CPAN::Config->{getcwd} = 'cwd'; $CPAN::Config->{ftp_passive} = 1; + $CPAN::Config->{term_ornaments} = 1; $CPAN::Frontend->myprint("\n\n"); CPAN::HandleConfig->commit($configpm); @@ -693,13 +707,13 @@ my @prompts = ( manual_config => qq[ CPAN is the world-wide archive of perl resources. It consists of about -100 sites that all replicate the same contents all around the globe. +300 sites that all replicate the same contents around the globe. Many countries have at least one CPAN site already. The resources found on CPAN are easily accessible with the CPAN.pm module. If you want to use CPAN.pm, you have to configure it properly. -If you do not want to enter a dialog now, you can answer 'no' to this -question and I\'ll try to autoconfigure. (Note: you can revisit this +If you do NOT want to enter a dialog now, you can answer 'no' to this +question and I'll try to autoconfigure. (Note: you can revisit this dialog anytime later by typing 'o conf init' at the cpan prompt.) ], @@ -813,6 +827,31 @@ policy to one of the three values. prerequisites_policy => "Policy on building prerequisites (follow, ask or ignore)?", +check_sigs_intro => qq{ + +CPAN packages can be digitally signed by authors and thus verified +with the security provided by strong cryptography. The exact mechanism +is defined in the Module::Signature module. While this is generally +considered a good thing, it is not always convenient to the end user +to install modules that are signed incorrectly or where the key of the +author is not available or where some prerequisite for +Module::Signature has a bug and so on. + +With the check_sigs parameter you can turn signature checking on and +off. The default is off for now because the whole tool chain for the +functionality is not yet considered mature by some. The author of +CPAN.pm would recommend setting it to true most of the time and +turning it off only if it turns out to be annoying. + +Note that if you do not have Module::Signature installed, no signature +checks will be performed at all. + +}, + +check_sigs => +qq{Always try to check and verify signatures if a SIGNATURE file is in the package +and Module::Signature is installed (yes/no)?}, + external_progs => qq{ The CPAN module will need a few external programs to work properly. diff --git a/lib/CPAN/HandleConfig.pm b/lib/CPAN/HandleConfig.pm index 93e2a9c..588b15b 100644 --- a/lib/CPAN/HandleConfig.pm +++ b/lib/CPAN/HandleConfig.pm @@ -2,7 +2,7 @@ package CPAN::HandleConfig; use strict; use vars qw(%can %keys $VERSION); -$VERSION = sprintf "%.6f", substr(q$Rev: 657 $,4)/1000000 + 5.4; +$VERSION = sprintf "%.6f", substr(q$Rev: 740 $,4)/1000000 + 5.4; %can = ( commit => "Commit changes to disk", @@ -12,10 +12,12 @@ $VERSION = sprintf "%.6f", substr(q$Rev: 657 $,4)/1000000 + 5.4; ); %keys = map { $_ => undef } ( + # allow_unauthenticated ?? some day... "build_cache", "build_dir", "bzip2", "cache_metadata", + "check_sigs", "commandnumber_in_prompt", "cpan_home", "curl", @@ -48,6 +50,7 @@ $VERSION = sprintf "%.6f", substr(q$Rev: 657 $,4)/1000000 + 5.4; "ncftpget", "no_proxy", "pager", + "password", "prefer_installer", "prerequisites_policy", "scan_cache", @@ -55,8 +58,10 @@ $VERSION = sprintf "%.6f", substr(q$Rev: 657 $,4)/1000000 + 5.4; "show_upload_date", "tar", "term_is_latin", + "term_ornaments", "unzip", "urllist", + "username", "wait_list", "wget", ); @@ -272,6 +277,59 @@ sub defaults { 1; } +=head2 C<< CLASS->safe_quote ITEM >> + +Quotes an item to become safe against spaces +in shell interpolation. An item is enclosed +in double quotes if: + + - the item contains spaces in the middle + - the item does not start with a quote + +This happens to avoid shell interpolation +problems when whitespace is present in +directory names. + +This method uses C to determine +the correct quote. If C is +a space, no quoting will take place. + + +if it starts and ends with the same quote character: leave it as it is + +if it contains no whitespace: leave it as it is + +if it contains whitespace, then + +if it contains quotes: better leave it as it is + +else: quote it with the correct quote type for the box we're on + +=cut + +{ + # Instead of patching the guess, set commands_quote + # to the right value + my ($quotes,$use_quote) + = $^O eq 'MSWin32' + ? ('"', '"') + : (q<"'>, "'") + ; + + sub safe_quote { + my ($self, $command) = @_; + # Set up quote/default quote + my $quote = $CPAN::Config->{commands_quote} || $quotes; + + if ($quote ne ' ' + and $command =~ /\s/ + and $command !~ /[$quote]/) { + return qq<$use_quote$command$use_quote> + } + return $command; + } +} + sub init { my($self,@args) = @_; undef $CPAN::Config->{'inhibit_startup_message'}; # lazy trick to @@ -319,8 +377,16 @@ sub require_myconfig_or_config () { my $home = home(); unshift @INC, File::Spec->catdir($home,'.cpan'); eval { require CPAN::MyConfig }; + my $err_myconfig = $@; + if ($err_myconfig and $err_myconfig !~ m#locate CPAN/MyConfig\.pm#) { + die "Error while requiring CPAN::MyConfig:\n$err_myconfig"; + } unless ($INC{"CPAN/MyConfig.pm"}) { # this guy has settled his needs already eval {require CPAN::Config;}; # not everybody has one + my $err_config = $@; + if ($err_config and $err_config !~ m#locate CPAN/Config\.pm#) { + die "Error while requiring CPAN::Config:\n$err_config"; + } } } @@ -401,12 +467,12 @@ sub missing_config_data { "cache_metadata", "cpan_home", "ftp_proxy", - "gzip", + #"gzip", "http_proxy", "index_expire", "inhibit_startup_message", "keep_source_where", - "make", + #"make", "make_arg", "make_install_arg", "makepl_arg", @@ -415,11 +481,11 @@ sub missing_config_data { "mbuild_install_build_command", "mbuildpl_arg", "no_proxy", - "pager", + #"pager", "prerequisites_policy", "scan_cache", - "tar", - "unzip", + #"tar", + #"unzip", "urllist", ) { next unless exists $keys{$_}; @@ -486,7 +552,7 @@ package use strict; use vars qw($AUTOLOAD $VERSION); -$VERSION = sprintf "%.2f", substr(q$Rev: 657 $,4)/100; +$VERSION = sprintf "%.2f", substr(q$Rev: 740 $,4)/100; # formerly CPAN::HandleConfig was known as CPAN::Config sub AUTOLOAD { diff --git a/lib/CPAN/SIGNATURE b/lib/CPAN/SIGNATURE index abf2b69..6d8837d 100644 --- a/lib/CPAN/SIGNATURE +++ b/lib/CPAN/SIGNATURE @@ -1,5 +1,5 @@ This file contains message digests of all files listed in MANIFEST, -signed via the Module::Signature module, version 0.51. +signed via the Module::Signature module, version 0.54. To verify the content in this distribution, first make sure you have Module::Signature installed, then type: @@ -14,27 +14,27 @@ not run its Makefile.PL or Build.PL. -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 -SHA1 503d633750c15310bdac5fee77f4c97da1bc71f3 ChangeLog +SHA1 447d018a706534efcf1e1a435fb0935aae1f6623 ChangeLog SHA1 9b97524a7a91c815e46b19302a33829d3c26bbbf ChangeLog.old -SHA1 5d5c8e773ac9c97b5e7a5c65d9c31abef003b18b Changes +SHA1 3c9a07074ef95a9778e87a41f9315487c10feeba Changes SHA1 a029ffa2f2252bb8914eb658666244710994d256 Changes.old -SHA1 2eea12eec1dfa3b7c5e534d5252b4bb9becfa38f MANIFEST +SHA1 4532f91d1cd45d5b948accca01ad7bbf85e84655 MANIFEST SHA1 d6facfb968686d74e249cc1e45463e61ff18d026 MANIFEST.SKIP -SHA1 49f392243079d029a76b8fd56525acc0e1361d20 META.yml -SHA1 9f0ad024210c870711c6e52621483a6c735a2fc3 Makefile.PL +SHA1 4f388fc7e356900ed174cd8109b9af920c1e4f5c META.yml +SHA1 4c8e0f9432b5709d9d888685c095fd233fa82962 Makefile.PL SHA1 37e858c51409a297ef5d3fb35dc57cd3b57f9a4d PAUSE2003.pub SHA1 af016003ad503ed078c5f8254521d13a3e0c494f PAUSE2005.pub -SHA1 4ec86ae1993d8b497ce8c026530af71290366122 README -SHA1 78a1416b5cb1335b09472bcd17f4967e876e942f Todo +SHA1 4895962a895fea47b7dde8b08a1c137199e9b6ee README +SHA1 02b0065d1822dbb2a5d3a546f00c5450fb6cb79b Todo SHA1 efbe8e6882a2caa0d741b113959a706830ab5882 inc/Test/Builder.pm SHA1 ae1d68262bedc2475e2c6fd478d99b259b4fb109 inc/Test/More.pm -SHA1 6c2c007ac4f624f72635ec43ac045f6f031e7cd1 lib/CPAN.pm +SHA1 f74c02ef6e90ef9e057d9c1bb02008821ca1e9fe lib/CPAN.pm SHA1 94c4656fdae231c673719978e6e9a460f2dfc794 lib/CPAN/Admin.pm SHA1 8884e4b1932555e7d2f52d1df62097e8c78bb548 lib/CPAN/Debug.pm -SHA1 2b6bc87b7c09fb80d7962847e791cc697f1dc0f1 lib/CPAN/FirstTime.pm -SHA1 5b45acbcdc6da27ae1c1e6160cf78d51849d51ff lib/CPAN/HandleConfig.pm +SHA1 368d73cabcd53fc61f5ad091a0570f49100c934b lib/CPAN/FirstTime.pm +SHA1 8673b5108da6a37a9ebe0b6cc13065b80ed2dcbc lib/CPAN/HandleConfig.pm SHA1 f7b20d828c197710b4eac3029a30266242fb782b lib/CPAN/Nox.pm -SHA1 9c0d5f217194ac755e97e1f936a878bbc7eaa362 lib/CPAN/Tarzip.pm +SHA1 e7fe16eb17c3a987a7f504deca3f6cca4d5ea4ae lib/CPAN/Tarzip.pm SHA1 4d60b4782a851767c40dc27825057e584014cfc5 lib/CPAN/Version.pm SHA1 fb08e07d8740ef36e8ab719c6a9b7e89c4fe674a scripts/cpan SHA1 2a3adebb8252dc893681d17460082c2e08aa144a t/00signature.t @@ -43,12 +43,13 @@ SHA1 67e80e1cfc3530932de7743dd0c833b2c387609d t/02nox.t SHA1 b586d8e1a613880bbd2ec68d3abd0ca21e43b0c2 t/03pkgs.t SHA1 ebdb653877d5c5e5a071fe9933b18f018cde3250 t/10version.t SHA1 325d8a2f72d59c4cd2400c72403c05cd614c3abc t/11mirroredby.t -SHA1 96de4b1e41fca2ecf0641d4242020ccd05c4ef47 t/12cpan.t +SHA1 67e0a678e13fab53fa4441953c0f161add195616 t/12cpan.t SHA1 228e825e24b1cf3a3ca3fc24f1ea86de354c2cb6 t/30shell.pod -SHA1 5af241d60e757fbed792079b99eb0e15ac3d6628 t/30shell.t +SHA1 a2d61eaa040007d09f198f9b86df63025839567d t/30shell.t SHA1 6a79f15a10337bd3450604abf39d4462df2a550b t/50pod.t +SHA1 317755a5c56104702a6fd183457afcb3ee7d5251 t/60credentials.t SHA1 7efe930efd0a07d8101679ed15d4700dcf208137 t/CPAN/CpanTestDummies-1.55.pm -SHA1 2b0622cff92a038c8fbb2b852a55b014d20588f3 t/CPAN/TestConfig.pm +SHA1 f39ccb108dd4fb0e9635b24c09b5a2b299fe77e4 t/CPAN/TestConfig.pm SHA1 b4fd27234696da334ac6a1716222c70610a98c3a t/CPAN/authors/01mailrc.txt SHA1 61f6dbc7e5616028952b07a0451e029d41993bb6 t/CPAN/authors/id/A/AN/ANDK/CHECKSUMS SHA1 d1a101f24d2d0719c9991df28ede729d58005bb4 t/CPAN/authors/id/A/AN/ANDK/CHECKSUMS@588 @@ -63,12 +64,12 @@ SHA1 1aee1bed21f0e9755d693419e810ec75543eb0b7 t/CPAN/authors/id/A/AN/CHECKSUMS SHA1 1f3304f219bf0da4db6a60f638e11b61c2c2f4c0 t/CPAN/authors/id/A/CHECKSUMS SHA1 dfc900f5bfbc9683fa91977a1c7198222fbd4452 t/CPAN/authors/id/CHECKSUMS SHA1 468603b8016e599fec432e807890fb55f07483a6 t/CPAN/modules/02packages.details.txt -SHA1 9bbcc30e783e5fe67e2aa12d5f1fe113563e345c t/CPAN/modules/03modlist.data -SHA1 836b7df7eb49a55bfc2afdb666be6ac72e5658bc t/README.shell.txt +SHA1 f4c1a524de16347b37df6427ca01f98dd27f3c81 t/CPAN/modules/03modlist.data +SHA1 8d388a1036ae5e287a2331ce38d65f6b882ed623 t/README.shell.txt -----BEGIN PGP SIGNATURE----- -Version: GnuPG v1.4.2 (GNU/Linux) +Version: GnuPG v1.4.3 (GNU/Linux) -iD8DBQFEAqK+7IA58KMXwV0RAi6oAJ4mPY4qXiPW8Ee3PEbhyHMWyWJWPQCg6Q99 -CZnZg3sLednZofhJcd75dlM= -=wrpR +iD8DBQFEy7g57IA58KMXwV0RArlgAJ4q4WAEjyv92NefEikRM5hULGxKHQCfZVjo +Vdq3I7ykecETlhiyH2qR1ao= +=fOLR -----END PGP SIGNATURE----- diff --git a/lib/CPAN/Tarzip.pm b/lib/CPAN/Tarzip.pm index d0281d2..b5005dd 100644 --- a/lib/CPAN/Tarzip.pm +++ b/lib/CPAN/Tarzip.pm @@ -4,7 +4,7 @@ use strict; use vars qw($VERSION @ISA $BUGHUNTING); use CPAN::Debug; use File::Basename (); -$VERSION = sprintf "%.6f", substr(q$Rev: 659 $,4)/1000000 + 5.4; +$VERSION = sprintf "%.6f", substr(q$Rev: 714 $,4)/1000000 + 5.4; # module is internal to CPAN.pm @ISA = qw(CPAN::Debug); @@ -28,7 +28,7 @@ sub new { $bzip2 = File::Which::which("bzip2"); } if ($bzip2) { - $me->{UNGZIPPRG} = $bzip2; + $me->{UNGZIPPRG} = $bzip2 || "bzip2"; } else { $CPAN::Frontend->mydie(qq{ CPAN.pm needs the external program bzip2 in order to handle '$file'. @@ -39,7 +39,7 @@ program. } } else { # yes, we let gzip figure it out in *any* other case - $me->{UNGZIPPRG} = $CPAN::Config->{gzip}; + $me->{UNGZIPPRG} = $CPAN::Config->{gzip} || "gzip"; } bless $me, $class; } @@ -60,7 +60,8 @@ sub gzip { $fhw->close; return 1; } else { - system(qq{$self->{UNGZIPPRG} -c "$read" > "$write"})==0; + my $command = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG}); + system(qq{$command -c "$read" > "$write"})==0; } } @@ -82,7 +83,8 @@ sub gunzip { $fhw->close; return 1; } else { - system(qq{$self->{UNGZIPPRG} -dc "$read" > "$write"})==0; + my $command = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG}); + system(qq{$command -dc "$read" > "$write"})==0; } } @@ -114,7 +116,8 @@ sub gtest { $gz->gzclose(); CPAN->debug("err[$err]success[$success]") if $CPAN::DEBUG; } else { - $success = 0==system(qq{$self->{UNGZIPPRG} -qdt "$read"}); + my $command = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG}); + $success = 0==system(qq{$command -qdt "$read"}); } return $self->{GTEST} = $success; } @@ -135,7 +138,8 @@ sub TIEHANDLE { die "Could not gzopen $file"; $self->{GZ} = $gz; } else { - my $pipe = "$CPAN::Config->{gzip} -dc $file |"; + my $gzip = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG}); + my $pipe = "$gzip -dc $file |"; my $fh = FileHandle->new($pipe) or die "Could not pipe[$pipe]: $!"; binmode $fh; $self->{FH} = $fh; @@ -197,7 +201,7 @@ sub untar { $prefer=2; } elsif (MM->maybe_command($self->{UNGZIPPRG}) && - MM->maybe_command($CPAN::Config->{'tar'})) { + MM->maybe_command($CPAN::Config->{tar})) { # should be default until Archive::Tar handles bzip2 $prefer = 1; } elsif ( @@ -219,11 +223,13 @@ installed. Can't continue. if ($prefer==1) { # 1 => external gzip+tar my($system); my $is_compressed = $self->gtest(); + my $tarcommand = CPAN::HandleConfig->safe_quote($CPAN::Config->{tar}) || "tar"; if ($is_compressed) { - $system = qq{$self->{UNGZIPPRG} -dc }. - qq{< "$file" | $CPAN::Config->{tar} xvf -}; + my $command = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG}); + $system = qq{$command -dc }. + qq{< "$file" | $tarcommand xvf -}; } else { - $system = qq{$CPAN::Config->{tar} xvf "$file"}; + $system = qq{$tarcommand xvf "$file"}; } if (system($system) != 0) { # people find the most curious tar binaries that cannot handle @@ -239,7 +245,7 @@ installed. Can't continue. } $file = $ungzf; } - $system = qq{$CPAN::Config->{tar} xvf "$file"}; + $system = qq{$tarcommand xvf "$file"}; $CPAN::Frontend->myprint(qq{Using Tar:$system:\n}); if (system($system)==0) { $CPAN::Frontend->myprint(qq{Untarred $file successfully\n});