X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=git-debrebase;h=f56ec32e12a9833a15c69c53120d0f3708fc6011;hp=494452961245577de4454e9984f4d0473bd0fadc;hb=91c2126e5ab7bea38708933c9281c12c814bb200;hpb=ec2180ffff14c6e14703a70b4e68861312607f10 diff --git a/git-debrebase b/git-debrebase index 49445296..f56ec32e 100755 --- a/git-debrebase +++ b/git-debrebase @@ -36,6 +36,18 @@ use Dpkg::Version; use File::FnMatch qw(:fnmatch); use File::Copy; +our ($usage_message) = <<'END'; +usages: + git-debrebase [] [--|-i ] + git-debrebase [] status + git-debrebase [] prepush [--prose=...] + git-debrebase [] quick|conclude + git-debrebase [] new-upstream [
] + git-debrebase [] convert-from-gbp [] + ... +See git-debrebase(1), git-debrebase(5), dgit-maint-debrebase(7) (in dgit). +END + our ($opt_force, $opt_noop_ok, @opt_anchors); our ($opt_defaultcmd_interactive); @@ -45,10 +57,20 @@ $|=1; sub badusage ($) { my ($m) = @_; - print STDERR "bad usage: $m\n"; + print STDERR "$us: bad usage: $m\n"; finish 8; } +sub getoptions_main { + my $m = shift; + local $SIG{__WARN__}; # GetOptions calls `warn' to print messages + GetOptions @_ or badusage $m; +} +sub getoptions { + my $sc = shift; + getoptions_main "bad options follow \`git-debrebase $sc'", @_; +} + sub cfg ($;$) { my ($k, $optional) = @_; local $/ = "\0"; @@ -92,6 +114,7 @@ our $rd; our $workarea; our @git = qw(git); +our @dgit = qw(dgit); sub in_workarea ($) { my ($sub) = @_; @@ -287,6 +310,22 @@ 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. + 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); +} + # classify returns an info hash like this # CommitId => $objid # Hdr => # commit headers, including 1 final newline @@ -573,6 +612,7 @@ sub keycommits ($;$$$$) { my ($anchor, $breakwater); my $clogonly; my $cl; + my $found_pm; $fatal //= sub { fail $_[1]; }; my $x = sub { my ($cb, $tagsfx, $mainwhy, $xwhy) = @_; @@ -612,12 +652,20 @@ sub keycommits ($;$$$$) { $breakwater = undef; } elsif ($ty eq 'Pseudomerge' or $ty eq 'AddPatches') { + my $found_pm = 1; $x->($furniture, (lc $ty), "found interchange bureaucracy commit ($ty)"," ($head)"); } elsif ($ty eq 'DgitImportUnpatched') { - $x->($trouble, 'dgitimport', - "found dgit dsc import ($head)"); - return (undef,undef); + if ($found_pm) { + $x->($trouble, 'dgitimport', + "found dgit dsc import"," ($head)"); + return (undef,undef); + } else { + $x->($fatal, 'unprocessable', + "found bare dgit dsc import with no prior history", + " ($head)"); + return (undef,undef); + } } else { $x->($fatal, 'unprocessable', "found unprocessable commit, cannot cope: $cl->{Why}", @@ -629,14 +677,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: @@ -668,7 +717,7 @@ sub walk ($;$$) { my $prline = sub { return unless $report; - print $report $prdelim, @_; + print $report $prdelim, $report_lprefix, @_; $prdelim = "\n"; }; @@ -679,8 +728,8 @@ sub walk ($;$$) { if ($nogenerate) { return (undef,undef); } - fail "found unprocessable commit, cannot cope:". - (defined $cl->{Why} ? "; $cl->{Why}": ''). + fail "found unprocessable commit, cannot cope". + (defined $cl->{Why} ? "; $cl->{Why}:": ':'). " (commit $cur) (d.". (join ' ', map { sprintf "%#x", $_->{Differs} } @{ $cl->{Parents} }). @@ -792,13 +841,12 @@ sub walk ($;$$) { next; } else { # 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; - # 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); + # is already nearly in valid breakwater format, with the + # patches as commits. Unfortunately it contains + # debian/patches/. + printdebug "*** WALK BOMB bare dgit import\n"; + $cl->{Why} = "bare dgit dsc import"; + return $bomb->(); } die "$ty ?"; } else { @@ -944,6 +992,18 @@ sub update_head_postlaunder ($$$) { 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(); @@ -1083,6 +1143,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; @@ -1106,6 +1167,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(); @@ -1162,6 +1224,34 @@ sub do_stitch ($;$) { stitch($dangling_head, $ffq_prev, $gdrlast, $ffq_prev_commitish, $prose); } +sub upstream_commitish_search ($$) { + my ($upstream_version, $tried) = @_; + # todo: at some point maybe use git-deborig to do this + foreach my $tagpfx ('', 'v', 'upstream/') { + my $tag = $tagpfx.(dep14_version_mangle $upstream_version); + my $new_upstream = git_get_ref "refs/tags/$tag"; + push @$tried, $tag; + return $new_upstream if length $new_upstream; + } +} + +sub resolve_upstream_version ($$) { + my ($new_upstream, $upstream_version) = @_; + + if (!defined $new_upstream) { + my @tried; + $new_upstream = upstream_commitish_search $upstream_version, \@tried; + 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; + + return $new_upstream; +} + sub cmd_new_upstream () { # automatically and unconditionally launders before rebasing # if rebase --abort is used, laundering has still been done @@ -1177,26 +1267,11 @@ sub cmd_new_upstream () { if ($new_version->is_native()) { $new_version = (new Dpkg::Version "$spec_version-1", check => 1); } - my $new_upstream_version = "$new_version"; - $new_upstream_version =~ s/-.*?$//;; 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; + my $new_upstream_version = upstreamversion $new_version; + $new_upstream = + resolve_upstream_version $new_upstream, $new_upstream_version; record_ffq_auto(); @@ -1503,11 +1578,13 @@ sub cmd_status () { print " not git-debrebase (diverged since last stitch)\n" } } + print "you are currently rebasing\n" if currently_rebasing(); } sub cmd_stitch () { my $prose = 'stitch'; - GetOptions('prose=s', \$prose) or badusage("bad options to stitch"); + getoptions("stitch", + 'prose=s', \$prose); badusage "no arguments allowed" if @ARGV; do_stitch $prose, 0; } @@ -1532,6 +1609,24 @@ sub cmd_conclude () { do_stitch 'quick'; } +sub cmd_scrap () { + if (currently_rebasing()) { + runcmd @git, qw(rebase --abort); + } + my ($ffq_prev, $gdrlast, $ffq_prev_commitish) = ffq_prev_info(); + if (!$ffq_prev_commitish) { + fail "No ongoing git-debrebase session." unless $opt_noop_ok; + finish 0; + } + my $scrapping_head = get_head(); + badusage "no arguments allowed" if @ARGV; + push @deferred_updates, + "update $gdrlast $ffq_prev_commitish $git_null_obj", + "update $ffq_prev $git_null_obj $ffq_prev_commitish"; + snags_maybe_bail(); + update_head_checkout $scrapping_head, $ffq_prev_commitish, "scrap"; +} + sub make_patches_staged ($) { my ($head) = @_; # Produces the patches that would result from $head if it were @@ -1539,15 +1634,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; }; } @@ -1570,9 +1657,10 @@ sub make_patches ($) { sub cmd_make_patches () { my $opt_quiet_would_amend; - GetOptions('quiet-would-amend!', \$opt_quiet_would_amend) - or badusage("bad options to 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; @@ -1593,19 +1681,31 @@ sub cmd_make_patches () { } sub cmd_convert_from_gbp () { - badusage "needs 1 optional argument, the upstream git rev" + badusage "want only 1 optional argument, the upstream git commitish" unless @ARGV<=1; + + my $clogp = parsechangelog(); + my $version = $clogp->{'Version'} + // die "missing Version from changelog"; + my ($upstream_spec) = @ARGV; - $upstream_spec //= 'refs/heads/upstream'; - my $upstream = git_rev_parse $upstream_spec; + + my $upstream_version = upstreamversion $version; + my $upstream = + resolve_upstream_version($upstream_spec, $upstream_version); + my $old_head = get_head(); my $upsdiff = get_differs $upstream, $old_head; if ($upsdiff & D_UPS) { - runcmd @git, qw(--no-pager diff), + runcmd @git, qw(--no-pager diff --stat), $upstream, $old_head, qw( -- :!/debian :/); - fail "upstream ($upstream_spec) and HEAD are not identical in upstream files"; + fail <1; + + my @upstreams; + + if (@ARGV) { + my $spec = shift @ARGV; + my $commit = git_rev_parse "$spec^{commit}"; + push @upstreams, { Commit => $commit, + Source => "$ARGV[0], from command line", + Only => 1, + }; + } + + my $head = get_head(); + + if (!$always) { + my $troubles = 0; + my $trouble = sub { $troubles++; }; + keycommits $head, sub{}, sub{}, $trouble, $trouble; + printdebug "troubles=$troubles\n"; + if (!$troubles) { + print STDERR <{Version}; + print STDERR "Considering possible commits corresponding to upstream:\n"; + + if (!@upstreams) { + if ($do_tags) { + my @tried; + my $ups_tag = upstream_commitish_search $version, \@tried; + if ($ups_tag) { + my $this = "git tag $tried[-1]"; + push @upstreams, { Commit => $ups_tag, + Source => $this, + }; + } else { + printf STDERR + " git tag: no suitable tag found (tried %s)\n", + "@tried"; + } + } + if ($do_origs) { + my $p = $clogp->{'Source'}; + # we do a quick check to see if there are plausible origs + my $something=0; + if (!opendir BPD, $bpd) { + die "$bpd: opendir: $!" unless $!==ENOENT; + } else { + while ($!=0, my $f = readdir BPD) { + next unless is_orig_file_of_p_v $f, $p, $version; + printf STDERR + " orig: found what looks like a .orig, %s\n", + "$bpd/$f"; + $something=1; + last; + } + die "read $bpd: $!" if $!; + closedir BPD; + } + if ($something) { + my $tree = cmdoutput + @dgit, qw(--build-products-dir), $bpd, + qw(print-unapplied-treeish); + fresh_workarea(); + in_workarea sub { + runcmd @git, qw(reset --quiet), $tree, qw(-- .); + rm_subdir_cached 'debian'; + $tree = cmdoutput @git, qw(write-tree); + my $ups_synth = make_commit [], [ < $ups_synth, + Source => "orig(s) imported via dgit", + }; + } + } else { + printf STDERR + " orig: no suitable origs found (looked for %s in %s)\n", + "${p}_".(stripeoch $version)."...", $bpd; + } + } + } + + my $some_patches = stat_exists 'debian/patches/series'; + + print STDERR "Evaluating possible commits corresponding to upstream:\n"; + + my $result; + foreach my $u (@upstreams) { + my $work = $head; + fresh_workarea(); + in_workarea sub { + runcmd @git, qw(reset --quiet), $u->{Commit}, qw(-- .); + runcmd @git, qw(checkout), $u->{Commit}, qw(-- .); + runcmd @git, qw(clean -xdff); + runcmd @git, qw(checkout), $head, qw(-- debian); + if ($some_patches) { + rm_subdir_cached 'debian/patches'; + $work = make_commit [ $work ], [ + 'git-debrebase convert-from-dgit-view: drop upstream changes from breakwater', + "Drop upstream changes, and delete debian/patches, as part of converting\n". + "to git-debrebase format. Upstream changes will appear as commits.", + '[git-debrebase convert-from-dgit-view: drop patches from tree]' + ]; + } + $work = make_commit [ $work, $u->{Commit} ], [ + 'git-debrebase convert-from-dgit-view: declare upstream', + '(Re)constructed breakwater merge.', + '[git-debrebase anchor: declare upstream]' + ]; + runcmd @git, qw(checkout --quiet -b mk), $work; + if ($some_patches) { + runcmd @git, qw(checkout), $head, qw(-- debian/patches); + runcmd @git, qw(reset --quiet); + my @gbp_cmd = (qw(gbp pq import)); + if (!$diagnose) { + my $gbp_err = "../gbp-pq-err"; + @gbp_cmd = shell_cmd "exec >$gbp_err 2>&1", @gbp_cmd; + } + my $r = system @gbp_cmd; + if ($r) { + printf STDERR + " %s: couldn't apply patches: gbp pq %s", + $u->{Source}, waitstatusmsg(); + return; + } + } + my $work = git_rev_parse qw(HEAD); + my $diffout = cmdoutput @git, qw(diff-tree --stat HEAD), $work; + if (length $diffout) { + print STDERR + " $u->{Source}: applying patches gives different tree\n"; + print STDERR $diffout if $diagnose; + return; + } + # OMG! + $u->{Result} = $work; + $result = $u; + }; + last if $result; + } + + if (!$result) { + fail <{Source}; + + ffq_check $result->{Result}; + snags_maybe_bail(); + update_head_checkout $head, $result->{Result}, + 'convert-from-dgit-view'; +} + sub cmd_downstream_rebase_launder_v0 () { badusage "needs 1 argument, the baseline" unless @ARGV==1; my ($base) = @ARGV; @@ -1780,10 +2068,13 @@ sub cmd_downstream_rebase_launder_v0 () { } } -GetOptions("D+" => \$debuglevel, +getoptions_main + ("bad options\n", + "D+" => \$debuglevel, 'noop-ok', => \$opt_noop_ok, 'f=s' => \@snag_force_opts, 'anchor=s' => \@opt_anchors, + '--dgit=s' => \($dgit[0]), 'force!', '-i:s' => sub { my ($opt,$val) = @_; @@ -1796,7 +2087,10 @@ GetOptions("D+" => \$debuglevel, # approach. '-i=s{0,}' does not work with bundling. push @$opt_defaultcmd_interactive, @ARGV; @ARGV=(); - }) or badusage "bad options\n"; + }, + 'help' => sub { print $usage_message or die $!; finish 0; }, + ); + initdebug('git-debrebase '); enabledebug if $debuglevel;