Adding upstream version 1.19.8.upstream/1.19.8upstream

Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>

1 files changed, 430 insertions, 0 deletions

diff --git a/scripts/Dpkg/Checksums.pm b/scripts/Dpkg/Checksums.pm
new file mode 100644
index 0000000..1237e8b
--- /dev/null
+++ b/scripts/Dpkg/Checksums.pm
@@ -0,0 +1,430 @@
+# Copyright © 2008 Frank Lichtenheld <djpig@debian.org>
+# Copyright © 2008, 2012-2015 Guillem Jover <guillem@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.03';
+our @EXPORT = qw(
+    checksums_is_supported
+    checksums_get_list
+    checksums_get_property
+);
+
+use Exporter qw(import);
+use Digest;
+
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling;
+
+=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 FUNCTIONS
+
+=over 4
+
+=cut
+
+my $CHECKSUMS = {
+    md5 => {
+	name => 'MD5',
+	regex => qr/[0-9a-f]{32}/,
+	strong => 0,
+    },
+    sha1 => {
+	name => 'SHA-1',
+	regex => qr/[0-9a-f]{40}/,
+	strong => 0,
+    },
+    sha256 => {
+	name => 'SHA-256',
+	regex => qr/[0-9a-f]{64}/,
+	strong => 1,
+    },
+};
+
+=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 = shift;
+    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 "name" (returns the name of the digest
+algorithm), "regex" for the regular expression describing the common
+string representation of the checksum, and "strong" for a boolean describing
+whether the checksum algorithm is considered cryptographically strong.
+
+=cut
+
+sub checksums_get_property($$) {
+    my ($alg, $property) = @_;
+
+    if ($property eq 'program') {
+        warnings::warnif('deprecated', 'obsolete checksums program property');
+    }
+
+    return unless checksums_is_supported($alg);
+    return $CHECKSUMS->{lc($alg)}{$property};
+}
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item $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 = shift;
+
+    $self->{files} = [];
+    $self->{checksums} = {};
+    $self->{size} = {};
+}
+
+=item $ck->add_from_file($filename, %opts)
+
+Add or verify 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, and the caller did not request that it be
+updated with the boolean "update" option.
+
+=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 (not $opts{update} and 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 $digest = Digest->new($CHECKSUMS->{$alg}{name});
+        open my $fh, '<', $file or syserr(g_('cannot open file %s'), $file);
+        $digest->addfile($fh);
+        close $fh;
+
+        my $newsum = $digest->hexdigest;
+        if (not $opts{update} and 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;
+    }
+}
+
+=item $ck->add_from_string($alg, $value, %opts)
+
+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, and the caller did not request that it be updated with
+the boolean "update" option.
+
+=cut
+
+sub add_from_string {
+    my ($self, $alg, $fieldtext, %opts) = @_;
+    $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 (not $opts{update} and  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 (not $opts{update} and 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;
+    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}, %opts);
+	}
+    }
+}
+
+=item @files = $ck->get_files()
+
+Return the list of files whose checksums are stored in the object.
+
+=cut
+
+sub get_files {
+    my $self = shift;
+    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 $bool = $ck->has_strong_checksums($file)
+
+Return a boolean on whether the file has a strong checksum.
+
+=cut
+
+sub has_strong_checksums {
+    my ($self, $file) = @_;
+
+    foreach my $alg (checksums_get_list()) {
+        return 1 if defined $self->get_checksum($file, $alg) and
+                    checksums_get_property($alg, 'strong');
+    }
+
+    return 0;
+}
+
+=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;
+    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 CHANGES
+
+=head2 Version 1.03 (dpkg 1.18.5)
+
+New property: Add new 'strong' property.
+
+New member: $ck->has_strong_checksums().
+
+=head2 Version 1.02 (dpkg 1.18.0)
+
+Obsolete property: Getting the 'program' checksum property will warn and
+return undef, the Digest module is used internally now.
+
+New property: Add new 'name' property with the name of the Digest algorithm
+to use.
+
+=head2 Version 1.01 (dpkg 1.17.6)
+
+New argument: Accept an options argument in $ck->export_to_string().
+
+New option: Accept new option 'update' in $ck->add_from_file() and
+$ck->add_from_control().
+
+=head2 Version 1.00 (dpkg 1.15.6)
+
+Mark the module as public.
+
+=cut
+
+1;