Treat .dsc as bytes, just like everything else, rather than letting HTTP::Message...

[dgit.git] / dgit

diff --git a/dgit b/dgit
index 461e5e658305f3bfcfe2f507117931f05aabedbc..4125c37a30432fc848f7d34f08c93c44e33e1426 100755 (executable)
--- a/dgit
+++ b/dgit
@@ -29,6 +29,7 @@ use File::Basename;
 use Dpkg::Version;
 use POSIX;
 use IPC::Open2;
+use Digest::SHA;
 
 our $our_version = 'UNRELEASED'; ###substituted###
 
@@ -317,10 +318,10 @@ sub url_get {
     my $r = $ua->get(@_) or die $!;
     return undef if $r->code == 404;
     $r->is_success or fail "failed to fetch $what: ".$r->status_line;
-    return $r->decoded_content();
+    return $r->decoded_content(charset => 'none');
 }
 
-our ($dscdata,$dscurl,$dsc,$skew_warning_vsn);
+our ($dscdata,$dscurl,$dsc,$dsc_checked,$skew_warning_vsn);
 
 sub shellquote {
     my @out;
@@ -753,7 +754,7 @@ sub archive_query_sshpsql ($$) {
     my ($proto,$data) = @_;
     sql_injection_check $isuite, $package;
     my @rows = sshpsql($data, <<END);
-        SELECT source.version, component.name, files.filename
+        SELECT source.version, component.name, files.filename, files.sha256sum
           FROM source
           JOIN src_associations ON source.id = src_associations.source
           JOIN suite ON suite.id = src_associations.suite
@@ -766,9 +767,10 @@ sub archive_query_sshpsql ($$) {
            AND files.filename LIKE '%.dsc';
 END
     @rows = sort { -version_compare_string($a->[0],$b->[0]) } @rows;
+    my $digester = Digest::SHA->new(256);
     @rows = map {
-       my ($vsn,$component,$filename) = @$_;
-       [ $vsn, "/pool/$component/$filename" ];
+       my ($vsn,$component,$filename,$sha256sum) = @$_;
+       [ $vsn, "/pool/$component/$filename",$digester,$sha256sum ];
     } @rows;
     return @rows;
 }
@@ -838,19 +840,28 @@ sub get_archive_dsc () {
     canonicalise_suite();
     my @vsns = archive_query('archive_query');
     foreach my $vinfo (@vsns) {
-       my ($vsn,$subpath) = @$vinfo;
+       my ($vsn,$subpath,$digester,$digest) = @$vinfo;
        $dscurl = access_cfg('mirror').$subpath;
        $dscdata = url_get($dscurl);
        if (!$dscdata) {
            $skew_warning_vsn = $vsn if !defined $skew_warning_vsn;
            next;
        }
+       if ($digester) {
+           $digester->reset();
+           $digester->add($dscdata);
+           my $got = $digester->hexdigest();
+           $got eq $digest or
+               fail "$dscurl has hash $got but".
+                   " archive told us to expect $digest";
+       }
        my $dscfh = new IO::File \$dscdata, '<' or die $!;
        printdebug Dumper($dscdata) if $debug>1;
        $dsc = parsecontrolfh($dscfh,$dscurl, allow_pgp=>1);
        printdebug Dumper($dsc) if $debug>1;
        my $fmt = getfield $dsc, 'Format';
        fail "unsupported source format $fmt, sorry" unless $format_ok{$fmt};
+       $dsc_checked = !!$digester;
        return;
     }
     $dsc = undef;
@@ -998,6 +1009,7 @@ sub generate_commit_from_dsc () {
     print D $dscdata or die "$dscfn: $!";
     close D or die "$dscfn: $!";
     my @cmd = qw(dpkg-source);
+    push @cmd, '--no-check' if $dsc_checked;
     push @cmd, qw(-x --), $dscfn;
     runcmd @cmd;