X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=4125c37a30432fc848f7d34f08c93c44e33e1426;hp=461e5e658305f3bfcfe2f507117931f05aabedbc;hb=4ddcb6049e18f68c71f5ac0148aee9fdca5acb6a;hpb=ac221d67c7227d43ad69f8a9a291411d15cefd41

diff --git a/dgit b/dgit
index 461e5e65..4125c37a 100755
--- 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;