Use new Dpkg::Checksums module

* scripts/dpkg-genchanges.pl, scripts/dpkg-source.pl: Use new
Dpkg::Checksums module. Adds new 'Checksums-{Sha1,Sha256}' field
to .changes and .dsc files. Increase changes format to 1.8.

diff --git a/scripts/dpkg-genchanges.pl b/scripts/dpkg-genchanges.pl
index 0fcd529b847c5f51f7f4c5e3ea8c51e186d3730d..b125fd994b1f223f62f600829a6f82bf228b0b4c 100755 (executable)
--- a/scripts/dpkg-genchanges.pl
+++ b/scripts/dpkg-genchanges.pl
@@ -8,6 +8,7 @@ use POSIX qw(:errno_h :signal_h);
 use English;
 use Dpkg;
 use Dpkg::Gettext;
+use Dpkg::Checksums;
 use Dpkg::ErrorHandling qw(warning error failure unknown internerr syserr
                            subprocerr usageerr);
 use Dpkg::Arch qw(get_host_arch debarch_eq debarch_is);
@@ -35,7 +36,7 @@ my $uploadfilesdir = '..';
 my $sourcestyle = 'i';
 my $quiet = 0;
 my $host_arch = get_host_arch();
-my $changes_format = "1.7";
+my $changes_format = "1.8";
 
 my %f2p;           # - file to package map
 my %p2f;           # - package to file map, has entries for "packagename"
@@ -53,7 +54,8 @@ my @descriptions;
 my @sourcefiles;
 my @fileslistfiles;
 
-my %md5sum;        # - md5sum to file map
+my %checksum;      # - file to checksum map
+my %size;          # - file to size map
 my %remove;        # - fields to remove
 my %override;
 my %archadded;
@@ -400,12 +402,27 @@ if (!is_binaryonly) {
     my $dsc_fields = parsecdata(\*CDATA, sprintf(_g("source control file %s"), $dsc),
                                allow_pgp => 1);
 
+    readallchecksums($dsc_fields, \%checksum, \%size);
+
+    my $rx_fname = qr/[0-9a-zA-Z][-+:.,=0-9a-zA-Z_~]+/;
     my $files = $dsc_fields->{'Files'};
-    for my $file (split(/\n /, $files)) {
-        next if $file eq '';
-        $file =~ m/^([0-9a-f]{32})[ \t]+\d+[ \t]+([0-9a-zA-Z][-+:.,=0-9a-zA-Z_~]+)$/
-            || error(_g("Files field contains bad line \`%s'"), $file);
-        ($md5sum{$2},$file) = ($1,$2);
+    for my $line (split(/\n /, $files)) {
+       next if $line eq '';
+       $line =~ m/^($check_regex{md5})[ \t]+(\d+)[ \t]+($rx_fname)$/
+           || error(_g("Files field contains bad line \`%s'"), $line);
+       my ($md5sum,$size,$file) = ($1,$2,$3);
+       if (exists($checksum{$file}{md5})
+           and $checksum{$file}{md5} ne $md5sum) {
+           error(_g("Conflicting checksums \`%s\' and \`%s' for file \`%s'"),
+                 $checksum{$file}{md5}, $md5sum, $file);
+       }
+       if (exists($size{$file})
+           and $size{$file} != $size) {
+           error(_g("Conflicting sizes \`%u\' and \`%u' for file \`%s'"),
+                 $size{$file}, $size, $file);
+       }
+       $checksum{$file}{md5} = $md5sum;
+       $size{$file} = $size;
         push(@sourcefiles,$file);
     }
     for my $f (@sourcefiles) {
@@ -477,23 +494,17 @@ for my $f (@sourcefiles, @fileslistfiles) {
     next if ($include == ARCH_INDEP and not debarch_eq('all', $p2arch{$f2p{$f}}));
     next if $filedone{$f}++;
     my $uf = "$uploadfilesdir/$f";
-    open(STDIN, "<", $uf) ||
-       syserr(_g("cannot open upload file %s for reading"), $uf);
-    (my @s = stat(STDIN)) || syserr(_g("cannot fstat upload file %s"), $uf);
-    my $size = $s[7];
-    $size || warning(_g("upload file %s is empty"), $uf);
-    my $md5sum = `md5sum`;
-    $? && subprocerr(_g("md5sum upload file %s"), $uf);
-    $md5sum =~ m/^([0-9a-f]{32})\s*-?\s*$/i ||
-        failure(_g("md5sum upload file %s gave strange output \`%s'"),
-                $uf, $md5sum);
-    $md5sum= $1;
-    defined($md5sum{$f}) && $md5sum{$f} ne $md5sum &&
-        error(_g("md5sum of source file %s (%s) is different from md5sum " .
-                 "in %s (%s)"), $uf, $md5sum, $dsc, $md5sum{$f});
-    $fields->{'Files'}.= "\n $md5sum $size $f2sec{$f} $f2pri{$f} $f";
+    $checksum{$f} ||= {};
+    getchecksums($uf, $checksum{$f}, \$size{$f});
+    foreach my $alg (sort keys %{$checksum{$f}}) {
+       $fields->{"Checksums-$alg"} .= "\n $checksum{$f}{$alg} $size{$f} $f";
+    }
+    $fields->{'Files'} .= "\n $checksum{$f}{md5} $size{$f} $f2sec{$f} $f2pri{$f} $f";
 }
 
+# redundant with the Files field
+delete $fields->{"Checksums-Md5"};
+
 $fields->{'Source'}= $sourcepackage;
 if ($fields->{'Version'} ne $substvars->get('source:Version')) {
     $fields->{'Source'} .= " (" . $substvars->get('source:Version') . ")";

diff --git a/scripts/dpkg-source.pl b/scripts/dpkg-source.pl
index 9cba941e6bd8db0fb9bc671285c8f12a3f4d1e6c..b63aedba450f68a24c39fb9a0b5d9ffc4d1d5d43 100755 (executable)
--- a/scripts/dpkg-source.pl
+++ b/scripts/dpkg-source.pl
@@ -5,6 +5,7 @@ use warnings;
 
 use Dpkg;
 use Dpkg::Gettext;
+use Dpkg::Checksums;
 use Dpkg::ErrorHandling qw(warning warnerror error failure unknown
                            internerr syserr subprocerr usageerr
                            $warnable_error $quiet_warnings);
@@ -98,7 +99,7 @@ my %remove;
 my %override;
 
 # Files
-my %md5sum;
+my %checksum;
 my %size;
 my %type;               # used by checktype
 my %filepatched;        # used by checkdiff
@@ -120,7 +121,8 @@ my @dsc_fields = (qw(Format Source Binary Architecture Version Origin
                     Maintainer Uploaders Dm-Upload-Allowed Homepage
                     Standards-Version Vcs-Browser Vcs-Arch Vcs-Bzr
                     Vcs-Cvs Vcs-Darcs Vcs-Git Vcs-Hg Vcs-Mtn Vcs-Svn),
-                  @src_dep_fields);
+                  @src_dep_fields,
+                  qw(Files));
 
 
 # Make sure patch doesn't get any funny ideas
@@ -196,7 +198,7 @@ General options:
 "), $progname,
     $diff_ignore_default_regexp,
     join('', map { " -I$_" } @tar_ignore_default_pattern),
-    "@comp_supported" ;
+    "@comp_supported";
 }
 
 sub handleformat {
@@ -772,6 +774,7 @@ if ($opmode eq 'build') {
     open(DSC, ">", "$basenamerev.dsc") ||
         syserr(_g("create %s"), "$basenamerev.dsc");
 
+    delete $fields->{'Checksums-Md5'}; # identical with Files field
     $substvars->parse($varlistfile) if $varlistfile && -e $varlistfile;
     tied(%{$fields})->set_field_importance(@dsc_fields);
     tied(%{$fields})->output(\*DSC, $substvars);
@@ -871,16 +874,29 @@ if ($opmode eq 'build') {
         $baseversion= $version; $revision= '';
     }
 
+    readallchecksums($fields, \%checksum, \%size);
+
+    my $rx_fname = qr/[0-9a-zA-Z][-+:.,=0-9a-zA-Z_~]+/;
     my $files = $fields->{'Files'};
     my @tarfiles;
     my $difffile;
     my $debianfile;
     my %seen;
     for my $file (split(/\n /, $files)) {
-        next if $file eq '';
-        $file =~ m/^([0-9a-f]{32})[ \t]+(\d+)[ \t]+([0-9a-zA-Z][-+:.,=0-9a-zA-Z_~]+)$/
-            || error(_g("Files field contains bad line `%s'"), $file);
-        ($md5sum{$3},$size{$3},$file) = ($1,$2,$3);
+       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);
+       (my $md5sum,$size{$3},$file) = ($1,$2,$3);
+       if (exists($checksum{$file}{md5})
+           and $checksum{$file}{md5} ne $md5sum) {
+           error(_g("Conflicting checksums \`%s\' and \`%s' for file \`%s'"),
+                 $checksum{$file}{md5}, $md5sum, $file);
+       }
+       $checksum{$file}{md5} = $md5sum;
+
        local $_ = $file;
 
        error(_g("Files field contains invalid filename `%s'"), $file)
@@ -1128,19 +1144,8 @@ if ($opmode eq 'build') {
 }
 
 sub checkstats {
-    my $dscdir = shift;
-    my ($f) = @_;
-    my @s;
-    my $m;
-    open(STDIN, "<", "$dscdir/$f") || syserr(_g("cannot read %s"), "$dscdir/$f");
-    (@s = stat(STDIN)) || syserr(_g("cannot fstat %s"), "$dscdir/$f");
-    $s[7] == $size{$f} || error(_g("file %s has size %s instead of expected %s"),
-                                $f, $s[7], $size{$f});
-    $m= `md5sum`; $? && subprocerr("md5sum $f"); $m =~ s/\n$//;
-    $m = readmd5sum( $m );
-    $m eq $md5sum{$f} || error(_g("file %s has md5sum %s instead of expected %s"),
-                               $f, $m, $md5sum{$f});
-    open(STDIN, "<", "/dev/null") || &syserr(_g("reopen stdin from /dev/null"));
+    my ($dscdir, $f) = @_;
+    getchecksums("$dscdir/$f", $checksum{$f}, \$size{$f});
 }
 
 sub erasedir {
@@ -1640,12 +1645,12 @@ sub addfile {
     my ($fields, $filename)= @_;
     $added_files{$filename}++ &&
         internerr(_g("tried to add file `%s' twice"), $filename);
-    stat($filename) || syserr(_g("could not stat output file `%s'"), $filename);
-    my $size = (stat _)[7];
-    my $md5sum= `md5sum <$filename`;
-    $? && &subprocerr("md5sum $filename");
-    $md5sum = readmd5sum( $md5sum );
-    $fields->{'Files'}.= "\n $md5sum $size $filename";
+    my (%sums, $size);
+    getchecksums($filename, \%sums, \$size);
+    foreach my $alg (sort keys %sums) {
+       $fields->{"Checksums-$alg"} .= "\n $sums{$alg} $size $filename";
+    }
+    $fields->{'Files'}.= "\n $sums{md5} $size $filename";
 }
 
 # replace \ddd with their corresponding character, refuse \ddd > \377
@@ -1668,10 +1673,3 @@ sub deoctify {
     return join("", @_);
 } }
 
-sub readmd5sum {
-    (my $md5sum = shift) or return;
-    $md5sum =~ s/^([0-9a-f]{32})\s*\*?-?\s*\n?$/$1/o
-        || failure(_g("md5sum gave bogus output `%s'"), $md5sum);
-    return $md5sum;
-}
-