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 (@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
'dpkg-source' => \@dpkgsource,
'dpkg-buildpackage' => \@dpkgbuildpackage,
'dpkg-genchanges' => \@dpkggenchanges,
+ 'gbp' => \@gbp,
'ch' => \@changesopts,
'mergechanges' => \@mergechanges);
autoflush STDOUT 1;
our $supplementary_message = '';
+our $need_split_build_invocation = 0;
+our $split_brain = 0;
END {
local ($@, $?);
}
}
+sub quiltmode_splitbrain () {
+ $quilt_mode =~ m/gbp|dpm|unapplied/;
+}
+
#---------- remote protocol support, common ----------
# remote push initiator/responder protocol:
sub runcmd {
debugcmd "+",@_;
- $!=0; $?=0;
+ $!=0; $?=-1;
failedcmd @_ if system @_;
}
my @cmd = (@git, qw(config -z --get-regexp .*));
debugcmd "|",@cmd;
- open GITS, "-|", @cmd or failedcmd @cmd;
+ open GITS, "-|", @cmd or die $!;
while (<GITS>) {
chomp or die;
printdebug "=> ", (messagequote $_), "\n";
" 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
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');
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 () {
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 (<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;
$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;
}
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';
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;
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;
}
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";
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) {
failedcmd @diffcmd;
}
}
- my $head = git_rev_parse('HEAD');
if (!$changesfile) {
- my $multi = "$buildproductsdir/".changespat $cversion,'multi';
- if (stat_exists "$multi") {
- $changesfile = $multi;
- } else {
- my $pat = changespat $cversion;
- 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";
}
}
}
-sub quiltify_trees_differ ($$) {
- my ($x,$y) = @_;
- # 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';
- 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 ($) {
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 <<END or die "$gipatch: $!";
+Subject: Update .gitignore from Debian packaging branch
+
+The Debian packaging git branch contains these updates to the upstream
+.gitignore file(s). This patch is autogenerated, to provide these
+updates to users of the official Debian archive view of the package.
+
+[dgit version $our_version]
+---
+END
+ close GIPATCH or die "$gipatch: $!";
+ runcmd shell_cmd "exec >>$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
#
# 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:
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') {
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);
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 ($$) {
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 <<END or die $!;
+Format: 3.0 (quilt)
+Source: $package
+Version: $fakeversion
+Files:
+END
+ my $dscaddfile=sub {
+ my ($b) = @_;
+
+ my $md = new Digest::MD5;
+
+ my $fh = new IO::File $b, '<' or die "$b $!";
+ stat $fh or die $!;
+ my $size = -s _;
+
+ $md->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 (<GC>) {
+ 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
# 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 <<END or die $!;
-Format: 3.0 (quilt)
-Source: $package
-Version: $fakeversion
-Files:
-END
+ my $splitbrain_cachekey;
- my $dscaddfile=sub {
- my ($b) = @_;
-
- my $md = new Digest::MD5;
+ quilt_make_fake_dsc($upstreamversion);
- my $fh = new IO::File $b, '<' or die "$b $!";
- stat $fh or die $!;
- my $size = -s _;
+ if (quiltmode_splitbrain()) {
+ my $cachehit;
+ ($cachehit, $splitbrain_cachekey) =
+ quilt_check_splitbrain_cache($headref, $upstreamversion);
+ return if $cachehit;
+ }
- $md->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);
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 $!;
exit 0;
}
+sub maybe_apply_patches_dirtily () {
+ return unless $quilt_mode =~ m/gbp|unapplied/;
+ print STDERR <<END or die $!;
+
+dgit: Building, or cleaning with rules target, in patches-unapplied tree.
+dgit: Have to apply the patches - making the tree dirty.
+dgit: (Consider specifying --clean=git and (or) using dgit sbuild.)
+
+END
+ $patches_applied_dirtily = 01;
+ $patches_applied_dirtily |= 02 unless stat_exists '.pc';
+ runcmd qw(dpkg-source --before-build .);
+}
+
+sub maybe_unapply_patches_again () {
+ progress "dgit: Unapplying patches again to tidy up the tree."
+ if $patches_applied_dirtily;
+ runcmd qw(dpkg-source --after-build .)
+ if $patches_applied_dirtily & 01;
+ rmtree '.pc'
+ if $patches_applied_dirtily & 02;
+}
+
#----- other building -----
-our $suppress_clean;
+our $clean_using_builder;
+# ^ tree is to be cleaned by dpkg-source's builtin idea that it should
+# clean the tree before building (perhaps invoked indirectly by
+# whatever we are using to run the build), rather than separately
+# and explicitly by us.
sub clean_tree () {
- return if $suppress_clean;
+ return if $clean_using_builder;
if ($cleanmode eq 'dpkg-source') {
+ maybe_apply_patches_dirtily();
runcmd_ordryrun_local @dpkgbuildpackage, qw(-T clean);
} elsif ($cleanmode eq 'dpkg-source-d') {
+ maybe_apply_patches_dirtily();
runcmd_ordryrun_local @dpkgbuildpackage, qw(-d -T clean);
} elsif ($cleanmode eq 'git') {
runcmd_ordryrun_local @git, qw(clean -xdf);
badusage "clean takes no additional arguments" if @ARGV;
notpushing();
clean_tree();
+ maybe_unapply_patches_again();
}
sub build_prep () {
$package = getfield $clogp, 'Source';
$version = getfield $clogp, 'Version';
build_maybe_quilt_fixup();
+ if ($rmchanges) {
+ my $pat = changespat $version;
+ foreach my $f (glob "$buildproductsdir/$pat") {
+ if (act_local()) {
+ unlink $f or fail "remove old changes file $f: $!";
+ } else {
+ progress "would remove $f";
+ }
+ }
+ }
}
sub changesopts_initial () {
sub massage_dbp_args ($;$) {
my ($cmd,$xargs) = @_;
- if ($cleanmode eq 'dpkg-source') {
- $suppress_clean = 1;
- return;
- }
+ # We need to:
+ #
+ # - if we're going to split the source build out so we can
+ # do strange things to it, massage the arguments to dpkg-buildpackage
+ # so that the main build doessn't build source (or add an argument
+ # to stop it building source by default).
+ #
+ # - add -nc to stop dpkg-source cleaning the source tree,
+ # unless we're not doing a split build and want dpkg-source
+ # as cleanmode, in which case we can do nothing
+ #
+ # return values:
+ # 0 - source will NOT need to be built separately by caller
+ # +1 - source will need to be built separately by caller
+ # +2 - source will need to be built separately by caller AND
+ # dpkg-buildpackage should not in fact be run at all!
debugcmd '#massaging#', @$cmd if $debuglevel>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/^-[bBASFgG]$/ } (@$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')) {
}
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 = changespat $version,'source';
+ if (act_local()) {
+ unlink "../$sourcechanges" or $!==ENOENT
+ 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",
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();
- changedir "..";
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 "..";
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;
rename "$cf", "$cf.inmulti" or fail "$cf\{,.inmulti}: $!";
}
}
+ maybe_unapply_patches_again();
printdone "build successful, results in $multichanges\n" or die $!;
}
} 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});
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')
$quilt_mode = $1;
}
+$need_split_build_invocation ||= quiltmode_splitbrain();
+
if (!defined $cleanmode) {
local $access_forpush;
$cleanmode = access_cfg('clean-mode', 'RETURN-UNDEF');
~ianmdlvl / dgit.git / blobdiff