X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=git-debrebase;h=04befff5484477c888825954b20ae53c760ce983;hp=ce348e291e78cec0d2f86725a6290b4fa69f55f5;hb=0899e14ec8d3eb877f4190882c5c3e92d02c460b;hpb=2e2af845dd1033adebc578773c84d2b6d8227839 diff --git a/git-debrebase b/git-debrebase index ce348e29..04befff5 100755 --- a/git-debrebase +++ b/git-debrebase @@ -18,6 +18,10 @@ # You should have received a copy of the GNU General Public License # along with this program. If not, see . +END { $? = $Debian::Dgit::ExitStatus::desired // -1; }; +use Debian::Dgit::GDR; +use Debian::Dgit::ExitStatus; + use strict; use Debian::Dgit qw(:DEFAULT :playground); @@ -30,6 +34,7 @@ use Data::Dumper; use Getopt::Long qw(:config posix_default gnu_compat bundling); use Dpkg::Version; use File::FnMatch qw(:fnmatch); +use File::Copy; our ($opt_force, $opt_noop_ok, @opt_anchors); our ($opt_defaultcmd_interactive); @@ -39,7 +44,7 @@ our $us = qw(git-debrebase); sub badusage ($) { my ($m) = @_; print STDERR "bad usage: $m\n"; - exit 12; + finish 8; } sub cfg ($;$) { @@ -99,19 +104,21 @@ sub fresh_workarea () { in_workarea sub { playtree_setup }; } -our $snags_forced; -our $snags_tripped; -our $snags_checked; +our $snags_forced = 0; +our $snags_tripped = 0; +our $snags_summarised = 0; our @deferred_updates; our @deferred_update_messages; +sub all_snags_summarised () { + $snags_forced + $snags_tripped == $snags_summarised; +} sub run_deferred_updates ($) { my ($mrest) = @_; - confess 'dangerous internal error' if - !$snags_checked || $snags_tripped || $snags_forced; + confess 'dangerous internal error' unless all_snags_summarised(); - my @upd_cmd = (@git, qw(update-ref --stdin -m), "debrebase: $mrest"); + my @upd_cmd = (git_update_ref_cmd "debrebase: $mrest", qw(--stdin)); debugcmd '>|', @upd_cmd; open U, "|-", @upd_cmd or die $!; foreach (@deferred_updates) { @@ -233,8 +240,8 @@ sub make_commit ($$) { } our @snag_force_opts; -sub snag ($$) { - my ($tag,$msg) = @_; +sub snag ($$;@) { + my ($tag,$msg) = @_; # ignores extra args, for benefit of keycommits if (grep { $_ eq $tag } @snag_force_opts) { $snags_forced++; print STDERR "git-debrebase: snag ignored (-f$tag): $msg\n"; @@ -244,26 +251,30 @@ sub snag ($$) { } } +# Important: all mainline code must call snags_maybe_bail after +# any point where snag might be called, but before making changes +# (eg before any call to run_deferred_updates). snags_maybe_bail +# may be called more than once if necessary (but this is not ideal +# because then the messages about number of snags may be confusing). sub snags_maybe_bail () { - $snags_checked++; + return if all_snags_summarised(); if ($snags_forced) { printf STDERR "%s: snags: %d overriden by individual -f options\n", $us, $snags_forced; - $snags_forced=0; } if ($snags_tripped) { if ($opt_force) { printf STDERR "%s: snags: %d overriden by global --force\n", $us, $snags_tripped; - $snags_tripped=0; } else { fail sprintf "%s: snags: %d blockers (you could -f, or --force)", $us, $snags_tripped; } } + $snags_summarised = $snags_forced + $snags_tripped; } sub any_snags () { return $snags_forced || $snags_tripped; @@ -424,6 +435,23 @@ sub classify ($) { # way also there's also an easy rune to look for the upstream # patches (--topo-order). + # Also this makes --first-parent be slightly more likely to + # be useful - it makes it provide a linearised breakwater history. + + # Of course one can say somthing like + # gitk -- ':/' ':!/debian' + # to get _just_ the commits touching upstream files, and by + # the TREESAME logic in git-rev-list this will leave the + # breakwater into upstream at the first anchor. But that + # doesn't report debian/ changes at all. + + # Other observations about gitk: by default, gitk seems to + # produce output in a different order to git-rev-list. I + # can't seem to find this documented anywhere. gitk + # --date-order DTRT. But, gitk always seems to put the + # parents from left to right, in order, so it's easy to see + # which way round a pseudomerge is. + $p[0]{IsOrigin} and $badanchor->("is an origin commit"); $p[1]{Differs} & ~DS_DEB and $badanchor->("upstream files differ from left parent"); @@ -512,13 +540,13 @@ sub classify ($) { return $unknown->("complex merge"); } -sub keycommits ($;$$$) { - my ($head, $furniture, $unclean, $trouble) = @_; +sub keycommits ($;$$$$) { + my ($head, $furniture, $unclean, $trouble, $fatal) = @_; # => ($anchor, $breakwater) - # $unclean->("unclean-$tagsfx", $msg) - # $furniture->("unclean-$tagsfx", $msg) - # $dgitimport->("unclean-$tagsfx", $msg) + # $unclean->("unclean-$tagsfx", $msg, $cl) + # $furniture->("unclean-$tagsfx", $msg, $cl) + # $dgitimport->("unclean-$tagsfx", $msg, $cl)) # is callled for each situation or commit that # wouldn't be found in a laundered branch # $furniture is for furniture commits such as might be found on an @@ -526,6 +554,8 @@ sub keycommits ($;$$$) { # $trouble is for things whnich prevent the return of # anchor and breakwater information; if that is ignored, # then keycommits returns (undef, undef) instead. + # $fatal is for unprocessable commits, and should normally cause + # a failure. If ignored, agaion, (undef, undef) is returned. # # If a callback is undef, fail is called instead. # If a callback is defined but false, the situation is ignored. @@ -535,15 +565,17 @@ sub keycommits ($;$$$) { my ($anchor, $breakwater); my $clogonly; + my $cl; + $fatal //= sub { fail $_[2]; }; my $x = sub { my ($cb, $tagsfx, $why) = @_; my $m = "branch needs laundering (run git-debrebase): $why"; fail $m unless defined $cb; return unless $cb; - $cb->("unclean-$tagsfx", $why); + $cb->("unclean-$tagsfx", $why, $cl); }; for (;;) { - my $cl = classify $head; + $cl = classify $head; my $ty = $cl->{Type}; if ($ty eq 'Packaging') { $breakwater //= $clogonly; @@ -577,12 +609,12 @@ sub keycommits ($;$$$) { } elsif ($ty eq 'DgitImportUnpatched') { $x->($trouble, 'dgitimport', "found dgit dsc import ($head)"); - $breakwater = undef; - $anchor = undef; - no warnings qw(exiting); - last; + return (undef,undef); } else { - fail "found unprocessable commit, cannot cope: $head; $cl->{Why}"; + $x->($fatal, 'unprocessable', + "found unprocessable commit, cannot cope: $head; $cl->{Why}" + ); + return (undef,undef); } $head = $cl->{Parents}[0]{CommitId}; } @@ -943,19 +975,8 @@ sub cmd_analyse () { } sub ffq_prev_branchinfo () { - # => ('status', "message", [$current, $ffq_prev, $gdrlast]) - # 'status' may be - # branch message is undef - # weird-symref } no $current, - # notbranch } no $ffq_prev my $current = git_get_symref(); - return ('detached', 'detached HEAD') unless defined $current; - return ('weird-symref', 'HEAD symref is not to refs/') - unless $current =~ m{^refs/}; - my $ffq_prev = "refs/$ffq_refprefix/$'"; - my $gdrlast = "refs/$gdrlast_refprefix/$'"; - printdebug "ffq_prev_branchinfo branch current $current\n"; - return ('branch', undef, $current, $ffq_prev, $gdrlast); + return gdr_ffq_prev_branchinfo($current); } sub record_ffq_prev_deferred () { @@ -999,7 +1020,7 @@ sub record_ffq_prev_deferred () { } return if $invert; my $lrval = git_get_ref $lrref; - return unless defined $lrval; + return unless length $lrval; if (is_fast_fwd $lrval, $currentval) { print "OK, you are ahead of $lrref\n" or die $!; @@ -1083,6 +1104,8 @@ sub stitch ($$$$$) { } } fresh_workarea(); + # We make pseudomerges with L as the contributing parent. + # This makes git rev-list --first-parent work properly. my $new_head = make_commit [ $old_head, $ffq_prev ], [ 'Declare fast forward / record previous work', "[git-debrebase pseudomerge: $prose]", @@ -1107,7 +1130,7 @@ sub do_stitch ($;$) { stitch($dangling_head, $ffq_prev, $gdrlast, $ffq_prev_commitish, $prose); } -sub cmd_new_upstream_v0 () { +sub cmd_new_upstream () { # automatically and unconditionally launders before rebasing # if rebase --abort is used, laundering has still been done @@ -1119,7 +1142,23 @@ sub cmd_new_upstream_v0 () { my $new_version = (new Dpkg::Version scalar(shift @ARGV), check => 1); my $new_upstream_version = $new_version->version(); - my $new_upstream = git_rev_parse (shift @ARGV // 'upstream'); + my $new_upstream = shift @ARGV; + if (!defined $new_upstream) { + my @tried; + # todo: at some point maybe use git-deborig to do this + foreach my $tagpfx ('', 'v', 'upstream/') { + my $tag = $tagpfx.(dep14_version_mangle $new_upstream_version); + $new_upstream = git_get_ref "refs/tags/$tag"; + last if length $new_upstream; + push @tried, $tag; + } + if (!length $new_upstream) { + fail "Could not determine appropriate upstream commitish.\n". + " (Tried these tags: @tried)\n". + " Check version, and specify upstream commitish explicitly."; + } + } + $new_upstream = git_rev_parse $new_upstream; record_ffq_auto(); @@ -1174,13 +1213,32 @@ sub cmd_new_upstream_v0 () { if ($old_upstream && $old_upstream->{Msg} =~ m{^\[git-debrebase }m) { if ($old_upstream->{Msg} =~ - m{^\[git-debrebase upstream-combine \.((?: $extra_orig_namepart_re)+)\:.*\]$}m + m{^\[git-debrebase upstream-combine (\.(?: $extra_orig_namepart_re)+)\:.*\]$}m ) { - my @oldpieces = ('', split / /, $1); - my $parentix = -1 + scalar @{ $old_upstream->{Parents} }; - foreach my $i (0..$#oldpieces) { - my $n = $oldpieces[$i]; - $piece->($n, Old => $old_upstream->{CommitId}.'^'.$parentix); + my @oldpieces = (split / /, $1); + my $old_n_parents = scalar @{ $old_upstream->{Parents} }; + if ($old_n_parents != @oldpieces && + $old_n_parents != @oldpieces + 1) { + snag 'upstream-confusing', sprintf + "previous upstream combine %s". + " mentions %d pieces (each implying one parent)". + " but has %d parents". + " (one per piece plus maybe a previous combine)", + $old_upstream->{CommitId}, + (scalar @oldpieces), + $old_n_parents; + } elsif ($oldpieces[0] ne '.') { + snag 'upstream-confusing', sprintf + "previous upstream combine %s". + " first piece is not \`.'", + $oldpieces[0]; + } else { + $oldpieces[0] = ''; + foreach my $i (0..$#oldpieces) { + my $n = $oldpieces[$i]; + my $hat = 1 + $i + ($old_n_parents - @oldpieces); + $piece->($n, Old => $old_upstream->{CommitId}.'^'.$hat); + } } } else { snag 'upstream-confusing', @@ -1293,6 +1351,8 @@ END 'launder for new upstream'; my @cmd = (@git, qw(rebase --onto), $new_bw, $old_bw, @ARGV); + local $ENV{GIT_REFLOG_ACTION} = git_reflog_action_msg + "debrebase new-upstream $new_version: rebase"; runcmd @cmd; # now it's for the user to sort out } @@ -1321,6 +1381,87 @@ sub cmd_breakwater () { print "$bw\n" or die $!; } +sub cmd_status () { + badusage "no arguments allowed" if @ARGV; + + # todo: gdr status should print divergence info + # todo: gdr status should print upstream component(s) info + # todo: gdr should leave/maintain some refs with this kind of info ? + + my $oldest = [ 0 ]; + my $newest; + my $note = sub { + my ($badness, $ourmsg, $snagname, $kcmsg, $cl) = @_; + if ($oldest->[0] < $badness) { + $oldest = $newest = undef; + } + $oldest = \@_; # we're walking backwards + $newest //= \@_; + }; + my ($anchor, $bw) = keycommits +(git_rev_parse 'HEAD'), + sub { $note->(1, 'branch contains furniture (not laundered)', @_); }, + sub { $note->(2, 'branch is unlaundered', @_); }, + sub { $note->(3, 'branch needs laundering', @_); }, + sub { $note->(4, 'branch not in git-debrebase form', @_); }; + + my $prcommitinfo = sub { + my ($cid) = @_; + flush STDOUT or die $!; + runcmd @git, qw(--no-pager log -n1), + '--pretty=format: %h %s%n', + $cid; + }; + + print "current branch contents, in git-debrebase terms:\n"; + if (!$oldest->[0]) { + print " branch is laundered\n"; + } else { + print " $oldest->[1]\n"; + my $printed = ''; + foreach my $info ($oldest, $newest) { + my $cid = $info->[4]{CommitId}; + next if $cid eq $printed; + $printed = $cid; + print " $info->[3]\n"; + $prcommitinfo->($cid); + } + } + + my $prab = sub { + my ($cid, $what) = @_; + if (!defined $cid) { + print " $what is not well-defined\n"; + } else { + print " $what\n"; + $prcommitinfo->($cid); + } + }; + print "key git-debrebase commits:\n"; + $prab->($anchor, 'anchor'); + $prab->($bw, 'breakwater'); + + my ($ffqstatus, $ffq_msg, $current, $ffq_prev, $gdrlast) = + ffq_prev_branchinfo(); + + print "branch and ref status, in git-debrebase terms:\n"; + if ($ffq_msg) { + print " $ffq_msg\n"; + } else { + $ffq_prev = git_get_ref $ffq_prev; + $gdrlast = git_get_ref $gdrlast; + if ($ffq_prev) { + print " unstitched; previous tip was:\n"; + $prcommitinfo->($ffq_prev); + } elsif (!$gdrlast) { + print " stitched? (no record of git-debrebase work)\n"; + } elsif (is_fast_fwd $gdrlast, 'HEAD') { + print " stitched\n"; + } else { + print " not git-debrebase (diverged since last stitch)\n" + } + } +} + sub cmd_stitch () { my $prose = 'stitch'; GetOptions('prose=s', \$prose) or die badusage("bad options to stitch"); @@ -1348,6 +1489,66 @@ sub cmd_conclude () { do_stitch 'quick'; } +sub make_patches_staged ($) { + my ($head) = @_; + # Produces the patches that would result from $head if it were + # laundered. + my ($secret_head, $secret_bw, $last_anchor) = walk $head; + fresh_workarea(); + in_workarea sub { + runcmd @git, qw(checkout -q -b bw), $secret_bw; + runcmd @git, qw(checkout -q -b patch-queue/bw), $secret_head; + my @gbp_cmd = (qw(gbp pq export)); + my $r = system shell_cmd 'exec >../gbp-pq-err 2>&1', @gbp_cmd; + if ($r) { + { local ($!,$?); copy('../gbp-pq-err', \*STDERR); } + failedcmd @gbp_cmd; + } + runcmd @git, qw(add -f debian/patches); + }; +} + +sub make_patches ($) { + my ($head) = @_; + keycommits $head, 0, \&snag; + make_patches_staged $head; + my $out; + in_workarea sub { + my $ptree = cmdoutput @git, qw(write-tree --prefix=debian/patches/); + runcmd @git, qw(read-tree), $head; + read_tree_subdir 'debian/patches', $ptree; + $out = make_commit [$head], [ + 'Commit patch queue (exported by git-debrebase)', + '[git-debrebase: export and commit patches]', + ]; + }; + return $out; +} + +sub cmd_make_patches () { + my $opt_quiet_would_amend; + GetOptions('quiet-would-amend!', \$opt_quiet_would_amend) + or die badusage("bad options to make-patches"); + badusage "no arguments allowed" if @ARGV; + my $old_head = get_head(); + my $new = make_patches $old_head; + my $d = get_differs $old_head, $new; + if ($d == 0) { + fail "No (more) patches to export." unless $opt_noop_ok; + return; + } elsif ($d == D_PAT_ADD) { + snags_maybe_bail(); + update_head_checkout $old_head, $new, 'make-patches'; + } else { + print STDERR failmsg + "Patch export produced patch amendments". + " (abandoned output commit $new).". + " Try laundering first." + unless $opt_quiet_would_amend; + finish 7; + } +} + sub cmd_convert_from_gbp () { badusage "needs 1 optional argument, the upstream git rev" unless @ARGV<=1; @@ -1421,14 +1622,10 @@ sub cmd_convert_to_gbp () { badusage "no arguments allowed" if @ARGV; my $head = get_head(); my (undef, undef, undef, $ffq, $gdrlast) = ffq_prev_branchinfo(); - my ($anchor, $bw) = keycommits $head, 0; - fresh_workarea(); + keycommits $head, 0; my $out; + make_patches_staged $head; in_workarea sub { - runcmd @git, qw(checkout -q -b bw), $bw; - runcmd @git, qw(checkout -q -b patch-queue/bw), $head; - runcmd qw(gbp pq export); - runcmd @git, qw(add debian/patches); $out = make_commit ['HEAD'], [ 'Commit patch queue (converted from git-debrebase format)', '[git-debrebase convert-to-gbp: commit patches]', @@ -1534,3 +1731,5 @@ if (!@ARGV || $opt_defaultcmd_interactive || $ARGV[0] =~ m{^-}) { $cmdfn or badusage "unknown git-debrebase sub-operation $cmd"; $cmdfn->(); } + +finish 0;