From 7097f538080436f7c6b4743b2dd6d73021ddb503 Mon Sep 17 00:00:00 2001
From: Frank Lichtenheld <djpig@debian.org>
Date: Sat, 26 Jan 2008 23:15:14 +0100
Subject: [PATCH] Dpkg::Checksums: New module for checksum handling in .dsc and
 .changes files

---
 debian/dpkg-dev.install   |   1 +
 scripts/Dpkg/Checksums.pm | 105 ++++++++++++++++++++++++++++++++++++++
 scripts/Makefile.am       |   1 +
 scripts/po/POTFILES.in    |   1 +
 4 files changed, 108 insertions(+)
 create mode 100644 scripts/Dpkg/Checksums.pm

diff --git a/debian/dpkg-dev.install b/debian/dpkg-dev.install
index 2f497272..a41aebbd 100644
--- a/debian/dpkg-dev.install
+++ b/debian/dpkg-dev.install
@@ -64,6 +64,7 @@ usr/share/man/*/dpkg-source.1
 usr/share/perl5/Dpkg/Arch.pm
 usr/share/perl5/Dpkg/BuildOptions.pm
 usr/share/perl5/Dpkg/Cdata.pm
+usr/share/perl5/Dpkg/Checksums.pm
 usr/share/perl5/Dpkg/Compression.pm
 usr/share/perl5/Dpkg/Control.pm
 usr/share/perl5/Dpkg/Changelog.pm
diff --git a/scripts/Dpkg/Checksums.pm b/scripts/Dpkg/Checksums.pm
new file mode 100644
index 00000000..90002ece
--- /dev/null
+++ b/scripts/Dpkg/Checksums.pm
@@ -0,0 +1,105 @@
+package Dpkg::Checksums;
+
+use strict;
+use warnings;
+
+use Dpkg;
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling qw(internerr syserr subprocerr failure error
+                           warning );
+
+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)
+	|| failure(_g("checksum program gave bogus output `%s'"), $checksum);
+    return $1;
+}
+
+
+sub readchecksums {
+    my ($alg, $fieldtext, $checksums, $sizes) = @_;
+    my %checksums;
+
+    $alg = lc($alg);
+    unless ($check_supported{$alg}) {
+	warning(_g("Unknown checksum algorithm \`%s', ignoring"), $alg);
+	return;
+    }
+    my $rx_fname = qr/[0-9a-zA-Z][-+:.,=0-9a-zA-Z_~]+/;
+    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;
+	};
+	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) {
+	    error(_g("Conflicting file sizes \`%u\' and \`%u' for file \`%s'"),
+		  $sizes->{$file}, $size, $file);
+	}
+	$checksums->{$file}{$alg} = $sum;
+	$sizes->{$file} = $size;
+    }
+
+    return 1;
+}
+
+sub readallchecksums {
+    my ($fields, $checksums, $sizes) = @_;
+
+    foreach my $field (keys %$fields) {
+	if ($field =~ /^Checksums-(\w+)$/
+	    && defined($fields->{$field})) {
+	    readchecksums($1, $fields->{$field}, $checksums, $sizes);
+	}
+    }
+}
+
+sub getchecksums {
+    my ($file, $checksums, $size) = @_;
+
+    (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);
+    }
+    $$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;
+    }
+}
+
+1;
diff --git a/scripts/Makefile.am b/scripts/Makefile.am
index e27f2949..a0b1a963 100644
--- a/scripts/Makefile.am
+++ b/scripts/Makefile.am
@@ -89,6 +89,7 @@ nobase_dist_perllib_DATA = \
 	Dpkg/Cdata.pm \
 	Dpkg/Changelog.pm \
 	Dpkg/Changelog/Debian.pm \
+	Dpkg/Checksums.pm \
 	Dpkg/Compression.pm \
 	Dpkg/Control.pm \
 	Dpkg/Deps.pm \
diff --git a/scripts/po/POTFILES.in b/scripts/po/POTFILES.in
index 4a14b35f..69092b77 100644
--- a/scripts/po/POTFILES.in
+++ b/scripts/po/POTFILES.in
@@ -18,6 +18,7 @@ scripts/Dpkg/Arch.pm
 scripts/Dpkg/Cdata.pm
 scripts/Dpkg/Changelog.pm
 scripts/Dpkg/Changelog/Debian.pm
+scripts/Dpkg/Checksums.pm
 scripts/Dpkg/Control.pm
 scripts/Dpkg/Deps.pm
 scripts/Dpkg/ErrorHandling.pm
-- 
2.39.5