scripts/Dpkg/Checksums.pm

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