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 $we_are_responder;
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);
autoflush STDOUT 1;
our $supplementary_message = '';
+our $need_split_build_invocation = 0;
END {
local ($@, $?);
return srcfn($vsn,".dsc");
}
+sub changespat ($;$) {
+ my ($vsn, $arch) = @_;
+ return "${package}_".(stripepoch $vsn)."_".($arch//'*').".changes";
+}
+
our $us = 'dgit';
initdebug('');
local ($?);
foreach my $f (@end) {
eval { $f->(); };
- warn "$us: cleanup: $@" if length $@;
+ print STDERR "$us: cleanup: $@" if length $@;
}
};
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 () {
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);
}
sub check_not_dirty () {
+ foreach my $f (qw(local-options local-patch-header)) {
+ if (stat_exists "debian/source/$f") {
+ fail "git tree contains debian/source/$f";
+ }
+ }
+
return if $ignoredirty;
+
my @cmd = (@git, qw(diff --quiet HEAD));
debugcmd "+",@cmd;
$!=0; $?=0; system @cmd;
} else {
failedcmd @cmd;
}
-
- foreach my $f (qw(local-options local-patch-header)) {
- if (stat_exists "debian/source/$f") {
- fail "git tree contains debian/source/$f";
- }
- }
}
sub commit_admin ($) {
my $format = getfield $dsc, 'Format';
printdebug "format $format\n";
if (madformat($format)) {
+ # user might have not used dgit build, so maybe do this now:
commit_quilty_patch();
}
check_not_dirty();
}
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";
}
sign_changes $changesfile;
}
- supplementary_message(<<'END');
+ supplementary_message(<<END);
Push failed, while uploading package(s) to the archive server.
You can retry the upload of exactly these same files with dput of:
$changesfile
return if $!==&ENOENT;
die "chdir $cwd_remove: $!";
}
- rmtree($dstdir) or die "remove $dstdir: $!\n";
+ if (stat $dstdir) {
+ rmtree($dstdir) or die "remove $dstdir: $!\n";
+ } elsif (!grep { $! == $_ }
+ (ENOENT, ENOTDIR, EACCES, EPERM, ELOOP)) {
+ } else {
+ print STDERR "check whether to remove $dstdir: $!\n";
+ }
};
}
}
}
-sub quiltify_trees_differ ($$) {
- my ($x,$y) = @_;
+sub quiltify_trees_differ ($$;$) {
+ my ($x,$y,$ignoregitignore) = @_;
# returns 1 iff the two tree objects differ other than in debian/
local $/=undef;
my @cmd = (@git, qw(diff-tree --name-only -z), $x, $y);
my $diffs= cmdoutput @cmd;
foreach my $f (split /\0/, $diffs) {
next if $f eq 'debian';
+ next if $f eq '.gitignore' && $ignoregitignore;
return 1;
}
return 0;
return $r;
}
-sub quiltify ($$) {
- my ($clogp,$target) = @_;
+sub quilt_could_gbp ($$$) {
+ my ($userhead,$unapplied,$applied) = @_;
+ return
+ !quiltify_trees_differ($userhead,$unapplied,1) &&
+ quiltify_trees_differ($userhead,$applied,1);
+}
+
+sub quiltify ($$$) {
+ my ($clogp,$target,$unapplied) = @_;
# Quilt patchification algorithm
#
# 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();
foreach my $notp (@nots) {
print STDERR "$us: ", $reportnot->($notp), "\n";
}
+ if (quilt_could_gbp($target,$unapplied,$oldtiptree)) {
+ print STDERR <<END;
+$us: Tree looks like a patches-unapplied git branch.
+$us: Maybe you forgot --quilt=gbp (aka --quilt=apply) ?
+END
+ }
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') {
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 ($$) {
# 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
+ # 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 $fakeversion="$upstreamversion-~~DGITFAKE";
my $fakedsc=new IO::File 'fake.dsc', '>' or die $!;
quilt_fixup_linkorigs($upstreamversion, $dscaddfile);
- my @files=qw(debian/source/format debian/rules);
+ 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;
$dscaddfile->($debtar);
close $fakedsc or die $!;
- runcmd qw(sh -ec), 'exec dpkg-source --no-check -x fake.dsc >/dev/null';
+ runcmd qw(sh -ec),
+ 'exec dpkg-source --no-check --skip-patches -x fake.dsc >/dev/null';
my $fakexdir= $package.'-'.(stripepoch $upstreamversion);
rename $fakexdir, "fake" or die "$fakexdir $!";
+ changedir 'fake';
+
+ remove_stray_gits();
+ mktree_in_ud_here();
+
+ rmtree '.pc';
+
+ runcmd @git, qw(add -Af .);
+ my $unapplied=git_write_tree();
+ printdebug "fake orig tree object $unapplied\n";
+
+ ensuredir '.pc';
+
+ runcmd qw(sh -ec),
+ 'exec dpkg-source --before-build . >/dev/null';
+
+ changedir '..';
+
quilt_fixup_mkwork($headref);
my $mustdeletepc=0;
rename '../fake/.pc','.pc' or die $!;
}
- quiltify($clogp,$headref);
+ quiltify($clogp,$headref,$unapplied);
if (!open P, '>>', ".pc/applied-patches") {
$!==&ENOENT or die $!;
$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') {
+ # 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;
+#print STDERR "MASS0 ",Dumper($cmd, $xargs, $need_split_build_invocation);
+ if ($cleanmode eq 'dpkg-source' && !$need_split_build_invocation) {
$suppress_clean = 1;
- return;
+ return 0;
}
- debugcmd '#massaging#', @$cmd if $debuglevel>1;
- my @newcmd = shift @$cmd;
# -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) {
+ $r = $dmode =~ m/[S]/ ? +2 :
+ $dmode =~ y/gGF/ABb/ ? +1 :
+ $dmode =~ m/[ABb]/ ? 0 :
+ die "$dmode ?";
+ }
+ 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();
+ runcmd_ordryrun_local @dbp;
+ }
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 (!$suppress_clean) {
+ 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();
+ runcmd_ordryrun_local @cmd, @ARGV;
}
- push @cmd, changesopts();
- runcmd_ordryrun_local @cmd, @ARGV;
printdone "build successful\n";
}
sub cmd_git_build { cmd_gbp_build(); } # compatibility with <= 1.0
$suppress_clean = 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)),
- changesopts();
+ runcmd_ordryrun_local @dpkgbuildpackage, qw(-us -uc -S),
+ changesopts();
} elsif ($cleanmode eq 'dpkg-source-d') {
- runcmd_ordryrun_local (@dpkgbuildpackage, qw(-us -uc -S -d)),
- changesopts();
+ runcmd_ordryrun_local @dpkgbuildpackage, qw(-us -uc -S -d),
+ changesopts();
} else {
my $pwd = must_getcwd();
my $leafdir = basename $pwd;
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;
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}: $!";
+ }
}
printdone "build successful, results in $multichanges\n" or die $!;
}
my $clogp = parsechangelog();
$version = getfield $clogp, 'Version';
$package = getfield $clogp, 'Source';
+ check_not_dirty();
+ clean_tree();
build_maybe_quilt_fixup();
}
} 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')
~ianmdlvl / dgit.git / blobdiff