Index: third_party/dpkg-dev/scripts/Dpkg/Checksums.pm |
diff --git a/third_party/dpkg-dev/scripts/Dpkg/Checksums.pm b/third_party/dpkg-dev/scripts/Dpkg/Checksums.pm |
new file mode 100644 |
index 0000000000000000000000000000000000000000..5b6d0aba5fd8d3339b35feb2a766735a38647be5 |
--- /dev/null |
+++ b/third_party/dpkg-dev/scripts/Dpkg/Checksums.pm |
@@ -0,0 +1,378 @@ |
+# 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 |
+# (at your option) any later version. |
+# |
+# This program is distributed in the hope that it will be useful, |
+# but WITHOUT ANY WARRANTY; without even the implied warranty of |
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
+# GNU General Public License for more details. |
+# |
+# You should have received a copy of the GNU General Public License |
+# along with this program. If not, see <https://www.gnu.org/licenses/>. |
+ |
+package Dpkg::Checksums; |
+ |
+use strict; |
+use warnings; |
+ |
+our $VERSION = '1.00'; |
+ |
+use Dpkg; |
+use Dpkg::Gettext; |
+use Dpkg::ErrorHandling; |
+use Dpkg::IPC; |
+ |
+use Exporter qw(import); |
+our @EXPORT = qw(checksums_get_list checksums_is_supported |
+ checksums_get_property); |
+ |
+=encoding utf8 |
+ |
+=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() { |
+ my @list = sort keys %{$CHECKSUMS}; |
+ return @list; |
+} |
+ |
+=item $bool = checksums_is_supported($alg) |
+ |
+Returns a boolean indicating whether the given checksum algorithm is |
+supported. The checksum algorithm is case-insensitive. |
+ |
+=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 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)) or 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 ''; |
+ 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 $self->{size}{$file} and $self->{size}{$file} != $size) { |
+ error(_g("conflicting file sizes '%u' and '%u' for file '%s'"), |
+ $self->{size}{$file}, $size, $file); |
+ } |
+ push @{$self->{files}}, $file unless exists $self->{size}{$file}; |
+ $checksums->{$file}{$alg} = $sum; |
+ $self->{size}{$file} = $size; |
+ } |
+} |
+ |
+=item $ck->add_from_control($control, %opts) |
+ |
+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}); |
+ } |
+ } |
+} |
+ |
+=item @files = $ck->get_files() |
+ |
+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}; |
+ } |
+ return; |
+} |
+ |
+=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; |