X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=d40a178a9cf78c42829265d746dd02d3d4ef19c7;hp=dbb0a062e57bd206432dd05bf57b03e73c6c9709;hb=1f80529a13489abd8606d95045d264733390903a;hpb=d8d9cfc47004f047540c6d0059ddd7005b380a27 diff --git a/dgit b/dgit index dbb0a062..d40a178a 100755 --- a/dgit +++ b/dgit @@ -59,29 +59,35 @@ our %previously; our $existing_package = 'dpkg'; 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 %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); our (@dput) = qw(dput); our (@debsign) = qw(debsign); our (@gpg) = qw(gpg); -our (@sbuild) = qw(sbuild -A); +our (@sbuild) = qw(sbuild); our (@ssh) = 'ssh'; our (@dgit) = qw(dgit); 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 @@ -96,6 +102,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); @@ -112,6 +119,8 @@ our $keyid; autoflush STDOUT 1; our $supplementary_message = ''; +our $need_split_build_invocation = 0; +our $split_brain = 0; END { local ($@, $?); @@ -147,6 +156,11 @@ sub dscfn ($) { return srcfn($vsn,".dsc"); } +sub changespat ($;$) { + my ($vsn, $arch) = @_; + return "${package}_".(stripepoch $vsn)."_".($arch//'*').".changes"; +} + our $us = 'dgit'; initdebug(''); @@ -155,7 +169,7 @@ END { local ($?); foreach my $f (@end) { eval { $f->(); }; - warn "$us: cleanup: $@" if length $@; + print STDERR "$us: cleanup: $@" if length $@; } }; @@ -188,6 +202,10 @@ sub deliberately_not_fast_forward () { } } +sub quiltmode_splitbrain () { + $quilt_mode =~ m/gbp|dpm|unapplied/; +} + #---------- remote protocol support, common ---------- # remote push initiator/responder protocol: @@ -380,7 +398,7 @@ our ($dscdata,$dscurl,$dsc,$dsc_checked,$skew_warning_vsn); sub runcmd { debugcmd "+",@_; - $!=0; $?=0; + $!=0; $?=-1; failedcmd @_ if system @_; } @@ -515,7 +533,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"; @@ -1142,7 +1160,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 @@ -1151,7 +1169,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'); @@ -1202,10 +1220,12 @@ our ($dsc_hash,$lastpush_hash); our $ud = '.git/dgit/unpack'; -sub prep_ud () { - rmtree($ud); +sub prep_ud (;$) { + my ($d) = @_; + $d //= $ud; + rmtree($d); mkpath '.git/dgit'; - mkdir $ud or die $!; + mkdir $d or die $!; } sub mktree_in_ud_here () { @@ -1223,7 +1243,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 () { @@ -1239,7 +1259,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; @@ -1305,9 +1325,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; } @@ -1427,7 +1448,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'; @@ -1706,7 +1727,7 @@ sub clone ($) { canonicalise_suite(); badusage "dry run makes no sense with clone" unless act_local(); my $hasgit = check_for_git(); - mkdir $dstdir or die "$dstdir $!"; + mkdir $dstdir or fail "create \`$dstdir': $!"; changedir $dstdir; runcmd @git, qw(init -q); my $giturl = access_giturl(1); @@ -1761,9 +1782,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; @@ -1829,11 +1850,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; } @@ -1969,9 +1994,31 @@ END my $format = getfield $dsc, 'Format'; printdebug "format $format\n"; + + my $head = git_rev_parse('HEAD'); + if (madformat($format)) { - commit_quilty_patch(); + # user might have not used dgit build, so maybe do this now: + if (quiltmode_splitbrain()) { + my $upstreamversion = $clogp->{Version}; + $upstreamversion =~ s/-[^-]*$//; + changedir $ud; + quilt_make_fake_dsc($upstreamversion); + my ($dgitview, $cachekey) = + quilt_check_splitbrain_cache($head, $upstreamversion); + $dgitview or fail + "--quilt=$quilt_mode but no cached dgit view: + perhaps tree changed since dgit build[-source] ?"; + $split_brain = 1; + 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"; @@ -1983,7 +2030,7 @@ END my $diffopt = $debuglevel>0 ? '--exit-code' : '--quiet'; my @diffcmd = (@git, qw(diff), $diffopt, $tree); debugcmd "+",@diffcmd; - $!=0; $?=0; + $!=0; $?=-1; my $r = system @diffcmd; if ($r) { if ($r==256) { @@ -1995,21 +2042,14 @@ END failedcmd @diffcmd; } } - my $head = git_rev_parse('HEAD'); if (!$changesfile) { - my $multi = "$buildproductsdir/". - "${package}_".(stripepoch $cversion)."_multi.changes"; - if (stat_exists "$multi") { - $changesfile = $multi; - } else { - my $pat = "${package}_".(stripepoch $cversion)."_*.changes"; - my @cs = glob "$buildproductsdir/$pat"; - fail "failed to find unique changes file". - " (looked for $pat in $buildproductsdir, or $multi);". - " perhaps you need to use dgit -C" - unless @cs==1; - ($changesfile) = @cs; - } + my $pat = changespat $cversion; + my @cs = glob "$buildproductsdir/$pat"; + fail "failed to find unique changes file". + " (looked for $pat in $buildproductsdir);". + " perhaps you need to use dgit -C" + unless @cs==1; + ($changesfile) = @cs; } else { $changesfile = "$buildproductsdir/$changesfile"; } @@ -2083,7 +2123,7 @@ END sign_changes $changesfile; } - supplementary_message(<<'END'); + supplementary_message(<{$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'; - 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 ($) { @@ -2522,8 +2579,98 @@ sub quiltify_tree_sentinelfiles ($) { return $r; } -sub quiltify ($$) { - my ($clogp,$target) = @_; +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,$oldtiptree,$failsuggestion) = @_; # Quilt patchification algorithm # @@ -2549,14 +2696,6 @@ sub quiltify ($$) { # After traversing PT, we git commit the changes which # should be contained within debian/patches. - changedir '../fake'; - remove_stray_gits(); - mktree_in_ud_here(); - rmtree '.pc'; - runcmd @git, qw(add -Af .); - my $oldtiptree=git_write_tree(); - changedir '../work'; - # The search for the path S..T is breadth-first. We maintain a # todo list containing search nodes. A search node identifies a # commit, and looks something like this: @@ -2669,6 +2808,7 @@ sub quiltify ($$) { foreach my $notp (@nots) { print STDERR "$us: ", $reportnot->($notp), "\n"; } + print STDERR "$us: $_\n" foreach @$failsuggestion; fail "quilt fixup naive history linearisation failed.\n". "Use dpkg-source --commit by hand; or, --quilt=smash for one ugly patch"; } elsif ($quilt_mode eq 'smash') { @@ -2762,6 +2902,8 @@ sub build_maybe_quilt_fixup () { quilt_fixup_multipatch($clogp, $headref, $upstreamversion); } + die 'bug' if $split_brain && !$need_split_build_invocation; + changedir '../../../..'; runcmd_ordryrun_local @git, qw(pull --ff-only -q .git/dgit/unpack/work master); @@ -2773,7 +2915,7 @@ sub quilt_fixup_mkwork ($) { mkdir "work" or die $!; changedir "work"; mktree_in_ud_here(); - runcmd @git, qw(reset --hard), $headref; + runcmd @git, qw(reset -q --hard), $headref; } sub quilt_fixup_linkorigs ($$) { @@ -2821,14 +2963,123 @@ sub quilt_fixup_singlepatch ($$$) { chdir "work"; commit_quilty_patch(); +} + +sub quilt_make_fake_dsc ($) { + my ($upstreamversion) = @_; + + my $fakeversion="$upstreamversion-~~DGITFAKE"; + + 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 + 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 @@ -2874,47 +3125,65 @@ sub quilt_fixup_multipatch ($$$) { # 5. If we had a .pc in-tree, delete it, and git-commit # 6. Back in the main tree, fast forward to the new HEAD - my $fakeversion="$upstreamversion-~~DGITFAKE"; + # Another situation we may have to cope with is gbp-style + # patches-unapplied trees. + # + # We would want to detect these, so we know to escape into + # quilt_fixup_gbp. However, this is in general not possible. + # Consider a package with a one patch which the dgit user reverts + # (with git-revert or the moral equivalent). + # + # That is indistinguishable in contents from a patches-unapplied + # tree. And looking at the history to distinguish them is not + # useful because the user might have made a confusing-looking git + # history structure (which ought to produce an error if dgit can't + # cope, not a silent reintroduction of an unwanted patch). + # + # So gbp users will have to pass an option. But we can usually + # detect their failure to do so: if the tree is not a clean + # patches-applied tree, quilt linearisation fails, but the tree + # _is_ a clean patches-unapplied tree, we can suggest that maybe + # they want --quilt=unapplied. + # + # To help detect this, when we are extracting the fake dsc, we + # first extract it with --skip-patches, and then apply the patches + # afterwards with dpkg-source --before-build. That lets us save a + # tree object corresponding to .origs. - my $fakedsc=new IO::File 'fake.dsc', '>' or die $!; - print $fakedsc <addfile($fh); - print $fakedsc " ".$md->hexdigest." $size $b\n" or die $!; - }; + runcmd qw(sh -ec), + 'exec dpkg-source --no-check --skip-patches -x fake.dsc >/dev/null'; - quilt_fixup_linkorigs($upstreamversion, $dscaddfile); + my $fakexdir= $package.'-'.(stripepoch $upstreamversion); + rename $fakexdir, "fake" or die "$fakexdir $!"; - my @files=qw(debian/source/format debian/rules); - foreach my $maybe (qw(debian/patches debian/source/options)) { - next unless stat_exists "../../../$maybe"; - push @files, $maybe; - } + changedir 'fake'; - my $debtar= srcfn $fakeversion,'.debian.tar.gz'; - runcmd qw(env GZIP=-1 tar -zcf), "./$debtar", qw(-C ../../..), @files; + remove_stray_gits(); + mktree_in_ud_here(); - $dscaddfile->($debtar); - close $fakedsc or die $!; + rmtree '.pc'; - runcmd qw(sh -ec), 'exec dpkg-source --no-check -x fake.dsc >/dev/null'; + runcmd @git, qw(add -Af .); + my $unapplied=git_write_tree(); + printdebug "fake orig tree object $unapplied\n"; - my $fakexdir= $package.'-'.(stripepoch $upstreamversion); - rename $fakexdir, "fake" or die "$fakexdir $!"; + ensuredir '.pc'; + + runcmd qw(sh -ec), + 'exec dpkg-source --before-build . >/dev/null'; + + changedir '..'; quilt_fixup_mkwork($headref); @@ -2927,7 +3196,59 @@ END rename '../fake/.pc','.pc' or die $!; } - quiltify($clogp,$headref); + changedir '../fake'; + rmtree '.pc'; + runcmd @git, qw(add -Af .); + my $oldtiptree=git_write_tree(); + printdebug "fake o+d/p tree object $unapplied\n"; + changedir '../work'; + + + # 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 $!; @@ -2961,15 +3282,44 @@ sub quilt_fixup_editor () { exit 0; } +sub maybe_apply_patches_dirtily () { + return unless $quilt_mode =~ m/gbp|unapplied/; + print STDERR <1; - my @newcmd = shift @$cmd; +#print STDERR "MASS0 ",Dumper($cmd, $xargs, $need_split_build_invocation); + if ($cleanmode eq 'dpkg-source' && !$need_split_build_invocation) { + $clean_using_builder = 1; + return 0; + } # -nc has the side effect of specifying -b if nothing else specified - push @newcmd, '-nc'; # and some combinations of -S, -b, et al, are errors, rather than - # later simply overriding earlier - push @newcmd, '-F' unless grep { m/^-[bBASF]$/ } (@$cmd, @$xargs); - push @newcmd, @$cmd; - @$cmd = @newcmd; + # later simply overriding earlie. So we need to: + # - search the command line for these options + # - pick the last one + # - perhaps add our own as a default + # - perhaps adjust it to the corresponding non-source-building version + my $dmode = '-F'; + foreach my $l ($cmd, $xargs) { + next unless $l; + @$l = grep { !(m/^-[SgGFABb]$/s and $dmode=$_) } @$l; + } + push @$cmd, '-nc'; +#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; } sub cmd_build { my @dbp = (@dpkgbuildpackage, qw(-us -uc), changesopts_initial(), @ARGV); - massage_dbp_args \@dbp; - build_prep(); - push @dbp, changesopts_version(); - runcmd_ordryrun_local @dbp; + my $wantsrc = massage_dbp_args \@dbp; + if ($wantsrc > 0) { + build_source(); + } else { + build_prep(); + } + if ($wantsrc < 2) { + push @dbp, changesopts_version(); + maybe_apply_patches_dirtily(); + runcmd_ordryrun_local @dbp; + } + maybe_unapply_patches_again(); printdone "build successful\n"; } sub cmd_gbp_build { my @dbp = @dpkgbuildpackage; - massage_dbp_args \@dbp, \@ARGV; + + my $wantsrc = massage_dbp_args \@dbp, \@ARGV; my @cmd; if (length executable_on_path('git-buildpackage')) { @@ -3078,42 +3483,81 @@ sub cmd_gbp_build { } push @cmd, (qw(-us -uc --git-no-sign-tags), "--git-builder=@dbp"); - if ($cleanmode eq 'dpkg-source') { - $suppress_clean = 1; + if ($wantsrc > 0) { + build_source(); } else { - push @cmd, '--git-cleaner=true'; + if (!$clean_using_builder) { + push @cmd, '--git-cleaner=true'; + } + build_prep(); } - build_prep(); - unless (grep { m/^--git-debian-branch|^--git-ignore-branch/ } @ARGV) { - canonicalise_suite(); - push @cmd, "--git-debian-branch=".lbranch(); + if ($wantsrc < 2) { + unless (grep { m/^--git-debian-branch|^--git-ignore-branch/ } @ARGV) { + canonicalise_suite(); + push @cmd, "--git-debian-branch=".lbranch(); + } + push @cmd, changesopts(); + maybe_apply_patches_dirtily(); + runcmd_ordryrun_local @cmd, @ARGV; } - push @cmd, changesopts(); - 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 = "${package}_".(stripepoch $version)."_source.changes"; + $sourcechanges = changespat $version,'source'; + if (act_local()) { + unlink "../$sourcechanges" or $!==ENOENT + or fail "remove $sourcechanges: $!"; + } $dscfn = dscfn($version); - if ($cleanmode eq 'dpkg-source') { - runcmd_ordryrun_local (@dpkgbuildpackage, qw(-us -uc -S)), + 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') { - runcmd_ordryrun_local (@dpkgbuildpackage, qw(-us -uc -S -d)), + } elsif ($our_cleanmode eq 'dpkg-source-d') { + maybe_apply_patches_dirtily(); + runcmd_ordryrun_local @dpkgbuildpackage, qw(-us -uc -S -d), 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", @@ -3124,21 +3568,26 @@ 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"; } sub cmd_sbuild { build_source(); + my $pat = changespat $version; + if (!$rmchanges) { + my @unwanted = map { s#^\.\./##; $_; } glob "../$pat"; + @unwanted = grep { $_ ne changespat $version,'source' } @unwanted; + fail "changes files other than source matching $pat". + " already present (@unwanted);". + " building would result in ambiguity about the intended results" + if @unwanted; + } changedir ".."; - my $pat = "${package}_".(stripepoch $version)."_*.changes"; if (act_local()) { stat_exists $dscfn or fail "$dscfn (in parent directory): $!"; stat_exists $sourcechanges or fail "$sourcechanges (in parent directory): $!"; - foreach my $cf (glob $pat) { - next if $cf eq $sourcechanges; - unlink $cf or fail "remove $cf: $!"; - } } runcmd_ordryrun_local @sbuild, qw(-d), $isuite, @ARGV, $dscfn; my @changesfiles = glob $pat; @@ -3147,12 +3596,22 @@ sub cmd_sbuild { or $a cmp $b } @changesfiles; fail "wrong number of different changes files (@changesfiles)" - unless @changesfiles; + unless @changesfiles==2; + my $binchanges = parsecontrol($changesfiles[1], "binary changes file"); + foreach my $l (split /\n/, getfield $binchanges, 'Files') { + fail "$l found in binaries changes file $binchanges" + if $l =~ m/\.dsc$/; + } runcmd_ordryrun_local @mergechanges, @changesfiles; - my $multichanges = "${package}_".(stripepoch $version)."_multi.changes"; + my $multichanges = changespat $version,'multi'; if (act_local()) { stat_exists $multichanges or fail "$multichanges: $!"; + foreach my $cf (glob $pat) { + next if $cf eq $multichanges; + rename "$cf", "$cf.inmulti" or fail "$cf\{,.inmulti}: $!"; + } } + maybe_unapply_patches_again(); printdone "build successful, results in $multichanges\n" or die $!; } @@ -3161,6 +3620,8 @@ sub cmd_quilt_fixup { my $clogp = parsechangelog(); $version = getfield $clogp, 'Version'; $package = getfield $clogp, 'Source'; + check_not_dirty(); + clean_tree(); build_maybe_quilt_fixup(); } @@ -3311,9 +3772,16 @@ sub parseopts () { } elsif (m/^--no-rm-on-error$/s) { push @ropts, $_; $rmonerror = 0; + } elsif (m/^--(no-)?rm-old-changes$/s) { + push @ropts, $_; + $rmchanges = !$1; } elsif (m/^--deliberately-($deliberately_re)$/s) { push @ropts, $_; push @deliberatelies, $&; + } elsif (m/^--always-split-source-build$/s) { + # undocumented, for testing + push @ropts, $_; + $need_split_build_invocation = 1; } elsif (m/^(--[-0-9a-z]+)(=|$)/ && ($oi = $valopts_long{$1})) { $val = $2 ? $' : undef; #'; $valopt->($oi->{Long}); @@ -3417,6 +3885,11 @@ if (!@ARGV) { my $cmd = shift @ARGV; $cmd =~ y/-/_/; +if (!defined $rmchanges) { + local $access_forpush; + $rmchanges = access_cfg_bool(0, 'rm-old-changes'); +} + if (!defined $quilt_mode) { local $access_forpush; $quilt_mode = cfg('dgit.force.quilt-mode', 'RETURN-UNDEF') @@ -3427,6 +3900,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');