use LWP::UserAgent;
use Dpkg::Control::Hash;
use File::Path;
+use File::Spec;
use File::Temp qw(tempdir);
use File::Basename;
use Dpkg::Version;
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 $cleanmode_re = qr{(?: dpkg-source (?: -d )? (?: ,no-check | ,all-check )?
+ | (?: git | git-ff ) (?: ,always )?
+ | check (?: ,ignores )?
+ | none
+ )}x;
our $git_authline_re = '^([^<>]+) \<(\S+)\> (\d+ [-+]\d+)$';
our $splitbraincache = 'dgit-intern/quilt-cache';
our (@gbp_build) = ('');
our (@gbp_pq) = ('gbp pq');
our (@changesopts) = ('');
-our (@pbuilder) = ("sudo -E pbuilder");
-our (@cowbuilder) = ("sudo -E cowbuilder");
+our (@pbuilder) = ("sudo -E pbuilder","--no-source-only-changes");
+our (@cowbuilder) = ("sudo -E cowbuilder","--no-source-only-changes");
our %opts_opt_map = ('dget' => \@dget, # accept for compatibility
'curl' => \@curl,
}
sub no_such_package () {
- print STDERR f_ "%s: package %s does not exist in suite %s\n",
+ print STDERR f_ "%s: source package %s does not exist in suite %s\n",
$us, $package, $isuite;
finish 4;
}
printdebug "branch_is_gdr $walk ?-octopus NO\n";
return 0;
}
+ if (!@parents) {
+ printdebug "branch_is_gdr $walk origin\n";
+ return 0;
+ }
if ($get_patches->($walk) ne $tip_patches) {
# Our parent added, removed, or edited patches, and wasn't
# a gdr make-patches commit. gdr make-patches probably
@$l==1 or badcfg
f_ "multiple values for %s (in %s git config)", $c, $src
if @$l > 1;
+ $l->[0] =~ m/\n/ and badcfg f_
+ "value for config option %s (in %s git config) contains newline(s)!",
+ $c, $src;
return $l->[0];
}
return undef;
__ "(nominal) distro being accessed");
}
+sub check_bpd_exists () {
+ stat $buildproductsdir
+ or fail f_ "build-products-dir %s is not accessible: %s\n",
+ $buildproductsdir, $!;
+}
+
+sub dotdot_bpd_transfer_origs ($$$) {
+ my ($bpd_abs, $upstreamversion, $wanted) = @_;
+ # checks is_orig_file_of_vsn and if
+ # calls $wanted->{$leaf} and expects boolish
+
+ return if $buildproductsdir eq '..';
+
+ my $warned;
+ my $dotdot = $maindir;
+ $dotdot =~ s{/[^/]+$}{};
+ opendir DD, $dotdot or fail "opendir .. ($dotdot): $!";
+ while ($!=0, defined(my $leaf = readdir DD)) {
+ {
+ local ($debuglevel) = $debuglevel-1;
+ printdebug "DD_BPD $leaf ?\n";
+ }
+ next unless is_orig_file_of_vsn $leaf, $upstreamversion;
+ next unless $wanted->($leaf);
+ next if lstat "$bpd_abs/$leaf";
+
+ print STDERR f_
+ "%s: found orig(s) in .. missing from build-products-dir, transferring:\n",
+ $us
+ unless $warned++;
+ $! == &ENOENT or fail f_
+ "check orig file %s in bpd %s: %s", $leaf, $bpd_abs, $!;
+ lstat "$dotdot/$leaf" or fail f_
+ "check orig file %s in ..: %s", $leaf, $!;
+ if (-l _) {
+ stat "$dotdot/$leaf" or fail f_
+ "check target of orig symlink %s in ..: %s", $leaf, $!;
+ my $ltarget = readlink "$dotdot/$leaf" or
+ die "readlink $dotdot/$leaf: $!";
+ if ($ltarget !~ m{^/}) {
+ $ltarget = "$dotdot/$ltarget";
+ }
+ symlink $ltarget, "$bpd_abs/$leaf"
+ or die "$ltarget $bpd_abs $leaf: $!";
+ print STDERR f_
+ "%s: cloned orig symlink from ..: %s\n",
+ $us, $leaf;
+ } elsif (link "$dotdot/$leaf", "$bpd_abs/$leaf") {
+ print STDERR f_
+ "%s: hardlinked orig from ..: %s\n",
+ $us, $leaf;
+ } elsif ($! != EXDEV) {
+ fail f_ "failed to make %s a hardlink to %s: %s",
+ "$bpd_abs/$leaf", "$dotdot/$leaf", $!;
+ } else {
+ symlink "$bpd_abs/$leaf", "$dotdot/$leaf"
+ or die "$bpd_abs $dotdot $leaf $!";
+ print STDERR f_
+ "%s: symmlinked orig from .. on other filesystem: %s\n",
+ $us, $leaf;
+ }
+ }
+ die "$dotdot; $!" if $!;
+ closedir DD;
+}
+
sub generate_commits_from_dsc () {
# See big comment in fetch_from_archive, below.
# See also README.dsc-import.
prep_ud();
changedir $playground;
+ my $bpd_abs = bpd_abs();
+ my $upstreamv = upstreamversion $dsc->{version};
my @dfi = dsc_files_info();
+
+ dotdot_bpd_transfer_origs $bpd_abs, $upstreamv,
+ sub { grep { $_->{Filename} eq $_[0] } @dfi };
+
foreach my $fi (@dfi) {
my $f = $fi->{Filename};
die "$f ?" if $f =~ m#/|^\.|\.dsc$|\.tmp$#;
- my $upper_f = (bpd_abs()."/$f");
+ my $upper_f = "$bpd_abs/$f";
printdebug "considering reusing $f: ";
printdebug "considering saving $f: ";
- if (link $f, $upper_f) {
+ if (rename_link_xf 1, $f, $upper_f) {
printdebug "linked.\n";
- } elsif ((printdebug "($!) "),
+ } elsif ((printdebug "($@) "),
$! != EEXIST) {
- fail f_ "saving %s: %s", "$buildproductsdir/$f", $!;
+ fail f_ "saving %s: %s", "$buildproductsdir/$f", $@;
} elsif (!$refetched) {
printdebug "no need.\n";
- } elsif (link $f, "$upper_f,fetch") {
+ } elsif (rename_link_xf 1, $f, "$upper_f,fetch") {
printdebug "linked (using ...,fetch).\n";
- } elsif ((printdebug "($!) "),
+ } elsif ((printdebug "($@) "),
$! != EEXIST) {
- fail f_ "saving %s: %s", "$buildproductsdir/$f,fetch", $!;
+ fail f_ "saving %s: %s", "$buildproductsdir/$f,fetch", $@;
} else {
printdebug "cannot.\n";
}
# from the debian/changelog, so we record the tree objects now and
# make them into commits later.
my @tartrees;
- my $upstreamv = upstreamversion $dsc->{version};
my $orig_f_base = srcfn $upstreamv, '';
foreach my $fi (@dfi) {
}
sub fetch_from_archive () {
+ check_bpd_exists();
ensure_setup_existing_tree();
# Ensures that lrref() is what is actually in the archive, one way
}
printdebug "clone main body\n";
- canonicalise_suite();
- my $hasgit = check_for_git();
mkdir $dstdir or fail f_ "create \`%s': %s", $dstdir, $!;
changedir $dstdir;
+ check_bpd_exists();
+
+ canonicalise_suite();
+ my $hasgit = check_for_git();
+
runcmd @git, qw(init -q);
record_maindir();
setup_new_tree();
}
sub check_not_dirty () {
- foreach my $f (qw(local-options local-patch-header)) {
- if (stat_exists "debian/source/$f") {
- fail f_ "git tree contains debian/source/%s", $f;
+ my @forbid = qw(local-options local-patch-header);
+ @forbid = map { "debian/source/$_" } @forbid;
+ foreach my $f (@forbid) {
+ if (stat_exists $f) {
+ fail f_ "git tree contains %s", $f;
}
}
+ my @cmd = (@git, qw(status -uall --ignored --porcelain));
+ push @cmd, qw(debian/source/format debian/source/options);
+ push @cmd, @forbid;
+
+ my $bad = cmdoutput @cmd;
+ if (length $bad) {
+ fail +(__
+ "you have uncommitted changes to critical files, cannot continue:\n").
+ $bad;
+ }
+
return if $includedirty;
git_check_unmodified();
sub pseudomerge_make_commit ($$$$ $$) {
my ($clogp, $dgitview, $archive_hash, $i_arch_v,
$msg_cmd, $msg_msg) = @_;
- progress f_ "Declaring that HEAD inciudes all changes in %s...",
+ progress f_ "Declaring that HEAD includes all changes in %s...",
$i_arch_v->[0];
my $tree = cmdoutput qw(git rev-parse), "${dgitview}:";
my $i_arch_v = pseudomerge_version_check($clogp, $archive_hash);
if (!defined $overwrite_version) {
- progress __ "Checking that HEAD inciudes all changes in archive...";
+ progress __ "Checking that HEAD includes all changes in archive...";
}
return $dgitview if is_fast_fwd $archive_hash, $dgitview;
if ($sourceonlypolicy eq 'ok') {
} elsif ($sourceonlypolicy eq 'always') {
forceable_fail [qw(uploading-binaries)],
- __ "uploading binaries, although distroy policy is source only"
+ __ "uploading binaries, although distro policy is source only"
if $hasdebs;
} elsif ($sourceonlypolicy eq 'never') {
forceable_fail [qw(uploading-source-only)],
- __ "source-only upload, although distroy policy requires .debs"
+ __ "source-only upload, although distro policy requires .debs"
if !$hasdebs;
} elsif ($sourceonlypolicy eq 'not-wholly-new') {
forceable_fail [qw(uploading-source-only)],
printdebug "considering C=$c->{Commit} P=$p->{Commit}\n";
my @cmd= (@git, qw(diff-tree -r --name-only),
- $p->{Commit},$c->{Commit}, qw(-- debian/patches .pc));
+ $p->{Commit},$c->{Commit},
+ qw(-- debian/patches .pc debian/source/format));
my $patchstackchange = cmdoutput @cmd;
if (length $patchstackchange) {
$patchstackchange =~ s/\n/,/g;
if (act_local()) {
debugcmd "+",@cmd;
$!=0; $?=-1;
- failedcmd @cmd if system @cmd and $?!=7*256;
+ failedcmd @cmd
+ if system @cmd
+ and not ($? == 7*256 or
+ $? == -1 && $!==ENOENT);
} else {
dryrun_report @cmd;
}
# calls $fn->($leafname);
my $bpd_abs = bpd_abs();
+
+ dotdot_bpd_transfer_origs $bpd_abs, $upstreamversion, sub { 1 };
+
opendir QFD, $bpd_abs or fail "buildproductsdir: $bpd_abs: $!";
- while ($!=0, defined(my $b = readdir QFD)) {
- my $f = bpd_abs()."/".$b;
+ while ($!=0, defined(my $leaf = readdir QFD)) {
+ my $f = bpd_abs()."/".$leaf;
{
local ($debuglevel) = $debuglevel-1;
- printdebug "QF linkorigs $b, $f ?\n";
+ printdebug "QF linkorigs bpd $leaf, $f ?\n";
}
- next unless is_orig_file_of_vsn $b, $upstreamversion;
- printdebug "QF linkorigs $b, $f Y\n";
- link_ltarget $f, $b or die "$b $!";
- $fn->($b);
+ next unless is_orig_file_of_vsn $leaf, $upstreamversion;
+ printdebug "QF linkorigs $leaf, $f Y\n";
+ link_ltarget $f, $leaf or die "$leaf $!";
+ $fn->($leaf);
}
die "$buildproductsdir: $!" if $!;
closedir QFD;
changedir "..";
runcmd @dpkgsource, qw(-x), (srcfn $version, ".dsc");
rename srcfn("$upstreamversion", "/debian/patches"),
- "work/debian/patches";
+ "work/debian/patches"
+ or $!==ENOENT
+ or confess "install d/patches: $!";
changedir "work";
commit_quilty_patch();
END
my $dscaddfile=sub {
- my ($b) = @_;
+ my ($leaf) = @_;
my $md = new Digest::MD5;
- my $fh = new IO::File $b, '<' or die "$b $!";
+ my $fh = new IO::File $leaf, '<' or die "$leaf $!";
stat $fh or confess $!;
my $size = -s _;
$md->addfile($fh);
- print $fakedsc " ".$md->hexdigest." $size $b\n" or confess $!;
+ print $fakedsc " ".$md->hexdigest." $size $leaf\n" or confess $!;
};
unpack_playtree_linkorigs($upstreamversion, $dscaddfile);
};
my @dl;
- foreach my $b (qw(01 02)) {
+ foreach my $bits (qw(01 02)) {
foreach my $v (qw(O2H O2A H2A)) {
- push @dl, ($diffbits->{$v} & $b) ? '##' : '==';
+ push @dl, ($diffbits->{$v} & $bits) ? '##' : '==';
}
}
printdebug "differences \@dl @dl.\n";
#----- other building -----
-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_check_git ($$$) {
+ my ($honour_ignores, $message, $ignmessage) = @_;
+ my @cmd = (@git, qw(clean -dn));
+ push @cmd, qw(-x) unless $honour_ignores;
+ my $leftovers = cmdoutput @cmd;
+ if (length $leftovers) {
+ print STDERR $leftovers, "\n" or confess $!;
+ $message .= $ignmessage if $honour_ignores;
+ fail $message;
+ }
+}
+
+sub clean_tree_check_git_wd ($) {
+ my ($message) = @_;
+ return if $cleanmode =~ m{no-check};
+ return if $patches_applied_dirtily; # yuk
+ clean_tree_check_git +($cleanmode !~ m{all-check}),
+ $message, "\n".__ <<END;
+If this is just missing .gitignore entries, use a different clean
+mode, eg --clean=dpkg-source,no-check (-wdn/-wddn) to ignore them
+or --clean=git (-wg/-wgf) to use \`git clean' instead.
+END
+}
+
+sub clean_tree_check () {
+ # This function needs to not care about modified but tracked files.
+ # That was done by check_not_dirty, and by now we may have run
+ # the rules clean target which might modify tracked files (!)
+ if ($cleanmode =~ m{^check}) {
+ clean_tree_check_git +($cleanmode =~ m{ignores}), __
+ "tree contains uncommitted files and --clean=check specified", '';
+ } elsif ($cleanmode =~ m{^dpkg-source}) {
+ clean_tree_check_git_wd __
+ "tree contains uncommitted files (NB dgit didn't run rules clean)";
+ } elsif ($cleanmode =~ m{^git}) {
+ clean_tree_check_git 1, __
+ "tree contains uncommited, untracked, unignored files\n".
+ "You can use --clean=git[-ff],always (-wga/-wgfa) to delete them.", '';
+ } elsif ($cleanmode eq 'none') {
+ } else {
+ confess "$cleanmode ?";
+ }
+}
sub clean_tree () {
- 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') {
+ # We always clean the tree ourselves, rather than leave it to the
+ # builder (dpkg-source, or soemthing which calls dpkg-source).
+ if ($cleanmode =~ m{^dpkg-source}) {
+ my @cmd = @dpkgbuildpackage;
+ push @cmd, qw(-d) if $cleanmode =~ m{^dpkg-source-d};
+ push @cmd, qw(-T clean);
maybe_apply_patches_dirtily();
- runcmd_ordryrun_local @dpkgbuildpackage, qw(-d -T clean);
- } elsif ($cleanmode eq 'git') {
+ runcmd_ordryrun_local @cmd;
+ clean_tree_check_git_wd __
+ "tree contains uncommitted files (after running rules clean)";
+ } elsif ($cleanmode =~ m{^git(?!-)}) {
runcmd_ordryrun_local @git, qw(clean -xdf);
- } elsif ($cleanmode eq 'git-ff') {
+ } elsif ($cleanmode =~ m{^git-ff}) {
runcmd_ordryrun_local @git, qw(clean -xdff);
- } elsif ($cleanmode eq 'check') {
- my $leftovers = cmdoutput @git, qw(clean -xdn);
- if (length $leftovers) {
- print STDERR $leftovers, "\n" or confess $!;
- fail __
- "tree contains uncommitted files and --clean=check specified";
- }
+ } elsif ($cleanmode =~ m{^check}) {
+ clean_tree_check();
} elsif ($cleanmode eq 'none') {
} else {
- die "$cleanmode ?";
+ confess "$cleanmode ?";
}
}
sub build_prep ($) {
my ($wantsrc) = @_;
build_prep_early();
- # clean the tree if we're trying to include dirty changes in the
- # source package, or we are running the builder in $maindir
- clean_tree() if $includedirty || ($wantsrc & WANTSRC_BUILDER);
+ check_bpd_exists();
+ if (!building_source_in_playtree() || ($wantsrc & WANTSRC_BUILDER)
+ # Clean the tree because we're going to use the contents of
+ # $maindir. (We trying to include dirty changes in the source
+ # package, or we are running the builder in $maindir.)
+ || $cleanmode =~ m{always}) {
+ # Or because the user asked us to.
+ clean_tree();
+ } else {
+ # We don't actually need to do anything in $maindir, but we
+ # should do some kind of cleanliness check because (i) the
+ # user may have forgotten a `git add', and (ii) if the user
+ # said -wc we should still do the check.
+ clean_tree_check();
+ }
build_maybe_quilt_fixup();
if ($rmchanges) {
my $pat = changespat $version;
build_source();
midbuild_checkchanges_vanilla $wantsrc;
} else {
- if (!$clean_using_builder) {
- push @cmd, '--git-cleaner=true';
- }
+ push @cmd, '--git-cleaner=true';
}
maybe_unapply_patches_again();
if ($wantsrc & WANTSRC_BUILDER) {
}
} else {
$leafdir = basename $maindir;
+
+ if ($buildproductsdir ne '..') {
+ # Well, we are going to run dpkg-source -b which consumes
+ # origs from .. and generates output there. To make this
+ # work when the bpd is not .. , we would have to (i) link
+ # origs from bpd to .. , (ii) check for files that
+ # dpkg-source -b would/might overwrite, and afterwards
+ # (iii) move all the outputs back to the bpd (iv) except
+ # for the origs which should be deleted from .. if they
+ # weren't there beforehand. And if there is an error and
+ # we don't run to completion we would necessarily leave a
+ # mess. This is too much. The real way to fix this
+ # is for dpkg-source to have bpd support.
+ confess unless $includedirty;
+ fail __
+ "--include-dirty not supported with --build-products-dir, sorry";
+ }
+
changedir '..';
}
runcmd_ordryrun_local @cmd, $leafdir;
my $mv = sub {
my ($why, $l) = @_;
printdebug " renaming ($why) $l\n";
- rename "$l", bpd_abs()."/$l"
- or fail f_ "put in place new built file (%s): %s", $l, $!;
+ rename_link_xf 0, "$l", bpd_abs()."/$l"
+ or fail f_ "put in place new built file (%s): %s", $l, $@;
};
foreach my $l (split /\n/, getfield $dsc, 'Files') {
$l =~ m/\S+$/ or next;
fail f_ <<END, $dsc_hash
.dsc contains Dgit field referring to object %s
Your git tree does not have that object. Try `git fetch' from a
-plausible server (browse.dgit.d.o? alioth?), and try the import-dsc again.
+plausible server (browse.dgit.d.o? salsa?), and try the import-dsc again.
END
}
if ($oldhash && !is_fast_fwd $oldhash, $dsc_hash) {
my @dfi = dsc_files_info();
foreach my $fi (@dfi) {
my $f = $fi->{Filename};
+ # We transfer all the pieces of the dsc to the bpd, not just
+ # origs. This is by analogy with dgit fetch, which wants to
+ # keep them somewhere to avoid downloading them again.
+ # We make symlinks, though. If the user wants copies, then
+ # they can copy the parts of the dsc to the bpd using dcmd,
+ # or something.
my $here = "$buildproductsdir/$f";
if (lstat $here) {
- next if stat $here;
+ if (stat $here) {
+ next;
+ }
fail f_ "lstat %s works but stat gives %s !", $here, $!;
}
fail f_ "stat %s: %s", $here, $! unless $! == ENOENT;
+ printdebug "not in bpd, $f ...\n";
+ # $f does not exist in bpd, we need to transfer it
my $there = $dscfn;
- if ($dscfn =~ m#^(?:\./+)?\.\./+#) {
- $there = $';
- } elsif ($dscfn =~ m#^/#) {
- $there = $dscfn;
+ $there =~ s{[^/]+$}{$f} or confess "$there ?";
+ # $there is file we want, relative to user's cwd, or abs
+ printdebug "not in bpd, $f, test $there ...\n";
+ stat $there or fail f_
+ "import %s requires %s, but: %s", $dscfn, $there, $!;
+ if ($there =~ m#^(?:\./+)?\.\./+#) {
+ # $there is relative to user's cwd
+ my $there_from_parent = $';
+ if ($buildproductsdir !~ m{^/}) {
+ # abs2rel, despite its name, can take two relative paths
+ $there = File::Spec->abs2rel($there,$buildproductsdir);
+ # now $there is relative to bpd, great
+ printdebug "not in bpd, $f, abs2rel, $there ...\n";
+ } else {
+ $there = (dirname $maindir)."/$there_from_parent";
+ # now $there is absoute
+ printdebug "not in bpd, $f, rel2rel, $there ...\n";
+ }
+ } elsif ($there =~ m#^/#) {
+ # $there is absolute already
+ printdebug "not in bpd, $f, abs, $there ...\n";
} else {
fail f_
"cannot import %s which seems to be inside working tree!",
$dscfn;
}
- $there =~ s#/+[^/]+$## or fail f_
- "import %s requires .../%s, but it does not exist",
- $dscfn, $f;
- $there .= "/$f";
- my $test = $there =~ m{^/} ? $there : "../$there";
- stat $test or fail f_
- "import %s requires %s, but: %s", $dscfn, $test, $!;
symlink $there, $here or fail f_
"symlink %s to %s: %s", $there, $here, $!;
progress f_ "made symlink %s -> %s", $here, $there;
import_dsc_result $dstbranch, $newhash,
"dgit import-dsc: $info",
- f_ "results are in in git ref %s", $dstbranch;
+ f_ "results are in git ref %s", $dstbranch;
}
sub pre_archive_api_query () {
($om = $opts_opt_map{$1})) {
push @ropts, $_;
push @$om, $2;
+ } elsif (m/^--([-0-9a-z]+)\!:(.*)/s &&
+ !$opts_opt_cmdonly{$1} &&
+ ($om = $opts_opt_map{$1})) {
+ push @ropts, $_;
+ my $cmd = shift @$om;
+ @$om = ($cmd, grep { $_ ne $2 } @$om);
} elsif (m/^--(gbp|dpm)$/s) {
push @ropts, "--quilt=$1";
$quilt_mode = $1;
} elsif (s/^-wn$//s) {
push @ropts, $&;
$cleanmode = 'none';
- } elsif (s/^-wg$//s) {
+ } elsif (s/^-wg(f?)(a?)$//s) {
push @ropts, $&;
$cleanmode = 'git';
- } elsif (s/^-wgf$//s) {
- push @ropts, $&;
- $cleanmode = 'git-ff';
- } elsif (s/^-wd$//s) {
+ $cleanmode .= '-ff' if $1;
+ $cleanmode .= ',always' if $2;
+ } elsif (s/^-wd(d?)([na]?)$//s) {
push @ropts, $&;
$cleanmode = 'dpkg-source';
- } elsif (s/^-wdd$//s) {
- push @ropts, $&;
- $cleanmode = 'dpkg-source-d';
+ $cleanmode .= '-d' if $1;
+ $cleanmode .= ',no-check' if $2 eq 'n';
+ $cleanmode .= ',all-check' if $2 eq 'a';
} elsif (s/^-wc$//s) {
push @ropts, $&;
$cleanmode = 'check';
+ } elsif (s/^-wci$//s) {
+ push @ropts, $&;
+ $cleanmode = 'check,ignores';
} elsif (s/^-c([^=]*)\=(.*)$//s) {
push @git, '-c', $&;
$gitcfgs{cmdline}{$1} = [ $2 ];
chomp $@;
fail f_ <<END, $@;
On entry to dgit, %s
-This is a bug produced by something in in your execution environment.
+This is a bug produced by something in your execution environment.
Giving up.
END
}
if (!defined $cleanmode) {
local $access_forpush;
- $cleanmode = access_cfg('clean-mode', 'RETURN-UNDEF');
+ $cleanmode = access_cfg('clean-mode-newer', 'RETURN-UNDEF');
+ $cleanmode = undef if $cleanmode && $cleanmode !~ m/^$cleanmode_re$/;
+
+ $cleanmode //= access_cfg('clean-mode', 'RETURN-UNDEF');
$cleanmode //= 'dpkg-source';
badcfg f_ "unknown clean-mode \`%s'", $cleanmode unless
- $cleanmode =~ m/^($cleanmode_re)$(?!\n)/s;
+ $cleanmode =~ m/$cleanmode_re/;
}
$buildproductsdir //= access_cfg('build-products-dir', 'RETURN-UNDEF');
my $pre_fn = ${*::}{"pre_$cmd"};
$pre_fn->() if $pre_fn;
-record_maindir if $invoked_in_git_tree;
+if ($invoked_in_git_tree) {
+ changedir_git_toplevel();
+ record_maindir();
+}
git_slurp_config();
my $fn = ${*::}{"cmd_$cmd"};