X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=95398497b7c4d9ba77208da8297b33b5c949a851;hp=b63910eda159a71f0ffd4553cb3660f7b13ffac7;hb=f81f0db4c42e6f9439146680b0bd057d0d64b672;hpb=c1c45feee9c79e9a2dfe20771405ba4f8d548642 diff --git a/dgit b/dgit index b63910ed..95398497 100755 --- a/dgit +++ b/dgit @@ -34,12 +34,15 @@ use POSIX; use IPC::Open2; use Digest::SHA; use Digest::MD5; +use List::Util qw(any); +use List::MoreUtils qw(pairwise); +use Carp; use Debian::Dgit; our $our_version = 'UNRELEASED'; ###substituted### -our @rpushprotovsn_support = qw(3 2); +our @rpushprotovsn_support = qw(4 3 2); # 4 is new tag format our $protovsn; our $isuite = 'unstable'; @@ -65,6 +68,9 @@ our $quilt_modes_re = 'linear|smash|auto|nofix|nocheck|gbp|unapplied'; our $we_are_responder; our $initiator_tempdir; our $patches_applied_dirtily = 00; +our $tagformat_want; +our $tagformat; +our $tagformatfn; our %format_ok = map { $_=>1 } ("1.0","3.0 (native)","3.0 (quilt)"); @@ -132,6 +138,17 @@ our @ourdscfield = qw(Dgit Vcs-Dgit-Master); our $csuite; our $instead_distro; +sub debiantag ($$) { + my ($v,$distro) = @_; + return $tagformatfn->($v, $distro); +} + +sub debiantag_maintview ($$) { + my ($v,$distro) = @_; + $v =~ y/~:/_%/; + return "$distro/$v"; +} + sub lbranch () { return "$branchprefix/$csuite"; } my $lbranch_re = '^refs/heads/'.$branchprefix.'/([^/.]+)$'; sub lref () { return "refs/heads/".lbranch(); } @@ -139,6 +156,28 @@ sub lrref () { return "refs/remotes/$remotename/".server_branch($csuite); } sub rrref () { return server_ref($csuite); } sub lrfetchrefs () { return "refs/dgit-fetch/$csuite"; } +sub lrfetchref () { return lrfetchrefs.'/'.server_branch($csuite); } + +# We fetch some parts of lrfetchrefs/*. Ideally we delete these +# locally fetched refs because they have unhelpful names and clutter +# up gitk etc. So we track whether we have "used up" head ref (ie, +# whether we have made another local ref which refers to this object). +# +# (If we deleted them unconditionally, then we might end up +# re-fetching the same git objects each time dgit fetch was run.) +# +# So, leach use of lrfetchrefs needs to be accompanied by arrangements +# in git_fetch_us to fetch the refs in question, and possibly a call +# to lrfetchref_used. + +our (%lrfetchrefs_f, %lrfetchrefs_d); +# $lrfetchrefs_X{lrfetchrefs."/heads/whatever"} = $objid + +sub lrfetchref_used ($) { + my ($fullrefname) = @_; + my $objid = $lrfetchrefs_f{$fullrefname}; + $lrfetchrefs_d{$fullrefname} = $objid if defined $objid; +} sub stripepoch ($) { my ($vsn) = @_; @@ -180,11 +219,6 @@ sub no_such_package () { exit 4; } -sub fetchspec () { - local $csuite = '*'; - return "+".rrref().":".lrref(); -} - sub changedir ($) { my ($newdir) = @_; printdebug "CD $newdir\n"; @@ -213,6 +247,16 @@ sub quiltmode_splitbrain () { # where is ,... ... # < dgit-remote-push-ready # +# occasionally: +# +# > progress NBYTES +# [NBYTES message] +# +# > supplementary-message NBYTES # $protovsn >= 3 +# [NBYTES message] +# +# main sequence: +# # > file parsed-changelog # [indicates that output of dpkg-parsechangelog follows] # > data-block NBYTES @@ -226,7 +270,13 @@ sub quiltmode_splitbrain () { # > file changes # [etc] # -# > param head HEAD +# > param head DGIT-VIEW-HEAD +# > param csuite SUITE +# > param tagformat old|new +# > param maint-view MAINT-VIEW-HEAD +# +# > previously REFNAME=OBJNAME # if --deliberately-not-fast-forward +# # goes into tag, for replay prevention # # > want signed-tag # [indicates that signed tag is wanted] @@ -398,7 +448,7 @@ our ($dscdata,$dscurl,$dsc,$dsc_checked,$skew_warning_vsn); sub runcmd { debugcmd "+",@_; - $!=0; $?=0; + $!=0; $?=-1; failedcmd @_ if system @_; } @@ -482,10 +532,12 @@ our %defcfg = ('dgit.default.distro' => 'debian', 'dgit.default.ssh' => 'ssh', 'dgit.default.archive-query' => 'madison:', 'dgit.default.sshpsql-dbname' => 'service=projectb', + 'dgit.default.dgit-tag-format' => 'old,new,maint', 'dgit-distro.debian.archive-query' => 'ftpmasterapi:', 'dgit-distro.debian.git-check' => 'url', 'dgit-distro.debian.git-check-suffix' => '/info/refs', 'dgit-distro.debian.new-private-pushers' => 't', + 'dgit-distro.debian.dgit-tag-format' => 'old', 'dgit-distro.debian/push.git-url' => '', 'dgit-distro.debian/push.git-host' => 'push.dgit.debian.org', 'dgit-distro.debian/push.git-user-force' => 'dgit', @@ -533,7 +585,7 @@ sub git_slurp_config () { my @cmd = (@git, qw(config -z --get-regexp .*)); debugcmd "|",@cmd; - open GITS, "-|", @cmd or failedcmd @cmd; + open GITS, "-|", @cmd or die $!; while () { chomp or die; printdebug "=> ", (messagequote $_), "\n"; @@ -1107,6 +1159,48 @@ sub archive_query_dummycat ($$) { return sort { -version_compare($a->[0],$b->[0]); } @rows; } +#---------- tag format handling ---------- + +sub access_cfg_tagformats () { + split /\,/, access_cfg('dgit-tag-format'); +} + +sub need_tagformat ($$) { + my ($fmt, $why) = @_; + fail "need to use tag format $fmt ($why) but also need". + " to use tag format $tagformat_want->[0] ($tagformat_want->[1])". + " - no way to proceed" + if $tagformat_want && $tagformat_want->[0] ne $fmt; + $tagformat_want = [$fmt, $why, $tagformat_want->[2] // 0]; +} + +sub select_tagformat () { + # sets $tagformatfn + return if $tagformatfn && !$tagformat_want; + die 'bug' if $tagformatfn && $tagformat_want; + # ... $tagformat_want assigned after previous select_tagformat + + my (@supported) = grep { $_ ne 'maint' } access_cfg_tagformats(); + printdebug "select_tagformat supported @supported\n"; + + $tagformat_want //= [ $supported[0], "distro access configuration", 0 ]; + printdebug "select_tagformat specified @$tagformat_want\n"; + + my ($fmt,$why,$override) = @$tagformat_want; + + fail "target distro supports tag formats @supported". + " but have to use $fmt ($why)" + unless $override + or grep { $_ eq $fmt } @supported; + + $tagformat_want = undef; + $tagformat = $fmt; + $tagformatfn = ${*::}{"debiantag_$fmt"}; + + fail "trying to use unknown tag format \`$fmt' ($why) !" + unless $tagformatfn; +} + #---------- archive query entrypoints and rest of program ---------- sub canonicalise_suite () { @@ -1144,9 +1238,11 @@ sub get_archive_dsc () { my $fmt = getfield $dsc, 'Format'; fail "unsupported source format $fmt, sorry" unless $format_ok{$fmt}; $dsc_checked = !!$digester; + printdebug "get_archive_dsc: Version ".(getfield $dsc, 'Version')."\n"; return; } $dsc = undef; + printdebug "get_archive_dsc: nothing in archive, returning undef\n"; } sub check_for_git (); @@ -1160,7 +1256,7 @@ sub check_for_git () { " set -e; cd ".access_cfg('git-path').";". " if test -d $package.git; then echo 1; else echo 0; fi"); my $r= cmdoutput @cmd; - if ($r =~ m/^divert (\w+)$/) { + if (defined $r and $r =~ m/^divert (\w+)$/) { my $divert=$1; my ($usedistro,) = access_distros(); # NB that if we are pushing, $usedistro will be $distro/push @@ -1169,7 +1265,7 @@ sub check_for_git () { progress "diverting to $divert (using config for $instead_distro)"; return check_for_git(); } - failedcmd @cmd unless $r =~ m/^[01]$/; + failedcmd @cmd unless defined $r and $r =~ m/^[01]$/; return $r+0; } elsif ($how eq 'url') { my $prefix = access_cfg('git-check-url','git-url'); @@ -1216,7 +1312,7 @@ sub create_remote_git_repo () { } } -our ($dsc_hash,$lastpush_hash); +our ($dsc_hash,$lastpush_mergeinput); our $ud = '.git/dgit/unpack'; @@ -1243,7 +1339,7 @@ sub git_write_tree () { sub remove_stray_gits () { my @gitscmd = qw(find -name .git -prune -print0); debugcmd "|",@gitscmd; - open GITS, "-|", @gitscmd or failedcmd @gitscmd; + open GITS, "-|", @gitscmd or die $!; { local $/="\0"; while () { @@ -1259,7 +1355,7 @@ sub remove_stray_gits () { sub mktree_in_ud_from_only_subdir () { # changes into the subdir my (@dirs) = <*/.>; - die unless @dirs==1; + die "@dirs ?" unless @dirs==1; $dirs[0] =~ m#^([^/]+)/\.$# or die; my $dir = $1; changedir $dir; @@ -1395,7 +1491,8 @@ sub check_for_vendor_patches () { "distro being accessed"); } -sub generate_commit_from_dsc () { +sub generate_commits_from_dsc () { + # See big comment in fetch_from_archive, below. prep_ud(); changedir $ud; @@ -1444,10 +1541,16 @@ $changes # imported from the archive END close C or die $!; - my $outputhash = make_commit qw(../commit.tmp); + my $rawimport_hash = make_commit qw(../commit.tmp); my $cversion = getfield $clogp, 'Version'; + my $rawimport_mergeinput = { + Commit => $rawimport_hash, + Info => "Import of source package", + }; + my @output = ($rawimport_mergeinput); progress "synthesised git commit from .dsc $cversion"; - if ($lastpush_hash) { + if ($lastpush_mergeinput) { + my $lastpush_hash = $lastpush_mergeinput->{Commit}; runcmd @git, qw(reset -q --hard), $lastpush_hash; runcmd qw(sh -ec), 'dpkg-parsechangelog >>../changelogold.tmp'; my $oldclogp = parsecontrol('../changelogold.tmp','previous changelog'); @@ -1455,37 +1558,28 @@ END my $vcmp = version_compare($oversion, $cversion); if ($vcmp < 0) { - # git upload/ is earlier vsn than archive, use archive - open C, ">../commit2.tmp" or die $!; - print C < < 1 }); Record $package ($cversion) in archive suite $csuite END - $outputhash = make_commit qw(../commit2.tmp); } elsif ($vcmp > 0) { print STDERR < 10) { + fail "too many iterations trying to get sane fetch!"; + } + + my @look = map { "refs/$_" } @specs; + my @lcmd = (@git, qw(ls-remote -q --refs), access_giturl(), @look); + debugcmd "|",@lcmd; + + my %wantr; + open GITLS, "-|", @lcmd or die $!; + while () { + printdebug "=> ", $_; + m/^(\w+)\s+(\S+)\n/ or die "ls-remote $_ ?"; + my ($objid,$rrefname) = ($1,$2); + if (!$wanted_rref->($rrefname)) { + print STDERR <($rrefname)) { + printdebug <'; + my $want = $wantr{$rrefname}; + next if $got eq $want; + if (!defined $objgot{$want}) { + print STDERR <{Clogp} exists and returns it + return $mi->{Clogp} if $mi->{Clogp}; + my $mclog = ".git/dgit/clog-$mi->{Commit}"; + mkpath '.git/dgit'; + runcmd shell_cmd "exec >$mclog", @git, qw(cat-file blob), + "$mi->{Commit}:debian/changelog"; + $mi->{Clogp} = parsechangelog("-l$mclog"); +} + +sub mergeinfo_version ($) { + return getfield( (mergeinfo_getclogp $_[0]), 'Version' ); +} + sub fetch_from_archive () { # ensures that lrref() is what is actually in the archive, # one way or another @@ -1584,35 +1822,164 @@ sub fetch_from_archive () { progress "no version available from the archive"; } - $lastpush_hash = git_get_ref(lrref()); + # If the archive's .dsc has a Dgit field, there are three + # relevant git commitids we need to choose between and/or merge + # together: + # 1. $dsc_hash: the Dgit field from the archive + # 2. $lastpush_hash: the suite branch on the dgit git server + # 3. $lastfetch_hash: our local tracking brach for the suite + # + # These may all be distinct and need not be in any fast forward + # relationship: + # + # If the dsc was pushed to this suite, then the server suite + # branch will have been updated; but it might have been pushed to + # a different suite and copied by the archive. Conversely a more + # recent version may have been pushed with dgit but not appeared + # in the archive (yet). + # + # $lastfetch_hash may be awkward because archive imports + # (particularly, imports of Dgit-less .dscs) are performed only as + # needed on individual clients, so different clients may perform a + # different subset of them - and these imports are only made + # public during push. So $lastfetch_hash may represent a set of + # imports different to a subsequent upload by a different dgit + # client. + # + # Our approach is as follows: + # + # As between $dsc_hash and $lastpush_hash: if $lastpush_hash is a + # descendant of $dsc_hash, then it was pushed by a dgit user who + # had based their work on $dsc_hash, so we should prefer it. + # Otherwise, $dsc_hash was installed into this suite in the + # archive other than by a dgit push, and (necessarily) after the + # last dgit push into that suite (since a dgit push would have + # been descended from the dgit server git branch); thus, in that + # case, we prefer the archive's version (and produce a + # pseudo-merge to overwrite the dgit server git branch). + # + # (If there is no Dgit field in the archive's .dsc then + # generate_commit_from_dsc uses the version numbers to decide + # whether the suite branch or the archive is newer. If the suite + # branch is newer it ignores the archive's .dsc; otherwise it + # generates an import of the .dsc, and produces a pseudo-merge to + # overwrite the suite branch with the archive contents.) + # + # The outcome of that part of the algorithm is the `public view', + # and is same for all dgit clients: it does not depend on any + # unpublished history in the local tracking branch. + # + # As between the public view and the local tracking branch: The + # local tracking branch is only updated by dgit fetch, and + # whenever dgit fetch runs it includes the public view in the + # local tracking branch. Therefore if the public view is not + # descended from the local tracking branch, the local tracking + # branch must contain history which was imported from the archive + # but never pushed; and, its tip is now out of date. So, we make + # a pseudo-merge to overwrite the old imports and stitch the old + # history in. + # + # Finally: we do not necessarily reify the public view (as + # described above). This is so that we do not end up stacking two + # pseudo-merges. So what we actually do is figure out the inputs + # to any public view psuedo-merge and put them in @mergeinputs. + + my @mergeinputs; + # $mergeinputs[]{Commit} + # $mergeinputs[]{Info} + # $mergeinputs[0] is the one whose tree we use + # @mergeinputs is in the order we use in the actual commit) + # + # Also: + # $mergeinputs[]{Message} is a commit message to use + # $mergeinputs[]{ReverseParents} if def specifies that parent + # list should be in opposite order + # Such an entry has no Commit or Info. It applies only when found + # in the last entry. (This ugliness is to support making + # identical imports to previous dgit versions.) + + my $lastpush_hash = git_get_ref(lrfetchref()); printdebug "previous reference hash=$lastpush_hash\n"; - my $hash; + $lastpush_mergeinput = $lastpush_hash && { + Commit => $lastpush_hash, + Info => "dgit suite branch on dgit git server", + }; + + my $lastfetch_hash = git_get_ref(lrref()); + printdebug "fetch_from_archive: lastfetch=$lastfetch_hash\n"; + my $lastfetch_mergeinput = $lastfetch_hash && { + Commit => $lastfetch_hash, + Info => "dgit client's archive history view", + }; + + my $dsc_mergeinput = $dsc_hash && { + Commit => $dsc_hash, + Info => "Dgit field in .dsc from archive", + }; + + my $cwd = getcwd(); + my $del_lrfetchrefs = sub { + changedir $cwd; + my $gur; + printdebug "del_lrfetchrefs\n"; + foreach my $fullrefname (sort keys %lrfetchrefs_d) { + my $objid = $lrfetchrefs_d{$fullrefname}; + printdebug "del_lrfetchrefs: $fullrefname=$objid.\n"; + if (!$gur) { + $gur ||= new IO::Handle; + open $gur, "|-", qw(git update-ref --stdin) or die $!; + } + printf $gur "delete %s %s\n", $fullrefname, $objid; + } + if ($gur) { + close $gur or failedcmd "git update-ref delete lrfetchrefs"; + } + }; + if (defined $dsc_hash) { fail "missing remote git history even though dsc has hash -". - " could not find ref ".lrref(). - " (should have been fetched from ".access_giturl()."#".rrref().")" + " could not find ref ".rref()." at ".access_giturl() unless $lastpush_hash; - $hash = $dsc_hash; ensure_we_have_orig(); if ($dsc_hash eq $lastpush_hash) { + @mergeinputs = $dsc_mergeinput } elsif (is_fast_fwd($dsc_hash,$lastpush_hash)) { print STDERR <{Commit}; + $h and is_fast_fwd($lastfetch_hash, $h); + # If true, one of the existing parents of this commit + # is a descendant of the $lastfetch_hash, so we'll + # be ff from that automatically. + } @mergeinputs + ) { + # Otherwise: + push @mergeinputs, $lastfetch_mergeinput; + } + + printdebug "fetch mergeinfos:\n"; + foreach my $mi (@mergeinputs) { + if ($mi->{Info}) { + printdebug " commit $mi->{Commit} $mi->{Info}\n"; + } else { + printdebug sprintf " ReverseParents=%d Message=%s", + $mi->{ReverseParents}, $mi->{Message}; + } } + + my $compat_info= pop @mergeinputs + if $mergeinputs[$#mergeinputs]{Message}; + + @mergeinputs = grep { defined $_->{Commit} } @mergeinputs; + + my $hash; + if (@mergeinputs > 1) { + # here we go, then: + my $tree_commit = $mergeinputs[0]{Commit}; + + my $tree = cmdoutput @git, qw(cat-file commit), $tree_commit; + $tree =~ m/\n\n/; $tree = $`; + $tree =~ m/^tree (\w+)$/m or die "$dsc_hash tree ?"; + $tree = $1; + + # We use the changelog author of the package in question the + # author of this pseudo-merge. This is (roughly) correct if + # this commit is simply representing aa non-dgit upload. + # (Roughly because it does not record sponsorship - but we + # don't have sponsorship info because that's in the .changes, + # which isn't in the archivw.) + # + # But, it might be that we are representing archive history + # updates (including in-archive copies). These are not really + # the responsibility of the person who created the .dsc, but + # there is no-one whose name we should better use. (The + # author of the .dsc-named commit is clearly worse.) + + my $useclogp = mergeinfo_getclogp $mergeinputs[0]; + my $author = clogp_authline $useclogp; + my $cversion = getfield $useclogp, 'Version'; + + my $mcf = ".git/dgit/mergecommit"; + open MC, ">", $mcf or die "$mcf $!"; + print MC <{Commit} } @mergeinputs; + @parents = reverse @parents if $compat_info->{ReverseParents}; + print MC <{Commit} +END + + print MC <{Message}) { + print MC $compat_info->{Message} or die $!; + } else { + print MC <{Info} + or die $!; + }; + + $message_add_info->($mergeinputs[0]); + print MC <($_) foreach @mergeinputs[1..$#mergeinputs]; + } + + close MC or die $!; + $hash = make_commit $mcf; + } else { + $hash = $mergeinputs[0]{Commit}; + } + progress "fetch hash=$hash\n"; + + my $chkff = sub { + my ($lasth, $what) = @_; + return unless $lasth; + die "$lasth $hash $what ?" unless is_fast_fwd($lasth, $hash); + }; + + $chkff->($lastpush_hash, 'dgit repo server tip (last push)'); + $chkff->($lastfetch_hash, 'local tracking tip (last fetch)'); + + runcmd @git, qw(update-ref -m), "dgit fetch $csuite", + 'DGIT_ARCHIVE', $hash; + cmdoutput @git, qw(log -n2), $hash; + # ... gives git a chance to complain if our commit is malformed + if (defined $skew_warning_vsn) { mkpath '.git/dgit'; printdebug "SKEW CHECK WANT $skew_warning_vsn\n"; @@ -1656,7 +2135,8 @@ We were able to obtain only $got_vsn END } } - if ($lastpush_hash ne $hash) { + + if ($lastfetch_hash ne $hash) { my @upd_cmd = (@git, qw(update-ref -m), 'dgit fetch', lrref(), $hash); if (act_local()) { cmdoutput @upd_cmd; @@ -1664,6 +2144,10 @@ END dryrun_report @upd_cmd; } } + + lrfetchref_used lrfetchref(); + + unshift @end, $del_lrfetchrefs; return 1; } @@ -1732,7 +2216,6 @@ sub clone ($) { runcmd @git, qw(init -q); my $giturl = access_giturl(1); if (defined $giturl) { - set_local_git_config "remote.$remotename.fetch", fetchspec(); open H, "> .git/HEAD" or die $!; print H "ref: ".lref()."\n" or die $!; close H or die $!; @@ -1782,9 +2265,9 @@ sub check_not_dirty () { my @cmd = (@git, qw(diff --quiet HEAD)); debugcmd "+",@cmd; - $!=0; $?=0; system @cmd; - return if !$! && !$?; - if (!$! && $?==256) { + $!=0; $?=-1; system @cmd; + return if !$?; + if ($?==256) { fail "working tree is dirty (does not match HEAD)"; } else { failedcmd @cmd; @@ -1875,7 +2358,7 @@ sub push_parse_changelog ($) { my $dscfn = dscfn($cversion); - return ($clogp, $cversion, $tag, $dscfn); + return ($clogp, $cversion, $dscfn); } sub push_parse_dsc ($$$) { @@ -1888,13 +2371,38 @@ sub push_parse_dsc ($$$) { " but debian/changelog is for $package $cversion"; } -sub push_mktag ($$$$$$$) { - my ($head,$clogp,$tag, - $dscfn, +sub push_tagwants ($$$$) { + my ($cversion, $dgithead, $maintviewhead, $tfbase) = @_; + my @tagwants; + push @tagwants, { + TagFn => \&debiantag, + Objid => $dgithead, + TfSuffix => '', + View => 'dgit', + }; + if (defined $maintviewhead) { + push @tagwants, { + TagFn => \&debiantag_maintview, + Objid => $maintviewhead, + TfSuffix => '-maintview', + View => 'maint', + }; + } + foreach my $tw (@tagwants) { + $tw->{Tag} = $tw->{TagFn}($cversion, access_basedistro); + $tw->{Tfn} = sub { $tfbase.$tw->{TfSuffix}.$_[0]; }; + } + return @tagwants; +} + +sub push_mktags ($$ $$ $) { + my ($clogp,$dscfn, $changesfile,$changesfilewhat, - $tfn) = @_; + $tagwants) = @_; - $dsc->{$ourdscfield[0]} = $head; + die unless $tagwants->[0]{View} eq 'dgit'; + + $dsc->{$ourdscfield[0]} = $tagwants->[0]{Objid}; $dsc->save("$dscfn.tmp") or die $!; my $changes = parsecontrol($changesfile,$changesfilewhat); @@ -1912,45 +2420,66 @@ sub push_mktag ($$$$$$$) { my $authline = clogp_authline $clogp; my $delibs = join(" ", "",@deliberatelies); my $declaredistro = access_basedistro(); - open TO, '>', $tfn->('.tmp') or die $!; - print TO <{Tfn}; + my $head = $tw->{Objid}; + my $tag = $tw->{Tag}; + + open TO, '>', $tfn->('.tmp') or die $!; + print TO <{View} eq 'dgit') { + print TO <{View} eq 'maint') { + print TO <('.tmp'); - if ($sign) { - if (!defined $keyid) { - $keyid = access_cfg('keyid','RETURN-UNDEF'); - } - if (!defined $keyid) { - $keyid = getfield $clogp, 'Maintainer'; - } - unlink $tfn->('.tmp.asc') or $!==&ENOENT or die $!; - my @sign_cmd = (@gpg, qw(--detach-sign --armor)); - push @sign_cmd, qw(-u),$keyid if defined $keyid; - push @sign_cmd, $tfn->('.tmp'); - runcmd_ordryrun @sign_cmd; - if (act_scary()) { - $tagobjfn = $tfn->('.signed.tmp'); - runcmd shell_cmd "exec >$tagobjfn", qw(cat --), - $tfn->('.tmp'), $tfn->('.tmp.asc'); + my $tagobjfn = $tfn->('.tmp'); + if ($sign) { + if (!defined $keyid) { + $keyid = access_cfg('keyid','RETURN-UNDEF'); + } + if (!defined $keyid) { + $keyid = getfield $clogp, 'Maintainer'; + } + unlink $tfn->('.tmp.asc') or $!==&ENOENT or die $!; + my @sign_cmd = (@gpg, qw(--detach-sign --armor)); + push @sign_cmd, qw(-u),$keyid if defined $keyid; + push @sign_cmd, $tfn->('.tmp'); + runcmd_ordryrun @sign_cmd; + if (act_scary()) { + $tagobjfn = $tfn->('.signed.tmp'); + runcmd shell_cmd "exec >$tagobjfn", qw(cat --), + $tfn->('.tmp'), $tfn->('.tmp.asc'); + } } - } + return $tagobjfn; + }; - return ($tagobjfn); + my @r = map { $mktag->($_); } @$tagwants; + return @r; } sub sign_changes ($) { @@ -1971,16 +2500,21 @@ sub dopush ($) { Push failed, while preparing your push. You can retry the push, after fixing the problem, if you like. END + + need_tagformat 'new', "quilt mode $quilt_mode" + if quiltmode_splitbrain; + prep_ud(); access_giturl(); # check that success is vaguely likely + select_tagformat(); my $clogpfn = ".git/dgit/changelog.822.tmp"; runcmd shell_cmd "exec >$clogpfn", qw(dpkg-parsechangelog); responder_send_file('parsed-changelog', $clogpfn); - my ($clogp, $cversion, $tag, $dscfn) = + my ($clogp, $cversion, $dscfn) = push_parse_changelog("$clogpfn"); my $dscpath = "$buildproductsdir/$dscfn"; @@ -1995,15 +2529,32 @@ END my $format = getfield $dsc, 'Format'; printdebug "format $format\n"; - my $head = git_rev_parse('HEAD'); + my $actualhead = git_rev_parse('HEAD'); + my $dgithead = $actualhead; + my $maintviewhead = undef; if (madformat($format)) { # user might have not used dgit build, so maybe do this now: - commit_quilty_patch(); + if (quiltmode_splitbrain()) { + my $upstreamversion = $clogp->{Version}; + $upstreamversion =~ s/-[^-]*$//; + changedir $ud; + quilt_make_fake_dsc($upstreamversion); + my ($dgitview, $cachekey) = + quilt_check_splitbrain_cache($actualhead, $upstreamversion); + $dgitview or fail + "--quilt=$quilt_mode but no cached dgit view: + perhaps tree changed since dgit build[-source] ?"; + $split_brain = 1; + $dgithead = $dgitview; + $maintviewhead = $actualhead; + changedir '../../../..'; + prep_ud(); # so _only_subdir() works, below + } else { + commit_quilty_patch(); + } } - die 'xxx fast forward (should not depend on quilt mode, but will always be needed if we did $split_brain)' if $split_brain; - check_not_dirty(); changedir $ud; progress "checking that $dscfn corresponds to HEAD"; @@ -2013,9 +2564,9 @@ END check_for_vendor_patches() if madformat($dsc->{format}); changedir '../../../..'; my $diffopt = $debuglevel>0 ? '--exit-code' : '--quiet'; - my @diffcmd = (@git, qw(diff), $diffopt, $tree); + my @diffcmd = (@git, qw(diff), $diffopt, $tree, $dgithead); debugcmd "+",@diffcmd; - $!=0; $?=0; + $!=0; $?=-1; my $r = system @diffcmd; if ($r) { if ($r==256) { @@ -2040,8 +2591,13 @@ END } responder_send_file('changes',$changesfile); - responder_send_command("param head $head"); + responder_send_command("param head $dgithead"); responder_send_command("param csuite $csuite"); + responder_send_command("param tagformat $tagformat"); + if (quiltmode_splitbrain) { + die unless ($protovsn//4) >= 4; + responder_send_command("param maint-view $maintviewhead"); + } if (deliberately_not_fast_forward) { git_for_each_ref(lrfetchrefs, sub { @@ -2052,8 +2608,9 @@ END }); } - my $tfn = sub { ".git/dgit/tag$_[0]"; }; - my $tagobjfn; + my @tagwants = push_tagwants($cversion, $dgithead, $maintviewhead, + ".git/dgit/tag"); + my @tagobjfns; supplementary_message(<<'END'); Push failed, while signing the tag. @@ -2061,23 +2618,29 @@ You can retry the push, after fixing the problem, if you like. END # If we manage to sign but fail to record it anywhere, it's fine. if ($we_are_responder) { - $tagobjfn = $tfn->('.signed.tmp'); - responder_receive_files('signed-tag', $tagobjfn); + @tagobjfns = map { $_->{Tfn}('.signed-tmp') } @tagwants; + responder_receive_files('signed-tag', @tagobjfns); } else { - $tagobjfn = - push_mktag($head,$clogp,$tag, - $dscpath, - $changesfile,$changesfile, - $tfn); + @tagobjfns = push_mktags($clogp,$dscpath, + $changesfile,$changesfile, + \@tagwants); } supplementary_message(<<'END'); Push failed, *after* signing the tag. If you want to try again, you should use a new version number. END - my $tag_obj_hash = cmdoutput @git, qw(hash-object -w -t tag), $tagobjfn; - runcmd_ordryrun @git, qw(verify-tag), $tag_obj_hash; - runcmd_ordryrun_local @git, qw(update-ref), "refs/tags/$tag", $tag_obj_hash; + pairwise { $a->{TagObjFn} = $b } @tagwants, @tagobjfns; + + foreach my $tw (@tagwants) { + my $tag = $tw->{Tag}; + my $tagobjfn = $tw->{TagObjFn}; + my $tag_obj_hash = + cmdoutput @git, qw(hash-object -w -t tag), $tagobjfn; + runcmd_ordryrun @git, qw(verify-tag), $tag_obj_hash; + runcmd_ordryrun_local + @git, qw(update-ref), "refs/tags/$tag", $tag_obj_hash; + } supplementary_message(<<'END'); Push failed, while updating the remote git repository - see messages above. @@ -2086,9 +2649,19 @@ END if (!check_for_git()) { create_remote_git_repo(); } - runcmd_ordryrun @git, qw(push),access_giturl(), - $forceflag."HEAD:".rrref(), $forceflag."refs/tags/$tag"; - runcmd_ordryrun @git, qw(update-ref -m), 'dgit push', lrref(), 'HEAD'; + + my @pushrefs = $forceflag.$dgithead.":".rrref(); + foreach my $tw (@tagwants) { + my $view = $tw->{View}; + next unless $view eq 'dgit' + or any { $_ eq $view } access_cfg_tagformats(); + # ^ $view is "dgit" or "maint" so this looks for "maint" + # in archive supported tagformats. + push @pushrefs, $forceflag."refs/tags/$tw->{Tag}"; + } + + runcmd_ordryrun @git, qw(push),access_giturl(), @pushrefs; + runcmd_ordryrun @git, qw(update-ref -m), 'dgit push', lrref(), $dgithead; supplementary_message(<<'END'); Push failed, after updating the remote git repository. @@ -2304,7 +2877,7 @@ sub cmd_remote_push_build_host { unless defined $protovsn; responder_send_command("dgit-remote-push-ready $protovsn"); - + rpush_handle_protovsn_bothends(); changedir $dir; &cmd_push; } @@ -2313,6 +2886,13 @@ 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) +sub rpush_handle_protovsn_bothends () { + if ($protovsn < 4) { + need_tagformat 'old', "rpush negotiated protocol $protovsn"; + } + select_tagformat(); +} + our $i_tmp; sub i_cleanup { @@ -2371,6 +2951,12 @@ sub cmd_rpush { ($protovsn) = initiator_expect { m/^dgit-remote-push-ready (\S+)/ }; die "$protovsn ?" unless grep { $_ eq $protovsn } @rpushprotovsn_support; $supplementary_message = '' unless $protovsn >= 3; + + fail "rpush negotiated protocol version $protovsn". + " which does not support quilt mode $quilt_mode" + if quiltmode_splitbrain; + + rpush_handle_protovsn_bothends(); for (;;) { my ($icmd,$iargs) = initiator_expect { m/^(\S+)(?: (.*))?$/; @@ -2442,13 +3028,13 @@ sub i_resp_want ($) { print RI "files-end\n" or die $!; } -our ($i_clogp, $i_version, $i_tag, $i_dscfn, $i_changesfn); +our ($i_clogp, $i_version, $i_dscfn, $i_changesfn); sub i_localname_parsed_changelog { return "remote-changelog.822"; } sub i_file_parsed_changelog { - ($i_clogp, $i_version, $i_tag, $i_dscfn) = + ($i_clogp, $i_version, $i_dscfn) = push_parse_changelog "$i_tmp/remote-changelog.822"; die if $i_dscfn =~ m#/|^\W#; } @@ -2475,17 +3061,26 @@ sub i_want_signed_tag { my $head = $i_param{'head'}; die if $head =~ m/[^0-9a-f]/ || $head !~ m/^../; + my $maintview = $i_param{'maint-view'}; + die if defined $maintview && $maintview =~ m/[^0-9a-f]/; + + select_tagformat(); + if ($protovsn >= 4) { + my $p = $i_param{'tagformat'} // ''; + $p eq $tagformat + or badproto \*RO, "tag format mismatch: $p vs. $tagformat"; + } + die unless $i_param{'csuite'} =~ m/^$suite_re$/; $csuite = $&; push_parse_dsc $i_dscfn, 'remote dsc', $i_version; - my $tagobjfn = - push_mktag $head, $i_clogp, $i_tag, - $i_dscfn, - $i_changesfn, 'remote changes', - sub { "tag$_[0]"; }; + my @tagwants = push_tagwants $i_version, $head, $maintview, "tag"; - return $tagobjfn; + return + push_mktags $i_clogp, $i_dscfn, + $i_changesfn, 'remote changes', + \@tagwants; } sub i_want_signed_dsc_changes { @@ -2803,7 +3398,8 @@ sub quiltify ($$$$) { die "$quilt_mode ?"; } - my $time = time; + my $time = $ENV{'GIT_COMMITTER_DATE'} || time; + $time =~ s/\s.*//; # trim timezone from GIT_COMMITTER_DATE my $ncommits = 3; my $msg = cmdoutput @git, qw(log), "-n$ncommits"; @@ -3003,7 +3599,7 @@ sub quilt_check_splitbrain_cache ($$) { my $splitbrain_cachekey; progress - "dgit: split brain (separate dgit view) may needed (--quilt=$quilt_mode)."; + "dgit: split brain (separate dgit view) may be needed (--quilt=$quilt_mode)."; # we look in the reflog of dgit-intern/quilt-cache # we look for an entry whose message is the key for the cache lookup my @cachekey = (qw(dgit), $our_version); @@ -3288,6 +3884,7 @@ sub maybe_unapply_patches_again () { if $patches_applied_dirtily & 01; rmtree '.pc' if $patches_applied_dirtily & 02; + $patches_applied_dirtily = 0; } #----- other building ----- @@ -3476,16 +4073,15 @@ sub cmd_gbp_build { } build_prep(); } + maybe_unapply_patches_again(); if ($wantsrc < 2) { unless (grep { m/^--git-debian-branch|^--git-ignore-branch/ } @ARGV) { canonicalise_suite(); push @cmd, "--git-debian-branch=".lbranch(); } push @cmd, changesopts(); - maybe_apply_patches_dirtily(); runcmd_ordryrun_local @cmd, @ARGV; } - maybe_unapply_patches_again(); printdone "build successful\n"; } sub cmd_git_build { cmd_gbp_build(); } # compatibility with <= 1.0 @@ -3568,6 +4164,7 @@ sub cmd_sbuild { " building would result in ambiguity about the intended results" if @unwanted; } + my $wasdir = must_getcwd(); changedir ".."; if (act_local()) { stat_exists $dscfn or fail "$dscfn (in parent directory): $!"; @@ -3596,6 +4193,7 @@ sub cmd_sbuild { rename "$cf", "$cf.inmulti" or fail "$cf\{,.inmulti}: $!"; } } + changedir $wasdir; maybe_unapply_patches_again(); printdone "build successful, results in $multichanges\n" or die $!; } @@ -3763,6 +4361,11 @@ sub parseopts () { } elsif (m/^--deliberately-($deliberately_re)$/s) { push @ropts, $_; push @deliberatelies, $&; + } elsif (m/^--dgit-tag-format=(old|new)$/s) { + # undocumented, for testing + push @ropts, $_; + $tagformat_want = [ $1, 'command line', 1 ]; + # 1 menas overrides distro configuration } elsif (m/^--always-split-source-build$/s) { # undocumented, for testing push @ropts, $_;