Dpkg::Checksums: Add strong digest marking support

This will make it possible to error out when a source package only
contains no strong digests.

3 files changed, 33 insertions, 4 deletions

diff --git a/debian/changelog b/debian/changelog
index 60f7f369d..9b379c81c 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -75,6 +75,7 @@ dpkg (1.18.5) UNRELEASED; urgency=medium
       Base on a patch by Daniel Dehennin <daniel.dehennin@baby-gnu.org>.
     - Add new functions to validate and parse architecture names in Dpkg::Arch.
     - Make the dependency parser more strict in Dpkg::Deps. Closes: #784806
+    - Add strong digest marking support to Dpkg::Checksums.
   * Build system:
     - Fix building development documentation.
     - Remove unused UA_LIBS variable.
diff --git a/scripts/Dpkg/Checksums.pm b/scripts/Dpkg/Checksums.pm
index 00a5f41b4..36eb61550 100644
--- a/scripts/Dpkg/Checksums.pm
+++ b/scripts/Dpkg/Checksums.pm
@@ -20,7 +20,7 @@ package Dpkg::Checksums;
 use strict;
 use warnings;
 
-our $VERSION = '1.02';
+our $VERSION = '1.03';
 our @EXPORT = qw(
     checksums_is_supported
     checksums_get_list
@@ -56,14 +56,17 @@ 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,
     },
 };
 
@@ -95,8 +98,9 @@ sub checksums_is_supported($) {
 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) and "regex" for the regular expression describing the common
-string representation of the checksum.
+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
 
@@ -335,6 +339,23 @@ sub get_size {
     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
@@ -376,6 +397,12 @@ sub export_to_control {
 
 =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 carp() and
diff --git a/scripts/t/Dpkg_Checksums.t b/scripts/t/Dpkg_Checksums.t
index b59d95036..f15720261 100644
--- a/scripts/t/Dpkg_Checksums.t
+++ b/scripts/t/Dpkg_Checksums.t
@@ -16,7 +16,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 41;
+use Test::More tests => 44;
 
 BEGIN {
     use_ok('Dpkg::Checksums');
@@ -89,6 +89,7 @@ foreach my $c (@expected_checksums) {
 
     ok(defined checksums_get_property($c, 'name'), "Checksum $c has name");
     ok(defined checksums_get_property($c, 'regex'), "Checksum $c has regex");
+    ok(defined checksums_get_property($c, 'strong'), "Checksum $c has strong");
 }
 
 my $ck = Dpkg::Checksums->new();