view release on metacpan or  search on metacpan

lib/CPANPLUS/Module/Checksums.pm  view on Meta::CPAN

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 $cpan_path = $href->{ $self->package }->{'cpan_path'};

    if ( defined $cpan_path ) {
        my $chk_pth = join '/', 'authors/id', $cpan_path;
        if ( $chk_pth ne $self->path ) {
            error(loc(  "Archive checksum path for '%1': " .
                        "should be '%2', but it says it is '%3'. Abandoning.",
                        $self->package, $self->path, $chk_pth));
            return $self->status->checksum_ok(0);
        }
    }

    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;