chiark / gitweb /
dgit build, by default, uses the archive to find out what the correct -v<version...
[dgit.git] / dgit
diff --git a/dgit b/dgit
index 5ea9c26613432c1bbb95fcc4f86f2fa1351c410a..254e3fbf5f588bc1f1bc6a7c20f41492cdd09ab2 100755 (executable)
--- a/dgit
+++ b/dgit
@@ -45,6 +45,7 @@ our $ignoredirty = 0;
 our $noquilt = 0;
 our $existing_package = 'dpkg';
 our $cleanmode = 'dpkg-source';
+our $changes_since_version;
 our $we_are_responder;
 our $initiator_tempdir;
 
@@ -113,8 +114,6 @@ sub dscfn ($) {
     return "${package}_".(stripepoch $vsn).".dsc";
 }
 
-sub changesopts () { return @changesopts[1..$#changesopts]; }
-
 our $us = 'dgit';
 our $debugprefix = '';
 
@@ -248,14 +247,14 @@ sub responder_send_command ($) {
     my ($command) = @_;
     return unless $we_are_responder;
     # called even without $we_are_responder
-    printdebug "<< $command\n";
+    printdebug ">> $command\n";
     print PO $command, "\n" or die $!;
 }    
 
 sub responder_send_file ($$) {
     my ($keyword, $ourfn) = @_;
     return unless $we_are_responder;
-    printdebug "[[ $keyword $ourfn\n";
+    printdebug "]] $keyword $ourfn\n";
     responder_send_command "file $keyword";
     protocol_send_file \*PO, $ourfn;
 }
@@ -263,11 +262,12 @@ sub responder_send_file ($$) {
 sub responder_receive_files ($@) {
     my ($keyword, @ourfns) = @_;
     die unless $we_are_responder;
-    printdebug "]] $keyword @ourfns\n";
+    printdebug "[[ $keyword @ourfns\n";
     responder_send_command "want $keyword";
     foreach my $fn (@ourfns) {
        protocol_receive_file \*PI, $fn;
     }
+    printdebug "[[\$\n";
     protocol_expect { m/^files-end$/ } \*PI;
 }
 
@@ -1268,13 +1268,18 @@ sub dopush () {
     responder_send_command("param head $head");
 
     my $tfn = sub { ".git/dgit/tag$_[0]"; };
-    my ($tagobjfn) =
-       $we_are_responder
-       ? responder_receive_files('signed-tag', $tfn->('.signed.tmp'))
-       : push_mktag($head,$clogp,$tag,
-                    "../$dscfn",
-                    $changesfile,$changesfile,
-                                $tfn);
+    my $tagobjfn;
+
+    if ($we_are_responder) {
+       $tagobjfn = $tfn->('.signed.tmp');
+       responder_receive_files('signed-tag', $tagobjfn);
+    } else {
+       $tagobjfn =
+           push_mktag($head,$clogp,$tag,
+                      "../$dscfn",
+                      $changesfile,$changesfile,
+                      $tfn);
+    }
 
     my $tag_obj_hash = cmdoutput @git, qw(hash-object -w -t tag), $tagobjfn;
     runcmd_ordryrun @git, qw(verify-tag), $tag_obj_hash;
@@ -1498,16 +1503,6 @@ sub cmd_rpush {
        };
        i_method "i_resp", $icmd, $iargs;
     }
-
-    my $pid = $i_child_pid;
-    $i_child_pid = undef; # prevents killing some other process with same pid
-    printdebug "waiting for remote child $pid...";
-    my $got = waitpid $pid, 0;
-    die $! unless $got == $pid;
-    die "remote child failed $?" if $?;
-
-    i_cleanup();
-    exit 0;
 }
 
 sub i_resp_progress ($) {
@@ -1517,7 +1512,15 @@ sub i_resp_progress ($) {
 }
 
 sub i_resp_complete {
+    my $pid = $i_child_pid;
+    $i_child_pid = undef; # prevents killing some other process with same pid
+    printdebug "waiting for remote child $pid...\n";
+    my $got = waitpid $pid, 0;
+    die $! unless $got == $pid;
+    die "remote child failed $?" if $?;
+
     i_cleanup();
+    printdebug "all done\n";
     exit 0;
 }
 
@@ -1527,6 +1530,7 @@ sub i_resp_file ($) {
     my $localpath = "$i_tmp/$localname";
     stat $localpath and badproto \*RO, "file $keyword ($localpath) twice";
     protocol_receive_file \*RO, $localpath;
+    i_method "i_file", $keyword;
 }
 
 our %i_param;
@@ -1542,45 +1546,60 @@ sub i_resp_want ($) {
     my ($keyword) = @_;
     die "$keyword ?" if $i_wanted{$keyword}++;
     my @localpaths = i_method "i_want", $keyword;
-    printdebug "]]  $keyword @localpaths\n";
+    printdebug "[[  $keyword @localpaths\n";
     foreach my $localpath (@localpaths) {
        protocol_send_file \*RI, $localpath;
     }
-    print RI "end-files\n" or die $!;
+    print RI "files-end\n" or die $!;
 }
 
-our ($i_clogp, $i_version, $i_tag, $i_dscfn);
+our ($i_clogp, $i_version, $i_tag, $i_dscfn, $i_changesfn);
 
-sub i_localname_parsed_changelog { return "remote-changelog.822"; }
-sub i_localname_changes { return "remote.changes"; }
-sub i_localname_dsc {
+sub i_localname_parsed_changelog {
+    return "remote-changelog.822";
+}
+sub i_file_parsed_changelog {
     ($i_clogp, $i_version, $i_tag, $i_dscfn) =
        push_parse_changelog "$i_tmp/remote-changelog.822";
     die if $i_dscfn =~ m#/|^\W#;
+}
+
+sub i_localname_dsc {
+    defined $i_dscfn or badproto \*RO, "dsc (before parsed-changelog)";
     return $i_dscfn;
 }
+sub i_file_dsc { }
+
+sub i_localname_changes {
+    defined $i_dscfn or badproto \*RO, "dsc (before parsed-changelog)";
+    $i_changesfn = $i_dscfn;
+    $i_changesfn =~ s/\.dsc$/_dgit.changes/ or die;
+    return $i_changesfn;
+}
+sub i_file_changes { }
 
 sub i_want_signed_tag {
     printdebug Dumper(\%i_param, $i_dscfn);
-    defined $i_param{'head'} && defined $i_dscfn
-       or badproto \*RO, "sequencing error";
+    defined $i_param{'head'} && defined $i_dscfn && defined $i_clogp
+       or badproto \*RO, "premature desire for signed-tag";
     my $head = $i_param{'head'};
     die if $head =~ m/[^0-9a-f]/ || $head !~ m/^../;
 
-    push_parse_dsc $i_dscfn, 'remote dsc', 
+    push_parse_dsc $i_dscfn, 'remote dsc', $i_version;
 
-    push_mktag $head, $i_clogp, $i_tag,
-        $i_dscfn,
-        'remote.changes', 'remote changes',
-        'tag.tag';
+    my $tagobjfn =
+       push_mktag $head, $i_clogp, $i_tag,
+           $i_dscfn,
+           $i_changesfn, 'remote changes',
+           sub { "tag$_[0]"; };
 
-    return 'tag.tag';
+    return $tagobjfn;
 }
 
 sub i_want_signed_dsc_changes {
     rename "$i_dscfn.tmp","$i_dscfn" or die "$i_dscfn $!";
-    sign_changes 'remote.changes';
-    return ($i_dscfn, 'remote.changes');
+    sign_changes $i_changesfn;
+    return ($i_dscfn, $i_changesfn);
 }
 
 #---------- building etc. ----------
@@ -1670,6 +1689,26 @@ sub build_prep () {
     build_maybe_quilt_fixup();
 }
 
+sub changesopts () {
+    my @opts =@changesopts[1..$#changesopts];
+    if (!defined $changes_since_version) {
+       my @vsns = archive_query('archive_query');
+       if (@vsns) {
+           @vsns = map { $_->[0] } @vsns;
+           @vsns = sort { version_compare_string($a, $b) } @vsns;
+           $changes_since_version = $vsns[0];
+           progress "changelog will contain changes since $vsns[0]";
+       } else {
+           $changes_since_version = '_';
+           progress "package seems new, not specifying -v<version>";
+       }
+    }
+    if ($changes_since_version ne '_') {
+       unshift @opts, "-v$changes_since_version";
+    }
+    return @opts;
+}
+
 sub cmd_build {
     badusage "dgit build implies --clean=dpkg-source"
        if $cleanmode ne 'dpkg-source';
@@ -1739,7 +1778,14 @@ sub cmd_sbuild {
        }
     }
     runcmd_ordryrun_local @sbuild, @ARGV, qw(-d), $isuite, $dscfn;
-    runcmd_ordryrun_local @mergechanges, glob $pat;
+    my @changesfiles = glob $pat;
+    @changesfiles = sort {
+       ($b =~ m/_source\.changes$/ <=> $a =~ m/_source\.changes$/)
+           or $a cmp $b
+    } @changesfiles;
+    fail "wrong number of different changes files (@changesfiles)"
+       unless @changesfiles;
+    runcmd_ordryrun_local @mergechanges, @changesfiles;
     my $multichanges = "${package}_".(stripepoch $version)."_multi.changes";
     if (act_local()) {
        stat $multichanges or fail "$multichanges: $!";
@@ -1791,6 +1837,9 @@ sub parseopts () {
            } elsif (m/^--new$/) {
                push @ropts, $_;
                $new_package=1;
+           } elsif (m/^--since-version=([^_]+|_)$/) {
+               push @ropts, $_;
+               $changes_since_version = $1;
            } elsif (m/^--(\w+)=(.*)/s &&
                     ($om = $opts_opt_map{$1}) &&
                     length $om->[0]) {
@@ -1844,7 +1893,10 @@ sub parseopts () {
                } elsif (s/^-N/-/) {
                    push @ropts, $&;
                    $new_package=1;
-               } elsif (m/^-[vm]/) {
+               } elsif (s/^-v([^_]+|_)$//s) {
+                   push @ropts, $&;
+                   $changes_since_version = $1;
+               } elsif (m/^-m/) {
                    push @ropts, $&;
                    push @changesopts, $_;
                    $_ = '';