1# Copyright © 2008 Frank Lichtenheld <djpig@debian.org> 2# Copyright © 2008, 2012-2015 Guillem Jover <guillem@debian.org> 3# Copyright © 2010 Raphaël Hertzog <hertzog@debian.org> 4# 5# This program is free software; you can redistribute it and/or modify 6# it under the terms of the GNU General Public License as published by 7# the Free Software Foundation; either version 2 of the License, or 8# (at your option) any later version. 9# 10# This program is distributed in the hope that it will be useful, 11# but WITHOUT ANY WARRANTY; without even the implied warranty of 12# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13# GNU General Public License for more details. 14# 15# You should have received a copy of the GNU General Public License 16# along with this program. If not, see <https://www.gnu.org/licenses/>. 17 18package Dpkg::Checksums; 19 20use strict; 21use warnings; 22 23our $VERSION = '1.03'; 24our @EXPORT = qw( 25 checksums_is_supported 26 checksums_get_list 27 checksums_get_property 28); 29 30use Exporter qw(import); 31use Digest; 32 33use Dpkg::Gettext; 34use Dpkg::ErrorHandling; 35 36=encoding utf8 37 38=head1 NAME 39 40Dpkg::Checksums - generate and manipulate file checksums 41 42=head1 DESCRIPTION 43 44This module provides an object that can generate and manipulate 45various file checksums as well as some methods to query information 46about supported checksums. 47 48=head1 FUNCTIONS 49 50=over 4 51 52=cut 53 54my $CHECKSUMS = { 55 md5 => { 56 name => 'MD5', 57 regex => qr/[0-9a-f]{32}/, 58 strong => 0, 59 }, 60 sha1 => { 61 name => 'SHA-1', 62 regex => qr/[0-9a-f]{40}/, 63 strong => 0, 64 }, 65 sha256 => { 66 name => 'SHA-256', 67 regex => qr/[0-9a-f]{64}/, 68 strong => 1, 69 }, 70}; 71 72=item @list = checksums_get_list() 73 74Returns the list of supported checksums algorithms. 75 76=cut 77 78sub checksums_get_list() { 79 my @list = sort keys %{$CHECKSUMS}; 80 return @list; 81} 82 83=item $bool = checksums_is_supported($alg) 84 85Returns a boolean indicating whether the given checksum algorithm is 86supported. The checksum algorithm is case-insensitive. 87 88=cut 89 90sub checksums_is_supported($) { 91 my $alg = shift; 92 return exists $CHECKSUMS->{lc($alg)}; 93} 94 95=item $value = checksums_get_property($alg, $property) 96 97Returns the requested property of the checksum algorithm. Returns undef if 98either the property or the checksum algorithm doesn't exist. Valid 99properties currently include "name" (returns the name of the digest 100algorithm), "regex" for the regular expression describing the common 101string representation of the checksum, and "strong" for a boolean describing 102whether the checksum algorithm is considered cryptographically strong. 103 104=cut 105 106sub checksums_get_property($$) { 107 my ($alg, $property) = @_; 108 109 if ($property eq 'program') { 110 warnings::warnif('deprecated', 'obsolete checksums program property'); 111 } 112 113 return unless checksums_is_supported($alg); 114 return $CHECKSUMS->{lc($alg)}{$property}; 115} 116 117=back 118 119=head1 METHODS 120 121=over 4 122 123=item $ck = Dpkg::Checksums->new() 124 125Create a new Dpkg::Checksums object. This object is able to store 126the checksums of several files to later export them or verify them. 127 128=cut 129 130sub new { 131 my ($this, %opts) = @_; 132 my $class = ref($this) || $this; 133 134 my $self = {}; 135 bless $self, $class; 136 $self->reset(); 137 138 return $self; 139} 140 141=item $ck->reset() 142 143Forget about all checksums stored. The object is again in the same state 144as if it was newly created. 145 146=cut 147 148sub reset { 149 my $self = shift; 150 151 $self->{files} = []; 152 $self->{checksums} = {}; 153 $self->{size} = {}; 154} 155 156=item $ck->add_from_file($filename, %opts) 157 158Add or verify checksums information for the file $filename. The file must 159exists for the call to succeed. If you don't want the given filename to 160appear when you later export the checksums you might want to set the "key" 161option with the public name that you want to use. Also if you don't want 162to generate all the checksums, you can pass an array reference of the 163wanted checksums in the "checksums" option. 164 165It the object already contains checksums information associated the 166filename (or key), it will error out if the newly computed information 167does not match what's stored, and the caller did not request that it be 168updated with the boolean "update" option. 169 170=cut 171 172sub add_from_file { 173 my ($self, $file, %opts) = @_; 174 my $key = exists $opts{key} ? $opts{key} : $file; 175 my @alg; 176 if (exists $opts{checksums}) { 177 push @alg, map { lc } @{$opts{checksums}}; 178 } else { 179 push @alg, checksums_get_list(); 180 } 181 182 push @{$self->{files}}, $key unless exists $self->{size}{$key}; 183 (my @s = stat($file)) or syserr(g_('cannot fstat file %s'), $file); 184 if (not $opts{update} and exists $self->{size}{$key} and 185 $self->{size}{$key} != $s[7]) { 186 error(g_('file %s has size %u instead of expected %u'), 187 $file, $s[7], $self->{size}{$key}); 188 } 189 $self->{size}{$key} = $s[7]; 190 191 foreach my $alg (@alg) { 192 my $digest = Digest->new($CHECKSUMS->{$alg}{name}); 193 open my $fh, '<', $file or syserr(g_('cannot open file %s'), $file); 194 $digest->addfile($fh); 195 close $fh; 196 197 my $newsum = $digest->hexdigest; 198 if (not $opts{update} and exists $self->{checksums}{$key}{$alg} and 199 $self->{checksums}{$key}{$alg} ne $newsum) { 200 error(g_('file %s has checksum %s instead of expected %s (algorithm %s)'), 201 $file, $newsum, $self->{checksums}{$key}{$alg}, $alg); 202 } 203 $self->{checksums}{$key}{$alg} = $newsum; 204 } 205} 206 207=item $ck->add_from_string($alg, $value, %opts) 208 209Add checksums of type $alg that are stored in the $value variable. 210$value can be multi-lines, each line should be a space separated list 211of checksum, file size and filename. Leading or trailing spaces are 212not allowed. 213 214It the object already contains checksums information associated to the 215filenames, it will error out if the newly read information does not match 216what's stored, and the caller did not request that it be updated with 217the boolean "update" option. 218 219=cut 220 221sub add_from_string { 222 my ($self, $alg, $fieldtext, %opts) = @_; 223 $alg = lc($alg); 224 my $rx_fname = qr/[0-9a-zA-Z][-+:.,=0-9a-zA-Z_~]+/; 225 my $regex = checksums_get_property($alg, 'regex'); 226 my $checksums = $self->{checksums}; 227 228 for my $checksum (split /\n */, $fieldtext) { 229 next if $checksum eq ''; 230 unless ($checksum =~ m/^($regex)\s+(\d+)\s+($rx_fname)$/) { 231 error(g_('invalid line in %s checksums string: %s'), 232 $alg, $checksum); 233 } 234 my ($sum, $size, $file) = ($1, $2, $3); 235 if (not $opts{update} and exists($checksums->{$file}{$alg}) 236 and $checksums->{$file}{$alg} ne $sum) { 237 error(g_("conflicting checksums '%s' and '%s' for file '%s'"), 238 $checksums->{$file}{$alg}, $sum, $file); 239 } 240 if (not $opts{update} and exists $self->{size}{$file} 241 and $self->{size}{$file} != $size) { 242 error(g_("conflicting file sizes '%u' and '%u' for file '%s'"), 243 $self->{size}{$file}, $size, $file); 244 } 245 push @{$self->{files}}, $file unless exists $self->{size}{$file}; 246 $checksums->{$file}{$alg} = $sum; 247 $self->{size}{$file} = $size; 248 } 249} 250 251=item $ck->add_from_control($control, %opts) 252 253Read checksums from Checksums-* fields stored in the Dpkg::Control object 254$control. It uses $self->add_from_string() on the field values to do the 255actual work. 256 257If the option "use_files_for_md5" evaluates to true, then the "Files" 258field is used in place of the "Checksums-Md5" field. By default the option 259is false. 260 261=cut 262 263sub add_from_control { 264 my ($self, $control, %opts) = @_; 265 $opts{use_files_for_md5} //= 0; 266 foreach my $alg (checksums_get_list()) { 267 my $key = "Checksums-$alg"; 268 $key = 'Files' if ($opts{use_files_for_md5} and $alg eq 'md5'); 269 if (exists $control->{$key}) { 270 $self->add_from_string($alg, $control->{$key}, %opts); 271 } 272 } 273} 274 275=item @files = $ck->get_files() 276 277Return the list of files whose checksums are stored in the object. 278 279=cut 280 281sub get_files { 282 my $self = shift; 283 return @{$self->{files}}; 284} 285 286=item $bool = $ck->has_file($file) 287 288Return true if we have checksums for the given file. Returns false 289otherwise. 290 291=cut 292 293sub has_file { 294 my ($self, $file) = @_; 295 return exists $self->{size}{$file}; 296} 297 298=item $ck->remove_file($file) 299 300Remove all checksums of the given file. 301 302=cut 303 304sub remove_file { 305 my ($self, $file) = @_; 306 return unless $self->has_file($file); 307 delete $self->{checksums}{$file}; 308 delete $self->{size}{$file}; 309 @{$self->{files}} = grep { $_ ne $file } $self->get_files(); 310} 311 312=item $checksum = $ck->get_checksum($file, $alg) 313 314Return the checksum of type $alg for the requested $file. This will not 315compute the checksum but only return the checksum stored in the object, if 316any. 317 318If $alg is not defined, it returns a reference to a hash: keys are 319the checksum algorithms and values are the checksums themselves. The 320hash returned must not be modified, it's internal to the object. 321 322=cut 323 324sub get_checksum { 325 my ($self, $file, $alg) = @_; 326 $alg = lc($alg) if defined $alg; 327 if (exists $self->{checksums}{$file}) { 328 return $self->{checksums}{$file} unless defined $alg; 329 return $self->{checksums}{$file}{$alg}; 330 } 331 return; 332} 333 334=item $size = $ck->get_size($file) 335 336Return the size of the requested file if it's available in the object. 337 338=cut 339 340sub get_size { 341 my ($self, $file) = @_; 342 return $self->{size}{$file}; 343} 344 345=item $bool = $ck->has_strong_checksums($file) 346 347Return a boolean on whether the file has a strong checksum. 348 349=cut 350 351sub has_strong_checksums { 352 my ($self, $file) = @_; 353 354 foreach my $alg (checksums_get_list()) { 355 return 1 if defined $self->get_checksum($file, $alg) and 356 checksums_get_property($alg, 'strong'); 357 } 358 359 return 0; 360} 361 362=item $ck->export_to_string($alg, %opts) 363 364Return a multi-line string containing the checksums of type $alg. The 365string can be stored as-is in a Checksum-* field of a Dpkg::Control 366object. 367 368=cut 369 370sub export_to_string { 371 my ($self, $alg, %opts) = @_; 372 my $res = ''; 373 foreach my $file ($self->get_files()) { 374 my $sum = $self->get_checksum($file, $alg); 375 my $size = $self->get_size($file); 376 next unless defined $sum and defined $size; 377 $res .= "\n$sum $size $file"; 378 } 379 return $res; 380} 381 382=item $ck->export_to_control($control, %opts) 383 384Export the checksums in the Checksums-* fields of the Dpkg::Control 385$control object. 386 387=cut 388 389sub export_to_control { 390 my ($self, $control, %opts) = @_; 391 $opts{use_files_for_md5} //= 0; 392 foreach my $alg (checksums_get_list()) { 393 my $key = "Checksums-$alg"; 394 $key = 'Files' if ($opts{use_files_for_md5} and $alg eq 'md5'); 395 $control->{$key} = $self->export_to_string($alg, %opts); 396 } 397} 398 399=back 400 401=head1 CHANGES 402 403=head2 Version 1.03 (dpkg 1.18.5) 404 405New property: Add new 'strong' property. 406 407New member: $ck->has_strong_checksums(). 408 409=head2 Version 1.02 (dpkg 1.18.0) 410 411Obsolete property: Getting the 'program' checksum property will warn and 412return undef, the Digest module is used internally now. 413 414New property: Add new 'name' property with the name of the Digest algorithm 415to use. 416 417=head2 Version 1.01 (dpkg 1.17.6) 418 419New argument: Accept an options argument in $ck->export_to_string(). 420 421New option: Accept new option 'update' in $ck->add_from_file() and 422$ck->add_from_control(). 423 424=head2 Version 1.00 (dpkg 1.15.6) 425 426Mark the module as public. 427 428=cut 429 4301; 431