chiark / gitweb /
Provide --force-changes-origs-exactly
[dgit.git] / dgit
diff --git a/dgit b/dgit
index e489150ec790f0959449d5d749e0bfba00e6bfa5..5be5c75bae3ac28fce662351ad930bb1f413ce8c 100755 (executable)
--- 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 {
@@ -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;
@@ -3325,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);