home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / perl / 5.10.0 / CPANPLUS / Module / Checksums.pm < prev    next >
Encoding:
Perl POD Document  |  2009-06-26  |  6.4 KB  |  252 lines
  1. package CPANPLUS::Module::Checksums;
  2.  
  3. use strict;
  4. use vars qw[@ISA];
  5.  
  6.  
  7. use CPANPLUS::Error;
  8. use CPANPLUS::Internals::Constants;
  9.  
  10. use FileHandle;
  11.  
  12. use Locale::Maketext::Simple    Class => 'CPANPLUS', Style => 'gettext';
  13. use Params::Check               qw[check];
  14. use Module::Load::Conditional   qw[can_load];
  15.  
  16. $Params::Check::VERBOSE = 1;
  17.  
  18. @ISA = qw[ CPANPLUS::Module::Signature ];
  19.  
  20. =head1 NAME
  21.  
  22. CPANPLUS::Module::Checksums
  23.  
  24. =head1 SYNOPSIS
  25.  
  26.     $file   = $modobj->checksums;
  27.     $bool   = $mobobj->_validate_checksum;
  28.  
  29. =head1 DESCRIPTION
  30.  
  31. This is a class that provides functions for checking the checksum 
  32. of a distribution. Should not be loaded directly, but used via the
  33. interface provided via C<CPANPLUS::Module>.
  34.  
  35. =head1 METHODS
  36.  
  37. =head2 $mod->checksums
  38.  
  39. Fetches the checksums file for this module object.
  40. For the options it can take, see C<CPANPLUS::Module::fetch()>.
  41.  
  42. Returns the location of the checksums file on success and false
  43. on error.
  44.  
  45. The location of the checksums file is also stored as
  46.  
  47.     $mod->status->checksums
  48.  
  49. =cut
  50.  
  51. sub checksums {
  52.     my $mod = shift or return;
  53.  
  54.     my $file = $mod->_get_checksums_file( @_ );
  55.  
  56.     return $mod->status->checksums( $file ) if $file;
  57.  
  58.     return;
  59. }
  60.  
  61. ### checks if the package checksum matches the one
  62. ### from the checksums file
  63. sub _validate_checksum {
  64.     my $self = shift; #must be isa CPANPLUS::Module
  65.     my $conf = $self->parent->configure_object;
  66.     my %hash = @_;
  67.  
  68.     my $verbose;
  69.     my $tmpl = {
  70.         verbose => {    default => $conf->get_conf('verbose'),
  71.                         store   => \$verbose },
  72.     };
  73.  
  74.     check( $tmpl, \%hash ) or return;
  75.  
  76.     ### if we can't check it, we must assume it's ok ###
  77.     return $self->status->checksum_ok(1)
  78.             unless can_load( modules => { 'Digest::MD5' => '0.0' } );
  79.     #class CPANPLUS::Module::Status is runtime-generated
  80.  
  81.     my $file = $self->_get_checksums_file( verbose => $verbose ) or (
  82.         error(loc(q[Could not fetch '%1' file], CHECKSUMS)), return );
  83.  
  84.     $self->_check_signature_for_checksum_file( file => $file ) or (
  85.         error(loc(q[Could not verify '%1' file], CHECKSUMS)), return );
  86.     #for whole CHECKSUMS file
  87.  
  88.     my $href = $self->_parse_checksums_file( file => $file ) or (
  89.         error(loc(q[Could not parse '%1' file], CHECKSUMS)), return );
  90.  
  91.     my $size = $href->{ $self->package }->{'size'};
  92.  
  93.     ### the checksums file tells us the size of the archive
  94.     ### but the downloaded file is of different size
  95.     if( defined $size ) {
  96.         if( not (-s $self->status->fetch == $size) ) {
  97.             error(loc(  "Archive size does not match for '%1': " .
  98.                         "size is '%2' but should be '%3'",
  99.                         $self->package, -s $self->status->fetch, $size));
  100.             return $self->status->checksum_ok(0);
  101.         }
  102.     } else {
  103.         msg(loc("Archive size is not known for '%1'",$self->package),$verbose);
  104.     }
  105.     
  106.     my $md5 = $href->{ $self->package }->{'md5'};
  107.  
  108.     unless( defined $md5 ) {
  109.         msg(loc("No 'md5' checksum known for '%1'",$self->package),$verbose);
  110.  
  111.         return $self->status->checksum_ok(1);
  112.     }
  113.  
  114.     $self->status->checksum_value($md5);
  115.  
  116.  
  117.     my $fh = FileHandle->new( $self->status->fetch ) or return;
  118.     binmode $fh;
  119.  
  120.     my $ctx = Digest::MD5->new;
  121.     $ctx->addfile( $fh );
  122.  
  123.     my $flag = $ctx->hexdigest eq $md5;
  124.     $flag
  125.         ? msg(loc("Checksum matches for '%1'", $self->package),$verbose)
  126.         : error(loc("Checksum does not match for '%1': " .
  127.                     "MD5 is '%2' but should be '%3'",
  128.                     $self->package, $ctx->hexdigest, $md5),$verbose);
  129.  
  130.  
  131.     return $self->status->checksum_ok(1) if $flag;
  132.     return $self->status->checksum_ok(0);
  133. }
  134.  
  135.  
  136. ### fetches the module objects checksum file ###
  137. sub _get_checksums_file {
  138.     my $self = shift;
  139.     my %hash = @_;
  140.  
  141.     my $clone = $self->clone;
  142.     $clone->package( CHECKSUMS );
  143.  
  144.     my $file = $clone->fetch( %hash, force => 1 ) or return;
  145.  
  146.     return $file;
  147. }
  148.  
  149. sub _parse_checksums_file {
  150.     my $self = shift;
  151.     my %hash = @_;
  152.  
  153.     my $file;
  154.     my $tmpl = {
  155.         file    => { required => 1, allow => FILE_READABLE, store => \$file },
  156.     };
  157.     my $args = check( $tmpl, \%hash );
  158.  
  159.     my $fh = OPEN_FILE->( $file ) or return;
  160.  
  161.     ### loop over the header, there might be a pgp signature ###
  162.     my $signed;
  163.     while (<$fh>) {
  164.         last if /^\$cksum = \{\s*$/;    # skip till this line
  165.         my $header = PGP_HEADER;        # but be tolerant of whitespace
  166.         $signed = 1 if /^${header}\s*$/;# due to crossplatform linebreaks
  167.    }
  168.  
  169.     ### read the filehandle, parse it rather than eval it, even though it
  170.     ### *should* be valid perl code
  171.     my $dist;
  172.     my $cksum = {};
  173.     while (<$fh>) {
  174.  
  175.         if (/^\s*'([^']+)' => \{\s*$/) {
  176.             $dist = $1;
  177.  
  178.         } elsif (/^\s*'([^']+)' => '?([^'\n]+)'?,?\s*$/ and defined $dist) {
  179.             $cksum->{$dist}{$1} = $2;
  180.  
  181.         } elsif (/^\s*}[,;]?\s*$/) {
  182.             undef $dist;
  183.  
  184.         } elsif (/^__END__\s*$/) {
  185.             last;
  186.  
  187.         } else {
  188.             error( loc("Malformed %1 line: %2", CHECKSUMS, $_) );
  189.         }
  190.     }
  191.  
  192.     return $cksum;
  193. }
  194.  
  195. sub _check_signature_for_checksum_file {
  196.     my $self = shift;
  197.  
  198.     my $conf = $self->parent->configure_object;
  199.     my %hash = @_;
  200.  
  201.     ### you don't want to check signatures,
  202.     ### so let's just return true;
  203.     return 1 unless $conf->get_conf('signature');
  204.  
  205.     my($force,$file,$verbose);
  206.     my $tmpl = {
  207.         file    => { required => 1, allow => FILE_READABLE, store => \$file },
  208.         force   => { default => $conf->get_conf('force'), store => \$force },
  209.         verbose => { default => $conf->get_conf('verbose'), store => \$verbose },
  210.     };
  211.  
  212.     my $args = check( $tmpl, \%hash ) or return;
  213.  
  214.     my $fh = OPEN_FILE->($file) or return;
  215.  
  216.     my $signed;
  217.     while (<$fh>) {
  218.         my $header = PGP_HEADER;
  219.         $signed = 1 if /^$header$/;
  220.     }
  221.  
  222.     if ( !$signed ) {
  223.         msg(loc("No signature found in %1 file '%2'",
  224.                 CHECKSUMS, $file), $verbose);
  225.  
  226.         return 1 unless $force;
  227.  
  228.         error( loc( "%1 file '%2' is not signed -- aborting",
  229.                     CHECKSUMS, $file ) );
  230.         return;
  231.  
  232.     }
  233.  
  234.     if( can_load( modules => { 'Module::Signature' => '0.06' } ) ) {
  235.         # local $Module::Signature::SIGNATURE = $file;
  236.         # ... check signatures ...
  237.     }
  238.  
  239.     return 1;
  240. }
  241.  
  242.  
  243.  
  244. # Local variables:
  245. # c-indentation-style: bsd
  246. # c-basic-offset: 4
  247. # indent-tabs-mode: nil
  248. # End:
  249. # vim: expandtab shiftwidth=4:
  250.  
  251. 1;
  252.