X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=5be5c75bae3ac28fce662351ad930bb1f413ce8c;hp=038df387f84dd754a3c55300f99c6d9a130bb173;hb=61b85b99276ae505f3c6712e2caa0251643d0db8;hpb=6b9101bc9749d9b7399cb5d89bacbec097bf0d4d

diff --git a/dgit b/dgit
index 038df387..5be5c75b 100755
--- a/dgit
+++ b/dgit
@@ -76,7 +76,7 @@ our $tagformatfn;
 
 our %forceopts = map { $_=>0 }
     qw(unrepresentable unsupported-source-format
-       dsc-changes-mismatch
+       dsc-changes-mismatch changes-origs-exactly
        import-gitapply-absurd
        import-gitapply-no-absurd);
 
@@ -619,7 +619,7 @@ our %defcfg = ('dgit.default.distro' => 'debian',
 	       'dgit-distro.test-dummy.git-url' => "$td/git",
 	       'dgit-distro.test-dummy.git-host' => "git",
 	       'dgit-distro.test-dummy.git-path' => "$td/git",
-	       'dgit-distro.test-dummy.archive-query' => "ftpmasterapi:",
+	       'dgit-distro.test-dummy.archive-query' => "dummycatapi:",
 	       'dgit-distro.test-dummy.archive-query-url' => "file://$td/aq/",
 	       'dgit-distro.test-dummy.mirror' => "file://$td/mirror/",
 	       'dgit-distro.test-dummy.upload-host' => 'test-dummy',
@@ -1029,7 +1029,7 @@ sub api_query ($$;$) {
     return decode_json($json);
 }
 
-sub canonicalise_suite_ftpmasterapi () {
+sub canonicalise_suite_ftpmasterapi {
     my ($proto,$data) = @_;
     my $suites = api_query($data, 'suites');
     my @matched;
@@ -1053,7 +1053,7 @@ sub canonicalise_suite_ftpmasterapi () {
     return $cn;
 }
 
-sub archive_query_ftpmasterapi () {
+sub archive_query_ftpmasterapi {
     my ($proto,$data) = @_;
     my $info = api_query($data, "dsc_in_suite/$isuite/$package");
     my @rows;
@@ -1089,6 +1089,33 @@ sub file_in_archive_ftpmasterapi {
     my $info = api_query($data, "file_in_archive/$pat", 1);
 }
 
+#---------- `dummyapicat' archive query method ----------
+
+sub archive_query_dummycatapi { archive_query_ftpmasterapi @_; }
+sub canonicalise_suite_dummycatapi { canonicalise_suite_ftpmasterapi @_; }
+
+sub file_in_archive_dummycatapi ($$$) {
+    my ($proto,$data,$filename) = @_;
+    my $mirror = access_cfg('mirror');
+    $mirror =~ s#^file://#/# or die "$mirror ?";
+    my @out;
+    my @cmd = (qw(sh -ec), '
+            cd "$1"
+            find -name "$2" -print0 |
+            xargs -0r sha256sum
+        ', qw(x), $mirror, $filename);
+    debugcmd "-|", @cmd;
+    open FIA, "-|", @cmd or die $!;
+    while (<FIA>) {
+	chomp or die;
+	printdebug "| $_\n";
+	m/^(\w+)  (\S+)$/ or die "$_ ?";
+	push @out, { sha256sum => $1, filename => $2 };
+    }
+    close FIA or die failedcmd @cmd;
+    return \@out;
+}
+
 #---------- `madison' archive query method ----------
 
 sub archive_query_madison {
@@ -1480,9 +1507,9 @@ sub mktree_in_ud_from_only_subdir (;$) {
 }
 
 our @files_csum_info_fields = 
-    (['Checksums-Sha256','Digest::SHA', 'new(256)'],
-     ['Checksums-Sha1',  'Digest::SHA', 'new(1)'],
-     ['Files',           'Digest::MD5', 'new()']);
+    (['Checksums-Sha256','Digest::SHA', 'new(256)', 'sha256sum'],
+     ['Checksums-Sha1',  'Digest::SHA', 'new(1)',   'sha1sum'],
+     ['Files',           'Digest::MD5', 'new()',    'md5sum']);
 
 sub dsc_files_info () {
     foreach my $csumi (@files_csum_info_fields) {
@@ -1588,6 +1615,101 @@ sub is_orig_file_of_vsn ($$) {
     return 1;
 }
 
+sub changes_update_origs_from_dsc ($$$$) {
+    my ($dsc, $changes, $upstreamvsn, $changesfile) = @_;
+    my %changes_f;
+    printdebug "checking origs needed ($upstreamvsn)...\n";
+    $_ = getfield $changes, 'Files';
+    m/^\w+ \d+ (\S+ \S+) \S+$/m or
+	fail "cannot find section/priority from .changes Files field";
+    my $placementinfo = $1;
+    my %changed;
+    printdebug "checking origs needed placement '$placementinfo'...\n";
+    foreach my $l (split /\n/, getfield $dsc, 'Files') {
+	$l =~ m/\S+$/ or next;
+	my $file = $&;
+	printdebug "origs $file | $l\n";
+	next unless is_orig_file_of_vsn $file, $upstreamvsn;
+	printdebug "origs $file is_orig\n";
+	my $have = archive_query('file_in_archive', $file);
+	if (!defined $have) {
+	    print STDERR <<END;
+archive does not support .orig check; hope you used --ch:--sa/-sd if needed
+END
+	    return;
+	}
+	my $found_same = 0;
+	my @found_differ;
+	printdebug "origs $file \$#\$have=$#$have\n";
+	foreach my $h (@$have) {
+	    my $same = 0;
+	    my @differ;
+	    foreach my $csumi (@files_csum_info_fields) {
+		my ($fname, $module, $method, $archivefield) = @$csumi;
+		next unless defined $h->{$archivefield};
+		$_ = $dsc->{$fname};
+		next unless defined;
+		m/^(\w+) .* \Q$file\E$/m or
+		    fail ".dsc $fname missing entry for $file";
+		if ($h->{$archivefield} eq $1) {
+		    $same++;
+		} else {
+		    push @differ,
+ "$archivefield: $h->{$archivefield} (archive) != $1 (local .dsc)";
+		}
+	    }
+	    die "$file ".Dumper($h)." ?!" if $same && @differ;
+	    $found_same++
+		if $same;
+	    push @found_differ, "archive $h->{filename}: ".join "; ", @differ
+		if @differ;
+	}
+	print "origs $file f.same=$found_same #f._differ=$#found_differ\n";
+	if (@found_differ && !$found_same) {
+	    fail join "\n",
+		"archive contains $file with different checksum",
+		@found_differ;
+	}
+	# Now we edit the changes file to add or remove it
+	foreach my $csumi (@files_csum_info_fields) {
+	    my ($fname, $module, $method, $archivefield) = @$csumi;
+	    next unless defined $changes->{$fname};
+	    if ($found_same) {
+		# in archive, delete from .changes if it's there
+		$changed{$file} = "removed" if
+		    $changes->{$fname} =~ s/^.* \Q$file\E$(?:)\n//m;
+	    } elsif ($changes->{$fname} =~ m/^.* \Q$file\E$(?:)\n/m) {
+		# not in archive, but it's here in the .changes
+	    } else {
+		my $dsc_data = getfield $dsc, $fname;
+		$dsc_data =~ m/^(.* \Q$file\E$)\n/m or die "$dsc_data $file ?";
+		my $extra = $1;
+		$extra =~ s/ \d+ /$&$placementinfo /
+		    or die "$fname $extra >$dsc_data< ?"
+		    if $fname eq 'Files';
+		$changes->{$fname} .= "\n". $extra;
+		$changed{$file} = "added";
+	    }
+	}
+    }
+    if (%changed) {
+	foreach my $file (keys %changed) {
+	    progress sprintf
+		"edited .changes for archive .orig contents: %s %s",
+		$changed{$file}, $file;
+	}
+	my $chtmp = "$changesfile.tmp";
+	$changes->save($chtmp);
+	if (act_local()) {
+	    rename $chtmp,$changesfile or die "$changesfile $!";
+	} else {
+	    progress "[new .changes left in $changesfile]";
+	}
+    } else {
+	progress "$changesfile already has appropriate .orig(s) (if any)";
+    }
+}
+
 sub make_commit ($) {
     my ($file) = @_;
     return cmdoutput @git, qw(hash-object -w -t commit), $file;
@@ -3236,11 +3358,12 @@ END
     my $dgithead = $actualhead;
     my $maintviewhead = undef;
 
+    my $upstreamversion = $clogp->{Version};
+    $upstreamversion =~ s/-[^-]*$//;
+
     if (madformat_wantfixup($format)) {
 	# user might have not used dgit build, so maybe do this now:
 	if (quiltmode_splitbrain()) {
-	    my $upstreamversion = $clogp->{Version};
-	    $upstreamversion =~ s/-[^-]*$//;
 	    changedir $ud;
 	    quilt_make_fake_dsc($upstreamversion);
 	    my $cachekey;
@@ -3324,9 +3447,15 @@ END
 
     # Check that changes and .dsc agree enough
     $changesfile =~ m{[^/]*$};
-    files_compare_inputs($dsc, parsecontrol($changesfile,$&))
+    my $changes = parsecontrol($changesfile,$&);
+    files_compare_inputs($dsc, $changes)
 	unless forceing [qw(dsc-changes-mismatch)];
 
+    # Perhaps adjust .dsc to contain right set of origs
+    changes_update_origs_from_dsc($dsc, $changes, $upstreamversion,
+				  $changesfile)
+	unless forceing [qw(changes-origs-exactly)];
+
     # Checks complete, we're going to try and go ahead:
 
     responder_send_file('changes',$changesfile);