diff options
author | Raphaël Hertzog <hertzog@debian.org> | 2010-02-25 17:47:14 +0100 |
---|---|---|
committer | Raphaël Hertzog <hertzog@debian.org> | 2010-02-25 18:40:57 +0100 |
commit | 08094e069d2ae05b50dc31ba64e3f3b865e4a8e0 (patch) | |
tree | 2ddb3c791911d3fe967a34812fc9244dec128a8f /scripts/Dpkg | |
parent | af71e3484e0959d45dea24e254ab1d58010e8009 (diff) | |
download | dpkg-08094e069d2ae05b50dc31ba64e3f3b865e4a8e0.tar.gz |
Dpkg::Checksums: rewrite to provide an object-oriented API
Many other modules and scripts are also updated to cope with the new API.
The API of the module should be stable from now on, hence increased
$VERSION to "1.00".
Diffstat (limited to 'scripts/Dpkg')
-rw-r--r-- | scripts/Dpkg/Checksums.pm | 384 | ||||
-rw-r--r-- | scripts/Dpkg/Control/Fields.pm | 8 | ||||
-rw-r--r-- | scripts/Dpkg/Control/Hash.pm | 4 | ||||
-rw-r--r-- | scripts/Dpkg/Source/Package.pm | 55 |
4 files changed, 337 insertions, 114 deletions
diff --git a/scripts/Dpkg/Checksums.pm b/scripts/Dpkg/Checksums.pm index 1a7d2b8ae..29cf69af4 100644 --- a/scripts/Dpkg/Checksums.pm +++ b/scripts/Dpkg/Checksums.pm @@ -1,3 +1,6 @@ +# Copyright © 2008 Frank Lichtenheld <djpig@debian.org> +# Copyright © 2010 Raphaël Hertzog <hertzog@debian.org> +# # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or @@ -16,104 +19,357 @@ package Dpkg::Checksums; use strict; use warnings; -our $VERSION = "0.01"; +our $VERSION = "1.00"; use Dpkg; use Dpkg::Gettext; use Dpkg::ErrorHandling; +use Dpkg::IPC; use base qw(Exporter); -our @EXPORT = qw(@check_supported %check_supported %check_prog %check_regex - readchecksums readallchecksums getchecksums); - -our @check_supported = qw(md5 sha1 sha256); -our %check_supported = map { $_ => 1 } @check_supported; -our %check_prog = ( md5 => 'md5sum', sha1 => 'sha1sum', - sha256 => 'sha256sum' ); -our %check_regex = ( md5 => qr/[0-9a-f]{32}/, - sha1 => qr/[0-9a-f]{40}/, - sha256 => qr/[0-9a-f]{64}/ ); - -sub extractchecksum { - my ($alg, $checksum) = @_; - ($checksum =~ /^($check_regex{$alg})(\s|$)/m) - || error(_g("checksum program gave bogus output `%s'"), $checksum); - return $1; +our @EXPORT = qw(checksums_get_list checksums_is_supported + checksums_get_property); + +=head1 NAME + +Dpkg::Checksums - generate and manipulate file checksums + +=head1 DESCRIPTION + +This module provides an object that can generate and manipulate +various file checksums as well as some methods to query information +about supported checksums. + +=head1 EXPORTED FUNCTIONS + +=over 4 + +=cut + +my $CHECKSUMS = { + "md5" => { + "program" => [ "md5sum" ], + "regex" => qr/[0-9a-f]{32}/, + }, + "sha1" => { + "program" => [ "sha1sum" ], + "regex" => qr/[0-9a-f]{40}/, + }, + "sha256" => { + "program" => [ "sha256sum" ], + "regex" => qr/[0-9a-f]{64}/, + }, +}; + +=item @list = checksums_get_list() + +Returns the list of supported checksums algorithms. + +=cut + +sub checksums_get_list() { + return sort keys %{$CHECKSUMS}; } +=item $bool = checksums_is_supported($alg) -sub readchecksums { - my ($alg, $fieldtext, $checksums, $sizes) = @_; - my %checksums; +Returns a boolean indicating whether the given checksum algorithm is +supported. The checksum algorithm is case-insensitive. - $alg = lc($alg); - unless ($check_supported{$alg}) { - warning(_g("Unknown checksum algorithm \`%s', ignoring"), $alg); - return; +=cut + +sub checksums_is_supported($) { + my ($alg) = @_; + return exists $CHECKSUMS->{lc($alg)}; +} + +=item $value = checksums_get_property($alg, $property) + +Returns the requested property of the checksum algorithm. Returns undef if +either the property or the checksum algorithm doesn't exist. Valid +properties currently include "program" (returns an array reference with +a program name and parameters required to compute the checksum of the +filename given as last parameter) and "regex" for the regular expression +describing the common string representation of the checksum (as output +by the program that generates it). + +=cut + +sub checksums_get_property($$) { + my ($alg, $property) = @_; + return undef unless checksums_is_supported($alg); + return $CHECKSUMS->{lc($alg)}{$property}; +} + +=back + +=head1 OBJECT METHODS + +=over 4 + +=item my $ck = Dpkg::Checksums->new() + +Create a new Dpkg::Checksums object. This object is able to store +the checksums of several files to later export them or verify them. + +=cut + +sub new { + my ($this, %opts) = @_; + my $class = ref($this) || $this; + + my $self = {}; + bless $self, $class; + $self->reset(); + + return $self; +} + +=item $ck->reset() + +Forget about all checksums stored. The object is again in the same state +as if it was newly created. + +=cut + +sub reset { + my ($self) = @_; + $self->{files} = []; + $self->{checksums} = {}; + $self->{size} = {}; +} + +=item $ck->add_from_file($filename, %opts) + +Add checksums information for the file $filename. The file must exists +for the call to succeed. If you don't want the given filename to appear +when you later export the checksums you might want to set the "key" +option with the public name that you want to use. Also if you don't want +to generate all the checksums, you can pass an array reference of the +wanted checksums in the "checksums" option. + +It the object already contains checksums information associated the +filename (or key), it will error out if the newly computed information +does not match what's stored. + +=cut + +sub add_from_file { + my ($self, $file, %opts) = @_; + my $key = exists $opts{key} ? $opts{key} : $file; + my @alg; + if (exists $opts{checksums}) { + push @alg, map { lc($_) } @{$opts{checksums}}; + } else { + push @alg, checksums_get_list(); + } + + push @{$self->{files}}, $key unless exists $self->{size}{$key}; + (my @s = stat($file)) || syserr(_g("cannot fstat file %s"), $file); + if (exists $self->{size}{$key} and $self->{size}{$key} != $s[7]) { + error(_g("File %s has size %u instead of expected %u"), + $file, $s[7], $self->{size}{$key}); } + $self->{size}{$key} = $s[7]; + + foreach my $alg (@alg) { + my @exec = (@{$CHECKSUMS->{$alg}{"program"}}, $file); + my $regex = $CHECKSUMS->{$alg}{"regex"}; + my $output; + spawn('exec' => \@exec, to_string => \$output); + if ($output =~ /^($regex)(\s|$)/m) { + my $newsum = $1; + if (exists $self->{checksums}{$key}{$alg} and + $self->{checksums}{$key}{$alg} ne $newsum) { + error(_g("File %s has checksum %s instead of expected %s (algorithm %s)"), + $file, $newsum, $self->{checksums}{$key}{$alg}, $alg); + } + $self->{checksums}{$key}{$alg} = $newsum; + } else { + error(_g("checksum program gave bogus output `%s'"), $output); + } + } +} + +=item $ck->add_from_string($alg, $value) + +Add checksums of type $alg that are stored in the $value variable. +$value can be multi-lines, each line should be a space separated list +of checksum, file size and filename. Leading or trailing spaces are +not allowed. + +It the object already contains checksums information associated to the +filenames, it will error out if the newly read information does not match +what's stored. + +=cut + +sub add_from_string { + my ($self, $alg, $fieldtext) = @_; + $alg = lc($alg); my $rx_fname = qr/[0-9a-zA-Z][-+:.,=0-9a-zA-Z_~]+/; + my $regex = checksums_get_property($alg, "regex"); + my $checksums = $self->{checksums}; + for my $checksum (split /\n */, $fieldtext) { next if $checksum eq ''; - $checksum =~ m/^($check_regex{$alg})\s+(\d+)\s+($rx_fname)$/ - || do { - warning(_g("Checksums-%s field contains bad line \`%s'"), - ucfirst($alg), $checksum); - next; - }; + unless ($checksum =~ m/^($regex)\s+(\d+)\s+($rx_fname)$/) { + error(_g("invalid line in %s checksums string: %s"), + $alg, $checksum); + } my ($sum, $size, $file) = ($1, $2, $3); if (exists($checksums->{$file}{$alg}) and $checksums->{$file}{$alg} ne $sum) { error(_g("Conflicting checksums \`%s\' and \`%s' for file \`%s'"), $checksums->{$file}{$alg}, $sum, $file); } - if (exists($sizes->{$file}) - and $sizes->{$file} != $size) { + if (exists $self->{size}{$file} and $self->{size}{$file} != $size) { error(_g("Conflicting file sizes \`%u\' and \`%u' for file \`%s'"), - $sizes->{$file}, $size, $file); + $self->{size}{$file}, $size, $file); } + push @{$self->{files}}, $file unless exists $self->{size}{$file}; $checksums->{$file}{$alg} = $sum; - $sizes->{$file} = $size; + $self->{size}{$file} = $size; } - - return 1; } -sub readallchecksums { - my ($fields, $checksums, $sizes) = @_; +=item $ck->add_from_control($control, %opts) - foreach my $field (keys %$fields) { - if ($field =~ /^Checksums-(\w+)$/ - && defined($fields->{$field})) { - readchecksums($1, $fields->{$field}, $checksums, $sizes); +Read checksums from Checksums-* fields stored in the Dpkg::Control object +$control. It uses $self->add_from_string() on the field values to do the +actual work. + +If the option "use_files_for_md5" evaluates to true, then the "Files" +field is used in place of the "Checksums-Md5" field. By default the option +is false. + +=cut + +sub add_from_control { + my ($self, $control, %opts) = @_; + $opts{use_files_for_md5} = 0 unless exists $opts{use_files_for_md5}; + foreach my $alg (checksums_get_list()) { + my $key = "Checksums-$alg"; + $key = "Files" if ($opts{use_files_for_md5} and $alg eq "md5"); + if (exists $control->{$key}) { + $self->add_from_string($alg, $control->{$key}); } } } -sub getchecksums { - my ($file, $checksums, $size) = @_; +=item @files = $ck->get_files() - (my @s = stat($file)) || syserr(_g("cannot fstat file %s"), $file); - my $newsize = $s[7]; - if (defined($$size) - and $newsize != $$size) { - error(_g("File %s has size %u instead of expected %u"), - $file, $newsize, $$size); +Return the list of files whose checksums are stored in the object. + +=cut + +sub get_files { + my ($self) = @_; + return @{$self->{files}}; +} + +=item $bool = $ck->has_file($file) + +Return true if we have checksums for the given file. Returns false +otherwise. + +=cut + +sub has_file { + my ($self, $file) = @_; + return exists $self->{size}{$file}; +} + +=item $ck->remove_file($file) + +Remove all checksums of the given file. + +=cut + +sub remove_file { + my ($self, $file) = @_; + return unless $self->has_file($file); + delete $self->{'checksums'}{$file}; + delete $self->{'size'}{$file}; + @{$self->{'files'}} = grep { $_ ne $file } $self->get_files(); +} + +=item $checksum = $ck->get_checksum($file, $alg) + +Return the checksum of type $alg for the requested $file. This will not +compute the checksum but only return the checksum stored in the object, if +any. + +If $alg is not defined, it returns a reference to a hash: keys are +the checksum algorithms and values are the checksums themselves. The +hash returned must not be modified, it's internal to the object. + +=cut + +sub get_checksum { + my ($self, $file, $alg) = @_; + $alg = lc($alg) if defined $alg; + if (exists $self->{checksums}{$file}) { + return $self->{checksums}{$file} unless defined $alg; + return $self->{checksums}{$file}{$alg}; } - $$size = $newsize; - - foreach my $alg (@check_supported) { - my $prog = $check_prog{$alg}; - my $newsum = `$prog $file`; - $? && subprocerr("%s %s", $prog, $file); - $newsum = extractchecksum($alg, $newsum); - - if (defined($checksums->{$alg}) - and $newsum ne $checksums->{$alg}) { - error(_g("File %s has checksum %s instead of expected %s (algorithm %s)"), - $file, $newsum, $checksums->{$alg}, $alg); - } - $checksums->{$alg} = $newsum; + return undef; +} + +=item $size = $ck->get_size($file) + +Return the size of the requested file if it's available in the object. + +=cut + +sub get_size { + my ($self, $file) = @_; + return $self->{size}{$file}; +} + +=item $ck->export_to_string($alg, %opts) + +Return a multi-line string containing the checksums of type $alg. The +string can be stored as-is in a Checksum-* field of a Dpkg::Control +object. + +=cut + +sub export_to_string { + my ($self, $alg, %opts) = @_; + my $res = ""; + foreach my $file ($self->get_files()) { + my $sum = $self->get_checksum($file, $alg); + my $size = $self->get_size($file); + next unless defined $sum and defined $size; + $res .= "\n$sum $size $file"; + } + return $res; +} + +=item $ck->export_to_control($control, %opts) + +Export the checksums in the Checksums-* fields of the Dpkg::Control +$control object. + +=cut + +sub export_to_control { + my ($self, $control, %opts) = @_; + $opts{use_files_for_md5} = 0 unless exists $opts{use_files_for_md5}; + foreach my $alg (checksums_get_list()) { + my $key = "Checksums-$alg"; + $key = "Files" if ($opts{use_files_for_md5} and $alg eq "md5"); + $control->{$key} = $self->export_to_string($alg, %opts); } } +=back + +=head1 AUTHOR + +Raphaël Hertzog <hertzog@debian.org>. + +=cut + 1; diff --git a/scripts/Dpkg/Control/Fields.pm b/scripts/Dpkg/Control/Fields.pm index 8f14d9f19..f0a17c4b0 100644 --- a/scripts/Dpkg/Control/Fields.pm +++ b/scripts/Dpkg/Control/Fields.pm @@ -24,7 +24,7 @@ use base qw(Exporter); use Dpkg::Gettext; use Dpkg::ErrorHandling; use Dpkg::Control::Types; -use Dpkg::Checksums qw(@check_supported %check_supported); +use Dpkg::Checksums; use Dpkg::Vendor qw(run_vendor_hook); our @EXPORT = qw(field_capitalize field_is_official field_is_allowed_in @@ -266,9 +266,9 @@ our %FIELDS = ( }, ); -my @checksum_fields = map { field_capitalize("Checksums-$_") } @check_supported; +my @checksum_fields = map { field_capitalize("Checksums-$_") } checksums_get_list(); my @sum_fields = map { $_ eq "md5" ? "MD5sum" : field_capitalize($_) } - @check_supported; + checksums_get_list(); &field_register($_, CTRL_PKG_SRC | CTRL_FILE_CHANGES) foreach @checksum_fields; &field_register($_, CTRL_INDEX_PKG) foreach @sum_fields; @@ -353,7 +353,7 @@ sub field_capitalize($) { my $field = lc(shift); # Some special cases due to history return "MD5sum" if $field eq "md5sum"; - return uc($field) if exists $check_supported{$field}; + return uc($field) if checksums_is_supported($field); # Generic case return join '-', map { ucfirst } split /-/, $field; } diff --git a/scripts/Dpkg/Control/Hash.pm b/scripts/Dpkg/Control/Hash.pm index b613da40d..2633b4f97 100644 --- a/scripts/Dpkg/Control/Hash.pm +++ b/scripts/Dpkg/Control/Hash.pm @@ -375,7 +375,7 @@ package Dpkg::Control::Hash::Tie; # type Dpkg::Control. use Dpkg::ErrorHandling; -use Dpkg::Checksums qw(%check_supported); +use Dpkg::Checksums; use Tie::Hash; use base qw(Tie::ExtraHash); @@ -384,7 +384,7 @@ sub field_capitalize($) { my $field = lc(shift); # Some special cases due to history return "MD5sum" if $field eq "md5sum"; - return uc($field) if exists $check_supported{$field}; + return uc($field) if checksums_is_supported($field); # Generic case return join '-', map { ucfirst } split /-/, $field; } diff --git a/scripts/Dpkg/Source/Package.pm b/scripts/Dpkg/Source/Package.pm index f6c9f724f..3ebfc56c5 100644 --- a/scripts/Dpkg/Source/Package.pm +++ b/scripts/Dpkg/Source/Package.pm @@ -94,6 +94,7 @@ sub new { my $self = { 'fields' => Dpkg::Control->new(type => CTRL_PKG_SRC), 'options' => {}, + 'checksums' => Dpkg::Checksums->new(), }; bless $self, $class; if (exists $args{'options'}) { @@ -149,7 +150,7 @@ sub initialize { } } - $self->parse_files(); + $self->{'checksums'}->add_from_control($fields, use_files_for_md5 => 1); $self->upgrade_object_type(0); } @@ -186,43 +187,15 @@ sub get_filename { sub get_files { my ($self) = @_; - return keys %{$self->{'files'}}; -} - -sub parse_files { - my ($self) = @_; - my $rx_fname = qr/[0-9a-zA-Z][-+:.,=0-9a-zA-Z_~]+/; - my $files = $self->{'fields'}{'Files'}; - foreach my $file (split(/\n/, $files)) { - next if $file eq ''; - $file =~ m/^($check_regex{md5}) # checksum - [ \t]+(\d+) # size - [ \t]+($rx_fname) # filename - $/x - || error(_g("Files field contains bad line `%s'"), $file); - if (exists $self->{'files'}{$3}) { - error(_g("file `%s' listed twice in Files field"), $3); - } else { - $self->{'files'}{$3} = $2; - } - } + return $self->{'checksums'}->get_files(); } sub check_checksums { my ($self) = @_; - my ($fields, %checksum, %size) = $self->{'fields'}; - my $has_md5 = 1; - if (not exists $fields->{'Checksums-Md5'}) { - $fields->{'Checksums-Md5'} = $fields->{'Files'}; - $has_md5 = 0; - } - # extract the checksums from the fields in two hashes - readallchecksums($self->{'fields'}, \%checksum, \%size); - delete $fields->{'Checksums-Md5'} unless $has_md5; - # getchecksums verify the checksums if they are pre-filled - foreach my $file ($self->get_files()) { - getchecksums($self->{'basedir'} . $file, $checksum{$file}, - \$size{$file}); + my $checksums = $self->{'checksums'}; + # add_from_file verify the checksums if they are already existing + foreach my $file ($checksums->get_files()) { + $checksums->add_from_file($self->{'basedir'} . $file, key => $file); } } @@ -415,16 +388,12 @@ sub can_build { sub add_file { my ($self, $filename) = @_; my ($fn, $dir) = fileparse($filename); - if (exists $self->{'files'}{$fn}) { + if ($self->{'checksums'}->has_file($fn)) { internerr("tried to add file '%s' twice", $fn); } - my (%sums, $size); - getchecksums($filename, \%sums, \$size); - $self->{'files'}{$fn} = $size; - foreach my $alg (sort keys %sums) { - $self->{'fields'}{"Checksums-$alg"} .= "\n$sums{$alg} $size $fn"; - } - $self->{'fields'}{'Files'}.= "\n$sums{md5} $size $fn"; + $self->{'checksums'}->add_from_file($filename, key => $fn); + $self->{'checksums'}->export_to_control($self->{'fields'}, + use_files_for_md5 => 1); } sub write_dsc { @@ -457,8 +426,6 @@ sub write_dsc { $filename = $self->get_basename(1) . ".dsc"; } open(DSC, ">", $filename) || syserr(_g("cannot write %s"), $filename); - - delete $fields->{'Checksums-Md5'}; # identical with Files field $fields->apply_substvars($opts{'substvars'}); $fields->output(\*DSC); close(DSC); |