Edit File: Checksums.pm
package CPANPLUS::Module::Checksums; 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.9138"; =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;