CPAN
view release on metacpan or search on metacpan
lib/CPAN/Distribution.pm view on Meta::CPAN
my($self) = @_;
my($dist) = $self->id;
my($sans,$suffix) = $dist =~ /(.+)\.(tgz|tar[\._-]gz|tar\.Z|zip)$/;
$self->debug("sans[$sans] suffix[$suffix]\n") if $CPAN::DEBUG;
my($local_file);
my($local_wanted) =
File::Spec->catfile(
$CPAN::Config->{keep_source_where},
"authors",
"id",
split(/\//,"$sans.readme"),
);
my $readme = "authors/id/$sans.readme";
$self->debug("Doing localize for '$readme'") if $CPAN::DEBUG;
$local_file = CPAN::FTP->localize($readme,
$local_wanted)
or $CPAN::Frontend->mydie(qq{No $sans.readme found});
if ($^O eq 'MacOS') {
Mac::BuildTools::launch_file($local_file);
return;
}
my $fh_pager = FileHandle->new;
local($SIG{PIPE}) = "IGNORE";
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 "$pager"
});
$fh_pager->print(<$fh_readme>);
$fh_pager->close;
}
#-> sub CPAN::Distribution::verifyCHECKSUM ;
sub verifyCHECKSUM {
my($self) = @_;
EXCUSE: {
my @e;
$self->{CHECKSUM_STATUS} ||= "";
$self->{CHECKSUM_STATUS} eq "OK" and push @e, "Checksum was ok";
$CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
}
my($lc_want,$lc_file,@local,$basename);
@local = split(/\//,$self->id);
pop @local;
push @local, "CHECKSUMS";
$lc_want =
File::Spec->catfile($CPAN::Config->{keep_source_where},
"authors", "id", @local);
local($") = "/";
if (my $size = -s $lc_want) {
$self->debug("lc_want[$lc_want]size[$size]") if $CPAN::DEBUG;
my @stat = stat $lc_want;
my $epoch_starting_support_of_cpan_path = 1637471530;
if ($stat[9] >= $epoch_starting_support_of_cpan_path) {
if ($self->CHECKSUM_check_file($lc_want, 1)) {
return $self->{CHECKSUM_STATUS} = "OK";
}
} else {
unlink $lc_want;
}
}
$lc_file = CPAN::FTP->localize("authors/id/@local",
$lc_want,1);
unless ($lc_file) {
$CPAN::Frontend->myprint("Trying $lc_want.gz\n");
$local[-1] .= ".gz";
$lc_file = CPAN::FTP->localize("authors/id/@local",
"$lc_want.gz",1);
if ($lc_file) {
$lc_file =~ s/\.gz(?!\n)\Z//;
eval{CPAN::Tarzip->new("$lc_file.gz")->gunzip($lc_file)};
} else {
return;
}
}
if ($self->CHECKSUM_check_file($lc_file)) {
return $self->{CHECKSUM_STATUS} = "OK";
}
}
#-> sub CPAN::Distribution::SIG_check_file ;
sub SIG_check_file {
my($self,$chk_file) = @_;
my $rv = eval { Module::Signature::_verify($chk_file) };
if ($rv eq Module::Signature::CANNOT_VERIFY()) {
$CPAN::Frontend->myprint(qq{\nSignature for }.
qq{file $chk_file could not be verified for an unknown reason. }.
$self->as_string.
qq{Module::Signature verification returned value $rv\n\n}
);
my $wrap = qq{The manual says for this case: Cannot verify the
OpenPGP signature, maybe due to the lack of a network connection to
the key server, or if neither gnupg nor Crypt::OpenPGP exists on the
system. You probably want to analyse the situation and if you cannot
fix it you will have to decide whether you want to stop this session
or you want to turn off signature verification. The latter would be
done with the command 'o conf init check_sigs'};
$CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
} if ($rv == Module::Signature::SIGNATURE_OK()) {
$CPAN::Frontend->myprint("Signature for $chk_file ok\n");
return $self->{SIG_STATUS} = "OK";
} else {
$CPAN::Frontend->mywarn(qq{\nSignature invalid for }.
qq{file $chk_file. }.
qq{Please investigate.\n\n}.
$self->as_string.
qq{Module::Signature verification returned value $rv\n\n}
);
my $wrap = qq{I\'d recommend removing $chk_file. Its signature
is invalid. Maybe you have configured your 'urllist' with
lib/CPAN/Distribution.pm view on Meta::CPAN
$self->debug("Module::Signature is installed, verifying") if $CPAN::DEBUG;
$self->SIG_check_file($chk_file);
} else {
$self->debug("Module::Signature is NOT installed") if $CPAN::DEBUG;
}
}
$file = $self->{localfile};
$basename = File::Basename::basename($file);
my($signed_data);
my $fh = FileHandle->new;
if ($check_sigs) {
my $tempdir;
if ($CPAN::META->has_usable("File::Temp")) {
$tempdir = File::Temp::tempdir("CHECKSUMS-XXXX", CLEANUP => 1, DIR => "/tmp" );
} else {
$tempdir = File::Spec->catdir(File::Spec->tmpdir, "CHECKSUMS-$$");
File::Path::mkpath($tempdir);
}
my $tempfile = File::Spec->catfile($tempdir, "CHECKSUMS.$$");
unlink $tempfile; # ignore missing file
my $devnull = File::Spec->devnull;
my $gpg = $CPAN::Config->{gpg} or
$CPAN::Frontend->mydie("Your configuration suggests that you do not have 'gpg' installed. This is needed to verify checksums with the config variable 'check_sigs' on. Please configure it with 'o conf init gpg'");
my $system = qq{"$gpg" --verify --batch --no-tty --output "$tempfile" "$chk_file" 2> "$devnull"};
0 == system $system or $CPAN::Frontend->mydie("gpg run was failing, cannot continue: $system");
open $fh, $tempfile or $CPAN::Frontend->mydie("Could not open $tempfile: $!");
local $/;
$signed_data = <$fh>;
close $fh;
File::Path::rmtree($tempdir);
} else {
my $fh = FileHandle->new;
if (open $fh, $chk_file) {
local($/);
$signed_data = <$fh>;
} else {
$CPAN::Frontend->mydie("Could not open $chk_file for reading");
}
close $fh;
}
$signed_data =~ s/\015?\012/\n/g;
my($compmt) = Safe->new();
$cksum = $compmt->reval($signed_data);
if ($@) {
rename $chk_file, "$chk_file.bad";
Carp::confess($@) if $@;
}
if (! ref $cksum or ref $cksum ne "HASH") {
$CPAN::Frontend->mywarn(qq{
Warning: checksum file '$chk_file' broken.
When trying to read that file I expected to get a hash reference
for further processing, but got garbage instead.
});
my $answer = CPAN::Shell::colorable_makemaker_prompt("Proceed nonetheless?", "no");
$answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.\n");
$self->{CHECKSUM_STATUS} = "NIL -- CHECKSUMS file broken";
return;
} elsif (exists $cksum->{$basename} && ! exists $cksum->{$basename}{cpan_path}) {
$CPAN::Frontend->mywarn(qq{
Warning: checksum file '$chk_file' not conforming.
The cksum does not contain the key 'cpan_path' for '$basename'.
});
my $answer = CPAN::Shell::colorable_makemaker_prompt("Proceed nonetheless?", "no");
$answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.\n");
$self->{CHECKSUM_STATUS} = "NIL -- CHECKSUMS file without cpan_path";
return;
} elsif (exists $cksum->{$basename} && substr($self->{ID},0,length($cksum->{$basename}{cpan_path}))
ne $cksum->{$basename}{cpan_path}) {
$CPAN::Frontend->mywarn(qq{
Warning: checksum file not matching path '$self->{ID}'.
The cksum contain the key 'cpan_path=$cksum->{$basename}{cpan_path}'
which does not match the ID of the distribution '$self->{ID}'.
Something's suspicious might be going on here. Please investigate.
});
my $answer = CPAN::Shell::colorable_makemaker_prompt("Proceed nonetheless?", "no");
$answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.\n");
$self->{CHECKSUM_STATUS} = "NIL -- CHECKSUMS non-matching cpan_path vs. ID";
return;
} elsif (exists $cksum->{$basename}{sha256}) {
$self->debug("Found checksum for $basename:" .
"$cksum->{$basename}{sha256}\n") if $CPAN::DEBUG;
open($fh, $file);
binmode $fh;
my $eq = $self->eq_CHECKSUM($fh,$cksum->{$basename}{sha256});
$fh->close;
$fh = CPAN::Tarzip->TIEHANDLE($file);
unless ($eq) {
my $dg = Digest::SHA->new(256);
my($data,$ref);
$ref = \$data;
while ($fh->READ($ref, 4096) > 0) {
$dg->add($data);
}
my $hexdigest = $dg->hexdigest;
$eq += $hexdigest eq $cksum->{$basename}{'sha256-ungz'};
}
if ($eq) {
$CPAN::Frontend->myprint("Checksum for $file ok\n");
return $self->{CHECKSUM_STATUS} = "OK";
} else {
$CPAN::Frontend->myprint(qq{\nChecksum mismatch for }.
qq{distribution file. }.
qq{Please investigate.\n\n}.
$self->as_string,
$CPAN::META->instance(
'CPAN::Author',
$self->cpan_userid
)->as_string);
my $wrap = qq{I\'d recommend removing $file. Its
checksum is incorrect. Maybe you have configured your 'urllist' with
a bad URL. Please check this array with 'o conf urllist', and
retry.};
$CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
# former versions just returned here but this seems a
# serious threat that deserves a die
# $CPAN::Frontend->myprint("\n\n");
# sleep 3;
# return;
}
# close $fh if fileno($fh);
} else {
return if $sloppy;
unless ($self->{CHECKSUM_STATUS}) {
$CPAN::Frontend->mywarn(qq{
Warning: No checksum for $basename in $chk_file.
The cause for this may be that the file is very new and the checksum
has not yet been calculated, but it may also be that something is
going awry right now.
});
lib/CPAN/Distribution.pm view on Meta::CPAN
$CPAN::Frontend->mywarn("The current configuration of allow_installing_outdated_dists is '$allow_outdd', but for this option we would need 'CPAN::DistnameInfo' installed. Please install 'CPAN::DistnameInfo' as soon as possible. As long as...
$allow_outdd = "yes";
}
}
return 1 if
$allow_down eq "yes"
&& $allow_outdd eq "yes";
my($dist_version, $dist_dist);
if ($allow_outdd ne "yes"){
my $dni = CPAN::DistnameInfo->new($pretty_id);
$dist_version = $dni->version;
$dist_dist = $dni->dist;
}
my $iterator = blib_pm_walk();
my(@down,@outdd);
while (my $file = $iterator->()) {
my $version = CPAN::Module->parse_version($file);
my($volume, $directories, $pmfile) = File::Spec->splitpath( $file );
my @dirs = File::Spec->splitdir( $directories );
my(@blib_plus1) = splice @dirs, 0, 2;
my($pmpath) = File::Spec->catfile(grep { length($_) } @dirs, $pmfile);
unless ($allow_down eq "yes") {
if (my $inst_file = $self->_file_in_path($pmpath, \@INC)) {
my $inst_version = CPAN::Module->parse_version($inst_file);
my $cmp = CPAN::Version->vcmp($version, $inst_version);
if ($cmp) {
if ($cmp < 0) {
push @down, { pmpath => $pmpath, version => $version, inst_version => $inst_version };
}
}
if (@down) {
my $why = "allow_installing_module_downgrades: $id contains downgrading module(s) (e.g. '$down[0]{pmpath}' would downgrade installed '$down[0]{inst_version}' to '$down[0]{version}')";
if (my($default) = $allow_down =~ m|^ask/(.+)|) {
$default = "yes" unless $default =~ /^(y|n)/i;
my $answer = CPAN::Shell::colorable_makemaker_prompt
("$why. Do you want to allow installing it?",
$default, "colorize_warn");
$allow_down = $answer =~ /^\s*y/i ? "yes" : "no";
}
if ($allow_down eq "no") {
return (0, $why);
}
}
}
}
unless ($allow_outdd eq "yes") {
my @pmpath = (@dirs, $pmfile);
$pmpath[-1] =~ s/\.pm$//;
my $mo = CPAN::Shell->expand("Module",join "::", grep { length($_) } @pmpath);
if ($mo) {
my $cpan_version = $mo->cpan_version;
my $is_lower = CPAN::Version->vlt($version, $cpan_version);
my $other_dist;
if (my $mo_dist = $mo->distribution) {
$other_dist = $mo_dist->pretty_id;
my $dni = CPAN::DistnameInfo->new($other_dist);
if ($dni->dist eq $dist_dist){
if (CPAN::Version->vgt($dni->version, $dist_version)) {
push @outdd, {
pmpath => $pmpath,
cpan_path => $dni->pathname,
dist_version => $dni->version,
dist_dist => $dni->dist,
};
}
}
}
}
if (@outdd && $allow_outdd ne "yes") {
my $why = "allow_installing_outdated_dists: $id contains module(s) that are indexed on the CPAN with a different distro: (e.g. '$outdd[0]{pmpath}' is indexed with '$outdd[0]{cpan_path}')";
if ($outdd[0]{dist_dist} eq $dist_dist) {
$why .= ", and this has a higher distribution-version, i.e. version '$outdd[0]{dist_version}' is higher than '$dist_version')";
}
if (my($default) = $allow_outdd =~ m|^ask/(.+)|) {
$default = "yes" unless $default =~ /^(y|n)/i;
my $answer = CPAN::Shell::colorable_makemaker_prompt
("$why. Do you want to allow installing it?",
$default, "colorize_warn");
$allow_outdd = $answer =~ /^\s*y/i ? "yes" : "no";
}
if ($allow_outdd eq "no") {
return (0, $why);
}
}
}
}
return 1;
}
sub _file_in_path { # similar to CPAN::Module::_file_in_path
my($self,$pmpath,$incpath) = @_;
my($dir,@packpath);
foreach $dir (@$incpath) {
my $pmfile = File::Spec->catfile($dir,$pmpath);
if (-f $pmfile) {
return $pmfile;
}
}
return;
}
sub introduce_myself {
my($self) = @_;
$CPAN::Frontend->myprint(sprintf(" %s\n",$self->pretty_id));
}
#-> sub CPAN::Distribution::dir ;
sub dir {
shift->{build_dir};
}
#-> sub CPAN::Distribution::perldoc ;
sub perldoc {
my($self) = @_;
my($dist) = $self->id;
my $package = $self->called_for;
if ($CPAN::META->has_inst("Pod::Perldocs")) {
my($perl) = $self->perl
or $CPAN::Frontend->mydie("Couldn't find executable perl\n");
my @args = ($perl, q{-MPod::Perldocs}, q{-e},
q{Pod::Perldocs->run()}, $package);
my($wstatus);
unless ( ($wstatus = system(@args)) == 0 ) {
my $estatus = $wstatus >> 8;
$CPAN::Frontend->myprint(qq{
Function system("@args")
returned status $estatus (wstat $wstatus)
});
}
( run in 2.434 seconds using v1.01-cache-2.11-cpan-39bf76dae61 )