1 package CPANPLUS::Module::Checksums;
8 use CPANPLUS::Internals::Constants;
12 use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext';
13 use Params::Check qw[check];
14 use Module::Load::Conditional qw[can_load];
16 $Params::Check::VERBOSE = 1;
18 @ISA = qw[ CPANPLUS::Module::Signature ];
22 CPANPLUS::Module::Checksums
26 $file = $modobj->checksums;
27 $bool = $mobobj->_validate_checksum;
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>.
37 =head2 $mod->checksums
39 Fetches the checksums file for this module object.
40 For the options it can take, see C<CPANPLUS::Module::fetch()>.
42 Returns the location of the checksums file on success and false
45 The location of the checksums file is also stored as
47 $mod->status->checksums
52 my $mod = shift or return;
54 my $file = $mod->_get_checksums_file( @_ );
56 return $mod->status->checksums( $file ) if $file;
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;
70 verbose => { default => $conf->get_conf('verbose'),
74 check( $tmpl, \%hash ) or return;
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
81 my $file = $self->_get_checksums_file( verbose => $verbose ) or (
82 error(loc(q[Could not fetch '%1' file], CHECKSUMS)), return );
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
88 my $href = $self->_parse_checksums_file( file => $file ) or (
89 error(loc(q[Could not parse '%1' file], CHECKSUMS)), return );
91 my $size = $href->{ $self->package }->{'size'};
93 ### the checksums file tells us the size of the archive
94 ### but the downloaded file is of different 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);
103 msg(loc("Archive size is not known for '%1'",$self->package),$verbose);
106 my $md5 = $href->{ $self->package }->{'md5'};
108 unless( defined $md5 ) {
109 msg(loc("No 'md5' checksum known for '%1'",$self->package),$verbose);
111 return $self->status->checksum_ok(1);
114 $self->status->checksum_value($md5);
117 my $fh = FileHandle->new( $self->status->fetch ) or return;
120 my $ctx = Digest::MD5->new;
121 $ctx->addfile( $fh );
123 my $flag = $ctx->hexdigest eq $md5;
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);
131 return $self->status->checksum_ok(1) if $flag;
132 return $self->status->checksum_ok(0);
136 ### fetches the module objects checksum file ###
137 sub _get_checksums_file {
141 my $clone = $self->clone;
142 $clone->package( CHECKSUMS );
144 my $file = $clone->fetch( ttl => 3600, %hash ) or return;
149 sub _parse_checksums_file {
155 file => { required => 1, allow => FILE_READABLE, store => \$file },
157 my $args = check( $tmpl, \%hash );
159 my $fh = OPEN_FILE->( $file ) or return;
161 ### loop over the header, there might be a pgp signature ###
163 while (local $_ = <$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
169 ### read the filehandle, parse it rather than eval it, even though it
170 ### *should* be valid perl code
173 while (local $_ = <$fh>) {
175 if (/^\s*'([^']+)' => \{\s*$/) {
178 } elsif (/^\s*'([^']+)' => '?([^'\n]+)'?,?\s*$/ and defined $dist) {
179 $cksum->{$dist}{$1} = $2;
181 } elsif (/^\s*}[,;]?\s*$/) {
184 } elsif (/^__END__\s*$/) {
188 error( loc("Malformed %1 line: %2", CHECKSUMS, $_) );
195 sub _check_signature_for_checksum_file {
198 my $conf = $self->parent->configure_object;
201 ### you don't want to check signatures,
202 ### so let's just return true;
203 return 1 unless $conf->get_conf('signature');
205 my($force,$file,$verbose);
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 },
212 my $args = check( $tmpl, \%hash ) or return;
214 my $fh = OPEN_FILE->($file) or return;
217 while (local $_ = <$fh>) {
218 my $header = PGP_HEADER;
219 $signed = 1 if /^$header$/;
223 msg(loc("No signature found in %1 file '%2'",
224 CHECKSUMS, $file), $verbose);
226 return 1 unless $force;
228 error( loc( "%1 file '%2' is not signed -- aborting",
229 CHECKSUMS, $file ) );
234 if( can_load( modules => { 'Module::Signature' => '0.06' } ) ) {
235 # local $Module::Signature::SIGNATURE = $file;
236 # ... check signatures ...
245 # c-indentation-style: bsd
247 # indent-tabs-mode: nil
249 # vim: expandtab shiftwidth=4: