summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/CPANPLUS/Module/Checksums.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/CPANPLUS/Module/Checksums.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/CPANPLUS/Module/Checksums.pm260
1 files changed, 0 insertions, 260 deletions
diff --git a/Master/tlpkg/tlperl/lib/CPANPLUS/Module/Checksums.pm b/Master/tlpkg/tlperl/lib/CPANPLUS/Module/Checksums.pm
deleted file mode 100644
index 51263b4d252..00000000000
--- a/Master/tlpkg/tlperl/lib/CPANPLUS/Module/Checksums.pm
+++ /dev/null
@@ -1,260 +0,0 @@
-package CPANPLUS::Module::Checksums;
-use deprecate;
-
-use strict;
-use vars qw[@ISA $VERSION];
-
-use CPANPLUS::Error;
-use CPANPLUS::Internals::Constants;
-
-use FileHandle;
-
-use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext';
-use Params::Check qw[check];
-use Module::Load::Conditional qw[can_load];
-
-$Params::Check::VERBOSE = 1;
-
-@ISA = qw[ CPANPLUS::Module::Signature ];
-$VERSION = "0.9135";
-
-=head1 NAME
-
-CPANPLUS::Module::Checksums - checking the checksum of a distribution
-
-=head1 SYNOPSIS
-
- $file = $modobj->checksums;
- $bool = $mobobj->_validate_checksum;
-
-=head1 DESCRIPTION
-
-This is a class that provides functions for checking the checksum
-of a distribution. Should not be loaded directly, but used via the
-interface provided via C<CPANPLUS::Module>.
-
-=head1 METHODS
-
-=head2 $mod->checksums
-
-Fetches the checksums file for this module object.
-For the options it can take, see C<CPANPLUS::Module::fetch()>.
-
-Returns the location of the checksums file on success and false
-on error.
-
-The location of the checksums file is also stored as
-
- $mod->status->checksums
-
-=cut
-
-sub checksums {
- my $mod = shift or return;
-
- my $file = $mod->_get_checksums_file( @_ );
-
- return $mod->status->checksums( $file ) if $file;
-
- return;
-}
-
-### checks if the package checksum matches the one
-### from the checksums file
-sub _validate_checksum {
- my $self = shift; #must be isa CPANPLUS::Module
- my $conf = $self->parent->configure_object;
- my %hash = @_;
-
- my $verbose;
- my $tmpl = {
- verbose => { default => $conf->get_conf('verbose'),
- store => \$verbose },
- };
-
- check( $tmpl, \%hash ) or return;
-
- ### if we can't check it, we must assume it's ok ###
- return $self->status->checksum_ok(1)
- unless can_load( modules => { 'Digest::SHA' => '0.0' } );
- #class CPANPLUS::Module::Status is runtime-generated
-
- my $file = $self->_get_checksums_file( verbose => $verbose ) or (
- error(loc(q[Could not fetch '%1' file], CHECKSUMS)), return );
-
- $self->_check_signature_for_checksum_file( file => $file ) or (
- error(loc(q[Could not verify '%1' file], CHECKSUMS)), return );
- #for whole CHECKSUMS file
-
- my $href = $self->_parse_checksums_file( file => $file ) or (
- error(loc(q[Could not parse '%1' file], CHECKSUMS)), return );
-
- my $size = $href->{ $self->package }->{'size'};
-
- ### the checksums file tells us the size of the archive
- ### but the downloaded file is of different size
- if( defined $size ) {
- if( not (-s $self->status->fetch == $size) ) {
- error(loc( "Archive size does not match for '%1': " .
- "size is '%2' but should be '%3'",
- $self->package, -s $self->status->fetch, $size));
- return $self->status->checksum_ok(0);
- }
- } else {
- msg(loc("Archive size is not known for '%1'",$self->package),$verbose);
- }
-
- my $sha = $href->{ $self->package }->{'sha256'};
-
- unless( defined $sha ) {
- msg(loc("No 'sha256' checksum known for '%1'",$self->package),$verbose);
-
- return $self->status->checksum_ok(1);
- }
-
- $self->status->checksum_value($sha);
-
-
- my $fh = FileHandle->new( $self->status->fetch ) or return;
- binmode $fh;
-
- my $ctx = Digest::SHA->new(256);
- $ctx->addfile( $fh );
-
- my $hexdigest = $ctx->hexdigest;
- my $flag = $hexdigest eq $sha;
- $flag
- ? msg(loc("Checksum matches for '%1'", $self->package),$verbose)
- : error(loc("Checksum does not match for '%1': " .
- "SHA256 is '%2' but should be '%3'",
- $self->package, $hexdigest, $sha),$verbose);
-
-
- return $self->status->checksum_ok(1) if $flag;
- return $self->status->checksum_ok(0);
-}
-
-
-### fetches the module objects checksum file ###
-sub _get_checksums_file {
- my $self = shift;
- my %hash = @_;
-
- my $clone = $self->clone;
- $clone->package( CHECKSUMS );
-
- # If the user specified a fetchdir, then every CHECKSUMS file will always
- # be stored there, not in an author-specific subdir. Thus, in this case,
- # we need to always re-fetch the CHECKSUMS file and hence need to set the
- # TTL to something small.
- my $have_fetchdir =
- $self->parent->configure_object->get_conf('fetchdir') ne '';
- my $ttl = $have_fetchdir ? 0.001 : 3600;
- my $file = $clone->fetch( ttl => $ttl, %hash ) or return;
-
- return $file;
-}
-
-sub _parse_checksums_file {
- my $self = shift;
- my %hash = @_;
-
- my $file;
- my $tmpl = {
- file => { required => 1, allow => FILE_READABLE, store => \$file },
- };
- my $args = check( $tmpl, \%hash );
-
- my $fh = OPEN_FILE->( $file ) or return;
-
- ### loop over the header, there might be a pgp signature ###
- my $signed;
- while (local $_ = <$fh>) {
- last if /^\$cksum = \{\s*$/; # skip till this line
- my $header = PGP_HEADER; # but be tolerant of whitespace
- $signed = 1 if /^${header}\s*$/;# due to crossplatform linebreaks
- }
-
- ### read the filehandle, parse it rather than eval it, even though it
- ### *should* be valid perl code
- my $dist;
- my $cksum = {};
- while (local $_ = <$fh>) {
-
- if (/^\s*'([^']+)' => \{\s*$/) {
- $dist = $1;
-
- } elsif (/^\s*'([^']+)' => '?([^'\n]+)'?,?\s*$/ and defined $dist) {
- $cksum->{$dist}{$1} = $2;
-
- } elsif (/^\s*}[,;]?\s*$/) {
- undef $dist;
-
- } elsif (/^__END__\s*$/) {
- last;
-
- } else {
- error( loc("Malformed %1 line: %2", CHECKSUMS, $_) );
- }
- }
-
- return $cksum;
-}
-
-sub _check_signature_for_checksum_file {
- my $self = shift;
-
- my $conf = $self->parent->configure_object;
- my %hash = @_;
-
- ### you don't want to check signatures,
- ### so let's just return true;
- return 1 unless $conf->get_conf('signature');
-
- my($force,$file,$verbose);
- my $tmpl = {
- file => { required => 1, allow => FILE_READABLE, store => \$file },
- force => { default => $conf->get_conf('force'), store => \$force },
- verbose => { default => $conf->get_conf('verbose'), store => \$verbose },
- };
-
- my $args = check( $tmpl, \%hash ) or return;
-
- my $fh = OPEN_FILE->($file) or return;
-
- my $signed;
- while (local $_ = <$fh>) {
- my $header = PGP_HEADER;
- $signed = 1 if /^$header$/;
- }
-
- if ( !$signed ) {
- msg(loc("No signature found in %1 file '%2'",
- CHECKSUMS, $file), $verbose);
-
- return 1 unless $force;
-
- error( loc( "%1 file '%2' is not signed -- aborting",
- CHECKSUMS, $file ) );
- return;
-
- }
-
- if( can_load( modules => { 'Module::Signature' => '0.06' } ) ) {
- # local $Module::Signature::SIGNATURE = $file;
- # ... check signatures ...
- }
-
- return 1;
-}
-
-
-
-# Local variables:
-# c-indentation-style: bsd
-# c-basic-offset: 4
-# indent-tabs-mode: nil
-# End:
-# vim: expandtab shiftwidth=4:
-
-1;
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-21 05:12:32 +0000