X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?a=blobdiff_plain;f=dgit;h=a73fffddc1d635aa44512b3e6e4199d2ddffdf5c;hb=233fa856bec4d90e55531f54b81a264273cd4cb8;hp=7e642c037b8dedef77c9f62c9750efccf73fe5e4;hpb=eab588a83905122af678182876c2f800e4b6fa77;p=dgit.git

diff --git a/dgit b/dgit
index 7e642c03..a73fffdd 100755
--- a/dgit
+++ b/dgit
@@ -52,6 +52,7 @@ our $new_package = 0;
 our $ignoredirty = 0;
 our $rmonerror = 1;
 our @deliberatelies;
+our %supersedes;
 our $existing_package = 'dpkg';
 our $cleanmode = 'dpkg-source';
 our $changes_since_version;
@@ -104,15 +105,14 @@ autoflush STDOUT 1;
 
 our $remotename = 'dgit';
 our @ourdscfield = qw(Dgit Vcs-Dgit-Master);
-our $branchprefix = 'dgit';
 our $csuite;
 our $instead_distro;
 
 sub lbranch () { return "$branchprefix/$csuite"; }
 my $lbranch_re = '^refs/heads/'.$branchprefix.'/([^/.]+)$';
 sub lref () { return "refs/heads/".lbranch(); }
-sub lrref () { return "refs/remotes/$remotename/$branchprefix/$csuite"; }
-sub rrref () { return "refs/$branchprefix/$csuite"; }
+sub lrref () { return "refs/remotes/$remotename/".server_branch($csuite); }
+sub rrref () { return server_ref($csuite); }
 
 sub stripepoch ($) {
     my ($vsn) = @_;
@@ -186,13 +186,6 @@ 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: $!";
-}
-
 sub deliberately ($) {
     return !!grep { $_[0] eq $_ } @deliberatelies;
 }
@@ -530,6 +523,7 @@ our %defcfg = ('dgit.default.distro' => 'debian',
 	       'dgit-distro.debian.git-user-force' => 'dgit',
 	       'dgit-distro.debian.git-proto' => 'git+ssh://',
 	       'dgit-distro.debian.git-path' => '/dgit/debian/repos',
+	       'dgit-distro.debian.git-check' => 'ssh-cmd',
  'dgit-distro.debian.archive-query-url', 'https://api.ftp-master.debian.org/',
  'dgit-distro.debian.archive-query-tls-key',
     '/etc/ssl/certs/%HOST%.pem:/etc/dgit/%HOST%.pem',
@@ -538,8 +532,7 @@ our %defcfg = ('dgit.default.distro' => 'debian',
 	       'dgit-distro.debian/alioth.git-user-force' => '',
 	       'dgit-distro.debian/alioth.git-proto' => 'git+ssh://',
 	       'dgit-distro.debian/alioth.git-path' => '/git/dgit-repos/repos',
-	       'dgit-distro.debian.git-check' => 'ssh-cmd',
-	       'dgit-distro.debian.git-create' => 'ssh-cmd',
+	       'dgit-distro.debian/alioth.git-create' => 'ssh-cmd',
 	       'dgit-distro.debian.sshpsql-host' => 'mirror.ftp-master.debian.org',
 	       'dgit-distro.debian.upload-host' => 'ftp-master', # for dput
 	       'dgit-distro.debian.mirror' => 'http://ftp.debian.org/debian/',
@@ -780,6 +773,25 @@ sub must_getcwd () {
     return $d;
 }
 
+our %rmad;
+
+sub archive_query ($) {
+    my ($method) = @_;
+    my $query = access_cfg('archive-query','RETURN-UNDEF');
+    $query =~ s/^(\w+):// or badcfg "invalid archive-query method \`$query'";
+    my $proto = $1;
+    my $data = $'; #';
+    { no strict qw(refs); &{"${method}_${proto}"}($proto,$data); }
+}
+
+sub pool_dsc_subpath ($$) {
+    my ($vsn,$component) = @_; # $package is implict arg
+    my $prefix = substr($package, 0, $package =~ m/^l/ ? 4 : 1);
+    return "/pool/$component/$prefix/$package/".dscfn($vsn);
+}
+
+#---------- `ftpmaster-api' archive query method (nascent) ----------
+
 sub archive_api_query_cmd ($) {
     my ($subpath) = @_;
     my @cmd = qw(curl -sS);
@@ -801,22 +813,7 @@ sub archive_api_query_cmd ($) {
     return @cmd;
 }
 
-our %rmad;
-
-sub archive_query ($) {
-    my ($method) = @_;
-    my $query = access_cfg('archive-query','RETURN-UNDEF');
-    $query =~ s/^(\w+):// or badcfg "invalid archive-query method \`$query'";
-    my $proto = $1;
-    my $data = $'; #';
-    { no strict qw(refs); &{"${method}_${proto}"}($proto,$data); }
-}
-
-sub pool_dsc_subpath ($$) {
-    my ($vsn,$component) = @_; # $package is implict arg
-    my $prefix = substr($package, 0, $package =~ m/^l/ ? 4 : 1);
-    return "/pool/$component/$prefix/$package/".dscfn($vsn);
-}
+#---------- `madison' archive query method ----------
 
 sub archive_query_madison {
     return map { [ @$_[0..1] ] } madison_get_parse(@_);
@@ -864,6 +861,8 @@ sub canonicalise_suite_madison {
     return $r[0][2];
 }
 
+#---------- `sshpsql' archive query method ----------
+
 sub sshpsql ($$$) {
     my ($data,$runeinfo,$sql) = @_;
     if (!length $data) {
@@ -937,6 +936,8 @@ END
     return $rows[0];
 }
 
+#---------- `dummycat' archive query method ----------
+
 sub canonicalise_suite_dummycat ($$) {
     my ($proto,$data) = @_;
     my $dpath = "$data/suite.$isuite";
@@ -976,6 +977,8 @@ sub archive_query_dummycat ($$) {
     return sort { -version_compare($a->[0],$b->[0]); } @rows;
 }
 
+#---------- archive query entrypoints and rest of program ----------
+
 sub canonicalise_suite () {
     return if defined $csuite;
     fail "cannot operate on $isuite suite" if $isuite eq 'UNRELEASED';
@@ -1352,8 +1355,8 @@ $later_warning_msg
 END
 	    $hash = $lastpush_hash;
 	} else {
-	    fail "archive's .dsc refers to ".$dsc_hash.
-		" but this is an ancestor of ".$lastpush_hash;
+	    fail "git head (".lrref()."=$lastpush_hash) is not a ".
+		"descendant of archive's .dsc hash ($dsc_hash)";
 	}
     } elsif ($dsc) {
 	$hash = generate_commit_from_dsc();
@@ -1570,6 +1573,7 @@ sub push_mktag ($$$$$$$) {
     # to control the "tagger" (b) we can do remote signing
     my $authline = clogp_authline $clogp;
     my $delibs = join(" ", "",@deliberatelies);
+    my $declaredistro = access_basedistro();
     open TO, '>', $tfn->('.tmp') or die $!;
     print TO <<END or die $!;
 object $head
@@ -1578,8 +1582,14 @@ tag $tag
 tagger $authline
 
 $package release $cversion for $clogsuite ($csuite) [dgit]
-[dgit distro=$distro$delibs]
+[dgit distro=$declaredistro$delibs]
+END
+    foreach my $ref (sort keys %supersedes) {
+		    print TO <<END or die $!;
+[dgit supersede:$ref=$supersedes{$ref}]
 END
+    }
+
     close TO or die $!;
 
     my $tagobjfn = $tfn->('.tmp');
@@ -1692,6 +1702,15 @@ sub dopush () {
     responder_send_command("param head $head");
     responder_send_command("param csuite $csuite");
 
+    my $forceflag = deliberately('not-fast-forward') ? '+' : '';
+    if ($forceflag && defined $lastpush_hash) {
+	git_for_each_tag_referring($lastpush_hash, sub {
+	    my ($objid,$fullrefname,$tagname) = @_;
+	    responder_send_command("supersedes $fullrefname=$objid");
+	    $supersedes{$fullrefname} = $objid;
+	});
+    }
+
     my $tfn = sub { ".git/dgit/tag$_[0]"; };
     my $tagobjfn;
 
@@ -1715,7 +1734,7 @@ sub dopush () {
 	create_remote_git_repo();
     }
     runcmd_ordryrun @git, qw(push),access_giturl(),
-        "HEAD:".rrref(), "refs/tags/$tag";
+        $forceflag."HEAD:".rrref(), "refs/tags/$tag";
     runcmd_ordryrun @git, qw(update-ref -m), 'dgit push', lrref(), 'HEAD';
 
     if ($we_are_responder) {
@@ -1996,6 +2015,14 @@ sub i_resp_param ($) {
     $i_param{$1} = $2;
 }
 
+sub i_resp_supersedes ($) {
+    $_[0] =~ m#^(refs/tags/\S+)=(\w+)$#
+	or badproto \*RO, "bad supersedes spec";
+    my $r = system qw(git check-ref-format), $1;
+    die "bad supersedes ref spec ($r)" if $r;
+    $supersedes{$1} = $2;
+}
+
 our %i_wanted;
 
 sub i_resp_want ($) {