X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=254e3fbf5f588bc1f1bc6a7c20f41492cdd09ab2;hp=6ec99acb31c13b998bc7c3dcdd4c13620dcd7b03;hb=6e24ac7bb85e30df00b3d14853b049e3f06b6dec;hpb=30016dc35aa58ddfe81a2be07a2d7399705ff971

diff --git a/dgit b/dgit
index 6ec99acb..254e3fbf 100755
--- 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,14 +114,14 @@ sub dscfn ($) {
     return "${package}_".(stripepoch $vsn).".dsc";
 }
 
-sub changesopts () { return @changesopts[1..$#changesopts]; }
-
 our $us = 'dgit';
 our $debugprefix = '';
 
 sub printdebug { print DEBUG $debugprefix, @_ or die $!; }
 
-sub fail { die "$us: @_\n"; }
+sub fail { 
+    die $us.($we_are_responder ? " (build host)" : "").": @_\n";
+}
 
 sub badcfg { print STDERR "$us: invalid configuration: @_\n"; exit 12; }
 
@@ -180,7 +181,6 @@ sub changedir ($) {
 sub badproto ($$) {
     my ($fh, $m) = @_;
     fail "connection lost: $!" if $fh->error;
-    fail "connection terminated" if $fh->eof;
     fail "protocol violation; $m not expected";
 }
 
@@ -208,9 +208,8 @@ sub protocol_send_file ($$) {
 	die "$ourfn: $!" unless defined $got;
 	last if !$got;
 	print $fh "data-block ".length($d)."\n" or die $!;
-	print $d or die $!;
+	print $fh $d or die $!;
     }
-    PF->eof or die "$ourfn $!";
     PF->error and die "$ourfn $!";
     print $fh "data-end\n" or die $!;
     close PF;
@@ -227,6 +226,7 @@ sub protocol_read_bytes ($$) {
 
 sub protocol_receive_file ($$) {
     my ($fh, $ourfn) = @_;
+    printdebug "() $ourfn\n";
     open PF, ">", $ourfn or die "$ourfn: $!";
     for (;;) {
 	my ($y,$l) = protocol_expect {
@@ -239,7 +239,6 @@ sub protocol_receive_file ($$) {
 	print PF $d or die $!;
     }
     close PF or die $!;
-    printdebug "() $ourfn\n";
 }
 
 #---------- remote protocol support, responder ----------
@@ -248,27 +247,28 @@ sub responder_send_command ($) {
     my ($command) = @_;
     return unless $we_are_responder;
     # called even without $we_are_responder
-    printdebug "<< $command\n";
-    print $command, "\n" or die $!;
+    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 \*STDOUT, $ourfn;
+    protocol_send_file \*PO, $ourfn;
 }
 
 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 \*STDIN, $fn;
+	protocol_receive_file \*PI, $fn;
     }
-    protocol_expect { m/^files-end$/ } \*STDIN;
+    printdebug "[[\$\n";
+    protocol_expect { m/^files-end$/ } \*PI;
 }
 
 #---------- remote protocol support, initiator ----------
@@ -284,7 +284,7 @@ sub progress {
     if ($we_are_responder) {
 	my $m = join '', @_;
 	responder_send_command "progress ".length($m) or die $!;
-	print $m or die $!;
+	print PO $m or die $!;
     } else {
 	print @_, "\n";
     }
@@ -1131,13 +1131,13 @@ sub push_parse_dsc ($$$) {
     my $dversion = getfield $dsc, 'Version';
     my $dscpackage = getfield $dsc, 'Source';
     ($dscpackage eq $package && $dversion eq $cversion) or
-	fail "$dsc is for $dscpackage $dversion".
+	fail "$dscfn is for $dscpackage $dversion".
 	    " but debian/changelog is for $package $cversion";
 }
 
-sub push_mktag ($$$$$$$$) {
+sub push_mktag ($$$$$$$) {
     my ($head,$clogp,$tag,
-	$dsc,$dscfn,
+	$dscfn,
 	$changesfile,$changesfilewhat,
 	$tfn) = @_;
 
@@ -1152,6 +1152,7 @@ sub push_mktag ($$$$$$$$) {
     }
 
     my $cversion = getfield $clogp, 'Version';
+    my $clogsuite = getfield $clogp, 'Distribution';
 
     # We make the git tag by hand because (a) that makes it easier
     # to control the "tagger" (b) we can do remote signing
@@ -1163,7 +1164,7 @@ type commit
 tag $tag
 tagger $authline
 
-$package release $cversion for $csuite [dgit]
+$package release $cversion for $clogsuite [dgit]
 END
     close TO or die $!;
 
@@ -1264,15 +1265,21 @@ sub dopush () {
     }
 
     responder_send_file('changes',$changesfile);
+    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,
-		     $dsc,"../$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;
@@ -1422,10 +1429,18 @@ sub cmd_remote_push_responder {
     die unless @rargs;
     my ($dir) = @rargs;
     $debugprefix = ' ';
-    changedir $dir;
     $we_are_responder = 1;
+
+    open PI, "<&STDIN" or die $!;
+    open STDIN, "/dev/null" or die $!;
+    open PO, ">&STDOUT" or die $!;
+    autoflush PO 1;
+    open STDOUT, ">&STDERR" or die $!;
     autoflush STDOUT 1;
+
     responder_send_command("dgit-remote-push-ready");
+
+    changedir $dir;
     &cmd_push;
 }
 
@@ -1488,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 ($) {
@@ -1507,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;
 }
 
@@ -1517,12 +1530,13 @@ 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;
 
-sub i_param ($) {
-    $_[0] =~ m/^(\S+) (.*)$/;
+sub i_resp_param ($) {
+    $_[0] =~ m/^(\S+) (.*)$/ or badproto \*RO, "bad param spec";
     $i_param{$1} = $2;
 }
 
@@ -1532,44 +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 {
-    defined $i_param{'head'} && defined $i_dscfn
-	or badproto \*RO, "sequencing error";
+    printdebug Dumper(\%i_param, $i_dscfn);
+    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,
-        $dsc, $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. ----------
@@ -1659,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';
@@ -1728,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: $!";
@@ -1780,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]) {
@@ -1833,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, $_;
 		    $_ = '';