X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=git-debrebase;h=66167b2bafd501671885cbb7db43984d200d6aa5;hp=98e645a43a9255b81a7821a671b406239c922f90;hb=6152f859fc4fa61b485362a6ff5613f436883db8;hpb=485a61ef66da7ad675e0495355b1f9f1df952bf5 diff --git a/git-debrebase b/git-debrebase index 98e645a4..66167b2b 100755 --- a/git-debrebase +++ b/git-debrebase @@ -36,6 +36,8 @@ use Dpkg::Version; use File::FnMatch qw(:fnmatch); use File::Copy; +$debugcmd_when_debuglevel = 2; + our ($usage_message) = <<'END'; usages: git-debrebase [] [--|-i ] @@ -48,11 +50,16 @@ usages: See git-debrebase(1), git-debrebase(5), dgit-maint-debrebase(7) (in dgit). END -our ($opt_force, $opt_noop_ok, @opt_anchors); +our ($opt_force, $opt_careful, $opt_noop_ok, @opt_anchors); our ($opt_defaultcmd_interactive); +$opt_careful = 0; + our $us = qw(git-debrebase); +our $wrecknoteprefix = 'refs/debrebase/wreckage'; +our $merge_cache_ref = 'refs/debrebase/merge-resolutions'; + $|=1; sub badusage ($) { @@ -105,8 +112,8 @@ sub get_commit ($) { sub D_UPS () { 0x02; } # upstream files sub D_PAT_ADD () { 0x04; } # debian/patches/ extra patches at end sub D_PAT_OTH () { 0x08; } # debian/patches other changes -sub D_DEB_CLOG () { 0x10; } # debian/ (not patches/ or changelog) -sub D_DEB_OTH () { 0x20; } # debian/changelog +sub D_DEB_CLOG () { 0x10; } # debian/changelog +sub D_DEB_OTH () { 0x20; } # debian/ (not patches/ or changelog) sub DS_DEB () { D_DEB_CLOG | D_DEB_OTH; } # debian/ (not patches/) our $playprefix = 'debrebase'; @@ -124,17 +131,42 @@ sub in_workarea ($) { die $@ if $@; } -sub fresh_workarea () { - $workarea = fresh_playground "$playprefix/work"; +sub fresh_workarea (;$) { + my ($subdir) = @_; + $subdir //= 'work'; + $workarea = fresh_playground "$playprefix/$subdir"; in_workarea sub { playtree_setup }; } +sub run_ref_updates_now ($$) { + my ($mrest, $updates) = @_; + # @$updates is a list of lines for git-update-ref, without \ns + + my @upd_cmd = (git_update_ref_cmd "debrebase: $mrest", qw(--stdin)); + debugcmd '>|', @upd_cmd; + open U, "|-", @upd_cmd or die $!; + foreach (@$updates) { + printdebug ">= ", $_, "\n"; + print U $_, "\n" or die $!; + } + printdebug ">\$\n"; + close U or failedcmd @upd_cmd; +} + our $snags_forced = 0; our $snags_tripped = 0; our $snags_summarised = 0; our @deferred_updates; our @deferred_update_messages; +sub merge_wreckage_cleaning ($) { + my ($updates) = @_; + git_for_each_ref("$wrecknoteprefix/*", sub { + my ($objid,$objtype,$fullrefname,$reftail) = @_; + push @$updates, "delete $fullrefname"; + }); +} + sub all_snags_summarised () { $snags_forced + $snags_tripped == $snags_summarised; } @@ -143,90 +175,158 @@ sub run_deferred_updates ($) { confess 'dangerous internal error' unless all_snags_summarised(); - my @upd_cmd = (git_update_ref_cmd "debrebase: $mrest", qw(--stdin)); - debugcmd '>|', @upd_cmd; - open U, "|-", @upd_cmd or die $!; - foreach (@deferred_updates) { - printdebug ">= ", $_, "\n"; - print U $_, "\n" or die $!; - } - printdebug ">\$\n"; - close U or failedcmd @upd_cmd; - + merge_wreckage_cleaning \@deferred_updates; + run_ref_updates_now $mrest, \@deferred_updates; print $_, "\n" foreach @deferred_update_messages; @deferred_updates = (); @deferred_update_messages = (); } +sub get_tree ($;$$) { + # tree object name => ([ $name, $info ], ...) + # where $name is the sort key, ie has / at end for subtrees + # $info is the LHS from git-ls-tree ( ) + # without $precheck, will crash if $x does not exist, so don't do that; + # instead pass '' to get (). + my ($x, $precheck, $recurse) = @_; + + return () if !length $x; + + if ($precheck) { + my ($type, $dummy) = git_cat_file $x, [qw(tree missing)]; + return () if $type eq 'missing'; + } + + our (@get_tree_memo, %get_tree_memo); + my $memo = $get_tree_memo{$x}; + return @$memo if $memo; + + local $Debian::Dgit::debugcmd_when_debuglevel = 3; + my @l; + my @cmd = (qw(git ls-tree -z --full-tree)); + push @cmd, qw(-r) if $recurse; + push @cmd, qw(--), $x; + my $o = cmdoutput @cmd; + $o =~ s/\0$//s; + my $last = ''; + foreach my $l (split /\0/, $o) { + my ($i, $n) = split /\t/, $l, 2; + $n .= '/' if $i =~ m/^\d+ tree /; + push @l, [ $n, $i ]; + confess "$x need $last < $n ?" unless $last lt $n; + } + $get_tree_memo{$x} = \@l; + push @get_tree_memo, $x; + if (@get_tree_memo > 10) { + delete $get_tree_memo{ shift @get_tree_memo }; + } + return @l; +} + +sub trees_diff_walk ($$$;$) { + # trees_diff_walk [$all,] $x, $y, sub {... } + # calls sub->($name, $ix, $iy) for each difference (with $all, each name) + # $x and $y are as for get_tree + # where $name, $ix, $iy are $name and $info from get_tree + my $all = shift @_ if @_>=4; + my ($x,$y,$call) = @_; + return if !$all and $x eq $y; + my @x = get_tree $x; + my @y = get_tree $y; + printdebug "trees_diff_walk(..$x,$y..) ".Dumper(\@x,\@y) + if $debuglevel >= 3; + while (@x || @y) { + my $cmp = !@x <=> !@y # eg @y empty? $cmp=-1, use x + || $x[0][0] cmp $y[0][0]; # eg, x lt y ? $cmp=-1, use x + my ($n, $ix, $iy); # all same? $cmp=0, use both + $ix=$iy=''; + printdebug "trees_diff_walk $cmp : @{ $x[0]//[] } | @{ $y[0]//[] }\n" + if $debuglevel >= 3; + ($n, $ix) = @{ shift @x } if $cmp <= 0; + ($n, $iy) = @{ shift @y } if $cmp >= 0; + next if !$all and $ix eq $iy; + printdebug sprintf + "trees_diff_walk(%d,'%s','%s') call('%s','%s','%s')\n", + !!$all,$x,$y, $n,$ix,$iy + if $debuglevel >= 2; + $call->($n, $ix, $iy); + } +} + sub get_differs ($$) { my ($x,$y) = @_; - # This resembles quiltify_trees_differ, in dgit, a bit. + # This does a similar job to quiltify_trees_differ, in dgit, a bit. # But we don't care about modes, or dpkg-source-unrepresentable # changes, and we don't need the plethora of different modes. # Conversely we need to distinguish different kinds of changes to # debian/ and debian/patches/. + # Also, here we have, and want to use, trees_diff_walk, because + # we may be calling this an awful lot and we want it to be fast. my $differs = 0; + my @debian_info; - my $rundiff = sub { - my ($opts, $limits, $fn) = @_; - my @cmd = (@git, qw(diff-tree -z --no-renames)); - push @cmd, @$opts; - push @cmd, "$_:" foreach $x, $y; - push @cmd, '--', @$limits; - my $diffs = cmdoutput @cmd; - foreach (split /\0/, $diffs) { $fn->(); } - }; + no warnings qw(exiting); - $rundiff->([qw(--name-only)], [], sub { - $differs |= $_ eq 'debian' ? DS_DEB : D_UPS; - }); + my $plain = sub { $_[0] =~ m{^(100|0*)644 blob }s; }; - if ($differs & DS_DEB) { - $differs &= ~DS_DEB; - $rundiff->([qw(--name-only -r)], [qw(debian)], sub { - $differs |= - m{^debian/patches/} ? D_PAT_OTH : - $_ eq 'debian/changelog' ? D_DEB_CLOG : - D_DEB_OTH; - }); - die "mysterious debian changes $x..$y" - unless $differs & (D_PAT_OTH|DS_DEB); - } - - if ($differs & D_PAT_OTH) { - my $mode; - $differs &= ~D_PAT_OTH; - my $pat_oth = sub { - $differs |= D_PAT_OTH; - no warnings qw(exiting); last; - }; - $rundiff->([qw(--name-status -r)], [qw(debian/patches/)], sub { - no warnings qw(exiting); - if (!defined $mode) { - $mode = $_; next; + trees_diff_walk "$x:", "$y:", sub { + my ($n,$ix,$iy) = @_; + + # analyse difference at the toplevel + + if ($n ne 'debian/') { + $differs |= D_UPS; + next; + } + if ($n eq 'debian') { + # one side has a non-tree for ./debian ! + $differs |= D_DEB_OTH; + next; + } + + my $xd = $ix && "$x:debian"; + my $yd = $iy && "$y:debian"; + trees_diff_walk $xd, $yd, sub { + my ($n,$ix,$iy) = @_; + + # analyse difference in debian/ + + if ($n eq 'changelog' && (!$ix || $plain->($ix)) + && $plain->($iy) ) { + $differs |= D_DEB_CLOG; + next; } - die unless s{^debian/patches/}{}; - my $ok; - if ($mode eq 'A' && !m/\.series$/s) { - $ok = 1; - } elsif ($mode eq 'M' && $_ eq 'series') { - my $x_s = (git_cat_file "$x:debian/patches/series", 'blob'); - my $y_s = (git_cat_file "$y:debian/patches/series", 'blob'); - chomp $x_s; $x_s .= "\n"; - $ok = $x_s eq substr($y_s, 0, length $x_s); - } else { - # nope + if ($n ne 'patches/') { + $differs |= D_DEB_OTH; + next; } - $mode = undef; - $differs |= $ok ? D_PAT_ADD : D_PAT_OTH; - }); - die "mysterious debian/patches changes $x..$y" - unless $differs & (D_PAT_ADD|D_PAT_OTH); - } - printdebug sprintf "get_differs %s, %s = %#x\n", $x, $y, $differs; + my $xp = $ix && "$xd/patches"; + my $yp = $iy && "$yd/patches"; + trees_diff_walk $xp, $yp, sub { + my ($n,$ix,$iy) = @_; + + # analyse difference in debian/patches + + my $ok; + if ($n !~ m/\.series$/s && !$ix && $plain->($iy)) { + $ok = 1; + } elsif ($n eq 'series' && $plain->($ix) && $plain->($iy)) { + my $x_s = (git_cat_file "$xp/series", 'blob'); + my $y_s = (git_cat_file "$yp/series", 'blob'); + chomp $x_s; $x_s .= "\n"; + $ok = $x_s eq substr($y_s, 0, length $x_s); + } else { + # nope + } + $differs |= $ok ? D_PAT_ADD : D_PAT_OTH; + }; + }; + }; + + printdebug sprintf "get_differs %s %s = %#x\n", $x, $y, $differs; return $differs; } @@ -255,6 +355,24 @@ sub read_tree_subdir ($$) { runcmd @git, qw(read-tree), "--prefix=$subdir/", $new_tree_object; } +sub read_tree_debian ($) { + my ($treeish) = @_; + read_tree_subdir 'debian', "$treeish:debian"; + rm_subdir_cached 'debian/patches'; +} + +sub read_tree_upstream ($;$$) { + my ($treeish, $keep_patches, $tree_with_debian) = @_; + # if $tree_with_debian is supplied, will use that for debian/ + # otherwise will save and restore it. + my $debian = + $tree_with_debian ? "$tree_with_debian:debian" + : cmdoutput @git, qw(write-tree --prefix=debian/); + runcmd @git, qw(read-tree), $treeish; + read_tree_subdir 'debian', $debian; + rm_subdir_cached 'debian/patches' unless $keep_patches; +}; + sub make_commit ($$) { my ($parents, $message_paras) = @_; my $tree = cmdoutput @git, qw(write-tree); @@ -310,6 +428,301 @@ sub any_snags () { return $snags_forced || $snags_tripped; } +sub gbp_pq_export ($$$) { + my ($bname, $base, $tip) = @_; + # must be run in a workarea. $bname and patch-queue/$bname + # ought not to exist. Leaves you on patch-queue/$bname with + # the patches staged but not committed. + printdebug "gbp_pq_export $bname $base $tip\n"; + runcmd @git, qw(checkout -q -b), $bname, $base; + runcmd @git, qw(checkout -q -b), "patch-queue/$bname", $tip; + 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) if stat_exists 'debian/patches'; +} + + +# xxx allow merge resolution separately from laundering, before git merge +# +# xxx general gdr docs highlight forbidden things +# xxx general gdr docs list allowable things ? +# xxx general gdr docs explicitly forbid some rebase + +# later/rework? +# use git-format-patch? +# our own patch identification algorithm? +# this is an alternative strategy + +sub merge_failed ($$;@) { + my ($wrecknotes, $emsg, @xmsgs) = @_; + my @m; + push @m, "Merge resolution failed: $emsg"; + push @m, @xmsgs; + + changedir $maindir; + + my @updates; + merge_wreckage_cleaning \@updates; + run_ref_updates_now "merge failed", \@updates; + + @updates = (); + keys %$wrecknotes; + while (my ($k,$v) = each %$wrecknotes) { + push @updates, "create $wrecknoteprefix/$k $v"; + } + run_ref_updates_now "merge failed", \@updates; + push @m, "Wreckage left in $wrecknoteprefix/*."; + + push @m, "See git-debrebase(1) section FAILED MERGES for suggestions."; + + # use finish rather than fail, in case we are within an eval + # (that can happen inside walk!) + print STDERR "\n"; + print STDERR "$us: $_\n" foreach @m; + finish 15; +} + +sub mwrecknote ($$$) { + my ($wrecknotes, $reftail, $commitish) = @_; + confess unless defined $commitish; + printdebug "mwrecknote $reftail $commitish\n"; + $wrecknotes->{$reftail} = $commitish; +} + +sub merge_attempt_cmd { + my $wrecknotes = shift @_; + debugcmd '+', @_; + $!=0; $?=-1; + if (system @_) { + merge_failed $wrecknotes, + failedcmd_waitstatus(), + "failed command: @_"; + } +} + +sub merge_series_patchqueue_convert ($$$); + +sub merge_series ($$$;@) { + my ($newbase, $wrecknotes, $base_q, @input_qs) = @_; + # $base_q{SeriesBase} $input_qs[]{SeriesBase} + # $base_q{SeriesTip} $input_qs[]{SeriesTip} + # ^ specifies several patch series (currently we only support exactly 2) + # return value is a commit which is the result of + # merging the two versions of the same topic branch + # $input_q[0] and $input_q[1] + # with respect to the old version + # $base_q + # all onto $newbase. + + # Creates, in *_q, a key MR for its private use + + printdebug "merge_series newbase=$newbase\n"; + + $input_qs[$_]{MR}{S} = $_ foreach (0..$#input_qs); + $base_q->{MR}{S} = 'base'; + + my %prereq; + # $prereq{}{} = 1 or absent + # $prereq{}{} exists or not (even later) + + my $merged_pq; + + my $mwrecknote = sub { &mwrecknote($wrecknotes, @_); }; + + my $attempt_cmd = sub { &merge_attempt_cmd($wrecknotes, @_); }; + + local $workarea; + fresh_workarea "merge"; + my $seriesfile = "debian/patches/series"; + in_workarea sub { + playtree_setup(); + foreach my $q ($base_q, reverse @input_qs) { + my $s = $q->{MR}{S}; + gbp_pq_export "p-$s", $q->{SeriesBase}, $q->{SeriesTip}; + my @earlier; + if (open S, $seriesfile) { + while (my $patch = ) { + chomp $patch or die $!; + $prereq{$patch} //= {}; + foreach my $earlier (@earlier) { + $prereq{$patch}{$earlier}{$s}++ and die; + } + push @earlier, $patch; + stat "debian/patches/$patch" or die "$patch ?"; + } + S->error and die "$seriesfile $!"; + close S; + } else { + die "$seriesfile $!" unless $!==ENOENT; + } + read_tree_upstream $newbase, 1; + my $pec = make_commit [ grep { defined } $base_q->{MR}{PEC} ], [ + "Convert $s to patch queue for merging", + "[git-debrebase merge-innards patch-queue import:". + " $q->{SeriesTip}]" + ]; + printdebug "merge_series pec $pec "; + runcmd @git, qw(rm -q --ignore-unmatch --cached), $seriesfile; + $pec = make_commit [ $pec ], [ + "Drop series file from $s to avoid merge trouble", + "[git-debrebase merge-innards patch-queue prep:". + " $q->{SeriesTip}]" + ]; + + read_tree_debian $newbase; + if (@earlier) { + read_tree_subdir 'debian/patches', "$pec:debian/patches"; + } else { + rm_subdir_cached 'debian/patches'; + } + $pec = make_commit [ $pec ], [ + "Update debian/ (excluding patches) to final to avoid re-merging", + "debian/ was already merged and we need to just take that.", + "[git-debrebase merge-innards patch-queue packaging:". + " $q->{SeriesTip}]" + ]; + + printdebug "pec' $pec\n"; + runcmd @git, qw(reset -q --hard), $pec; + $q->{MR}{PEC} = $pec; + $mwrecknote->("$q->{LeftRight}-patchqueue", $pec); + } + # now, because of reverse, we are on $input_q->{MR}{OQC} + runcmd @git, qw(checkout -q -b merge); + printdebug "merge_series merging...\n"; + my @mergecmd = (@git, qw(merge --quiet --no-edit), "p-1"); + + $attempt_cmd->(@mergecmd); + + printdebug "merge_series merge ok, series...\n"; + # We need to construct a new series file + # Firstly, resolve prereq + foreach my $f (sort keys %prereq) { + printdebug "merge_series patch\t$f\t"; + if (!stat_exists "debian/patches/$f") { + print DEBUG " drop\n" if $debuglevel; + # git merge deleted it; that's how we tell it's not wanted + delete $prereq{$f}; + next; + } + print DEBUG " keep\n" if $debuglevel; + foreach my $g (sort keys %{ $prereq{$f} }) { + my $gfp = $prereq{$f}{$g}; + printdebug "merge_series prereq\t$f\t-> $g\t"; + if (!!$gfp->{0} == !!$gfp->{1} + ? $gfp->{0} + : !$gfp->{base}) { + print DEBUG "\tkeep\n" if $debuglevel; + } else { + print DEBUG "\tdrop\n" if $debuglevel; + delete $prereq{$f}{$g}; + } + } + } + + my $unsat = sub { + my ($f) = @_; + return scalar keys %{ $prereq{$f} }; + }; + + my $nodate = time + 1; + my %authordate; + # $authordate{}; + my $authordate = sub { + my ($f) = @_; + $authordate{$f} //= do { + open PF, "<", "debian/patches/$f" or die "$f $!"; + while () { + return $nodate if m/^$/; + last if s{^Date: }{}; + } + chomp; + return cmdoutput qw(date +%s -d), $_; + }; + }; + + open NS, '>', $seriesfile or die $!; + + while (keys %prereq) { + my $best; + foreach my $try (sort keys %prereq) { + if ($best) { + next if ( + $unsat->($try) <=> $unsat->($best) or + $authordate->($try) <=> $authordate->($best) or + $try cmp $best + ) >= 0; + } + $best = $try; + } + printdebug "merge_series series next $best\n"; + print NS "$best\n" or die $!; + delete $prereq{$best}; + foreach my $gp (values %prereq) { + delete $gp->{$best}; + } + } + + runcmd @git, qw(add), $seriesfile; + runcmd @git, qw(commit --quiet -m), 'Merged patch queue form'; + $merged_pq = git_rev_parse 'HEAD'; + $mwrecknote->('merged-patchqueue', $merged_pq); + }; + return merge_series_patchqueue_convert + $wrecknotes, $newbase, $merged_pq; +} + +sub merge_series_patchqueue_convert ($$$) { + my ($wrecknotes, $newbase, $merged_pq) = @_; + + my $result; + in_workarea sub { + playtree_setup(); + printdebug "merge_series series gbp pq import\n"; + runcmd @git, qw(checkout -q -b mergec), $merged_pq; + + merge_attempt_cmd($wrecknotes, qw(gbp pq import)); + + # OK now we are on patch-queue/merge, and we need to rebase + # onto the intended parent and drop the patches from each one + + printdebug "merge_series series ok, building...\n"; + my $build = $newbase; + my @lcmd = (@git, qw(rev-list --reverse mergec..patch-queue/mergec)); + foreach my $c (grep /./, split /\n/, cmdoutput @lcmd) { + my $commit = git_cat_file $c, 'commit'; + printdebug "merge_series series ok, building $c\n"; + read_tree_upstream $c, 0, $newbase; + my $tree = cmdoutput @git, qw(write-tree); + $commit =~ s{^parent (\S+)$}{parent $build}m or confess; + $commit =~ s{^tree (\S+)$}{tree $tree}m or confess; + open C, ">", "../mcommit" or die $!; + print C $commit or die $!; + close C or die $!; + $build = cmdoutput @git, qw(hash-object -w -t commit ../mcommit); + } + $result = $build; + mwrecknote($wrecknotes, 'merged-result', $result); + + runcmd @git, qw(update-ref refs/heads/result), $result; + + runcmd @git, qw(checkout -q -b debug); + runcmd @git, qw(commit --allow-empty -q -m M-INDEX); + runcmd @git, qw(add .); + runcmd @git, qw(commit --allow-empty -q -m M-WORKTREE); + my $mdebug = git_rev_parse 'HEAD'; + printdebug sprintf "merge_series done debug=%s\n", $mdebug; + mwrecknote($wrecknotes, 'merged-debug', $mdebug); + }; + printdebug "merge_series returns $result\n"; + return $result; +} + # classify returns an info hash like this # CommitId => $objid # Hdr => # commit headers, including 1 final newline @@ -567,11 +980,44 @@ sub classify ($) { OrigParents => \@orig_ps); } - return $unknown->("complex merge"); + if (@p == 2 and + $r->{Msg} =~ m{^\[git-debrebase merged-breakwater.*\]$}m) { + # xxx ^ metadata tag needs adding to (5) + return $classify->("MergedBreakwaters"); + } + if ($r->{Msg} =~ m{^\[(git-debrebase|dgit)[: ].*\]$}m) { + return $unknown->("unknown kind of merge from $1"); + } + if (@p > 2) { + return $unknown->("octopus merge"); + } + + if (!$ENV{GIT_DEBREBASE_EXPERIMENTAL_MERGE}) { + return $unknown->("general two-parent merge"); + } + + return $classify->("VanillaMerge"); } -sub keycommits ($;$$$$) { - my ($head, $furniture, $unclean, $trouble, $fatal) = @_; +sub keycommits ($;$$$$$); + +sub mergedbreakwaters_anchor ($) { + my ($cl) = @_; + my $best_anchor; + foreach my $p (@{ $cl->{Parents} }) { + my ($panchor, $pbw) = keycommits $p->{CommitId}, + undef,undef,undef,undef, 1; + $best_anchor = $panchor + if !defined $best_anchor + or is_fast_fwd $best_anchor, $panchor; + fail "inconsistent anchors in merged-breakwaters $p->{CommitId}" + unless is_fast_fwd $panchor, $best_anchor; + } + return $best_anchor; +} + +sub keycommits ($;$$$$$) { + my ($head, $furniture, $unclean, $trouble, $fatal, $claimed_bw) = @_; # => ($anchor, $breakwater) # $unclean->("unclean-$tagsfx", $msg, $cl) @@ -587,6 +1033,8 @@ sub keycommits ($;$$$$) { # $fatal is for unprocessable commits, and should normally cause # a failure. If ignored, agaion, (undef, undef) is returned. # + # If $claimed_bw, this is supposed to be a breakwater commit. + # # If a callback is undef, fail is called instead. # If a callback is defined but false, the situation is ignored. # Callbacks may say: @@ -594,6 +1042,7 @@ sub keycommits ($;$$$$) { # if the answer is no longer wanted. my ($anchor, $breakwater); + $breakwater = $head if $claimed_bw; my $clogonly; my $cl; my $found_pm; @@ -606,6 +1055,13 @@ sub keycommits ($;$$$$) { return unless $cb; $cb->("unclean-$tagsfx", $why, $cl, $mainwhy); }; + my $found_anchor = sub { + ($anchor) = @_; + $breakwater //= $clogonly; + $breakwater //= $head; + no warnings qw(exiting); + last; + }; for (;;) { $cl = classify $head; my $ty = $cl->{Type}; @@ -619,10 +1075,7 @@ sub keycommits ($;$$$$) { } elsif ($ty eq 'Anchor' or $ty eq 'TreatAsAnchor' or $ty eq 'BreakwaterStart') { - $anchor = $head; - $breakwater //= $clogonly; - $breakwater //= $head; - last; + $found_anchor->($head); } elsif ($ty eq 'Upstream') { $x->($unclean, 'ordering', "packaging change ($breakwater) follows upstream change"," (eg $head)") @@ -650,6 +1103,12 @@ sub keycommits ($;$$$$) { " ($head)"); return (undef,undef); } + } elsif ($ty eq 'VanillaMerge') { + $x->($trouble, 'vanillamerge', + "found vanilla merge"," ($head)"); + return (undef,undef); + } elsif ($ty eq 'MergedBreakwaters') { + $found_anchor->(mergedbreakwaters_anchor $cl); } else { $x->($fatal, 'unprocessable', "found unprocessable commit, cannot cope: $cl->{Why}", @@ -661,14 +1120,15 @@ sub keycommits ($;$$$$) { return ($anchor, $breakwater); } -sub walk ($;$$); -sub walk ($;$$) { +sub walk ($;$$$); +sub walk ($;$$$) { my ($input, - $nogenerate,$report) = @_; + $nogenerate,$report, $report_lprefix) = @_; # => ($tip, $breakwater_tip, $last_anchor) # (or nothing, if $nogenerate) printdebug "*** WALK $input ".($nogenerate//0)." ".($report//'-')."\n"; + $report_lprefix //= ''; # go through commits backwards # we generate two lists of commits to apply: @@ -700,7 +1160,7 @@ sub walk ($;$$) { my $prline = sub { return unless $report; - print $report $prdelim, @_; + print $report $prdelim, $report_lprefix, @_; $prdelim = "\n"; }; @@ -729,10 +1189,18 @@ sub walk ($;$$) { no warnings qw(exiting); last; }; + my $nomerge = sub { + my ($emsg) = @_; + merge_failed $cl->{MergeWreckNotes}, $emsg; + }; + + my $mwrecknote = sub { &mwrecknote($cl->{MergeWreckNotes}, @_); }; + my $last_anchor; for (;;) { $cl = classify $cur; + $cl->{MergeWreckNotes} //= {}; my $ty = $cl->{Type}; my $st = $cl->{SubType}; $prline->("$cl->{CommitId} $cl->{Type}"); @@ -832,6 +1300,189 @@ sub walk ($;$$) { return $bomb->(); } die "$ty ?"; + } elsif ($ty eq 'MergedBreakwaters') { + $last_anchor = mergedbreakwaters_anchor $cl; + $build_start->(' MergedBreakwaters', $cur); + last; + } elsif ($ty eq 'VanillaMerge') { + # User may have merged unstitched branch(es). We will + # have now lost what ffq-prev was then (since the later + # pseudomerge may introduce further changes). The effect + # of resolving such a merge is that we may have to go back + # further in history to find a merge base, since the one + # which was reachable via ffq-prev is no longer findable. + # This is suboptimal, but if it all works we'll have done + # the right thing. + # xxx we should warn the user in the docs about this + + my $ok=1; + my $best_anchor; + # We expect to find a dominating anchor amongst the + # inputs' anchors. That will be the new anchor. + # + # More complicated is finding a merge base for the + # breakwaters. We need a merge base that is a breakwater + # commit. The ancestors of breakwater commits are more + # breakwater commits and possibly upstream commits and the + # ancestors of those upstream. Upstreams might have + # arbitrary ancestors. But any upstream commit U is + # either included in both anchors, in which case the + # earlier anchor is a better merge base than any of U's + # ancestors; or U is not included in the older anchor, in + # which case U is not an ancestor of the vanilla merge at + # all. So no upstream commit, nor any ancestor thereof, + # is a best merge base. As for non-breakwater Debian + # commits: these are never ancestors of any breakwater. + # + # So any best merge base as found by git-merge-base + # is a suitable breakwater anchor. Usually there will + # be only one. + + printdebug "*** MERGE\n"; + + my @bwbcmd = (@git, qw(merge-base)); + my @ibcmd = (@git, qw(merge-base --all)); + my $might_be_in_bw = 1; + + my $ps = $cl->{Parents}; + + $mwrecknote->('vanilla-merge', $cl->{CommitId}); + + foreach my $p (@$ps) { + $prline->(" VanillaMerge ".$p->{Ix}); + $prprdelim->(); + my ($ptip, $pbw, $panchor) = + walk $p->{CommitId}, 0, $report, + $report_lprefix.' '; + $p->{Laundered} = $p->{SeriesTip} = $ptip; + $p->{Breakwater} = $p->{SeriesBase} = $pbw; + $p->{Anchor} = $panchor; + + my $lr = $p->{LeftRight} = (qw(left right))[$p->{Ix}]; + $mwrecknote->("$lr-input", $p->{CommitId}); + + my $mwrecknote_parent = sub { + my ($which) = @_; + $mwrecknote->("$lr-".(lc $which), $p->{$which}); + }; + $mwrecknote_parent->('Laundered'); + $mwrecknote_parent->('Breakwater'); + $mwrecknote_parent->('Anchor'); + + $best_anchor = $panchor if + !defined $best_anchor or + is_fast_fwd $best_anchor, $panchor; + + printdebug " MERGE BA best=".($best_anchor//'-'). + " p=$panchor\n"; + } + + $mwrecknote->('result-anchor', $best_anchor); + + foreach my $p (@$ps) { + $prline->(" VanillaMerge ".$p->{Ix}); + if (!is_fast_fwd $p->{Anchor}, $best_anchor) { + $nomerge->('divergent anchors'); + } elsif ($p->{Anchor} eq $best_anchor) { + print $report " SameAnchor" if $report; + } else { + print $report " SupersededAnchor" if $report; + } + if ($p->{Breakwater} eq $p->{CommitId}) { + # this parent commit was its own breakwater, + # ie it is part of the breakwater + print $report " Breakwater" if $report; + } else { + $might_be_in_bw = 0; + } + push @bwbcmd, $p->{Breakwater}; + push @ibcmd, $p->{CommitId}; + } + + if ($ok && $might_be_in_bw) { + # We could rewrite this to contaion the metadata + # declaring it to be MergedBreakwaters, but + # unnecessarily rewriting a merge seems unhelpful. + $prline->(" VanillaMerge MergedBreakwaters"); + $last_anchor = $best_anchor; + $build_start->('MergedBreakwaters', $cur); + } + + my $bwb = cmdoutput @bwbcmd; + + # OK, now we have a breakwater base, but we need the merge + # base for the interchange branch because we need the delta + # queue. + # + # This a the best merge base of our inputs which has the + # breakwater merge base as an ancestor. + + my @ibs = + grep /./, + split /\n/, + cmdoutput @ibcmd; + + @ibs or confess 'internal error, expected anchor at least ?'; + + my $ib; + my $ibleaf; + foreach my $tibix (0..$#ibs) { + my $tib = $ibs[$tibix]; + my $ff = is_fast_fwd $bwb, $tib; + my $ok = !$ff ? 'rej' : $ib ? 'extra' : 'ok'; + my $tibleaf = "interchange-mbcand-$ok-$tibix"; + $mwrecknote->($tibleaf, $tib); + next unless $ff; + next if $ib; + $ib = $tib; + $ibleaf = $tibleaf; + } + + $ib or $nomerge->("no suitable interchange merge base"); + + $prline->(" VanillaMerge Base"); + $prprdelim->(); + my ($btip, $bbw, $banchor) = eval { + walk $ib, 0, $report, $report_lprefix.' '; + }; + $nomerge->("walking interchange branch merge base ($ibleaf):\n". + $@) + if length $@; + + $mwrecknote->("mergebase-laundered", $btip); + $mwrecknote->("mergebase-breakwater", $bbw); + $mwrecknote->("mergebase-anchor", $banchor); + + my $ibinfo = { SeriesTip => $btip, + SeriesBase => $bbw, + Anchor => $banchor, + LeftRight => 'mergebase' }; + + $bbw eq $bwb + or $nomerge->("interchange merge-base ($ib)'s". + " breakwater ($bbw)". + " != breakwaters' merge-base ($bwb)"); + + grep { $_->{Anchor} eq $ibinfo->{Anchor} } @$ps + or $nomerge->("interchange merge-base ($ib)'s". + " anchor ($ibinfo->{SeriesBase})". + " != any merge input's anchor (". + (join ' ', map { $_->{Anchor} } @$ps). + ")"); + + $cl->{MergeInterchangeBaseInfo} = $ibinfo; + $cl->{MergeBestAnchor} = $best_anchor; + push @brw_cl, { + %$cl, + SpecialMethod => 'MergeCreateMergedBreakwaters', + $xmsg->('constructed from vanilla merge', + ' merged-breakwater'), + }; + push @upp_cl, { + %$cl, + SpecialMethod => 'MergeMergeSeries', + }; + $build_start->('MergeBreakwaters', $cur); } else { printdebug "*** WALK BOMB unrecognised\n"; return $bomb->(); @@ -850,17 +1501,6 @@ sub walk ($;$$) { my $rewriting = 0; - my $read_tree_debian = sub { - my ($treeish) = @_; - read_tree_subdir 'debian', "$treeish:debian"; - rm_subdir_cached 'debian/patches'; - }; - my $read_tree_upstream = sub { - my ($treeish) = @_; - runcmd @git, qw(read-tree), $treeish; - $read_tree_debian->($build); - }; - $#upp_cl = $upp_limit if defined $upp_limit; my $committer_authline = calculate_committer_authline(); @@ -872,7 +1512,12 @@ sub walk ($;$$) { in_workarea sub { mkdir $rd or $!==EEXIST or die $!; my $current_method; - runcmd @git, qw(read-tree), $build; + my $want_debian = $build; + my $want_upstream = $build; + + my $read_tree_upstream = sub { ($want_upstream) = @_; }; + my $read_tree_debian = sub { ($want_debian) = @_; }; + foreach my $cl (qw(Debian), (reverse @brw_cl), { SpecialMethod => 'RecordBreakwaterTip' }, qw(Upstream), (reverse @upp_cl)) { @@ -903,6 +1548,53 @@ sub walk ($;$$) { next unless $differs & D_UPS; $read_tree_upstream->($cltree); push @parents, map { $_->{CommitId} } @{ $cl->{OrigParents} }; + } elsif ($method eq 'MergeCreateMergedBreakwaters') { + print "Found a general merge, will try to tidy it up.\n"; + $rewriting = 1; + $read_tree_upstream->($cl->{MergeBestAnchor}); + $read_tree_debian->($cltree); + @parents = map { $_->{Breakwater} } @{ $cl->{Parents} }; + } elsif ($method eq 'MergeMergeSeries') { + my $cachehit = reflog_cache_lookup + $merge_cache_ref, "vanilla-merge $cl->{CommitId}"; + if ($cachehit) { + print "Using supplied resolution for $cl->{CommitId}...\n"; + $build = $cachehit; + $mwrecknote->('cached-resolution', $build); + } else { + print "Running merge resolution for $cl->{CommitId}...\n"; + $mwrecknote->('new-base', $build); + $build = merge_series + $build, $cl->{MergeWreckNotes}, + $cl->{MergeInterchangeBaseInfo}, + @{ $cl->{Parents} }; + } + $last_anchor = $cl->{MergeBestAnchor}; + + # Check for mismerges: + my $check = sub { + my ($against, $allow, $what) = @_; + my $differs = get_differs $build, $against; + $nomerge->(sprintf + "merge misresolved: %s are not the same (%s %s d.%#x)", + $what, $against, $build, $differs) + if $differs & ~($allow | D_PAT_ADD); + }; + + # Breakwater changes which were in each side of the + # merge will have been incorporated into the + # MergeCreateMergedBreakwaters output. Because the + # upstream series was rebased onto the new breakwater, + # so should all of the packaging changes which were in + # the input. + $check->($input, D_UPS, 'debian files'); + + # Upstream files are merge_series, which ought to + # have been identical to the original merge. + $check->($cl->{CommitId}, DS_DEB, 'upstream files'); + + print "Merge resolution successful.\n"; + next; } else { confess "$method ?"; } @@ -913,27 +1605,46 @@ sub walk ($;$$) { printdebug "WALK REWRITING NOW cl=$cl procd=$procd\n"; } } - my $newtree = cmdoutput @git, qw(write-tree); - my $ch = $cl->{Hdr}; - $ch =~ s{^tree .*}{tree $newtree}m or confess "$ch ?"; - $ch =~ s{^parent .*\n}{}mg; - $ch =~ s{(?=^author)}{ - join '', map { "parent $_\n" } @parents - }me or confess "$ch ?"; - if ($rewriting) { - $ch =~ s{^committer .*$}{$committer_authline}m - or confess "$ch ?"; + if ($rewriting || $opt_careful) { + read_tree_upstream $want_upstream, 0, $want_debian; + + my $newtree = cmdoutput @git, qw(write-tree); + my $ch = $cl->{Hdr}; + $ch =~ s{^tree .*}{tree $newtree}m or confess "$ch ?"; + $ch =~ s{^parent .*\n}{}mg; + $ch =~ s{(?=^author)}{ + join '', map { "parent $_\n" } @parents + }me or confess "$ch ?"; + if ($rewriting) { + $ch =~ s{^committer .*$}{$committer_authline}m + or confess "$ch ?"; + } + my $cf = "$rd/m$rewriting"; + open CD, ">", $cf or die $!; + print CD $ch, "\n", $cl->{Msg} or die $!; + close CD or die $!; + my @cmd = (@git, qw(hash-object)); + push @cmd, qw(-w) if $rewriting; + push @cmd, qw(-t commit), $cf; + my $newcommit = cmdoutput @cmd; + confess "$ch ?" unless $rewriting + or $newcommit eq $cl->{CommitId}; + $build = $newcommit; + } else { + $build = $cl->{CommitId}; + trees_diff_walk "$want_upstream:", "$build:", sub { + my ($n) = @_; + no warnings qw(exiting); + next if $n eq 'debian/'; + confess "mismatch @_ ?"; + }; + trees_diff_walk "$want_debian:debian", "$build:debian", sub { + confess "mismatch @_ ?"; + }; + my @old_parents = map { $_->{CommitId} } @{ $cl->{Parents} }; + confess "mismatch @parents != @old_parents ?" + unless "@parents" eq "@old_parents"; } - my $cf = "$rd/m$rewriting"; - open CD, ">", $cf or die $!; - print CD $ch, "\n", $cl->{Msg} or die $!; - close CD or die $!; - my @cmd = (@git, qw(hash-object)); - push @cmd, qw(-w) if $rewriting; - push @cmd, qw(-t commit), $cf; - my $newcommit = cmdoutput @cmd; - confess "$ch ?" unless $rewriting or $newcommit eq $cl->{CommitId}; - $build = $newcommit; if (grep { $method eq $_ } qw(DgitImportUpstreamUpdate)) { $last_anchor = $cur; } @@ -941,7 +1652,7 @@ sub walk ($;$$) { }; my $final_check = get_differs $build, $input; - die sprintf "internal error %#x %s %s", $final_check, $build, $input + die sprintf "internal error %#x %s %s", $final_check, $input, $build if $final_check & ~D_PAT_ADD; my @r = ($build, $breakwater, $last_anchor); @@ -968,13 +1679,25 @@ sub update_head_checkout ($$$) { sub update_head_postlaunder ($$$) { my ($old, $tip, $reflogmsg) = @_; - return if $tip eq $old; + return if $tip eq $old && !@deferred_updates; print "git-debrebase: laundered (head was $old)\n"; update_head $old, $tip, $reflogmsg; # no tree changes except debian/patches runcmd @git, qw(rm --quiet --ignore-unmatch -rf debian/patches); } +sub currently_rebasing() { + foreach (qw(rebase-merge rebase-apply)) { + return 1 if stat_exists "$maindir_gitdir/$_"; + } + return 0; +} + +sub bail_if_rebasing() { + fail "you are in the middle of a git-rebase already" + if currently_rebasing(); +} + sub do_launder_head ($) { my ($reflogmsg) = @_; my $old = get_head(); @@ -1114,6 +1837,7 @@ sub record_ffq_prev_deferred () { # if "deferred", will have added something about that to # @deferred_update_messages, and also maybe printed (already) # some messages about ff checks + bail_if_rebasing(); my $currentval = get_head(); my ($status,$message, $ffq_prev,$gdrlast) = ffq_check $currentval; @@ -1123,7 +1847,7 @@ sub record_ffq_prev_deferred () { push @deferred_updates, "update $ffq_prev $currentval $git_null_obj"; push @deferred_updates, "delete $gdrlast"; - push @deferred_update_messages, "Recorded current head for preservation"; + push @deferred_update_messages, "Recorded previous head for preservation"; return ('deferred', undef); } @@ -1137,6 +1861,7 @@ sub record_ffq_auto () { } sub ffq_prev_info () { + bail_if_rebasing(); # => ($ffq_prev, $gdrlast, $ffq_prev_commitish) my ($status, $message, $current, $ffq_prev, $gdrlast) = ffq_prev_branchinfo(); @@ -1547,6 +2272,7 @@ sub cmd_status () { print " not git-debrebase (diverged since last stitch)\n" } } + print "you are currently rebasing\n" if currently_rebasing(); } sub cmd_stitch () { @@ -1556,7 +2282,10 @@ sub cmd_stitch () { badusage "no arguments allowed" if @ARGV; do_stitch $prose, 0; } -sub cmd_prepush () { cmd_stitch(); } +sub cmd_prepush () { + $opt_noop_ok = 1; + cmd_stitch(); +} sub cmd_quick () { badusage "no arguments allowed" if @ARGV; @@ -1577,6 +2306,37 @@ sub cmd_conclude () { do_stitch 'quick'; } +sub cmd_scrap () { + if (currently_rebasing()) { + runcmd @git, qw(rebase --abort); + push @deferred_updates, 'verify HEAD HEAD'; + # noop, but stops us complaining that scrap was a noop + } + badusage "no arguments allowed" if @ARGV; + my ($ffq_prev, $gdrlast, $ffq_prev_commitish) = ffq_prev_info(); + my $scrapping_head; + if ($ffq_prev_commitish) { + $scrapping_head = get_head(); + push @deferred_updates, + "update $gdrlast $ffq_prev_commitish $git_null_obj", + "update $ffq_prev $git_null_obj $ffq_prev_commitish"; + } + if (git_get_ref $merge_cache_ref) { + push @deferred_updates, + "delete $merge_cache_ref"; + } + if (!@deferred_updates) { + fail "No ongoing git-debrebase session." unless $opt_noop_ok; + finish 0; + } + snags_maybe_bail(); + if ($scrapping_head) { + update_head_checkout $scrapping_head, $ffq_prev_commitish, "scrap"; + } else { + run_deferred_updates "scrap"; + } +} + sub make_patches_staged ($) { my ($head) = @_; # Produces the patches that would result from $head if it were @@ -1584,15 +2344,7 @@ sub make_patches_staged ($) { 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); + gbp_pq_export 'bw', $secret_bw, $secret_head; }; } @@ -1618,6 +2370,7 @@ sub cmd_make_patches () { getoptions("make-patches", 'quiet-would-amend!', \$opt_quiet_would_amend); badusage "no arguments allowed" if @ARGV; + bail_if_rebasing(); my $old_head = get_head(); my $new = make_patches $old_head; my $d = get_differs $old_head, $new; @@ -1637,6 +2390,24 @@ sub cmd_make_patches () { } } +sub check_series_has_all_patches ($) { + my ($head) = @_; + my $seriesfn = 'debian/patches/series'; + my ($dummy, $series) = git_cat_file "$head:$seriesfn", + [qw(blob missing)]; + $series //= ''; + my %series; + foreach my $f (grep /\S/, grep {!m/^\s\#/} split /\n/, $series) { + fail "patch $f repeated in $seriesfn !" if $series{$f}++; + } + foreach my $patchfile (get_tree "$head:debian/patches", 1,1) { + my ($f,$i) = @$patchfile; + next if $series{$f}; + next if $f eq 'series'; + snag 'unused-patches', "Unused patch file $f will be discarded"; + } +} + sub cmd_convert_from_gbp () { badusage "want only 1 optional argument, the upstream git commitish" unless @ARGV<=1; @@ -1684,6 +2455,8 @@ END "upstream ($upstream) contains debian/ directory"; } + check_series_has_all_patches $old_head; + my $previous_dgit_view = eval { my @clogcmd = qw(dpkg-parsechangelog --format rfc822 -n2); my ($lvsn, $suite); @@ -1834,6 +2607,8 @@ END } } + check_series_has_all_patches $head; + snags_maybe_bail_early(); my $version = upstreamversion $clogp->{Version}; @@ -1976,6 +2751,46 @@ END 'convert-from-dgit-view'; } +sub cmd_record_resolved_merge () { + badusage "record-resolved-merge takes no further arguments" if @ARGV; + # xxx needs documentation + my $new = get_head(); + my $method; + + print "Checking how you have resolved the merge problem\n"; + my $nope = sub { print "Not $method: @_"; 0; }; + + my $maybe = sub { print "Seems to be $method.\n"; }; + my $yes = sub { + my ($key, $ref) = @_; + reflog_cache_insert $merge_cache_ref, $key, $ref; + print "OK. You can switch branches and try git-debrebase again.\n"; + 1; + }; + + fresh_workarea 'merge'; + sub { + $method = 'vanilla-merge patchqueue'; + my $vanilla = git_get_ref "$wrecknoteprefix/vanilla-merge"; + $vanilla or return $nope->("wreckage was not of vanilla-merge"); + foreach my $lr (qw(left right)) { + my $n = "$wrecknoteprefix/$lr-patchqueue"; + my $lrpq = git_get_ref $n; + $lrpq or return $nope->("wreckage did not contain patchqueues"); + is_fast_fwd $lrpq, $new or return $nope->("HEAD not ff of $n"); + } + $maybe->(); + my $newbase = git_get_ref "$wrecknoteprefix/new-base" + or die "wreckage element $wrecknoteprefix/new-base missing"; + my $result = merge_series_patchqueue_convert + {}, $newbase, $new; + $yes->("vanilla-merge $vanilla", $result); + 1; + }->() or sub { + fail "No resolved merge method seems applicable.\n"; + }->(); +} + sub cmd_downstream_rebase_launder_v0 () { badusage "needs 1 argument, the baseline" unless @ARGV==1; my ($base) = @ARGV;