X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=102864cf1a326bec0261158301f38e7b625986a0;hp=2c72213a56bd04ace2af90aaa6514ee164de5a9e;hb=3e228ac23b8b7351a7de2957de1f42fb894bb1f5;hpb=e17b7eb17ed4aa309c1a1b3757db1e0fc123df68 diff --git a/dgit b/dgit index 2c72213a..102864cf 100755 --- a/dgit +++ b/dgit @@ -34,12 +34,13 @@ use POSIX; use IPC::Open2; use Digest::SHA; use Digest::MD5; +use List::MoreUtils qw(pairwise); use Debian::Dgit; our $our_version = 'UNRELEASED'; ###substituted### -our @rpushprotovsn_support = qw(3 2); +our @rpushprotovsn_support = qw(3 2); # 4 is new tag format our $protovsn; our $isuite = 'unstable'; @@ -61,15 +62,22 @@ our $cleanmode; our $changes_since_version; our $rmchanges; our $quilt_mode; -our $quilt_modes_re = 'linear|smash|auto|nofix|nocheck'; +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)"); our $suite_re = '[-+.0-9a-z]+'; our $cleanmode_re = 'dpkg-source(?:-d)?|git|git-ff|check|none'; +our $git_authline_re = '^([^<>]+) \<(\S+)\> (\d+ [-+]\d+)$'; +our $splitbraincache = 'dgit-intern/quilt-cache'; + our (@git) = qw(git); our (@dget) = qw(dget); our (@curl) = qw(curl -f); @@ -83,6 +91,7 @@ our (@dpkgbuildpackage) = qw(dpkg-buildpackage -i\.git/ -I.git); our (@dpkgsource) = qw(dpkg-source -i\.git/ -I.git); our (@dpkggenchanges) = qw(dpkg-genchanges); our (@mergechanges) = qw(mergechanges -f); +our (@gbp) = qw(gbp); our (@changesopts) = (''); our %opts_opt_map = ('dget' => \@dget, # accept for compatibility @@ -97,6 +106,7 @@ our %opts_opt_map = ('dget' => \@dget, # accept for compatibility 'dpkg-source' => \@dpkgsource, 'dpkg-buildpackage' => \@dpkgbuildpackage, 'dpkg-genchanges' => \@dpkggenchanges, + 'gbp' => \@gbp, 'ch' => \@changesopts, 'mergechanges' => \@mergechanges); @@ -114,6 +124,7 @@ autoflush STDOUT 1; our $supplementary_message = ''; our $need_split_build_invocation = 0; +our $split_brain = 0; END { local ($@, $?); @@ -125,6 +136,11 @@ our @ourdscfield = qw(Dgit Vcs-Dgit-Master); our $csuite; our $instead_distro; +sub debiantag ($$) { + my ($v,$distro) = @_; + return $tagformatfn->($v, $distro); +} + sub lbranch () { return "$branchprefix/$csuite"; } my $lbranch_re = '^refs/heads/'.$branchprefix.'/([^/.]+)$'; sub lref () { return "refs/heads/".lbranch(); } @@ -195,6 +211,10 @@ sub deliberately_not_fast_forward () { } } +sub quiltmode_splitbrain () { + $quilt_mode =~ m/gbp|dpm|unapplied/; +} + #---------- remote protocol support, common ---------- # remote push initiator/responder protocol: @@ -202,6 +222,16 @@ sub deliberately_not_fast_forward () { # 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 @@ -216,6 +246,11 @@ sub deliberately_not_fast_forward () { # [etc] # # > param head HEAD +# > param csuite SUITE +# > param tagformat old|new +# +# > previously REFNAME=OBJNAME # if --deliberately-not-fast-forward +# # goes into tag, for replay prevention # # > want signed-tag # [indicates that signed tag is wanted] @@ -387,7 +422,7 @@ our ($dscdata,$dscurl,$dsc,$dsc_checked,$skew_warning_vsn); sub runcmd { debugcmd "+",@_; - $!=0; $?=0; + $!=0; $?=-1; failedcmd @_ if system @_; } @@ -471,10 +506,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', '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', @@ -522,7 +559,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"; @@ -1096,6 +1133,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) = 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 () { @@ -1149,7 +1228,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 @@ -1158,7 +1237,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'); @@ -1232,7 +1311,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 () { @@ -1248,7 +1327,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; @@ -1314,9 +1393,10 @@ sub clogp_authline ($) { $author =~ s#,.*##ms; my $date = cmdoutput qw(date), '+%s %z', qw(-d), getfield($clogp,'Date'); my $authline = "$author $date"; - $authline =~ m/^[^<>]+ \<\S+\> \d+ [-+]\d+$/ or + $authline =~ m/$git_authline_re/o or fail "unexpected commit author line format \`$authline'". " (was generated from changelog Maintainer field)"; + return ($1,$2,$3) if wantarray; return $authline; } @@ -1436,7 +1516,7 @@ END my $cversion = getfield $clogp, 'Version'; progress "synthesised git commit from .dsc $cversion"; if ($lastpush_hash) { - runcmd @git, qw(reset --hard), $lastpush_hash; + runcmd @git, qw(reset -q --hard), $lastpush_hash; runcmd qw(sh -ec), 'dpkg-parsechangelog >>../changelogold.tmp'; my $oldclogp = parsecontrol('../changelogold.tmp','previous changelog'); my $oversion = getfield $oldclogp, 'Version'; @@ -1529,14 +1609,14 @@ sub git_fetch_us () { runcmd_ordryrun_local @git, qw(fetch -p -n -q), access_giturl(), @specs; my %here; - my $tagpat = debiantag('*',access_basedistro); + my @tagpats = debiantags('*',access_basedistro); - git_for_each_ref("refs/tags/".$tagpat, sub { + git_for_each_ref([map { "refs/tags/$_" } @tagpats], sub { my ($objid,$objtype,$fullrefname,$reftail) = @_; printdebug "currently $fullrefname=$objid\n"; $here{$fullrefname} = $objid; }); - git_for_each_ref(lrfetchrefs."/tags/".$tagpat, sub { + git_for_each_ref([map { lrfetchrefs."/tags/".$_ } @tagpats], sub { my ($objid,$objtype,$fullrefname,$reftail) = @_; my $lref = "refs".substr($fullrefname, length lrfetchrefs); printdebug "offered $lref=$objid\n"; @@ -1770,9 +1850,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; @@ -1838,11 +1918,15 @@ sub get_source_format () { sub madformat ($) { my ($format) = @_; return 0 unless $format eq '3.0 (quilt)'; + our $quilt_mode_warned; if ($quilt_mode eq 'nocheck') { - progress "Not doing any fixup of \`$format' due to --no-quilt-fixup"; + progress "Not doing any fixup of \`$format' due to". + " ----no-quilt-fixup or --quilt=nocheck" + unless $quilt_mode_warned++; return 0; } - progress "Format \`$format', checking/updating patch stack"; + progress "Format \`$format', need to check/update patch stack" + unless $quilt_mode_warned++; return 1; } @@ -1859,7 +1943,7 @@ sub push_parse_changelog ($) { my $dscfn = dscfn($cversion); - return ($clogp, $cversion, $tag, $dscfn); + return ($clogp, $cversion, $dscfn); } sub push_parse_dsc ($$$) { @@ -1872,13 +1956,30 @@ 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, $tfbase) = @_; + my @tagwants; + push @tagwants, { + TagFn => \&debiantag, + Objid => $dgithead, + TfSuffix => '', + View => 'dgit', + }; + 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) = @_; + + die unless $tagwants->[0]{View} eq 'dgit'; - $dsc->{$ourdscfield[0]} = $head; + $dsc->{$ourdscfield[0]} = $tagwants->[0]{Objid}; $dsc->save("$dscfn.tmp") or die $!; my $changes = parsecontrol($changesfile,$changesfilewhat); @@ -1896,8 +1997,15 @@ 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 <('.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 ($) { @@ -1958,13 +2069,14 @@ END 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"; @@ -1978,10 +2090,35 @@ END my $format = getfield $dsc, 'Format'; printdebug "format $format\n"; + + 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"; @@ -1991,9 +2128,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) { @@ -2005,7 +2142,6 @@ END failedcmd @diffcmd; } } - my $head = git_rev_parse('HEAD'); if (!$changesfile) { my $pat = changespat $cversion; my @cs = glob "$buildproductsdir/$pat"; @@ -2019,8 +2155,9 @@ 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 (deliberately_not_fast_forward) { git_for_each_ref(lrfetchrefs, sub { @@ -2031,8 +2168,9 @@ END }); } - my $tfn = sub { ".git/dgit/tag$_[0]"; }; - my $tagobjfn; + my @tagwants = push_tagwants($cversion, $dgithead, + ".git/dgit/tag"); + my @tagobjfns; supplementary_message(<<'END'); Push failed, while signing the tag. @@ -2040,23 +2178,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. @@ -2065,9 +2209,14 @@ 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."HEAD:".rrref(); + foreach my $tw (@tagwants) { + 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. @@ -2283,7 +2432,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; } @@ -2292,6 +2441,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 { @@ -2350,6 +2506,7 @@ 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; + rpush_handle_protovsn_bothends(); for (;;) { my ($icmd,$iargs) = initiator_expect { m/^(\S+)(?: (.*))?$/; @@ -2421,13 +2578,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#; } @@ -2454,17 +2611,23 @@ sub i_want_signed_tag { my $head = $i_param{'head'}; die if $head =~ m/[^0-9a-f]/ || $head !~ m/^../; + 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, "tag"; - return $tagobjfn; + return + push_mktags $i_clogp, $i_dscfn, + $i_changesfn, 'remote changes', + \@tagwants; } sub i_want_signed_dsc_changes { @@ -2510,18 +2673,28 @@ END } } -sub quiltify_trees_differ ($$;$) { - my ($x,$y,$ignoregitignore) = @_; - # returns 1 iff the two tree objects differ other than in debian/ +sub quiltify_trees_differ ($$;$$) { + my ($x,$y,$finegrained,$ignorenamesr) = @_; + # returns true iff the two tree objects differ other than in debian/ + # with $finegrained, + # returns bitmask 01 - differ in upstream files except .gitignore + # 02 - differ in .gitignore + # if $ignorenamesr is defined, $ingorenamesr->{$fn} + # is set for each modified .gitignore filename $fn local $/=undef; - my @cmd = (@git, qw(diff-tree --name-only -z), $x, $y); + my @cmd = (@git, qw(diff-tree --name-only -z)); + push @cmd, qw(-r) if $finegrained; + push @cmd, $x, $y; my $diffs= cmdoutput @cmd; + my $r = 0; foreach my $f (split /\0/, $diffs) { - next if $f eq 'debian'; - next if $f eq '.gitignore' && $ignoregitignore; - return 1; + next if $f =~ m#^debian(?:/.*)?$#s; + my $isignore = $f =~ m#^(?:.*/)?.gitignore$#s; + $r |= $isignore ? 02 : 01; + $ignorenamesr->{$f}=1 if $ignorenamesr && $isignore; } - return 0; + printdebug "quiltify_trees_differ $x $y => $r\n"; + return $r; } sub quiltify_tree_sentinelfiles ($) { @@ -2533,15 +2706,98 @@ sub quiltify_tree_sentinelfiles ($) { return $r; } -sub quilt_could_gbp ($$$) { - my ($userhead,$unapplied,$applied) = @_; - return - !quiltify_trees_differ($userhead,$unapplied,1) && - quiltify_trees_differ($userhead,$applied,1); +sub quiltify_splitbrain_needed () { + if (!$split_brain) { + progress "dgit view: changes are required..."; + runcmd @git, qw(checkout -q -b dgit-view); + $split_brain = 1; + } +} + +sub quiltify_splitbrain ($$$$$$) { + my ($clogp, $unapplied, $headref, $diffbits, + $editedignores, $cachekey) = @_; + if ($quilt_mode !~ m/gbp|dpm/) { + # treat .gitignore just like any other upstream file + $diffbits = { %$diffbits }; + $_ = !!$_ foreach values %$diffbits; + } + # We would like any commits we generate to be reproducible + my @authline = clogp_authline($clogp); + local $ENV{GIT_COMMITTER_NAME} = $authline[0]; + local $ENV{GIT_COMMITTER_EMAIL} = $authline[1]; + local $ENV{GIT_COMMITTER_DATE} = $authline[2]; + + if ($quilt_mode =~ m/gbp|unapplied/ && + ($diffbits->{H2O} & 01)) { + my $msg = + "--quilt=$quilt_mode specified, implying patches-unapplied git tree\n". + " but git tree differs from orig in upstream files."; + if (!stat_exists "debian/patches") { + $msg .= + "\n ... debian/patches is missing; perhaps this is a patch queue branch?"; + } + fail $msg; + } + if ($quilt_mode =~ m/gbp|unapplied/ && + ($diffbits->{O2A} & 01)) { # some patches + quiltify_splitbrain_needed(); + progress "dgit view: creating patches-applied version using gbp pq"; + runcmd shell_cmd 'exec >/dev/null', @gbp, qw(pq import); + # gbp pq import creates a fresh branch; push back to dgit-view + runcmd @git, qw(update-ref refs/heads/dgit-view HEAD); + runcmd @git, qw(checkout -q dgit-view); + } + if (($diffbits->{H2O} & 02) && # user has modified .gitignore + !($diffbits->{O2A} & 02)) { # patches do not change .gitignore + quiltify_splitbrain_needed(); + progress "dgit view: creating patch to represent .gitignore changes"; + ensuredir "debian/patches"; + my $gipatch = "debian/patches/auto-gitignore"; + open GIPATCH, ">>", "$gipatch" or die "$gipatch: $!"; + stat GIPATCH or die "$gipatch: $!"; + fail "$gipatch already exists; but want to create it". + " to record .gitignore changes" if (stat _)[7]; + print GIPATCH <>$gipatch", @git, qw(diff), + $unapplied, $headref, "--", sort keys %$editedignores; + open SERIES, "+>>", "debian/patches/series" or die $!; + defined seek SERIES, -1, 2 or $!==EINVAL or die $!; + my $newline; + defined read SERIES, $newline, 1 or die $!; + print SERIES "\n" or die $! unless $newline eq "\n"; + print SERIES "auto-gitignore\n" or die $!; + close SERIES or die $!; + runcmd @git, qw(add -- debian/patches/series), $gipatch; + commit_admin "Commit patch to update .gitignore"; + } + + my $dgitview = git_rev_parse 'refs/heads/dgit-view'; + + changedir '../../../..'; + ensuredir ".git/logs/refs/dgit-intern"; + my $makelogfh = new IO::File ".git/logs/refs/$splitbraincache", '>>' + or die $!; + runcmd @git, qw(update-ref -m), $cachekey, "refs/$splitbraincache", + $dgitview; + + progress "dgit view: created (commit id $dgitview)"; + + changedir '.git/dgit/unpack/work'; } sub quiltify ($$$$) { - my ($clogp,$target,$unapplied,$oldtiptree) = @_; + my ($clogp,$target,$oldtiptree,$failsuggestion) = @_; # Quilt patchification algorithm # @@ -2679,12 +2935,7 @@ sub quiltify ($$$$) { foreach my $notp (@nots) { print STDERR "$us: ", $reportnot->($notp), "\n"; } - if (quilt_could_gbp($target,$unapplied,$oldtiptree)) { - print STDERR <' or die $!; + print $fakedsc <addfile($fh); + print $fakedsc " ".$md->hexdigest." $size $b\n" or die $!; + }; + + quilt_fixup_linkorigs($upstreamversion, $dscaddfile); + + my @files=qw(debian/source/format debian/rules + debian/control debian/changelog); + foreach my $maybe (qw(debian/patches debian/source/options + debian/tests/control)) { + next unless stat_exists "../../../$maybe"; + push @files, $maybe; + } + + my $debtar= srcfn $fakeversion,'.debian.tar.gz'; + runcmd qw(env GZIP=-1n tar -zcf), "./$debtar", qw(-C ../../..), @files; + + $dscaddfile->($debtar); + close $fakedsc or die $!; +} + +sub quilt_check_splitbrain_cache ($$) { + my ($headref, $upstreamversion) = @_; + # Called only if we are in (potentially) split brain mode. + # Called in $ud. + # Computes the cache key and looks in the cache. + # Returns ($dgit_view_commitid, $cachekey) or (undef, $cachekey) + + my $splitbrain_cachekey; + progress + "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); + push @cachekey, $upstreamversion; + push @cachekey, $quilt_mode; + push @cachekey, $headref; + + push @cachekey, hashfile('fake.dsc'); + + my $srcshash = Digest::SHA->new(256); + my %sfs = ( %INC, '$0(dgit)' => $0 ); + foreach my $sfk (sort keys %sfs) { + next unless m/^\$0\b/ || m{^Debian/Dgit\b}; + $srcshash->add($sfk," "); + $srcshash->add(hashfile($sfs{$sfk})); + $srcshash->add("\n"); + } + push @cachekey, $srcshash->hexdigest(); + $splitbrain_cachekey = "@cachekey"; + + my @cmd = (@git, qw(reflog), '--pretty=format:%H %gs', + $splitbraincache); + printdebug "splitbrain cachekey $splitbrain_cachekey\n"; + debugcmd "|(probably)",@cmd; + my $child = open GC, "-|"; defined $child or die $!; + if (!$child) { + chdir '../../..' or die $!; + if (!stat ".git/logs/refs/$splitbraincache") { + $! == ENOENT or die $!; + printdebug ">(no reflog)\n"; + exit 0; + } + exec @cmd; die $!; + } + while () { + chomp; + printdebug ">| ", $_, "\n" if $debuglevel > 1; + next unless m/^(\w+) (\S.*\S)$/ && $2 eq $splitbrain_cachekey; + + my $cachehit = $1; + quilt_fixup_mkwork($headref); + if ($cachehit ne $headref) { + progress "dgit view: found cached (commit id $cachehit)"; + runcmd @git, qw(checkout -q -b dgit-view), $cachehit; + $split_brain = 1; + return ($cachehit, $splitbrain_cachekey); + } + progress "dgit view: found cached, no changes required"; + return ($headref, $splitbrain_cachekey); + } + die $! if GC->error; + failedcmd unless close GC; + + printdebug "splitbrain cache miss\n"; + return (undef, $splitbrain_cachekey); } sub quilt_fixup_multipatch ($$$) { my ($clogp, $headref, $upstreamversion) = @_; - progress "starting quiltify (multiple patches, $quilt_mode mode)"; + progress "examining quilt state (multiple patches, $quilt_mode mode)"; # Our objective is: # - honour any existing .pc in case it has any strangeness @@ -2915,44 +3278,17 @@ sub quilt_fixup_multipatch ($$$) { # afterwards with dpkg-source --before-build. That lets us save a # tree object corresponding to .origs. - my $fakeversion="$upstreamversion-~~DGITFAKE"; + my $splitbrain_cachekey; - my $fakedsc=new IO::File 'fake.dsc', '>' or die $!; - print $fakedsc <addfile($fh); - print $fakedsc " ".$md->hexdigest." $size $b\n" or die $!; - }; - - quilt_fixup_linkorigs($upstreamversion, $dscaddfile); - - my @files=qw(debian/source/format debian/rules - debian/control debian/changelog); - foreach my $maybe (qw(debian/patches debian/source/options)) { - next unless stat_exists "../../../$maybe"; - push @files, $maybe; + if (quiltmode_splitbrain()) { + my $cachehit; + ($cachehit, $splitbrain_cachekey) = + quilt_check_splitbrain_cache($headref, $upstreamversion); + return if $cachehit; } - my $debtar= srcfn $fakeversion,'.debian.tar.gz'; - runcmd qw(env GZIP=-1 tar -zcf), "./$debtar", qw(-C ../../..), @files; - - $dscaddfile->($debtar); - close $fakedsc or die $!; - runcmd qw(sh -ec), 'exec dpkg-source --no-check --skip-patches -x fake.dsc >/dev/null'; @@ -2992,9 +3328,55 @@ END rmtree '.pc'; runcmd @git, qw(add -Af .); my $oldtiptree=git_write_tree(); + printdebug "fake o+d/p tree object $unapplied\n"; changedir '../work'; - quiltify($clogp,$headref,$unapplied,$oldtiptree); + + # We calculate some guesswork now about what kind of tree this might + # be. This is mostly for error reporting. + + my %editedignores; + my $diffbits = { + # H = user's HEAD + # O = orig, without patches applied + # A = "applied", ie orig with H's debian/patches applied + H2O => quiltify_trees_differ($headref, $unapplied, 1,\%editedignores), + H2A => quiltify_trees_differ($headref, $oldtiptree,1), + O2A => quiltify_trees_differ($unapplied,$oldtiptree,1), + }; + + my @dl; + foreach my $b (qw(01 02)) { + foreach my $v (qw(H2O O2A H2A)) { + push @dl, ($diffbits->{$v} & $b) ? '##' : '=='; + } + } + printdebug "differences \@dl @dl.\n"; + + progress sprintf +"$us: quilt differences: src: %s orig %s gitignores: %s orig %s\n". +"$us: quilt differences: HEAD %s o+d/p HEAD %s o+d/p", + $dl[0], $dl[1], $dl[3], $dl[4], + $dl[2], $dl[5]; + + my @failsuggestion; + if (!($diffbits->{H2O} & $diffbits->{O2A})) { + push @failsuggestion, "This might be a patches-unapplied branch."; + } elsif (!($diffbits->{H2A} & $diffbits->{O2A})) { + push @failsuggestion, "This might be a patches-applied branch."; + } + push @failsuggestion, "Maybe you need to specify one of". + " --quilt=gbp --quilt=dpm --quilt=unapplied ?"; + + if (quiltmode_splitbrain()) { + quiltify_splitbrain($clogp, $unapplied, $headref, + $diffbits, \%editedignores, + $splitbrain_cachekey); + return; + } + + progress "starting quiltify (multiple patches, $quilt_mode mode)"; + quiltify($clogp,$headref,$oldtiptree,\@failsuggestion); if (!open P, '>>', ".pc/applied-patches") { $!==&ENOENT or die $!; @@ -3028,15 +3410,44 @@ sub quilt_fixup_editor () { exit 0; } +sub maybe_apply_patches_dirtily () { + return unless $quilt_mode =~ m/gbp|unapplied/; + print STDERR <1; #print STDERR "MASS0 ",Dumper($cmd, $xargs, $need_split_build_invocation); if ($cleanmode eq 'dpkg-source' && !$need_split_build_invocation) { - $suppress_clean = 1; + $clean_using_builder = 1; return 0; } # -nc has the side effect of specifying -b if nothing else specified @@ -3157,11 +3569,13 @@ sub massage_dbp_args ($;$) { #print STDERR "MASS1 ",Dumper($cmd, $xargs, $dmode); my $r = 0; if ($need_split_build_invocation) { + printdebug "massage split $dmode.\n"; $r = $dmode =~ m/[S]/ ? +2 : $dmode =~ y/gGF/ABb/ ? +1 : $dmode =~ m/[ABb]/ ? 0 : die "$dmode ?"; } + printdebug "massage done $r $dmode.\n"; push @$cmd, $dmode; #print STDERR "MASS2 ",Dumper($cmd, $xargs, $r); return $r; @@ -3177,8 +3591,10 @@ sub cmd_build { } if ($wantsrc < 2) { push @dbp, changesopts_version(); + maybe_apply_patches_dirtily(); runcmd_ordryrun_local @dbp; } + maybe_unapply_patches_again(); printdone "build successful\n"; } @@ -3198,7 +3614,7 @@ sub cmd_gbp_build { if ($wantsrc > 0) { build_source(); } else { - if (!$suppress_clean) { + if (!$clean_using_builder) { push @cmd, '--git-cleaner=true'; } build_prep(); @@ -3209,16 +3625,27 @@ sub cmd_gbp_build { 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 sub build_source { - if ($cleanmode =~ m/^dpkg-source/) { - # dpkg-source will clean, so we shouldn't - $suppress_clean = 1; + my $our_cleanmode = $cleanmode; + if ($need_split_build_invocation) { + # Pretend that clean is being done some other way. This + # forces us not to try to use dpkg-buildpackage to clean and + # build source all in one go; and instead we run dpkg-source + # (and build_prep() will do the clean since $clean_using_builder + # is false). + $our_cleanmode = 'ELSEWHERE'; + } + if ($our_cleanmode =~ m/^dpkg-source/) { + # dpkg-source invocation (below) will clean, so build_prep shouldn't + $clean_using_builder = 1; } build_prep(); $sourcechanges = changespat $version,'source'; @@ -3227,18 +3654,38 @@ sub build_source { or fail "remove $sourcechanges: $!"; } $dscfn = dscfn($version); - if ($cleanmode eq 'dpkg-source') { + if ($our_cleanmode eq 'dpkg-source') { + maybe_apply_patches_dirtily(); runcmd_ordryrun_local @dpkgbuildpackage, qw(-us -uc -S), - changesopts(); - } elsif ($cleanmode eq 'dpkg-source-d') { + changesopts(); + } elsif ($our_cleanmode eq 'dpkg-source-d') { + maybe_apply_patches_dirtily(); runcmd_ordryrun_local @dpkgbuildpackage, qw(-us -uc -S -d), - changesopts(); + changesopts(); } else { - my $pwd = must_getcwd(); - my $leafdir = basename $pwd; - changedir ".."; - runcmd_ordryrun_local @dpkgsource, qw(-b --), $leafdir; - changedir $pwd; + my @cmd = (@dpkgsource, qw(-b --)); + if ($split_brain) { + changedir $ud; + runcmd_ordryrun_local @cmd, "work"; + my @udfiles = <${package}_*>; + changedir "../../.."; + foreach my $f (@udfiles) { + printdebug "source copy, found $f\n"; + next unless + $f eq $dscfn or + ($f =~ m/\.debian\.tar(?:\.\w+)$/ && + $f eq srcfn($version, $&)); + printdebug "source copy, found $f - renaming\n"; + rename "$ud/$f", "../$f" or $!==ENOENT + or fail "put in place new source file ($f): $!"; + } + } else { + my $pwd = must_getcwd(); + my $leafdir = basename $pwd; + changedir ".."; + runcmd_ordryrun_local @cmd, $leafdir; + changedir $pwd; + } runcmd_ordryrun_local qw(sh -ec), 'exec >$1; shift; exec "$@"','x', "../$sourcechanges", @@ -3249,6 +3696,7 @@ sub build_source { sub cmd_build_source { badusage "build-source takes no additional arguments" if @ARGV; build_source(); + maybe_unapply_patches_again(); printdone "source built, results in $dscfn and $sourcechanges"; } @@ -3291,6 +3739,7 @@ sub cmd_sbuild { rename "$cf", "$cf.inmulti" or fail "$cf\{,.inmulti}: $!"; } } + maybe_unapply_patches_again(); printdone "build successful, results in $multichanges\n" or die $!; } @@ -3457,6 +3906,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, $_; @@ -3579,6 +4033,8 @@ if (!defined $quilt_mode) { $quilt_mode = $1; } +$need_split_build_invocation ||= quiltmode_splitbrain(); + if (!defined $cleanmode) { local $access_forpush; $cleanmode = access_cfg('clean-mode', 'RETURN-UNDEF');