[Summary view] [Print] [Text view]

   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;