X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=git-debrebase;h=a3733a989d62ee890af7a8c948fe54443c5846a5;hp=3048793a8d6b6b254d292dba277cec576fe13788;hb=78dfec329693691f0ff468e444d7ae19aec220d1;hpb=5e9409d925fe81f6c9c4eed767febf6b59738742 diff --git a/git-debrebase b/git-debrebase index 3048793a..a3733a98 100755 --- a/git-debrebase +++ b/git-debrebase @@ -106,9 +106,11 @@ use strict; use Memoize; use Carp; +use POSIX; use Data::Dumper; +use Getopt::Long qw(:config posix_default gnu_compat bundling); -use Debian::Dgit qw(:DEFAULT $wa); +use Debian::Dgit qw(:DEFAULT :playground); sub badusage ($) { my ($m) = @_; @@ -129,9 +131,8 @@ memoize('cfg'); sub get_commit ($) { my ($objid) = @_; - my ($type,$data) = git_cat_file $objid; - die unless $type eq 'commit'; - $data =~ m/(?<=\n)\n/; + my $data = git_cat_file $objid, 'commit'; + $data =~ m/(?<=\n)\n/ or die "$objid ($data) ?"; return ($`,$'); } @@ -140,10 +141,94 @@ sub D_UPS () { return 0x2; } # upstream files sub D_PAT_ADD () { return 0x4; } # debian/patches/ extra patches at end sub D_PAT_OTH () { return 0x8; } # debian/patches other changes -our $rd = ".git/git-debrebase"; -our $ud = "$rd/work"; + +our $playprefix = 'debrebase'; +our $rd; +our $workarea; + our @git = qw(git); +sub in_workarea ($) { + my ($sub) = @_; + changedir $workarea; + my $r = eval { $sub->(); }; + changedir $maindir; +} + +sub fresh_workarea () { + $workarea = fresh_playground "$playprefix/work"; + in_workarea sub { playtree_setup }; +} + +sub get_differs ($$) { + my ($x,$y) = @_; + # This resembles 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/. + + my $differs = 0; + + 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->(); } + }; + + $rundiff->([qw(--name-only)], [], sub { + $differs |= $_ eq 'debian' ? D_DEB : D_UPS; + }); + + if ($differs & D_DEB) { + $differs &= ~D_DEB; + $rundiff->([qw(--name-only -r)], [qw(debian)], sub { + $differs |= $_ eq m{^debian/patches/} ? D_PAT_OTH : D_DEB; + }); + die "mysterious debian changes $x..$y" + unless $differs & (D_PAT_OTH|D_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; + } + 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 + } + $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; + + return $differs; +} + sub commit_pr_info ($) { my ($r) = @_; return Data::Dumper->dump([$r], [qw(commit)]); @@ -199,7 +284,7 @@ sub classify ($) { my ($h,$m) = get_commit $objid; my ($t) = $h =~ m/^tree (\w+)$/m or die $objid; - my (@ph) = $h =~ m/^parent (\w+)$/m; + my (@ph) = $h =~ m/^parent (\w+)$/mg; my @p; my $r = { @@ -218,14 +303,24 @@ sub classify ($) { }; } + printdebug "classify $objid \$t=$t \@p", + (map { sprintf " %s/%#x", $_->{CommitId}, $_->{Differs} } @p), + "\n"; + my $classify = sub { my ($type, @rest) = @_; $r = { %$r, Type => $type, @rest }; + if ($debuglevel) { + my $dd = new Data::Dumper [ $r ]; + Terse $dd 1; Indent $dd 0; Useqq $dd 1; + printdebug " = $type ".(Dump $dd)."\n"; + } return $r; }; my $unknown = sub { my ($why) = @_; $r = { %$r, Type => qw(Unknown) }; + printdebug " ** Unknown\n"; return $r; }; @@ -236,7 +331,14 @@ sub classify ($) { } elsif ($d & (D_PAT_ADD|D_PAT_OTH)) { return $unknown->("edits debian/patches"); } elsif ($d == D_DEB) { - return $classify->(qw(Packaging)); + my ($ty,$dummy) = git_cat_file "$ph[0]:debian"; + if ($ty eq 'tree') { + return $classify->(qw(Packaging)); + } elsif ($ty eq 'missing') { + return $classify->(qw(BreakwaterStart)); + } else { + return $unknown->("parent's debian is not a directory"); + } } elsif ($d == D_UPS) { return $classify->(qw(Upstream)); } elsif ($d == (D_DEB|D_UPS)) { @@ -271,7 +373,7 @@ sub classify ($) { Contributor => $bytime[1]); } foreach my $p (@p) { - my ($p_h, $p_m) = get_commit $p; + my ($p_h, $p_m) = get_commit $p->{CommitId}; $p->{IsOrigin} = $p_h !~ m/^parent \w+$/m; ($p->{IsDgitImport},) = $p_m =~ m/^\[dgit import ([0-9a-z]+) .*\]$/m; } @@ -288,39 +390,45 @@ sub classify ($) { my ($stype, $series) = git_cat_file "$t:debian/patches/series"; my $haspatches = $stype ne 'missing' && $series =~ m/^\s*[^#\n\t ]/m; +@p = reverse @p; #xxx + # How to decide about l/r ordering of breakwater merges ? git # --topo-order prefers to expand 2nd parent first. There's # already an easy rune to look for debian/ history anyway (git log # debian/) so debian breakwater branch should be 1st parent; that # way also there's also an easy rune to look for the upstream # patches (--topo-order). + + my $prevbrw = 0; + if (@p == 2 && !$haspatches && - !$p[0]{IsOrigin} && # breakwater merge never starts with an origin - !($p[0]{Differs} & ~D_DEB) && - !($p[1]{Differs} & ~D_UPS)) { + !$p[$prevbrw]{IsOrigin} && # breakwater never starts with an origin + !($p[$prevbrw]{Differs} & ~D_DEB) && + !($p[!$prevbrw]{Differs} & ~D_UPS)) { return $classify->(qw(BreakwaterUpstreamMerge), - OrigParents => [ $p[1] ]); + OrigParents => [ $p[!$prevbrw] ]); } # xxx multi-.orig upstreams return $unknown->("complex merge"); } -sub walk ($;$$$$); -sub walk { +sub walk ($;$$); +sub walk ($;$$) { my ($input, - $nogenerate,$report, - $wantdebonly,$depth) = @_; - # go through commits backwards - # we generate two lists of commits to apply + $nogenerate,$report) = @_; # => ($tip, $breakwater_tip) - my (@deb_cl, @ups_cl, @processed); + # (or nothing, if $nogenerate) + + # go through commits backwards + # we generate two lists of commits to apply: + # breakwater branch and upstream patches + my (@brw_cl, @upp_cl, @processed); my %found; + my $upp_limit; my @pseudomerges; - $depth //= 0; - my $cl; my $xmsg = sub { my ($appendinfo) = @_; @@ -330,52 +438,60 @@ sub walk { return (Msg => $ms); }; my $rewrite_from_here = sub { - push @processed, { SpecialMethod => 'StartRewrite' }; - }; - my $bomb = sub { # usage: return $bomb->(); - print $report " Unprocessable" if $report; - $prprdelim->(); - if ($nogenerate) { - return (undef,undef); - } - die "commit $cur: Cannot cope with this commit"; + my $sp_cl = { SpecialMethod => 'StartRewrite' }; + push @brw_cl, $sp_cl; + push @processed, $sp_cl; }; - my $cur = $input; - my $basis; my $prdelim = ""; my $prprdelim = sub { print $report $prdelim if $report; $prdelim=""; }; - for (;;) { - if (!defined $cur) { - if ($report) { - print $report $predelim, "Origin"; - $prdelim = "\n"; - } - $basis = undef; - last; + my $prline = sub { + return unless $report; + print $report $prdelim, @_; + $prdelim = "\n"; + }; + + my $bomb = sub { # usage: return $bomb->(); + print $report " Unprocessable" if $report; + $prprdelim->(); + if ($nogenerate) { + return (undef,undef); } + die "commit $cur: Cannot cope with this commit"; + }; + + my $build; + my $breakwater; + + my $build_start = sub { + my ($msg, $parent) = @_; + $prline->(" $msg"); + $build = $parent; + no warnings qw(exiting); last; + }; + + for (;;) { $cl = classify $cur; my $ty = $cl->{Type}; my $st = $cl->{SubType}; - if ($report) { - print $report $prdelim, "$cl->{CommitId} $cl->{Type}"; - $prdelim = "\n"; - } + $prline->("$cl->{CommitId} $cl->{Type}"); $found{$ty. ( defined($st) ? "-$st" : '' )}++; push @processed, $cl; - my $p0 = @[ $cl->{Parents} }==1 ? $cl->{Parents}[0]{CommitId} : undef; + my $p0 = @{ $cl->{Parents} }==1 ? $cl->{Parents}[0]{CommitId} : undef; if ($ty eq 'AddPatches') { $cur = $p0; $rewrite_from_here->(); next; } elsif ($ty eq 'Packaging') { - push @deb_cl, $cl; + push @brw_cl, $cl; $cur = $p0; next; + } elsif ($ty eq 'BreakwaterStart') { + $build_start->('FirstPackaging', $cur); } elsif ($ty eq 'Upstream') { - push @ups_cl, $cl; + push @upp_cl, $cl; $cur = $p0; next; } elsif ($ty eq 'Mixed') { @@ -384,97 +500,101 @@ sub walk { my $cls = { $cl, $xmsg->("split mixed commit: $wh part") }; push @$q, $cls; }; - $queue->(\@deb_cl, "debian"); - $queue->(\@ups_cl, "upstream"); + $queue->(\@brw_cl, "debian"); + $queue->(\@upp_cl, "upstream"); $rewrite_from_here->(); + $cur = $p0; next; } elsif ($ty eq 'Pseudomerge') { - print $report " Contributor=$ty->{Contributor}" if $report; + my $contrib = $cl->{Contributor}{CommitId}; + print $report " Contributor=$contrib" if $report; push @pseudomerges, $cl; $rewrite_from_here->(); - $cur = $ty->{Contributor}; + $cur = $contrib; next; } elsif ($ty eq 'BreakwaterUpstreamMerge') { - $basis = $cur; - last; + $build_start->("PreviousBreakwater", $cur); } elsif ($ty eq 'DgitImportUnpatched') { - # This import has a tree which is just like a breakwater - # tree, but it has the wrong history. Its ought to have - # the previous breakwater (which dgit ought to have - # generated a pseudomerge to overwrite) as an ancestor. - # That will make the history of the debian/ files correct. - # As for the upstream version: either it's the same upstream - # as the previous breakwater, in which case that history is - # precisely right. Otherwise, it was a non-gitish upload - # of a new upstream version. We can tell these apart - # by looking at the tree of the supposed upstream. - my $differs = get_differs $previous_breakwater, $cl->{Tree}; - printf $report " Differs=%#x", $differs if $report; - if ($differs & D_UPS) { - printf $report " D_UPS" if $report; - # This will also trigger if a non-dgit git-based NMU - # deleted .gitignore (which is a thing that some of - # the existing git tools do if the user doesn't - # somehow tell them not to). Ah well. - push @deb_cl, { - %$cl, - SpecialMethod => 'DgitImportUpstreamUpdate', - $xmsg->("convert dgit import: debian changes") - }; - } - push @deb_cl, { - %$cl, - SpecialMethod => 'DgitImportDebianUpdate', - $xmsg->("convert dgit import: upstream changes") - }; my $pm = $pseudomerges[-1]; if (defined $pm) { - # To an extent, this is heurstic. Imports don't have + # To an extent, this is heuristic. Imports don't have # a useful history of the debian/ branch. We assume # that the first pseudomerge after an import has a - # useful history or debian/, and ignore the histories - # from later pseudomerge. Often the first pseudomerge + # useful history of debian/, and ignore the histories + # from later pseudomerges. Often the first pseudomerge # will be the dgit import of the upload to the actual # suite intended by the non-dgit NMUer, and later # pseudomerges may represent in-archive copies. - my $ovwr = $pm->{Overwritten}; - printf $report " PM=%s \@Ovewritten:%d", $pm, (scalar @$ovwr) + my $ovwrs = $pm->{Overwritten}; + printf $report " PM=%s \@Overwr:%d", $pm, (scalar @$ovwrs) if $report; - if (@$ovwr != 1) { + if (@$ovwrs != 1) { return $bomb->(); } - $basis = walk - $ovwr->[0]{CommitId}, - $nogenerate, $report, - 1, $depth+1; + my $ovwr = $ovwrs->[0]{CommitId}; + printf $report " Overwr=%s", $ovwr if $report; + # This import has a tree which is just like a + # breakwater tree, but it has the wrong history. It + # ought to have the previous breakwater (which the + # pseudomerge overwrote) as an ancestor. That will + # make the history of the debian/ files correct. As + # for the upstream version: either it's the same as + # was ovewritten (ie, same as the previous + # breakwater), in which case that history is precisely + # right; or, otherwise, it was a non-gitish upload of a + # new upstream version. We can tell these apart by + # looking at the tree of the supposed upstream. + push @brw_cl, { + %$cl, + SpecialMethod => 'DgitImportDebianUpdate', + $xmsg->("convert dgit import: debian changes") + }; + my $differs = (get_differs $ovwr, $cl->{Tree}); + printf $report " Differs=%#x", $differs if $report; + if ($differs & D_UPS) { + printf $report " D_UPS" if $report; + # This will also trigger if a non-dgit git-based NMU + # deleted .gitignore (which is a thing that some of + # the existing git tools do if the user doesn't + # somehow tell them not to). Ah well. + push @brw_cl, { + %$cl, + SpecialMethod => 'DgitImportUpstreamUpdate', + $xmsg->("convert dgit import: upstream changes") + }; + } + $prline->(" Import"); + $rewrite_from_here->(); + $upp_limit //= $#upp_cl; # further, deeper, patches discarded + $cur = $ovwr; + next; } else { - # Everything is from this import. + # Everything is from this import. This kind of import + # is already in valid breakwater format, with the + # patches as commits. printf $report " NoPM" if $report; - - xxx set basis to undef or something to mean make origin + # last thing we processed will have been the first patch, + # if there is one; which is fine, so no need to rewrite + # on account of this import + $build_start->("ImportOrigin", $cur); } - $rewrite_from_here->(); - last; + die "$ty ?"; } else { return $bomb->(); } } $prprdelim->(); - if ($nogenerate) { - return (undef, $basis); - } + return if $nogenerate; # Now we build it back up again - workarea_fresh(); + fresh_workarea(); my $rewriting = 0; - my $build = $basis; - my $rm_tree_cached = sub { my ($subdir) = @_; - runcmd @git, qw(rm --quiet -rf --cached), $subdir; + runcmd @git, qw(rm --quiet -rf --cached --ignore-unmatch), $subdir; }; my $read_tree_debian = sub { my ($treeish) = @_; @@ -492,9 +612,9 @@ sub walk { in_workarea sub { mkdir $rd or $!==EEXIST or die $!; my $current_method; - foreach my $cl (qw(Debian), (reverse @deb_cl), + foreach my $cl (qw(Debian), (reverse @brw_cl), { SpecialMethod => 'RecordBreakwaterTip' }, - qw(Upstream), (reverse @ups_cl)) { + qw(Upstream), (reverse @upp_cl)) { if (!ref $cl) { $current_method = $cl; next; @@ -510,7 +630,6 @@ sub walk { $rewriting = 1; next; } elsif ($method eq 'RecordBreakwaterTip') { - last if $wantdebonly; $breakwater = $build; next; } elsif ($method eq 'DgitImportDebianUpdate') { @@ -547,22 +666,20 @@ sub walk { } }; - runcmd @git, qw(diff-tree --quiet), - map { $wantdebonly ? "$_:debian" : $_ } - $input, $build; + runcmd @git, qw(diff-tree --quiet), $input, $build; return ($build, $breakwater); } sub get_head () { return git_rev_parse qw(HEAD); } -sub update_head ($$) { +sub update_head ($$$) { my ($old, $new, $mrest) = @_; runcmd @git, qw(update-ref -m), "git-debrebase $mrest", $new, $old; } sub cmd_launder () { - badusage "no arguments to launder allowed"; + badusage "no arguments to launder allowed" if @ARGV; my $old = get_head(); my ($tip,$breakwater) = walk $old; update_head $old, $tip, 'launder'; @@ -581,13 +698,18 @@ sub cmd_analyse () { $old = get_head(); } my ($dummy,$breakwater) = walk $old, 1,*STDOUT; - print "$breakwater BREAKWATER\n"; STDOUT->error and die $!; } -my $toplevel = runcmd @git, qw(rev-parse --show-toplevel); +GetOptions("D+" => \$debuglevel) or die badusage "bad options\n"; +initdebug('git-debrebase '); +enabledebug if $debuglevel; + +my $toplevel = cmdoutput @git, qw(rev-parse --show-toplevel); chdir $toplevel or die "chdir $toplevel: $!"; +$rd = fresh_playground "$playprefix/misc"; + my $cmd = shift @ARGV; my $cmdfn = $cmd; $cmdfn =~ y/-/_/;