X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=b13b5ed566c74f36d24a96298f59eb5e0ea007aa;hp=40953871a6724b8c3015a4889e47aa275daac419;hb=8293f64249970c85187371555ad7bd162a37d695;hpb=8c229ab1d6afbf7008d3be50d5c33fa7a3dc88ab

diff --git a/dgit b/dgit
index 40953871..b13b5ed5 100755
--- a/dgit
+++ b/dgit
@@ -34,6 +34,8 @@ use Config;
 
 our $our_version = 'UNRELEASED'; ###substituted###
 
+our $rpushprotovsn = 2;
+
 our $isuite = 'unstable';
 our $idistro;
 our $package;
@@ -175,6 +177,13 @@ sub changedir ($) {
     chdir $newdir or die "chdir: $newdir: $!";
 }
 
+sub stat_exists ($) {
+    my ($f) = @_;
+    return 1 if stat $f;
+    return 0 if $!==&ENOENT;
+    die "stat $f: $!";
+}
+
 #---------- remote protocol support, common ----------
 
 # remote push initiator/responder protocol:
@@ -639,7 +648,6 @@ sub parsecontrolfh ($$;$) {
     for (;;) {
 	my %opts = ('name' => $desc);
 	$opts{allow_pgp}= $allowsigned || !$dpkgcontrolhash_noissigned;
-print STDERR Dumper(\%opts);
 	$c = Dpkg::Control::Hash->new(%opts);
 	$c->parse($fh,$desc) or die "parsing of $desc failed";
 	last if $allowsigned;
@@ -765,7 +773,7 @@ sub madison_parse ($) {
 	$5 eq 'source' or die "$rmad ?";
 	push @out, [$vsn,pool_dsc_subpath($vsn,$component),$newsuite];
     }
-    return sort { -version_compare_string($a->[0],$b->[0]); } @out;
+    return sort { -version_compare($a->[0],$b->[0]); } @out;
 }
 
 sub canonicalise_suite_madison ($$) {
@@ -823,7 +831,7 @@ sub archive_query_sshpsql ($$) {
            AND source.source='$package'
            AND files.filename LIKE '%.dsc';
 END
-    @rows = sort { -version_compare_string($a->[0],$b->[0]) } @rows;
+    @rows = sort { -version_compare($a->[0],$b->[0]) } @rows;
     my $digester = Digest::SHA->new(256);
     @rows = map {
 	my ($vsn,$component,$filename,$sha256sum) = @$_;
@@ -881,7 +889,7 @@ sub archive_query_dummycat ($$) {
     }
     C->error and die "$dpath: $!";
     close C;
-    return sort { -version_compare_string($a->[0],$b->[0]); } @rows;
+    return sort { -version_compare($a->[0],$b->[0]); } @rows;
 }
 
 sub canonicalise_suite () {
@@ -968,6 +976,12 @@ sub prep_ud () {
     mkdir $ud or die $!;
 }
 
+sub mktree_in_ud_here () {
+    runcmd qw(git init -q);
+    rmtree('.git/objects');
+    symlink '../../../../objects','.git/objects' or die $!;
+}
+
 sub mktree_in_ud_from_only_subdir () {
     # changes into the subdir
     my (@dirs) = <*/.>;
@@ -975,11 +989,8 @@ sub mktree_in_ud_from_only_subdir () {
     $dirs[0] =~ m#^([^/]+)/\.$# or die;
     my $dir = $1;
     changedir $dir;
-    fail "source package contains .git directory" if stat '.git';
-    die $! unless $!==&ENOENT;
-    runcmd qw(git init -q);
-    rmtree('.git/objects');
-    symlink '../../../../objects','.git/objects' or die $!;
+    fail "source package contains .git directory" if stat_exists '.git';
+    mktree_in_ud_here();
     runcmd @git, qw(add -Af);
     my $tree = cmdoutput @git, qw(write-tree);
     $tree =~ m/^\w+$/ or die "$tree ?";
@@ -1095,7 +1106,7 @@ END
 	my $oldclogp = parsecontrol('../changelogold.tmp','previous changelog');
 	my $oversion = getfield $oldclogp, 'Version';
 	my $vcmp =
-	    version_compare_string($oversion, $cversion);
+	    version_compare($oversion, $cversion);
 	if ($vcmp < 0) {
 	    # git upload/ is earlier vsn than archive, use archive
 	    open C, ">../commit2.tmp" or die $!;
@@ -1139,11 +1150,9 @@ sub complete_file_from_dsc ($$) {
     my $tf = "$dstdir/$f";
     my $downloaded = 0;
 
-    if (stat $tf) {
+    if (stat_exists $tf) {
 	progress "using existing $f";
     } else {
-	die "$tf $!" unless $!==&ENOENT;
-
 	my $furl = $dscurl;
 	$furl =~ s{/[^/]+$}{};
 	$furl .= "/$f";
@@ -1277,7 +1286,7 @@ END
 	my $gotclogp = parsechangelog("-l$clogf");
 	my $got_vsn = getfield $gotclogp, 'Version';
 	printdebug "SKEW CHECK GOT $got_vsn\n";
-	if (version_compare_string($got_vsn, $skew_warning_vsn) < 0) {
+	if (version_compare($got_vsn, $skew_warning_vsn) < 0) {
 	    print STDERR <<END or die $!;
 
 Warning: archive skew detected.  Using the available version:
@@ -1489,7 +1498,7 @@ sub dopush () {
 	push_parse_changelog("$clogpfn");
 
     my $dscpath = "$buildproductsdir/$dscfn";
-    stat $dscpath or
+    stat_exists $dscpath or
 	fail "looked for .dsc $dscfn, but $!;".
 	    " maybe you forgot to build";
 
@@ -1534,10 +1543,9 @@ sub dopush () {
     if (!$changesfile) {
 	my $multi = "$buildproductsdir/".
 	    "${package}_".(stripepoch $cversion)."_multi.changes";
-	if (stat "$multi") {
+	if (stat_exists "$multi") {
 	    $changesfile = $multi;
 	} else {
-	    $!==&ENOENT or die "$multi: $!";
 	    my $pat = "${package}_".(stripepoch $cversion)."_*.changes";
 	    my @cs = glob "$buildproductsdir/$pat";
 	    fail "failed to find unique changes file".
@@ -1620,10 +1628,8 @@ sub cmd_clone {
     }
     $dstdir ||= "$package";
 
-    if (stat $dstdir) {
+    if (stat_exists $dstdir) {
 	fail "$dstdir already exists";
-    } elsif ($! != &ENOENT) {
-	die "$dstdir: $!";
     }
 
     my $cwd_remove;
@@ -1727,12 +1733,15 @@ sub cmd_push {
 
 #---------- remote commands' implementation ----------
 
-sub cmd_remote_push_responder {
+sub cmd_remote_push_build_host {
     my ($nrargs) = shift @ARGV;
     my (@rargs) = @ARGV[0..$nrargs-1];
     @ARGV = @ARGV[$nrargs..$#ARGV];
     die unless @rargs;
-    my ($dir) = @rargs;
+    my ($dir,$vsnwant) = @rargs;
+    # vsnwant is a comma-separated list; we report which we have
+    # chosen in our ready response (so other end can tell if they
+    # offered several)
     $debugprefix = ' ';
     $we_are_responder = 1;
 
@@ -1743,12 +1752,21 @@ sub cmd_remote_push_responder {
     open STDOUT, ">&STDERR" or die $!;
     autoflush STDOUT 1;
 
-    responder_send_command("dgit-remote-push-ready");
+    $vsnwant //= 1;
+    fail "build host has dgit rpush protocol version".
+	" $rpushprotovsn but invocation host has $vsnwant"
+	unless grep { $rpushprotovsn eq $_ } split /,/, $vsnwant;
+
+    responder_send_command("dgit-remote-push-ready $rpushprotovsn");
 
     changedir $dir;
     &cmd_push;
 }
 
+sub cmd_remote_push_responder { cmd_remote_push_build_host(); }
+# ... for compatibility with proto vsn.1 dgit (just so that user gets
+#     a good error message)
+
 our $i_tmp;
 
 sub i_cleanup {
@@ -1784,11 +1802,11 @@ sub cmd_rpush {
 	$dir = nextarg;
     }
     $dir =~ s{^-}{./-};
-    my @rargs = ($dir);
+    my @rargs = ($dir,$rpushprotovsn);
     my @rdgit;
     push @rdgit, @dgit;
     push @rdgit, @ropts;
-    push @rdgit, qw(remote-push-responder), (scalar @rargs), @rargs;
+    push @rdgit, qw(remote-push-build-host), (scalar @rargs), @rargs;
     push @rdgit, @ARGV;
     my @cmd = (@ssh, $host, shellquote @rdgit);
     printcmd \*DEBUG,$debugprefix."+",@cmd;
@@ -1835,7 +1853,8 @@ sub i_resp_file ($) {
     my ($keyword) = @_;
     my $localname = i_method "i_localname", $keyword;
     my $localpath = "$i_tmp/$localname";
-    stat $localpath and badproto \*RO, "file $keyword ($localpath) twice";
+    stat_exists $localpath and
+	badproto \*RO, "file $keyword ($localpath) twice";
     protocol_receive_file \*RO, $localpath;
     i_method "i_file", $keyword;
 }
@@ -2040,7 +2059,7 @@ sub changesopts () {
 	}
 	if (@vsns) {
 	    @vsns = map { $_->[0] } @vsns;
-	    @vsns = sort { -version_compare_string($a, $b) } @vsns;
+	    @vsns = sort { -version_compare($a, $b) } @vsns;
 	    $changes_since_version = $vsns[0];
 	    progress "changelog will contain changes since $vsns[0]";
 	} else {
@@ -2105,8 +2124,9 @@ sub cmd_sbuild {
     changedir "..";
     my $pat = "${package}_".(stripepoch $version)."_*.changes";
     if (act_local()) {
-	stat $dscfn or fail "$dscfn (in parent directory): $!";
-	stat $sourcechanges or fail "$sourcechanges (in parent directory): $!";
+	stat_exist $dscfn or fail "$dscfn (in parent directory): $!";
+	stat_exists $sourcechanges
+	    or fail "$sourcechanges (in parent directory): $!";
 	foreach my $cf (glob $pat) {
 	    next if $cf eq $sourcechanges;
 	    unlink $cf or fail "remove $cf: $!";
@@ -2123,7 +2143,7 @@ sub cmd_sbuild {
     runcmd_ordryrun_local @mergechanges, @changesfiles;
     my $multichanges = "${package}_".(stripepoch $version)."_multi.changes";
     if (act_local()) {
-	stat $multichanges or fail "$multichanges: $!";
+	stat_exists $multichanges or fail "$multichanges: $!";
     }
     printdone "build successful, results in $multichanges\n" or die $!;
 }