) {
+ chomp or die;
+ printdebug "=> ", (messagequote $_), "\n";
+ m/\n/ or die "$_ ?";
+ push @{ $gitcfg{$`} }, $'; #';
}
- $git_get_config_memo{$c} = $v;
- return $v;
+ $!=0; $?=0;
+ close GITS
+ or ($!==0 && $?==256)
+ or failedcmd @cmd;
+}
+
+sub git_get_config ($) {
+ my ($c) = @_;
+ my $l = $gitcfg{$c};
+ printdebug"C $c ".(defined $l ? messagequote "'$l'" : "undef")."\n"
+ if $debuglevel >= 4;
+ $l or return undef;
+ @$l==1 or badcfg "multiple values for $c" if @$l > 1;
+ return $l->[0];
}
sub cfg {
@@ -549,10 +629,66 @@ sub access_quirk () {
return ('none',undef);
}
-our $access_pushing = 0;
+our $access_forpush;
+
+sub parse_cfg_bool ($$$) {
+ my ($what,$def,$v) = @_;
+ $v //= $def;
+ return
+ $v =~ m/^[ty1]/ ? 1 :
+ $v =~ m/^[fn0]/ ? 0 :
+ badcfg "$what needs t (true, y, 1) or f (false, n, 0) not \`$v'";
+}
+
+sub access_forpush_config () {
+ my $d = access_basedistro();
+
+ return 1 if
+ $new_package &&
+ parse_cfg_bool('new-private-pushers', 0,
+ cfg("dgit-distro.$d.new-private-pushers",
+ 'RETURN-UNDEF'));
+
+ my $v = cfg("dgit-distro.$d.readonly", 'RETURN-UNDEF');
+ $v //= 'a';
+ return
+ $v =~ m/^[ty1]/ ? 0 : # force readonly, forpush = 0
+ $v =~ m/^[fn0]/ ? 1 : # force nonreadonly, forpush = 1
+ $v =~ m/^[a]/ ? '' : # auto, forpush = ''
+ badcfg "readonly needs t (true, y, 1) or f (false, n, 0) or a (auto)";
+}
+
+sub access_forpush () {
+ $access_forpush //= access_forpush_config();
+ return $access_forpush;
+}
sub pushing () {
- $access_pushing = 1;
+ die "$access_forpush ?" if ($access_forpush // 1) ne 1;
+ badcfg "pushing but distro is configured readonly"
+ if access_forpush_config() eq '0';
+ $access_forpush = 1;
+ $supplementary_message = <<'END' unless $we_are_responder;
+Push failed, before we got started.
+You can retry the push, after fixing the problem, if you like.
+END
+ finalise_opts_opts();
+}
+
+sub notpushing () {
+ finalise_opts_opts();
+}
+
+sub supplementary_message ($) {
+ my ($msg) = @_;
+ if (!$we_are_responder) {
+ $supplementary_message = $msg;
+ return;
+ } elsif ($protovsn >= 3) {
+ responder_send_command "supplementary-message ".length($msg)
+ or die $!;
+ print PO $msg or die $!;
+ }
}
sub access_distros () {
@@ -570,13 +706,13 @@ sub access_distros () {
unshift @l, $instead_distro;
@l = grep { defined } @l;
- if ($access_pushing) {
+ if (access_forpush()) {
@l = map { ("$_/push", $_) } @l;
}
@l;
}
-sub access_cfg (@) {
+sub access_cfg_cfgs (@) {
my (@keys) = @_;
my @cfgs;
# The nesting of these loops determines the search order. We put
@@ -603,10 +739,21 @@ sub access_cfg (@) {
}
push @cfgs, map { "dgit.default.$_" } @realkeys;
push @cfgs, @rundef;
+ return @cfgs;
+}
+
+sub access_cfg (@) {
+ my (@keys) = @_;
+ my (@cfgs) = access_cfg_cfgs(@keys);
my $value = cfg(@cfgs);
return $value;
}
+sub access_cfg_bool ($$) {
+ my ($def, @keys) = @_;
+ parse_cfg_bool($keys[0], $def, access_cfg(@keys, 'RETURN-UNDEF'));
+}
+
sub string_to_ssh ($) {
my ($spec) = @_;
if ($spec =~ m/\s/) {
@@ -647,7 +794,7 @@ sub access_giturl (;$) {
my ($optional) = @_;
my $url = access_cfg('git-url','RETURN-UNDEF');
my $suffix;
- if (!defined $url) {
+ if (!length $url) {
my $proto = access_cfg('git-proto', 'RETURN-UNDEF');
return undef unless defined $proto;
$url =
@@ -897,7 +1044,7 @@ sub sshpsql ($$$) {
open P, "-|", @cmd or die $!;
while () {
chomp or die;
- printdebug("$debugprefix>|$_|\n");
+ printdebug(">|$_|\n");
push @rows, $_;
}
$!=0; $?=0; close P or failedcmd @cmd;
@@ -994,6 +1141,48 @@ sub archive_query_dummycat ($$) {
return sort { -version_compare($a->[0],$b->[0]); } @rows;
}
+#---------- tag format handling ----------
+
+sub access_cfg_tagformats () {
+ split /\,/, access_cfg('dgit-tag-format');
+}
+
+sub need_tagformat ($$) {
+ my ($fmt, $why) = @_;
+ fail "need to use tag format $fmt ($why) but also need".
+ " to use tag format $tagformat_want->[0] ($tagformat_want->[1])".
+ " - no way to proceed"
+ if $tagformat_want && $tagformat_want->[0] ne $fmt;
+ $tagformat_want = [$fmt, $why, $tagformat_want->[2] // 0];
+}
+
+sub select_tagformat () {
+ # sets $tagformatfn
+ return if $tagformatfn && !$tagformat_want;
+ die 'bug' if $tagformatfn && $tagformat_want;
+ # ... $tagformat_want assigned after previous select_tagformat
+
+ my (@supported) = grep { $_ ne 'maint' } access_cfg_tagformats();
+ printdebug "select_tagformat supported @supported\n";
+
+ $tagformat_want //= [ $supported[0], "distro access configuration", 0 ];
+ printdebug "select_tagformat specified @$tagformat_want\n";
+
+ my ($fmt,$why,$override) = @$tagformat_want;
+
+ fail "target distro supports tag formats @supported".
+ " but have to use $fmt ($why)"
+ unless $override
+ or grep { $_ eq $fmt } @supported;
+
+ $tagformat_want = undef;
+ $tagformat = $fmt;
+ $tagformatfn = ${*::}{"debiantag_$fmt"};
+
+ fail "trying to use unknown tag format \`$fmt' ($why) !"
+ unless $tagformatfn;
+}
+
#---------- archive query entrypoints and rest of program ----------
sub canonicalise_suite () {
@@ -1047,7 +1236,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
@@ -1056,7 +1245,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');
@@ -1065,6 +1254,9 @@ sub check_for_git () {
my $url = "$prefix/$package$suffix";
my @cmd = (qw(curl -sS -I), $url);
my $result = cmdoutput @cmd;
+ $result =~ s/^\S+ 200 .*\n\r?\n//;
+ # curl -sS -I with https_proxy prints
+ # HTTP/1.0 200 Connection established
$result =~ m/^\S+ (404|200) /s or
fail "unexpected results from git check query - ".
Dumper($prefix, $result);
@@ -1104,10 +1296,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 () {
@@ -1122,16 +1316,33 @@ sub git_write_tree () {
return $tree;
}
+sub remove_stray_gits () {
+ my @gitscmd = qw(find -name .git -prune -print0);
+ debugcmd "|",@gitscmd;
+ open GITS, "-|", @gitscmd or die $!;
+ {
+ local $/="\0";
+ while () {
+ chomp or die;
+ print STDERR "$us: warning: removing from source package: ",
+ (messagequote $_), "\n";
+ rmtree $_;
+ }
+ }
+ $!=0; $?=0; close GITS or failedcmd @gitscmd;
+}
+
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;
- fail "source package contains .git directory" if stat_exists '.git';
+
+ remove_stray_gits();
mktree_in_ud_here();
- my $format=get_source_format();
+ my ($format, $fopts) = get_source_format();
if (madformat($format)) {
rmtree '.pc';
}
@@ -1190,9 +1401,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;
}
@@ -1267,11 +1479,12 @@ sub generate_commit_from_dsc () {
my $f = $fi->{Filename};
die "$f ?" if $f =~ m#/|^\.|\.dsc$|\.tmp$#;
- link "../../../$f", $f
+ link_ltarget "../../../$f", $f
or $!==&ENOENT
or die "$f $!";
- complete_file_from_dsc('.', $fi);
+ complete_file_from_dsc('.', $fi)
+ or next;
if (is_orig_file($f)) {
link $f, "../../../../$f"
@@ -1311,7 +1524,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';
@@ -1366,10 +1579,10 @@ sub complete_file_from_dsc ($$) {
my $furl = $dscurl;
$furl =~ s{/[^/]+$}{};
$furl .= "/$f";
- die "$f ?" unless $f =~ m/^${package}_/;
+ die "$f ?" unless $f =~ m/^\Q${package}\E_/;
die "$f ?" if $f =~ m#/#;
runcmd_ordryrun_local @curl,qw(-o),$tf,'--',"$furl";
- next if !act_local();
+ return 0 if !act_local();
$downloaded = 1;
}
@@ -1383,13 +1596,16 @@ sub complete_file_from_dsc ($$) {
" demands hash $fi->{Hash} ".
($downloaded ? "(got wrong file from archive!)"
: "(perhaps you should delete this file?)");
+
+ return 1;
}
sub ensure_we_have_orig () {
foreach my $fi (dsc_files_info()) {
my $f = $fi->{Filename};
next unless is_orig_file($f);
- complete_file_from_dsc('..', $fi);
+ complete_file_from_dsc('..', $fi)
+ or next;
}
}
@@ -1401,14 +1617,14 @@ sub git_fetch_us () {
runcmd_ordryrun_local @git, qw(fetch -p -n -q), access_giturl(), @specs;
my %here;
- my $tagpat = debiantag('*',access_basedistro);
+ my @tagpats = debiantags('*',access_basedistro);
- git_for_each_ref("refs/tags/".$tagpat, sub {
+ git_for_each_ref([map { "refs/tags/$_" } @tagpats], sub {
my ($objid,$objtype,$fullrefname,$reftail) = @_;
printdebug "currently $fullrefname=$objid\n";
$here{$fullrefname} = $objid;
});
- git_for_each_ref(lrfetchrefs."/tags/".$tagpat, sub {
+ git_for_each_ref([map { lrfetchrefs."/tags/".$_ } @tagpats], sub {
my ($objid,$objtype,$fullrefname,$reftail) = @_;
my $lref = "refs".substr($fullrefname, length lrfetchrefs);
printdebug "offered $lref=$objid\n";
@@ -1532,7 +1748,10 @@ sub set_local_git_config ($$) {
runcmd @git, qw(config), $k, $v;
}
-sub setup_mergechangelogs () {
+sub setup_mergechangelogs (;$) {
+ my ($always) = @_;
+ return unless $always || access_cfg_bool(1, 'setup-mergechangelogs');
+
my $driver = 'dpkg-mergechangelogs';
my $cb = "merge.$driver";
my $attrs = '.git/info/attributes';
@@ -1559,12 +1778,32 @@ sub setup_mergechangelogs () {
rename "$attrs.new", "$attrs" or die "$attrs: $!";
}
+sub setup_useremail (;$) {
+ my ($always) = @_;
+ return unless $always || access_cfg_bool(1, 'setup-useremail');
+
+ my $setup = sub {
+ my ($k, $envvar) = @_;
+ my $v = access_cfg("user-$k", 'RETURN-UNDEF') // $ENV{$envvar};
+ return unless defined $v;
+ set_local_git_config "user.$k", $v;
+ };
+
+ $setup->('email', 'DEBEMAIL');
+ $setup->('name', 'DEBFULLNAME');
+}
+
+sub setup_new_tree () {
+ setup_mergechangelogs();
+ setup_useremail();
+}
+
sub clone ($) {
my ($dstdir) = @_;
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);
@@ -1588,7 +1827,7 @@ sub clone ($) {
$vcsgiturl =~ s/\s+-b\s+\S+//g;
runcmd @git, qw(remote add vcs-git), $vcsgiturl;
}
- setup_mergechangelogs();
+ setup_new_tree();
runcmd @git, qw(reset --hard), lrref();
printdone "ready for work in $dstdir";
}
@@ -1609,12 +1848,19 @@ sub pull () {
}
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;
- return if !$! && !$?;
- if (!$! && $?==256) {
+ $!=0; $?=-1; system @cmd;
+ return if !$?;
+ if ($?==256) {
fail "working tree is dirty (does not match HEAD)";
} else {
failedcmd @cmd;
@@ -1641,11 +1887,32 @@ sub commit_quilty_patch () {
progress "nothing quilty to commit, ok.";
return;
}
- runcmd_ordryrun_local @git, qw(add), sort keys %adds;
+ my @adds = map { s/[][*?\\]/\\$&/g; $_; } sort keys %adds;
+ runcmd_ordryrun_local @git, qw(add -f), @adds;
commit_admin "Commit Debian 3.0 (quilt) metadata";
}
sub get_source_format () {
+ my %options;
+ if (open F, "debian/source/options") {
+ while () {
+ next if m/^\s*\#/;
+ next unless m/\S/;
+ s/\s+$//; # ignore missing final newline
+ if (m/\s*\#\s*/) {
+ my ($k, $v) = ($`, $'); #');
+ $v =~ s/^"(.*)"$/$1/;
+ $options{$k} = $v;
+ } else {
+ $options{$_} = 1;
+ }
+ }
+ F->error and die $!;
+ close F;
+ } else {
+ die $! unless $!==&ENOENT;
+ }
+
if (!open F, "debian/source/format") {
die $! unless $!==&ENOENT;
return '';
@@ -1653,17 +1920,21 @@ sub get_source_format () {
$_ = ;
F->error and die $!;
chomp;
- return $_;
+ return ($_, \%options);
}
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;
}
@@ -1680,7 +1951,7 @@ sub push_parse_changelog ($) {
my $dscfn = dscfn($cversion);
- return ($clogp, $cversion, $tag, $dscfn);
+ return ($clogp, $cversion, $dscfn);
}
sub push_parse_dsc ($$$) {
@@ -1693,13 +1964,38 @@ sub push_parse_dsc ($$$) {
" but debian/changelog is for $package $cversion";
}
-sub push_mktag ($$$$$$$) {
- my ($head,$clogp,$tag,
- $dscfn,
+sub push_tagwants ($$$$) {
+ my ($cversion, $dgithead, $maintviewhead, $tfbase) = @_;
+ my @tagwants;
+ push @tagwants, {
+ TagFn => \&debiantag,
+ Objid => $dgithead,
+ TfSuffix => '',
+ View => 'dgit',
+ };
+ if (defined $maintviewhead) {
+ push @tagwants, {
+ TagFn => \&debiantag_maintview,
+ Objid => $maintviewhead,
+ TfSuffix => '-maintview',
+ View => 'maint',
+ };
+ }
+ foreach my $tw (@tagwants) {
+ $tw->{Tag} = $tw->{TagFn}($cversion, access_basedistro);
+ $tw->{Tfn} = sub { $tfbase.$tw->{TfSuffix}.$_[0]; };
+ }
+ return @tagwants;
+}
+
+sub push_mktags ($$ $$ $) {
+ my ($clogp,$dscfn,
$changesfile,$changesfilewhat,
- $tfn) = @_;
+ $tagwants) = @_;
+
+ die unless $tagwants->[0]{View} eq 'dgit';
- $dsc->{$ourdscfield[0]} = $head;
+ $dsc->{$ourdscfield[0]} = $tagwants->[0]{Objid};
$dsc->save("$dscfn.tmp") or die $!;
my $changes = parsecontrol($changesfile,$changesfilewhat);
@@ -1717,42 +2013,66 @@ sub push_mktag ($$$$$$$) {
my $authline = clogp_authline $clogp;
my $delibs = join(" ", "",@deliberatelies);
my $declaredistro = access_basedistro();
- open TO, '>', $tfn->('.tmp') or die $!;
- print TO <{Tfn};
+ my $head = $tw->{Objid};
+ my $tag = $tw->{Tag};
+
+ open TO, '>', $tfn->('.tmp') or die $!;
+ print TO <{View} eq 'dgit') {
+ print TO <{View} eq 'maint') {
+ print TO <('.tmp');
- if ($sign) {
- if (!defined $keyid) {
- $keyid = access_cfg('keyid','RETURN-UNDEF');
- }
- unlink $tfn->('.tmp.asc') or $!==&ENOENT or die $!;
- my @sign_cmd = (@gpg, qw(--detach-sign --armor));
- push @sign_cmd, qw(-u),$keyid if defined $keyid;
- push @sign_cmd, $tfn->('.tmp');
- runcmd_ordryrun @sign_cmd;
- if (act_scary()) {
- $tagobjfn = $tfn->('.signed.tmp');
- runcmd shell_cmd "exec >$tagobjfn", qw(cat --),
- $tfn->('.tmp'), $tfn->('.tmp.asc');
+ my $tagobjfn = $tfn->('.tmp');
+ if ($sign) {
+ if (!defined $keyid) {
+ $keyid = access_cfg('keyid','RETURN-UNDEF');
+ }
+ if (!defined $keyid) {
+ $keyid = getfield $clogp, 'Maintainer';
+ }
+ unlink $tfn->('.tmp.asc') or $!==&ENOENT or die $!;
+ my @sign_cmd = (@gpg, qw(--detach-sign --armor));
+ push @sign_cmd, qw(-u),$keyid if defined $keyid;
+ push @sign_cmd, $tfn->('.tmp');
+ runcmd_ordryrun @sign_cmd;
+ if (act_scary()) {
+ $tagobjfn = $tfn->('.signed.tmp');
+ runcmd shell_cmd "exec >$tagobjfn", qw(cat --),
+ $tfn->('.tmp'), $tfn->('.tmp.asc');
+ }
}
- }
+ return $tagobjfn;
+ };
- return ($tagobjfn);
+ my @r = map { $mktag->($_); } @$tagwants;
+ return @r;
}
sub sign_changes ($) {
@@ -1769,16 +2089,25 @@ sub sign_changes ($) {
sub dopush ($) {
my ($forceflag) = @_;
printdebug "actually entering push\n";
+ supplementary_message(<<'END');
+Push failed, while preparing your push.
+You can retry the push, after fixing the problem, if you like.
+END
+
+ need_tagformat 'new', "quilt mode $quilt_mode"
+ if quiltmode_splitbrain;
+
prep_ud();
access_giturl(); # check that success is vaguely likely
+ select_tagformat();
my $clogpfn = ".git/dgit/changelog.822.tmp";
runcmd shell_cmd "exec >$clogpfn", qw(dpkg-parsechangelog);
responder_send_file('parsed-changelog', $clogpfn);
- my ($clogp, $cversion, $tag, $dscfn) =
+ my ($clogp, $cversion, $dscfn) =
push_parse_changelog("$clogpfn");
my $dscpath = "$buildproductsdir/$dscfn";
@@ -1792,9 +2121,33 @@ sub dopush ($) {
my $format = getfield $dsc, 'Format';
printdebug "format $format\n";
+
+ my $actualhead = git_rev_parse('HEAD');
+ my $dgithead = $actualhead;
+ my $maintviewhead = undef;
+
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($actualhead, $upstreamversion);
+ $dgitview or fail
+ "--quilt=$quilt_mode but no cached dgit view:
+ perhaps tree changed since dgit build[-source] ?";
+ $split_brain = 1;
+ $dgithead = $dgitview;
+ $maintviewhead = $actualhead;
+ changedir '../../../..';
+ prep_ud(); # so _only_subdir() works, below
+ } else {
+ commit_quilty_patch();
+ }
}
+
check_not_dirty();
changedir $ud;
progress "checking that $dscfn corresponds to HEAD";
@@ -1804,9 +2157,9 @@ sub dopush ($) {
check_for_vendor_patches() if madformat($dsc->{format});
changedir '../../../..';
my $diffopt = $debuglevel>0 ? '--exit-code' : '--quiet';
- my @diffcmd = (@git, qw(diff), $diffopt, $tree);
+ my @diffcmd = (@git, qw(diff), $diffopt, $tree, $dgithead);
debugcmd "+",@diffcmd;
- $!=0; $?=0;
+ $!=0; $?=-1;
my $r = system @diffcmd;
if ($r) {
if ($r==256) {
@@ -1818,34 +2171,26 @@ sub dopush ($) {
failedcmd @diffcmd;
}
}
-#fetch from alioth
-#do fast forward check and maybe fake merge
-# if (!is_fast_fwd(mainbranch
-# runcmd @git, qw(fetch -p ), "$alioth_git/$package.git",
-# map { lref($_).":".rref($_) }
-# (uploadbranch());
- 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";
}
responder_send_file('changes',$changesfile);
- responder_send_command("param head $head");
+ responder_send_command("param head $dgithead");
responder_send_command("param csuite $csuite");
+ responder_send_command("param tagformat $tagformat");
+ if (quiltmode_splitbrain) {
+ die unless ($protovsn//4) >= 4;
+ responder_send_command("param maint-view $maintviewhead");
+ }
if (deliberately_not_fast_forward) {
git_for_each_ref(lrfetchrefs, sub {
@@ -1856,31 +2201,63 @@ sub dopush ($) {
});
}
- my $tfn = sub { ".git/dgit/tag$_[0]"; };
- my $tagobjfn;
+ my @tagwants = push_tagwants($cversion, $dgithead, $maintviewhead,
+ ".git/dgit/tag");
+ my @tagobjfns;
+ supplementary_message(<<'END');
+Push failed, while signing the tag.
+You can retry the push, after fixing the problem, if you like.
+END
+ # If we manage to sign but fail to record it anywhere, it's fine.
if ($we_are_responder) {
- $tagobjfn = $tfn->('.signed.tmp');
- responder_receive_files('signed-tag', $tagobjfn);
+ @tagobjfns = map { $_->{Tfn}('.signed-tmp') } @tagwants;
+ responder_receive_files('signed-tag', @tagobjfns);
} else {
- $tagobjfn =
- push_mktag($head,$clogp,$tag,
- $dscpath,
- $changesfile,$changesfile,
- $tfn);
+ @tagobjfns = push_mktags($clogp,$dscpath,
+ $changesfile,$changesfile,
+ \@tagwants);
}
+ supplementary_message(<<'END');
+Push failed, *after* signing the tag.
+If you want to try again, you should use a new version number.
+END
- my $tag_obj_hash = cmdoutput @git, qw(hash-object -w -t tag), $tagobjfn;
- runcmd_ordryrun @git, qw(verify-tag), $tag_obj_hash;
- runcmd_ordryrun_local @git, qw(update-ref), "refs/tags/$tag", $tag_obj_hash;
+ pairwise { $a->{TagObjFn} = $b } @tagwants, @tagobjfns;
+
+ foreach my $tw (@tagwants) {
+ my $tag = $tw->{Tag};
+ my $tagobjfn = $tw->{TagObjFn};
+ my $tag_obj_hash =
+ cmdoutput @git, qw(hash-object -w -t tag), $tagobjfn;
+ runcmd_ordryrun @git, qw(verify-tag), $tag_obj_hash;
+ runcmd_ordryrun_local
+ @git, qw(update-ref), "refs/tags/$tag", $tag_obj_hash;
+ }
+ supplementary_message(<<'END');
+Push failed, while updating the remote git repository - see messages above.
+If you want to try again, you should use a new version number.
+END
if (!check_for_git()) {
create_remote_git_repo();
}
- runcmd_ordryrun @git, qw(push),access_giturl(),
- $forceflag."HEAD:".rrref(), $forceflag."refs/tags/$tag";
- runcmd_ordryrun @git, qw(update-ref -m), 'dgit push', lrref(), 'HEAD';
+ my @pushrefs = $forceflag."HEAD:".rrref();
+ foreach my $tw (@tagwants) {
+ my $view = $tw->{View};
+ next unless $view eq 'dgit'
+ or any { $_ eq $view } access_cfg_tagformats();
+ push @pushrefs, $forceflag."refs/tags/$tw->{Tag}";
+ }
+
+ runcmd_ordryrun @git, qw(push),access_giturl(), @pushrefs;
+ runcmd_ordryrun @git, qw(update-ref -m), 'dgit push', lrref(), $dgithead;
+
+ supplementary_message(<<'END');
+Push failed, after updating the remote git repository.
+If you want to try again, you must use a new version number.
+END
if ($we_are_responder) {
my $dryrunsuffix = act_local() ? "" : ".tmp";
responder_receive_files('signed-dsc-changes',
@@ -1895,16 +2272,25 @@ sub dopush ($) {
sign_changes $changesfile;
}
+ supplementary_message(<&STDOUT" or die $!;
@@ -2060,12 +2458,17 @@ sub cmd_remote_push_build_host {
autoflush STDOUT 1;
$vsnwant //= 1;
- fail "build host has dgit rpush protocol version".
- " $rpushprotovsn but invocation host has $vsnwant"
- unless grep { $rpushprotovsn eq $_ } split /,/, $vsnwant;
+ ($protovsn) = grep {
+ $vsnwant =~ m{^(?:.*,)?$_(?:,.*)?$}
+ } @rpushprotovsn_support;
- responder_send_command("dgit-remote-push-ready $rpushprotovsn");
+ fail "build host has dgit rpush protocol versions ".
+ (join ",", @rpushprotovsn_support).
+ " but invocation host has $vsnwant"
+ unless defined $protovsn;
+ responder_send_command("dgit-remote-push-ready $protovsn");
+ rpush_handle_protovsn_bothends();
changedir $dir;
&cmd_push;
}
@@ -2074,6 +2477,13 @@ sub cmd_remote_push_responder { cmd_remote_push_build_host(); }
# ... for compatibility with proto vsn.1 dgit (just so that user gets
# a good error message)
+sub rpush_handle_protovsn_bothends () {
+ if ($protovsn < 4) {
+ need_tagformat 'old', "rpush negotiated protocol $protovsn";
+ }
+ select_tagformat();
+}
+
our $i_tmp;
sub i_cleanup {
@@ -2110,7 +2520,8 @@ sub cmd_rpush {
$dir = nextarg;
}
$dir =~ s{^-}{./-};
- my @rargs = ($dir,$rpushprotovsn);
+ my @rargs = ($dir);
+ push @rargs, join ",", @rpushprotovsn_support;
my @rdgit;
push @rdgit, @dgit;
push @rdgit, @ropts;
@@ -2128,7 +2539,15 @@ sub cmd_rpush {
}
$i_child_pid = open2(\*RO, \*RI, @cmd);
changedir $i_tmp;
- initiator_expect { m/^dgit-remote-push-ready/ };
+ ($protovsn) = initiator_expect { m/^dgit-remote-push-ready (\S+)/ };
+ die "$protovsn ?" unless grep { $_ eq $protovsn } @rpushprotovsn_support;
+ $supplementary_message = '' unless $protovsn >= 3;
+
+ fail "rpush negotiated protocol version $protovsn".
+ " which does not support quilt mode $quilt_mode"
+ if quiltmode_splitbrain;
+
+ rpush_handle_protovsn_bothends();
for (;;) {
my ($icmd,$iargs) = initiator_expect {
m/^(\S+)(?: (.*))?$/;
@@ -2144,6 +2563,11 @@ sub i_resp_progress ($) {
progress $msg;
}
+sub i_resp_supplementary_message ($) {
+ my ($rhs) = @_;
+ $supplementary_message = protocol_read_bytes \*RO, $rhs;
+}
+
sub i_resp_complete {
my $pid = $i_child_pid;
$i_child_pid = undef; # prevents killing some other process with same pid
@@ -2195,13 +2619,13 @@ sub i_resp_want ($) {
print RI "files-end\n" or die $!;
}
-our ($i_clogp, $i_version, $i_tag, $i_dscfn, $i_changesfn);
+our ($i_clogp, $i_version, $i_dscfn, $i_changesfn);
sub i_localname_parsed_changelog {
return "remote-changelog.822";
}
sub i_file_parsed_changelog {
- ($i_clogp, $i_version, $i_tag, $i_dscfn) =
+ ($i_clogp, $i_version, $i_dscfn) =
push_parse_changelog "$i_tmp/remote-changelog.822";
die if $i_dscfn =~ m#/|^\W#;
}
@@ -2228,17 +2652,26 @@ sub i_want_signed_tag {
my $head = $i_param{'head'};
die if $head =~ m/[^0-9a-f]/ || $head !~ m/^../;
+ my $maintview = $i_param{'maint-view'};
+ die if defined $maintview && $maintview =~ m/[^0-9a-f]/;
+
+ select_tagformat();
+ if ($protovsn >= 4) {
+ my $p = $i_param{'tagformat'} // '';
+ $p eq $tagformat
+ or badproto \*RO, "tag format mismatch: $p vs. $tagformat";
+ }
+
die unless $i_param{'csuite'} =~ m/^$suite_re$/;
$csuite = $&;
push_parse_dsc $i_dscfn, 'remote dsc', $i_version;
- my $tagobjfn =
- push_mktag $head, $i_clogp, $i_tag,
- $i_dscfn,
- $i_changesfn, 'remote changes',
- sub { "tag$_[0]"; };
+ my @tagwants = push_tagwants $i_version, $head, $maintview, "tag";
- return $tagobjfn;
+ return
+ push_mktags $i_clogp, $i_dscfn,
+ $i_changesfn, 'remote changes',
+ \@tagwants;
}
sub i_want_signed_dsc_changes {
@@ -2280,21 +2713,32 @@ END
local $ENV{'EDITOR'} = cmdoutput qw(realpath --), $0;
local $ENV{'VISUAL'} = $ENV{'EDITOR'};
local $ENV{$fakeeditorenv} = cmdoutput qw(realpath --), $descfn;
- runcmd_ordryrun_local @dpkgsource, qw(--commit .), $patchname;
+ runcmd @dpkgsource, qw(--commit .), $patchname;
}
}
-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 ($) {
@@ -2306,8 +2750,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
#
@@ -2333,13 +2867,6 @@ sub quiltify ($$) {
# After traversing PT, we git commit the changes which
# should be contained within debian/patches.
- changedir '../fake';
- mktree_in_ud_here();
- rmtree '.pc';
- runcmd @git, 'add', '.';
- 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:
@@ -2437,7 +2964,7 @@ sub quiltify ($$) {
my $abbrev = sub {
my $x = $_[0]{Commit};
$x =~ s/(.*?[0-9a-z]{8})[0-9a-z]*$/$1/;
- return $;
+ return $x;
};
my $reportnot = sub {
my ($notp) = @_;
@@ -2452,6 +2979,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') {
@@ -2461,7 +2989,8 @@ sub quiltify ($$) {
die "$quilt_mode ?";
}
- my $time = time;
+ my $time = $ENV{'GIT_COMMITTER_DATE'} || time;
+ $time =~ s/\s.*//; # trim timezone from GIT_COMMITTER_DATE
my $ncommits = 3;
my $msg = cmdoutput @git, qw(log), "-n$ncommits";
@@ -2524,12 +3053,206 @@ sub quiltify ($$) {
}
sub build_maybe_quilt_fixup () {
- my $format=get_source_format;
+ my ($format,$fopts) = get_source_format;
return unless madformat $format;
# sigh
check_for_vendor_patches();
+ my $clogp = parsechangelog();
+ my $headref = git_rev_parse('HEAD');
+
+ prep_ud();
+ changedir $ud;
+
+ my $upstreamversion=$version;
+ $upstreamversion =~ s/-[^-]*$//;
+
+ if ($fopts->{'single-debian-patch'}) {
+ quilt_fixup_singlepatch($clogp, $headref, $upstreamversion);
+ } else {
+ 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);
+}
+
+sub quilt_fixup_mkwork ($) {
+ my ($headref) = @_;
+
+ mkdir "work" or die $!;
+ changedir "work";
+ mktree_in_ud_here();
+ runcmd @git, qw(reset -q --hard), $headref;
+}
+
+sub quilt_fixup_linkorigs ($$) {
+ my ($upstreamversion, $fn) = @_;
+ # calls $fn->($leafname);
+
+ foreach my $f (<../../../../*>) { #/){
+ my $b=$f; $b =~ s{.*/}{};
+ {
+ local ($debuglevel) = $debuglevel-1;
+ printdebug "QF linkorigs $b, $f ?\n";
+ }
+ next unless is_orig_file $b, srcfn $upstreamversion,'';
+ printdebug "QF linkorigs $b, $f Y\n";
+ link_ltarget $f, $b or die "$b $!";
+ $fn->($b);
+ }
+}
+
+sub quilt_fixup_delete_pc () {
+ runcmd @git, qw(rm -rqf .pc);
+ commit_admin "Commit removal of .pc (quilt series tracking data)";
+}
+
+sub quilt_fixup_singlepatch ($$$) {
+ my ($clogp, $headref, $upstreamversion) = @_;
+
+ progress "starting quiltify (single-debian-patch)";
+
+ # dpkg-source --commit generates new patches even if
+ # single-debian-patch is in debian/source/options. In order to
+ # get it to generate debian/patches/debian-changes, it is
+ # necessary to build the source package.
+
+ quilt_fixup_linkorigs($upstreamversion, sub { });
+ quilt_fixup_mkwork($headref);
+
+ rmtree("debian/patches");
+
+ runcmd @dpkgsource, qw(-b .);
+ chdir "..";
+ runcmd @dpkgsource, qw(-x), (srcfn $version, ".dsc");
+ rename srcfn("$upstreamversion", "/debian/patches"),
+ "work/debian/patches";
+
+ 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 "examining quilt state (multiple patches, $quilt_mode mode)";
+
# Our objective is:
# - honour any existing .pc in case it has any strangeness
# - determine the git commit corresponding to the tip of
@@ -2553,7 +3276,7 @@ sub build_maybe_quilt_fixup () {
# can work. We do this as follows:
# 1. Collect all relevant .orig from parent directory
# 2. Generate a debian.tar.gz out of
- # debian/{patches,rules,source/format}
+ # debian/{patches,rules,source/format,source/options}
# 3. Generate a fake .dsc containing just these fields:
# Format Source Version Files
# 4. Extract the fake .dsc
@@ -2574,65 +3297,67 @@ sub build_maybe_quilt_fixup () {
# 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 $clogp = parsechangelog();
- my $headref = git_rev_parse('HEAD');
-
- prep_ud();
- changedir $ud;
+ # 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 $upstreamversion=$version;
- $upstreamversion =~ s/-[^-]*$//;
+ my $splitbrain_cachekey;
- my $fakeversion="$upstreamversion-~~DGITFAKE";
+ quilt_make_fake_dsc($upstreamversion);
- my $fakedsc=new IO::File 'fake.dsc', '>' or die $!;
- print $fakedsc </dev/null';
- my $fh = new IO::File $b, '<' or die "$b $!";
- stat $fh or die $!;
- my $size = -s _;
+ my $fakexdir= $package.'-'.(stripepoch $upstreamversion);
+ rename $fakexdir, "fake" or die "$fakexdir $!";
- $md->addfile($fh);
- print $fakedsc " ".$md->hexdigest." $size $b\n" or die $!;
- };
+ changedir 'fake';
- foreach my $f (<../../../../*>) { #/){
- my $b=$f; $b =~ s{.*/}{};
- next unless is_orig_file $b, srcfn $upstreamversion,'';
- link $f, $b or die "$b $!";
- $dscaddfile->($b);
- }
+ remove_stray_gits();
+ mktree_in_ud_here();
- my @files=qw(debian/source/format debian/rules);
- if (stat_exists '../../../debian/patches') {
- push @files, 'debian/patches';
- }
+ rmtree '.pc';
- my $debtar= srcfn $fakeversion,'.debian.tar.gz';
- runcmd qw(env GZIP=-1 tar -zcf), "./$debtar", qw(-C ../../..), @files;
+ runcmd @git, qw(add -Af .);
+ my $unapplied=git_write_tree();
+ printdebug "fake orig tree object $unapplied\n";
- $dscaddfile->($debtar);
- close $fakedsc or die $!;
+ ensuredir '.pc';
- runcmd qw(sh -ec), 'exec dpkg-source --no-check -x fake.dsc >/dev/null';
+ runcmd qw(sh -ec),
+ 'exec dpkg-source --before-build . >/dev/null';
- my $fakexdir= $package.'-'.(stripepoch $upstreamversion);
- rename $fakexdir, "fake" or die "$fakexdir $!";
+ changedir '..';
- mkdir "work" or die $!;
- changedir "work";
- mktree_in_ud_here();
- runcmd @git, qw(reset --hard), $headref;
+ quilt_fixup_mkwork($headref);
my $mustdeletepc=0;
if (stat_exists ".pc") {
@@ -2643,7 +3368,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 $!;
@@ -2654,12 +3431,8 @@ END
commit_quilty_patch();
if ($mustdeletepc) {
- runcmd @git, qw(rm -rqf .pc);
- commit_admin "Commit removal of .pc (quilt series tracking data)";
+ quilt_fixup_delete_pc();
}
-
- changedir '../../../..';
- runcmd @git, qw(pull --ff-only -q .git/dgit/unpack/work master);
}
sub quilt_fixup_editor () {
@@ -2681,12 +3454,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;
- 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 {
- build_prep();
- my @dbp = (@dpkgbuildpackage, qw(-us -uc), changesopts(), @ARGV);
- massage_dbp_args \@dbp;
- runcmd_ordryrun_local @dbp;
+ my @dbp = (@dpkgbuildpackage, qw(-us -uc), changesopts_initial(), @ARGV);
+ 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_git_build {
- build_prep();
+sub cmd_gbp_build {
my @dbp = @dpkgbuildpackage;
- massage_dbp_args \@dbp;
- my @cmd =
- (qw(git-buildpackage -us -uc --git-no-sign-tags),
- "--git-builder=@dbp");
- unless (grep { m/^--git-debian-branch|^--git-ignore-branch/ } @ARGV) {
- canonicalise_suite();
- push @cmd, "--git-debian-branch=".lbranch();
+
+ my $wantsrc = massage_dbp_args \@dbp, \@ARGV;
+
+ my @cmd;
+ if (length executable_on_path('git-buildpackage')) {
+ @cmd = qw(git-buildpackage);
+ } else {
+ @cmd = qw(gbp buildpackage);
}
- push @cmd, changesopts();
- runcmd_ordryrun_local @cmd, @ARGV;
+ push @cmd, (qw(-us -uc --git-no-sign-tags), "--git-builder=@dbp");
+
+ if ($wantsrc > 0) {
+ build_source();
+ } else {
+ if (!$clean_using_builder) {
+ push @cmd, '--git-cleaner=true';
+ }
+ build_prep();
+ }
+ 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;
+ }
+ maybe_unapply_patches_again();
printdone "build successful\n";
}
+sub cmd_git_build { cmd_gbp_build(); } # compatibility with <= 1.0
sub build_source {
+ 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",
@@ -2811,35 +3740,50 @@ 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, @ARGV, qw(-d), $isuite, $dscfn;
+ runcmd_ordryrun_local @sbuild, qw(-d), $isuite, @ARGV, $dscfn;
my @changesfiles = glob $pat;
@changesfiles = sort {
($b =~ m/_source\.changes$/ <=> $a =~ m/_source\.changes$/)
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 $!;
}
@@ -2848,6 +3792,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();
}
@@ -2870,7 +3816,17 @@ sub cmd_clone_dgit_repos_server {
sub cmd_setup_mergechangelogs {
badusage "no arguments allowed to dgit setup-mergechangelogs" if @ARGV;
- setup_mergechangelogs();
+ setup_mergechangelogs(1);
+}
+
+sub cmd_setup_useremail {
+ badusage "no arguments allowed to dgit setup-mergechangelogs" if @ARGV;
+ setup_useremail(1);
+}
+
+sub cmd_setup_new_tree {
+ badusage "no arguments allowed to dgit setup-tree" if @ARGV;
+ setup_new_tree();
}
#---------- argument parsing and main program ----------
@@ -2880,6 +3836,44 @@ sub cmd_version {
exit 0;
}
+our (%valopts_long, %valopts_short);
+our @rvalopts;
+
+sub defvalopt ($$$$) {
+ my ($long,$short,$val_re,$how) = @_;
+ my $oi = { Long => $long, Short => $short, Re => $val_re, How => $how };
+ $valopts_long{$long} = $oi;
+ $valopts_short{$short} = $oi;
+ # $how subref should:
+ # do whatever assignemnt or thing it likes with $_[0]
+ # if the option should not be passed on to remote, @rvalopts=()
+ # or $how can be a scalar ref, meaning simply assign the value
+}
+
+defvalopt '--since-version', '-v', '[^_]+|_', \$changes_since_version;
+defvalopt '--distro', '-d', '.+', \$idistro;
+defvalopt '', '-k', '.+', \$keyid;
+defvalopt '--existing-package','', '.*', \$existing_package;
+defvalopt '--build-products-dir','','.*', \$buildproductsdir;
+defvalopt '--clean', '', $cleanmode_re, \$cleanmode;
+defvalopt '--quilt', '', $quilt_modes_re, \$quilt_mode;
+
+defvalopt '', '-c', '.*=.*', sub { push @git, '-c', @_; };
+
+defvalopt '', '-C', '.+', sub {
+ ($changesfile) = (@_);
+ if ($changesfile =~ s#^(.*)/##) {
+ $buildproductsdir = $1;
+ }
+};
+
+defvalopt '--initiator-tempdir','','.*', sub {
+ ($initiator_tempdir) = (@_);
+ $initiator_tempdir =~ m#^/# or
+ badusage "--initiator-tempdir must be used specify an".
+ " absolute, not relative, directory."
+};
+
sub parseopts () {
my $om;
@@ -2889,6 +3883,27 @@ sub parseopts () {
@ssh = ($ENV{'GIT_SSH'});
}
+ my $oi;
+ my $val;
+ my $valopt = sub {
+ my ($what) = @_;
+ @rvalopts = ($_);
+ if (!defined $val) {
+ badusage "$what needs a value" unless @ARGV;
+ $val = shift @ARGV;
+ push @rvalopts, $val;
+ }
+ badusage "bad value \`$val' for $what" unless
+ $val =~ m/^$oi->{Re}$(?!\n)/s;
+ my $how = $oi->{How};
+ if (ref($how) eq 'SCALAR') {
+ $$how = $val;
+ } else {
+ $how->($val);
+ }
+ push @ropts, @rvalopts;
+ };
+
while (@ARGV) {
last unless $ARGV[0] =~ m/^-/;
$_ = shift @ARGV;
@@ -2910,10 +3925,7 @@ sub parseopts () {
} elsif (m/^--new$/) {
push @ropts, $_;
$new_package=1;
- } elsif (m/^--since-version=([^_]+|_)$/) {
- push @ropts, $_;
- $changes_since_version = $1;
- } elsif (m/^--([-0-9a-z]+)=(.*)/s &&
+ } elsif (m/^--([-0-9a-z]+)=(.+)/s &&
($om = $opts_opt_map{$1}) &&
length $om->[0]) {
push @ropts, $_;
@@ -2923,30 +3935,6 @@ sub parseopts () {
($om = $opts_opt_map{$1})) {
push @ropts, $_;
push @$om, $2;
- } elsif (m/^--existing-package=(.*)/s) {
- push @ropts, $_;
- $existing_package = $1;
- } elsif (m/^--initiator-tempdir=(.*)/s) {
- $initiator_tempdir = $1;
- $initiator_tempdir =~ m#^/# or
- badusage "--initiator-tempdir must be used specify an".
- " absolute, not relative, directory."
- } elsif (m/^--distro=(.*)/s) {
- push @ropts, $_;
- $idistro = $1;
- } elsif (m/^--build-products-dir=(.*)/s) {
- push @ropts, $_;
- $buildproductsdir = $1;
- } elsif (m/^--clean=(dpkg-source(?:-d)?|git|git-ff|check|none)$/s) {
- push @ropts, $_;
- $cleanmode = $1;
- } elsif (m/^--clean=(.*)$/s) {
- badusage "unknown cleaning mode \`$1'";
- } elsif (m/^--quilt=($quilt_modes_re)$/s) {
- push @ropts, $_;
- $quilt_mode = $1;
- } elsif (m/^--quilt=(.*)$/s) {
- badusage "unknown quilt fixup mode \`$1'";
} elsif (m/^--ignore-dirty$/s) {
push @ropts, $_;
$ignoredirty = 1;
@@ -2956,9 +3944,24 @@ 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/^--dgit-tag-format=(old|new)$/s) {
+ # undocumented, for testing
+ push @ropts, $_;
+ $tagformat_want = [ $1, 'command line', 1 ];
+ # 1 menas overrides distro configuration
+ } elsif (m/^--always-split-source-build$/s) {
+ # undocumented, for testing
+ push @ropts, $_;
+ $need_split_build_invocation = 1;
+ } elsif (m/^(--[-0-9a-z]+)(=|$)/ && ($oi = $valopts_long{$1})) {
+ $val = $2 ? $' : undef; #';
+ $valopt->($oi->{Long});
} else {
badusage "unknown long option \`$_'";
}
@@ -2979,30 +3982,10 @@ sub parseopts () {
} elsif (s/^-N/-/) {
push @ropts, $&;
$new_package=1;
- } elsif (s/^-v([^_]+|_)$//s) {
- push @ropts, $&;
- $changes_since_version = $1;
} elsif (m/^-m/) {
push @ropts, $&;
push @changesopts, $_;
$_ = '';
- } elsif (s/^-c(.*=.*)//s) {
- push @ropts, $&;
- push @git, '-c', $1;
- } elsif (s/^-d(.+)//s) {
- push @ropts, $&;
- $idistro = $1;
- } elsif (s/^-C(.+)//s) {
- push @ropts, $&;
- $changesfile = $1;
- if ($changesfile =~ s#^(.*)/##) {
- $buildproductsdir = $1;
- }
- } elsif (s/^-k(.+)//s) {
- $keyid=$1;
- } elsif (m/^-[vdCk]$/) {
- badusage
- "option \`$_' requires an argument (and no space before the argument)";
} elsif (s/^-wn$//s) {
push @ropts, $&;
$cleanmode = 'none';
@@ -3021,6 +4004,11 @@ sub parseopts () {
} elsif (s/^-wc$//s) {
push @ropts, $&;
$cleanmode = 'check';
+ } elsif (m/^-[a-zA-Z]/ && ($oi = $valopts_short{$&})) {
+ $val = $'; #';
+ $val = undef unless length $val;
+ $valopt->($oi->{Short});
+ $_ = '';
} else {
badusage "unknown short option \`$_'";
}
@@ -3029,11 +4017,41 @@ sub parseopts () {
}
}
+sub finalise_opts_opts () {
+ foreach my $k (keys %opts_opt_map) {
+ my $om = $opts_opt_map{$k};
+
+ my $v = access_cfg("cmd-$k", 'RETURN-UNDEF');
+ if (defined $v) {
+ badcfg "cannot set command for $k"
+ unless length $om->[0];
+ $om->[0] = $v;
+ }
+
+ foreach my $c (access_cfg_cfgs("opts-$k")) {
+ my $vl = $gitcfg{$c};
+ printdebug "CL $c ",
+ ($vl ? join " ", map { shellquote } @$vl : ""),
+ "\n" if $debuglevel >= 4;
+ next unless $vl;
+ badcfg "cannot configure options for $k"
+ if $opts_opt_cmdonly{$k};
+ my $insertpos = $opts_cfg_insertpos{$k};
+ @$om = ( @$om[0..$insertpos-1],
+ @$vl,
+ @$om[$insertpos..$#$om] );
+ }
+ }
+}
+
if ($ENV{$fakeeditorenv}) {
+ git_slurp_config();
quilt_fixup_editor();
}
parseopts();
+git_slurp_config();
+
print STDERR "DRY RUN ONLY\n" if $dryrun_level > 1;
print STDERR "DAMP RUN - WILL MAKE LOCAL (UNSIGNED) CHANGES\n"
if $dryrun_level == 1;
@@ -3044,7 +4062,13 @@ 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')
// access_cfg('quilt-mode', 'RETURN-UNDEF')
// 'linear';
@@ -3053,6 +4077,17 @@ 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');
+ $cleanmode //= 'dpkg-source';
+
+ badcfg "unknown clean-mode \`$cleanmode'" unless
+ $cleanmode =~ m/^($cleanmode_re)$(?!\n)/s;
+}
+
my $fn = ${*::}{"cmd_$cmd"};
$fn or badusage "unknown operation $cmd";
$fn->();