autoflush STDOUT 1;
our $supplementary_message = '';
-our $split_brain = 0;
+our $made_split_brain = 0;
+our $do_split_brain = 0;
+
+# Interactions between quilt mode and split brain
+# (currently, split brain only implemented iff
+# madformat_wantfixup && quiltmode_splitbrain)
+#
+# source format sane `3.0 (quilt)'
+# madformat_wantfixup()
+#
+# quilt mode normal quiltmode
+# (eg linear) _splitbrain
+#
+# ------------ ------------------------------------------------
+#
+# no split no q cache no q cache forbidden,
+# brain PM on master q fixup on master prevented
+# !$do_split_brain PM on master
+#
+# split brain no q cache q fixup cached, to dgit view
+# PM in dgit view PM in dgit view
+#
+# PM = pseudomerge to make ff, due to overwrite (or split view)
+# "no q cache" = do not record in cache on build, do not check cache
+# `3.0 (quilt)' with --quilt=nocheck is treated as sane format
END {
local ($@, $?);
my $got = read PF, $d, 65536;
die "$ourfn: $!" unless defined $got;
last if !$got;
- print $fh "data-block ".length($d)."\n" or confess $!;
- print $fh $d or confess $!;
+ print $fh "data-block ".length($d)."\n" or confess "$!";
+ print $fh $d or confess "$!";
}
PF->error and die "$ourfn $!";
- print $fh "data-end\n" or confess $!;
+ print $fh "data-end\n" or confess "$!";
close PF;
}
} $fh;
last unless $y;
my $d = protocol_read_bytes $fh, $l;
- print PF $d or confess $!;
+ print PF $d or confess "$!";
}
- close PF or confess $!;
+ close PF or confess "$!";
}
#---------- remote protocol support, responder ----------
return unless $we_are_responder;
# called even without $we_are_responder
printdebug ">> $command\n";
- print PO $command, "\n" or confess $!;
+ print PO $command, "\n" or confess "$!";
}
sub responder_send_file ($$) {
sub progress {
if ($we_are_responder) {
my $m = join '', @_;
- responder_send_command "progress ".length($m) or confess $!;
- print PO $m or confess $!;
+ responder_send_command "progress ".length($m) or confess "$!";
+ print PO $m or confess "$!";
} else {
print @_, "\n";
}
}
my $what = $_[$#_];
progress "downloading $what...";
- my $r = $ua->get(@_) or confess $!;
+ my $r = $ua->get(@_) or confess "$!";
return undef if $r->code == 404;
$r->is_success or fail f_ "failed to fetch %s: %s",
$what, $r->status_line;
END
sub badusage {
- print STDERR f_ "%s: %s\n%s", $us, "@_", __ $helpmsg or confess $!;
+ print STDERR f_ "%s: %s\n%s", $us, "@_", __ $helpmsg or confess "$!";
finish 8;
}
not_necessarily_a_tree();
}
sub cmd_help () {
- print __ $helpmsg or confess $!;
+ print __ $helpmsg or confess "$!";
finish 0;
}
return $access_forpush;
}
+sub default_from_access_cfg ($$$;$) {
+ my ($var, $keybase, $defval, $permit_re) = @_;
+ return if defined $$var;
+
+ $$var = access_cfg("$keybase-newer", 'RETURN-UNDEF');
+ $$var = undef if $$var && $$var !~ m/^$permit_re$/;
+
+ $$var //= access_cfg($keybase, 'RETURN-UNDEF');
+ $$var //= $defval;
+
+ badcfg f_ "unknown %s \`%s'", $keybase, $$var
+ if defined $permit_re and $$var !~ m/$permit_re/;
+}
+
sub pushing () {
confess +(__ 'internal error').' '.Dumper($access_forpush)," ?" if
defined $access_forpush and !$access_forpush;
return;
} elsif ($protovsn >= 3) {
responder_send_command "supplementary-message ".length($msg)
- or confess $!;
- print PO $msg or confess $!;
+ or confess "$!";
+ print PO $msg or confess "$!";
}
}
}
sub parse_dscdata () {
- my $dscfh = new IO::File \$dscdata, '<' or confess $!;
+ my $dscfh = new IO::File \$dscdata, '<' or confess "$!";
printdebug Dumper($dscdata) if $debuglevel>1;
$dsc = parsecontrolfh($dscfh,$dscurl,1);
printdebug Dumper($dsc) if $debuglevel>1;
cfg_apply_map(\$aptsuites, 'suite map',
access_cfg('aptget-suite-map', 'RETURN-UNDEF'));
- open SRCS, ">", "$aptget_base/$sourceslist" or confess $!;
+ open SRCS, ">", "$aptget_base/$sourceslist" or confess "$!";
printf SRCS "deb-src %s %s %s\n",
access_cfg('mirror'),
$aptsuites,
access_cfg('aptget-components')
- or confess $!;
+ or confess "$!";
ensuredir "$aptget_base/cache";
ensuredir "$aptget_base/lists";
- open CONF, ">", $aptget_configpath or confess $!;
+ open CONF, ">", $aptget_configpath or confess "$!";
print CONF <<END;
Debug::NoLocking "true";
APT::Get::List-Cleanup "false";
Dir::Etc::preferencesparts
)) {
ensuredir "$aptget_base/$key";
- print CONF "$key \"$quoted_base/$key\";\n" or confess $!;
+ print CONF "$key \"$quoted_base/$key\";\n" or confess "$!";
};
- my $oldatime = (time // confess $!) - 1;
+ my $oldatime = (time // confess "$!") - 1;
foreach my $oldlist (<$aptget_base/lists/*Release>) {
next unless stat_exists $oldlist;
my ($mtime) = (stat _)[9];
my @cmd = (qw(sh -ec), 'cd "$1"; shift'."\n".$rune,
qw(x), $mirror, @$argl);
debugcmd "-|", @cmd;
- open FIA, "-|", @cmd or confess $!;
+ open FIA, "-|", @cmd or confess "$!";
my $r = $fn->();
close FIA or ($!==0 && $?==141) or die failedcmd @cmd;
return $r;
" export LC_MESSAGES=C; export LC_CTYPE=C;".
" ".shellquote qw(psql -A), $dbname, qw(-c), $sql);
debugcmd "|",@cmd;
- open P, "-|", @cmd or confess $!;
+ open P, "-|", @cmd or confess "$!";
while (<P>) {
chomp or die;
printdebug(">|$_|\n");
my ($what) = @_;
my @gitscmd = qw(find -name .git -prune -print0);
debugcmd "|",@gitscmd;
- open GITS, "-|", @gitscmd or confess $!;
+ open GITS, "-|", @gitscmd or confess "$!";
{
local $/="\0";
while (<GITS>) {
new Dpkg::Compression::Process compression => $cname;
@compr_cmd = $compr_proc->get_uncompress_cmdline();
my $compr_fh = new IO::Handle;
- my $compr_pid = open $compr_fh, "-|" // confess $!;
+ my $compr_pid = open $compr_fh, "-|" // confess "$!";
if (!$compr_pid) {
- open STDIN, "<&", $input or confess $!;
+ open STDIN, "<&", $input or confess "$!";
exec @compr_cmd;
die "dgit (child): exec $compr_cmd[0]: $!\n";
}
}
rmtree "_unpack-tar";
- mkdir "_unpack-tar" or confess $!;
+ mkdir "_unpack-tar" or confess "$!";
my @tarcmd = qw(tar -x -f -
--no-same-owner --no-same-permissions
--no-acls --no-xattrs --no-selinux);
- my $tar_pid = fork // confess $!;
+ my $tar_pid = fork // confess "$!";
if (!$tar_pid) {
- chdir "_unpack-tar" or confess $!;
- open STDIN, "<&", $input or confess $!;
+ chdir "_unpack-tar" or confess "$!";
+ open STDIN, "<&", $input or confess "$!";
exec @tarcmd;
die f_ "dgit (child): exec %s: %s", $tarcmd[0], $!;
}
- $!=0; (waitpid $tar_pid, 0) == $tar_pid or confess $!;
+ $!=0; (waitpid $tar_pid, 0) == $tar_pid or confess "$!";
!$? or failedcmd @tarcmd;
close $input or
(@compr_cmd ? ($?==SIGPIPE || failedcmd @compr_cmd)
- : confess $!);
+ : confess "$!");
# finally, we have the results in "tarball", but maybe
# with the wrong permissions
printdebug "import main commit\n";
- open C, ">../commit.tmp" or confess $!;
- print C <<END or confess $!;
+ open C, ">../commit.tmp" or confess "$!";
+ print C <<END or confess "$!";
tree $tree
END
- print C <<END or confess $! foreach @tartrees;
+ print C <<END or confess "$!" foreach @tartrees;
parent $_->{Commit}
END
- print C <<END or confess $!;
+ print C <<END or confess "$!";
author $authline
committer $authline
[dgit import $treeimporthow $package $cversion]
END
- close C or confess $!;
+ close C or confess "$!";
my $rawimport_hash = make_commit qw(../commit.tmp);
if (madformat $dsc->{format}) {
progress f_ "%s: trying slow absurd-git-apply...", $us;
rename "../../gbp-pq-output","../../gbp-pq-output.0"
or $!==ENOENT
- or confess $!;
+ or confess "$!";
}
eval {
die "forbid absurd git-apply\n" if $use_absurd
Last version pushed with dgit: %s (newer or same)
%s
END
- __ $later_warning_msg or confess $!;
+ __ $later_warning_msg or confess "$!";
@output = $lastpush_mergeinput;
} else {
# Same version. Use what's in the server git branch,
open F, "<", "$tf" or die "$tf: $!";
$fi->{Digester}->reset();
$fi->{Digester}->addfile(*F);
- F->error and confess $!;
+ F->error and confess "$!";
$got = $fi->{Digester}->hexdigest();
return $got eq $fi->{Hash};
};
debugcmd "|",@lcmd;
my %wantr;
- open GITLS, "-|", @lcmd or confess $!;
+ open GITLS, "-|", @lcmd or confess "$!";
while (<GITLS>) {
printdebug "=> ", $_;
m/^(\w+)\s+(\S+)\n/ or die "ls-remote $_ ?";
printdebug "del_lrfetchrefs: $objid $fullrefname\n";
if (!$gur) {
$gur ||= new IO::Handle;
- open $gur, "|-", qw(git update-ref --stdin) or confess $!;
+ open $gur, "|-", qw(git update-ref --stdin) or confess "$!";
}
printf $gur "delete %s %s\n", $fullrefname, $objid;
}
Last version pushed with dgit: %s
%s
END
- __ $later_warning_msg or confess $!;
+ __ $later_warning_msg or confess "$!";
@mergeinputs = ($lastpush_mergeinput);
} else {
# Archive has .dsc which is not a descendant of the last dgit
Package not found in the archive, but has allegedly been pushed using dgit.
%s
END
- __ $later_warning_msg or confess $!;
+ __ $later_warning_msg or confess "$!";
} else {
printdebug "nothing found!\n";
if (defined $skew_warning_vsn) {
- print STDERR f_ <<END, $skew_warning_vsn or confess $!;
+ print STDERR f_ <<END, $skew_warning_vsn or confess "$!";
Warning: relevant archive skew detected.
Archive allegedly contains %s
my $mcf = dgit_privdir()."/mergecommit";
open MC, ">", $mcf or die "$mcf $!";
- print MC <<END or confess $!;
+ print MC <<END or confess "$!";
tree $tree
END
my @parents = grep { $_->{Commit} } @mergeinputs;
@parents = reverse @parents if $compat_info->{ReverseParents};
- print MC <<END or confess $! foreach @parents;
+ print MC <<END or confess "$!" foreach @parents;
parent $_->{Commit}
END
- print MC <<END or confess $!;
+ print MC <<END or confess "$!";
author $author
committer $author
END
if (defined $compat_info->{Message}) {
- print MC $compat_info->{Message} or confess $!;
+ print MC $compat_info->{Message} or confess "$!";
} else {
- print MC f_ <<END, $package, $cversion, $csuite or confess $!;
+ print MC f_ <<END, $package, $cversion, $csuite or confess "$!";
Record %s (%s) in archive suite %s
Record that
my ($mi) = (@_);
my $mversion = mergeinfo_version $mi;
printf MC " %-20s %s\n", $mversion, $mi->{Info}
- or confess $!;
+ or confess "$!";
};
$message_add_info->($mergeinputs[0]);
- print MC __ <<END or confess $!;
+ print MC __ <<END or confess "$!";
should be treated as descended from
END
$message_add_info->($_) foreach @mergeinputs[1..$#mergeinputs];
}
- close MC or confess $!;
+ close MC or confess "$!";
$hash = make_commit $mcf;
} else {
$hash = $mergeinputs[0]{Commit};
my $got_vsn = getfield $gotclogp, 'Version';
printdebug "SKEW CHECK GOT $got_vsn\n";
if (version_compare($got_vsn, $skew_warning_vsn) < 0) {
- print STDERR f_ <<END, $skew_warning_vsn, $got_vsn or confess $!;
+ print STDERR f_ <<END, $skew_warning_vsn, $got_vsn or confess "$!";
Warning: archive skew detected. Using the available version:
Archive allegedly contains %s
while (<ATTRS>) {
chomp;
next if m{^debian/changelog\s};
- print NATTRS $_, "\n" or confess $!;
+ print NATTRS $_, "\n" or confess "$!";
}
- ATTRS->error and confess $!;
+ ATTRS->error and confess "$!";
close ATTRS;
}
- print NATTRS "debian/changelog merge=$driver\n" or confess $!;
+ print NATTRS "debian/changelog merge=$driver\n" or confess "$!";
close NATTRS;
set_local_git_config "$cb.name", __ 'debian/changelog merge driver';
printdebug "is_gitattrs_setup: found old macro\n";
return 0;
}
- $gai->error and confess $!;
+ $gai->error and confess "$!";
printdebug "is_gitattrs_setup: found nothing\n";
return undef;
}
my $af = "$maindir_gitcommon/info/attributes";
ensuredir "$maindir_gitcommon/info";
- open GAO, "> $af.new" or confess $!;
- print GAO <<END, __ <<ENDT or confess $! unless defined $already;
+ open GAO, "> $af.new" or confess "$!";
+ print GAO <<END, __ <<ENDT or confess "$!" unless defined $already;
* dgit-defuse-attrs
$new
END
$_ = $new;
}
chomp;
- print GAO $_, "\n" or confess $!;
+ print GAO $_, "\n" or confess "$!";
}
- $gai->error and confess $!;
+ $gai->error and confess "$!";
}
- close GAO or confess $!;
+ close GAO or confess "$!";
rename "$af.new", "$af" or fail f_ "install %s: %s", $af, $!;
}
my @cmd = (@git, qw(ls-tree -lrz --), "${treeish}:");
debugcmd "|",@cmd;
my $gafl = new IO::File;
- open $gafl, "-|", @cmd or confess $!;
+ open $gafl, "-|", @cmd or confess "$!";
while (<$gafl>) {
chomp or die;
s/^\d+\s+\w+\s+\w+\s+(\d+)\t// or die;
# in child, sets things up, calls $fn->(), and returns undef
# in parent, returns canonical suite name for $tsuite
my $canonsuitefh = IO::File::new_tmpfile;
- my $pid = fork // confess $!;
+ my $pid = fork // confess "$!";
if (!$pid) {
forkcheck_setup();
$isuite = $tsuite;
$debugprefix .= " ";
progress f_ "fetching %s...", $tsuite;
canonicalise_suite();
- print $canonsuitefh $csuite, "\n" or confess $!;
- close $canonsuitefh or confess $!;
+ print $canonsuitefh $csuite, "\n" or confess "$!";
+ close $canonsuitefh or confess "$!";
$fn->();
return undef;
}
- waitpid $pid,0 == $pid or confess $!;
+ waitpid $pid,0 == $pid or confess "$!";
fail f_ "failed to obtain %s: %s", $tsuite, waitstatusmsg()
if $? && $?!=256*4;
- seek $canonsuitefh,0,0 or confess $!;
+ seek $canonsuitefh,0,0 or confess "$!";
local $csuite = <$canonsuitefh>;
- confess $! unless defined $csuite && chomp $csuite;
+ confess "$!" unless defined $csuite && chomp $csuite;
if ($? == 256*4) {
printdebug "multisuite $tsuite missing\n";
return $csuite;
}
sub clone_set_head () {
- open H, "> .git/HEAD" or confess $!;
- print H "ref: ".lref()."\n" or confess $!;
- close H or confess $!;
+ open H, "> .git/HEAD" or confess "$!";
+ print H "ref: ".lref()."\n" or confess "$!";
+ close H or confess "$!";
}
sub clone_finish ($) {
my ($dstdir) = @_;
$options{$_} = 1;
}
}
- F->error and confess $!;
+ F->error and confess "$!";
close F;
} else {
- confess $! unless $!==&ENOENT;
+ confess "$!" unless $!==&ENOENT;
}
if (!open F, "debian/source/format") {
- confess $! unless $!==&ENOENT;
+ confess "$!" unless $!==&ENOENT;
return '';
}
$_ = <F>;
- F->error and confess $!;
+ F->error and confess "$!";
chomp;
return ($_, \%options);
}
$cd = $gf->('Distribution');
};
if ($@) {
+ $@ =~ s/^\n//s;
$@ =~ s/^dgit: //gm;
fail "$@".
f_ "Perhaps debian/changelog does not mention %s ?", $v;
# git rev-list --first-parent DTRT.
my $pmf = dgit_privdir()."/pseudomerge";
open MC, ">", $pmf or die "$pmf $!";
- print MC <<END or confess $!;
+ print MC <<END or confess "$!";
tree $tree
parent $dgitview
parent $archive_hash
[$msg_cmd]
END
- close MC or confess $!;
+ close MC or confess "$!";
return make_commit($pmf);
}
$dsc->{$ourdscfield[0]} = join " ",
$tagwants->[0]{Objid}, $declaredistro, $tagwants->[0]{Tag},
$reader_giturl;
- $dsc->save("$dscfn.tmp") or confess $!;
+ $dsc->save("$dscfn.tmp") or confess "$!";
my $changes = parsecontrol($changesfile,$changesfilewhat);
foreach my $field (qw(Source Distribution Version)) {
my $head = $tw->{Objid};
my $tag = $tw->{Tag};
- open TO, '>', $tfn->('.tmp') or confess $!;
- print TO <<END or confess $!;
+ open TO, '>', $tfn->('.tmp') or confess "$!";
+ print TO <<END or confess "$!";
object $head
type commit
tag $tag
print TO f_ <<ENDT, $package, $cversion, $clogsuite, $csuite
%s release %s for %s (%s) [dgit]
ENDT
- or confess $!;
- print TO <<END or confess $!;
+ or confess "$!";
+ print TO <<END or confess "$!";
[dgit distro=$declaredistro$delibs]
END
foreach my $ref (sort keys %previously) {
- print TO <<END or confess $!;
+ print TO <<END or confess "$!";
[dgit previously:$ref=$previously{$ref}]
END
}
(maintainer view tag generated by dgit --quilt=%s)
END
$quilt_mode
- or confess $!;
+ or confess "$!";
} else {
confess Dumper($tw)."?";
}
- close TO or confess $!;
+ close TO or confess "$!";
my $tagobjfn = $tfn->('.tmp');
if ($sign) {
if (!defined $keyid) {
$keyid = getfield $clogp, 'Maintainer';
}
- unlink $tfn->('.tmp.asc') or $!==&ENOENT or confess $!;
+ unlink $tfn->('.tmp.asc') or $!==&ENOENT or confess "$!";
my @sign_cmd = (@gpg, qw(--detach-sign --armor));
push @sign_cmd, qw(-u),$keyid if defined $keyid;
push @sign_cmd, $tfn->('.tmp');
push_parse_dsc($dscpath, $dscfn, $cversion);
my $format = getfield $dsc, 'Format';
- printdebug "format $format\n";
my $symref = git_get_symref();
my $actualhead = git_rev_parse('HEAD');
if (madformat_wantfixup($format)) {
# user might have not used dgit build, so maybe do this now:
- if (quiltmode_splitbrain()) {
+ if ($do_split_brain) {
changedir $playground;
- quilt_make_fake_dsc($upstreamversion);
my $cachekey;
($dgithead, $cachekey) =
quilt_check_splitbrain_cache($actualhead, $upstreamversion);
"--quilt=%s but no cached dgit view:
perhaps HEAD changed since dgit build[-source] ?",
$quilt_mode;
- $split_brain = 1;
- $dgithead = splitbrain_pseudomerge($clogp,
- $actualhead, $dgithead,
- $archive_hash);
- $maintviewhead = $actualhead;
- changedir $maindir;
- prep_ud(); # so _only_subdir() works, below
- } else {
+ }
+ if (!$do_split_brain) {
+ # In split brain mode, do not attempt to incorporate dirty
+ # stuff from the user's working tree. That would be mad.
commit_quilty_patch();
}
}
+ if ($do_split_brain) {
+ $made_split_brain = 1;
+ $dgithead = splitbrain_pseudomerge($clogp,
+ $actualhead, $dgithead,
+ $archive_hash);
+ $maintviewhead = $actualhead;
+ changedir $maindir;
+ prep_ud(); # so _only_subdir() works, below
+ }
if (defined $overwrite_version && !defined $maintviewhead
&& $archive_hash) {
}
}
+ confess unless !!$made_split_brain == !!$do_split_brain;
+
changedir $playground;
progress f_ "checking that %s corresponds to HEAD", $dscfn;
runcmd qw(dpkg-source -x --),
my $r = system @diffcmd;
if ($r) {
if ($r==256) {
- my $referent = $split_brain ? $dgithead : 'HEAD';
+ my $referent = $made_split_brain ? $dgithead : 'HEAD';
my $diffs = cmdoutput @git, qw(diff --stat), $tree, $dgithead;
my @mode_changes;
parseopts();
build_or_push_prep_early();
pushing();
+ build_or_push_prep_modes();
check_not_dirty();
my $specsuite;
if (@ARGV==0) {
$we_are_responder = 1;
$us .= " (build host)";
- open PI, "<&STDIN" or confess $!;
- open STDIN, "/dev/null" or confess $!;
- open PO, ">&STDOUT" or confess $!;
+ open PI, "<&STDIN" or confess "$!";
+ open STDIN, "/dev/null" or confess "$!";
+ open PO, ">&STDOUT" or confess "$!";
autoflush PO 1;
- open STDOUT, ">&STDERR" or confess $!;
+ open STDOUT, ">&STDERR" or confess "$!";
autoflush STDOUT 1;
$vsnwant //= 1;
$i_child_pid = undef; # prevents killing some other process with same pid
printdebug "waiting for build host child $pid...\n";
my $got = waitpid $pid, 0;
- confess $! unless $got == $pid;
+ confess "$!" unless $got == $pid;
fail f_ "build host child failed: %s", waitstatusmsg() if $?;
i_cleanup();
fail f_ "rpush negotiated protocol version %s".
" which does not support quilt mode %s",
$protovsn, $quilt_mode
- if quiltmode_splitbrain;
+ if quiltmode_splitbrain && $protovsn < 4;
my @localpaths = i_method "i_want", $keyword;
printdebug "[[ $keyword @localpaths\n";
foreach my $localpath (@localpaths) {
protocol_send_file \*RI, $localpath;
}
- print RI "files-end\n" or confess $!;
+ print RI "files-end\n" or confess "$!";
}
our ($i_clogp, $i_version, $i_dscfn, $i_changesfn, @i_buildinfos);
my $descfn = ".git/dgit/quilt-description.tmp";
open O, '>', $descfn or confess "$descfn: $!";
$msg =~ s/\n+/\n\n/;
- print O <<END or confess $!;
+ print O <<END or confess "$!";
From: $author
${xinfo}Subject: $msg
---
END
- close O or confess $!;
+ close O or confess "$!";
{
local $ENV{'EDITOR'} = cmdoutput qw(realpath --), $0;
return $r;
}
-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, $oldtiptree, $diffbits,
$editedignores, $cachekey) = @_;
local $ENV{GIT_AUTHOR_EMAIL} = $authline[1];
local $ENV{GIT_AUTHOR_DATE} = $authline[2];
+ confess unless $do_split_brain;
+
my $fulldiffhint = sub {
my ($x,$y) = @_;
my $cmd = "git diff $x $y -- :/ ':!debian'";
}
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_pq, qw(import);
# gbp pq import creates a fresh branch; push back to dgit-view
}
if (($diffbits->{O2H} & 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";
close GIPATCH or die "$gipatch: $!";
runcmd shell_cmd "exec >>$gipatch", @git, qw(diff),
$unapplied, $headref, "--", sort keys %$editedignores;
- open SERIES, "+>>", "debian/patches/series" or confess $!;
- defined seek SERIES, -1, 2 or $!==EINVAL or confess $!;
+ open SERIES, "+>>", "debian/patches/series" or confess "$!";
+ defined seek SERIES, -1, 2 or $!==EINVAL or confess "$!";
my $newline;
- defined read SERIES, $newline, 1 or confess $!;
- print SERIES "\n" or confess $! unless $newline eq "\n";
- print SERIES "auto-gitignore\n" or confess $!;
+ defined read SERIES, $newline, 1 or confess "$!";
+ print SERIES "\n" or confess "$!" unless $newline eq "\n";
+ print SERIES "auto-gitignore\n" or confess "$!";
close SERIES or die $!;
runcmd @git, qw(add -f -- debian/patches/series), $gipatch;
commit_admin +(__ <<END).<<ENDU
[dgit ($our_version) update-gitignore-quilt-fixup]
ENDU
}
-
- my $dgitview = git_rev_parse 'HEAD';
-
- changedir $maindir;
- reflog_cache_insert "refs/$splitbraincache", $cachekey, $dgitview;
-
- changedir "$playground/work";
-
- my $saved = maybe_split_brain_save $headref, $dgitview, __ "converted";
- progress f_ "dgit view: created (%s)", $saved;
}
sub quiltify ($$$$) {
runcmd @git, qw(checkout -q), $cc, qw(debian/changelog);
}
-
- runcmd @git, qw(checkout -q master);
}
sub build_maybe_quilt_fixup () {
check_for_vendor_patches();
- if (quiltmode_splitbrain) {
- fail <<END unless access_cfg_tagformats_can_splitbrain;
-quilt mode $quilt_mode requires split view so server needs to support
- both "new" and "maint" tag formats, but config says it doesn't.
-END
- }
-
my $clogp = parsechangelog();
my $headref = git_rev_parse('HEAD');
my $symref = git_get_symref();
-
- if ($quilt_mode eq 'linear'
- && !$fopts->{'single-debian-patch'}
- && branch_is_gdr($headref)) {
- # This is much faster. It also makes patches that gdr
- # likes better for future updates without laundering.
- #
- # However, it can fail in some casses where we would
- # succeed: if there are existing patches, which correspond
- # to a prefix of the branch, but are not in gbp/gdr
- # format, gdr will fail (exiting status 7), but we might
- # be able to figure out where to start linearising. That
- # will be slower so hopefully there's not much to do.
- my @cmd = (@git_debrebase,
- qw(--noop-ok -funclean-mixed -funclean-ordering
- make-patches --quiet-would-amend));
- # We tolerate soe snags that gdr wouldn't, by default.
- if (act_local()) {
- debugcmd "+",@cmd;
- $!=0; $?=-1;
- failedcmd @cmd
- if system @cmd
- and not ($? == 7*256 or
- $? == -1 && $!==ENOENT);
- } else {
- dryrun_report @cmd;
- }
- $headref = git_rev_parse('HEAD');
- }
+ my $upstreamversion = upstreamversion $version;
prep_ud();
changedir $playground;
- my $upstreamversion = upstreamversion $version;
+ my $splitbrain_cachekey;
+
+ if ($do_split_brain) {
+ my $cachehit;
+ ($cachehit, $splitbrain_cachekey) =
+ quilt_check_splitbrain_cache($headref, $upstreamversion);
+ if ($cachehit) {
+ changedir $maindir;
+ return;
+ }
+ }
+
+ unpack_playtree_need_cd_work($headref);
+ if ($do_split_brain) {
+ runcmd @git, qw(checkout -q -b dgit-view);
+ # so long as work is not deleted, its current branch will
+ # remain dgit-view, rather than master, so subsequent calls to
+ # unpack_playtree_need_cd_work
+ # will DTRT, resetting dgit-view.
+ confess if $made_split_brain;
+ $made_split_brain = 1;
+ }
+ chdir '..';
if ($fopts->{'single-debian-patch'}) {
+ fail f_
+ "quilt mode %s does not make sense (or is not supported) with single-debian-patch",
+ $quilt_mode
+ if quiltmode_splitbrain();
quilt_fixup_singlepatch($clogp, $headref, $upstreamversion);
} else {
- quilt_fixup_multipatch($clogp, $headref, $upstreamversion);
+ quilt_fixup_multipatch($clogp, $headref, $upstreamversion,
+ $splitbrain_cachekey);
+ }
+
+ if ($do_split_brain) {
+ my $dgitview = git_rev_parse 'HEAD';
+
+ changedir $maindir;
+ reflog_cache_insert "refs/$splitbraincache",
+ $splitbrain_cachekey, $dgitview;
+
+ changedir "$playground/work";
+
+ my $saved = maybe_split_brain_save $headref, $dgitview, __ "converted";
+ progress f_ "dgit view: created (%s)", $saved;
}
changedir $maindir;
@git, qw(pull --ff-only -q), "$playground/work", qw(master);
}
-sub unpack_playtree_mkwork ($) {
+sub build_check_quilt_splitbrain () {
+ build_maybe_quilt_fixup();
+
+ if ($do_split_brain) {
+ fail <<END unless access_cfg_tagformats_can_splitbrain;
+quilt mode $quilt_mode requires split view so server needs to support
+ both "new" and "maint" tag formats, but config says it doesn't.
+END
+ }
+}
+
+sub unpack_playtree_need_cd_work ($) {
my ($headref) = @_;
- mkdir "work" or confess $!;
- changedir "work";
- mktree_in_ud_here();
+ # prep_ud() must have been called already.
+ if (!chdir "work") {
+ # Check in the filesystem because sometimes we run prep_ud
+ # in between multiple calls to unpack_playtree_need_cd_work.
+ confess "$!" unless $!==ENOENT;
+ mkdir "work" or confess "$!";
+ changedir "work";
+ mktree_in_ud_here();
+ }
runcmd @git, qw(reset -q --hard), $headref;
}
# necessary to build the source package.
unpack_playtree_linkorigs($upstreamversion, sub { });
- unpack_playtree_mkwork($headref);
+ unpack_playtree_need_cd_work($headref);
rmtree("debian/patches");
commit_quilty_patch();
}
-sub quilt_make_fake_dsc ($) {
+sub quilt_need_fake_dsc ($) {
+ # cwd should be playground
my ($upstreamversion) = @_;
+ return if stat_exists "fake.dsc";
+ # ^ OK to test this as a sentinel because if we created it
+ # we must either have done the rest too, or crashed.
+
my $fakeversion="$upstreamversion-~~DGITFAKE";
- my $fakedsc=new IO::File 'fake.dsc', '>' or confess $!;
- print $fakedsc <<END or confess $!;
+ my $fakedsc=new IO::File 'fake.dsc', '>' or confess "$!";
+ print $fakedsc <<END or confess "$!";
Format: 3.0 (quilt)
Source: $package
Version: $fakeversion
my $md = new Digest::MD5;
my $fh = new IO::File $leaf, '<' or die "$leaf $!";
- stat $fh or confess $!;
+ stat $fh or confess "$!";
my $size = -s _;
$md->addfile($fh);
- print $fakedsc " ".$md->hexdigest." $size $leaf\n" or confess $!;
+ print $fakedsc " ".$md->hexdigest." $size $leaf\n" or confess "$!";
};
unpack_playtree_linkorigs($upstreamversion, $dscaddfile);
runcmd qw(env GZIP=-1n tar -zcf), "./$debtar", qw(-C), $maindir, @files;
$dscaddfile->($debtar);
- close $fakedsc or confess $!;
+ close $fakedsc or confess "$!";
}
sub quilt_fakedsc2unapplied ($$) {
my ($headref, $upstreamversion) = @_;
# must be run in the playground
- # quilt_make_fake_dsc must have been called
+ # quilt_need_fake_dsc must have been called
+ quilt_need_fake_dsc($upstreamversion);
runcmd qw(sh -ec),
'exec dpkg-source --no-check --skip-patches -x fake.dsc >/dev/null';
# Computes the cache key and looks in the cache.
# Returns ($dgit_view_commitid, $cachekey) or (undef, $cachekey)
+ quilt_need_fake_dsc($upstreamversion);
+
my $splitbrain_cachekey;
progress f_
"refs/$splitbraincache", $splitbrain_cachekey;
if ($cachehit) {
- unpack_playtree_mkwork($headref);
+ unpack_playtree_need_cd_work($headref);
my $saved = maybe_split_brain_save $headref, $cachehit, "cache-hit";
if ($cachehit ne $headref) {
progress f_ "dgit view: found cached (%s)", $saved;
runcmd @git, qw(checkout -q -b dgit-view), $cachehit;
- $split_brain = 1;
+ $made_split_brain = 1;
return ($cachehit, $splitbrain_cachekey);
}
progress __ "dgit view: found cached, no changes required";
}
sub quilt_fixup_multipatch ($$$) {
- my ($clogp, $headref, $upstreamversion) = @_;
+ my ($clogp, $headref, $upstreamversion, $splitbrain_cachekey) = @_;
progress f_ "examining quilt state (multiple patches, %s mode)",
$quilt_mode;
# afterwards with dpkg-source --before-build. That lets us save a
# tree object corresponding to .origs.
- my $splitbrain_cachekey;
+ if ($quilt_mode eq 'linear'
+ && branch_is_gdr($headref)) {
+ # This is much faster. It also makes patches that gdr
+ # likes better for future updates without laundering.
+ #
+ # However, it can fail in some casses where we would
+ # succeed: if there are existing patches, which correspond
+ # to a prefix of the branch, but are not in gbp/gdr
+ # format, gdr will fail (exiting status 7), but we might
+ # be able to figure out where to start linearising. That
+ # will be slower so hopefully there's not much to do.
- quilt_make_fake_dsc($upstreamversion);
+ unpack_playtree_need_cd_work $headref;
- if (quiltmode_splitbrain()) {
- my $cachehit;
- ($cachehit, $splitbrain_cachekey) =
- quilt_check_splitbrain_cache($headref, $upstreamversion);
- return if $cachehit;
+ my @cmd = (@git_debrebase,
+ qw(--noop-ok -funclean-mixed -funclean-ordering
+ make-patches --quiet-would-amend));
+ # We tolerate soe snags that gdr wouldn't, by default.
+ if (act_local()) {
+ debugcmd "+",@cmd;
+ $!=0; $?=-1;
+ failedcmd @cmd
+ if system @cmd
+ and not ($? == 7*256 or
+ $? == -1 && $!==ENOENT);
+ } else {
+ dryrun_report @cmd;
+ }
+ $headref = git_rev_parse('HEAD');
+
+ chdir '..';
}
+
my $unapplied=quilt_fakedsc2unapplied($headref, $upstreamversion);
ensuredir '.pc';
changedir '..';
- unpack_playtree_mkwork($headref);
+ unpack_playtree_need_cd_work($headref);
my $mustdeletepc=0;
if (stat_exists ".pc") {
progress __ "Tree already contains .pc - will use it then delete it.";
$mustdeletepc=1;
} else {
- rename '../fake/.pc','.pc' or confess $!;
+ rename '../fake/.pc','.pc' or confess "$!";
}
changedir '../fake';
progress f_ "starting quiltify (multiple patches, %s mode)", $quilt_mode;
quiltify($clogp,$headref,$oldtiptree,\@failsuggestion);
+ runcmd @git, qw(checkout -q), (qw(master dgit-view)[!!$do_split_brain]);
if (!open P, '>>', ".pc/applied-patches") {
- $!==&ENOENT or confess $!;
+ $!==&ENOENT or confess "$!";
} else {
close P;
}
open I2, '<', $editing or confess "$editing: $!";
unlink $editing or confess "$editing: $!";
open O, '>', $editing or confess "$editing: $!";
- while (<I1>) { print O or confess $!; } I1->error and confess $!;
+ while (<I1>) { print O or confess "$!"; } I1->error and confess "$!";
my $copying = 0;
while (<I2>) {
$copying ||= m/^\-\-\- /;
next unless $copying;
- print O or confess $!;
+ print O or confess "$!";
}
- I2->error and confess $!;
+ I2->error and confess "$!";
close O or die $1;
finish 0;
}
sub maybe_apply_patches_dirtily () {
return unless $quilt_mode =~ m/gbp|unapplied/;
- print STDERR __ <<END or confess $!;
+ print STDERR __ <<END or confess "$!";
dgit: Building, or cleaning with rules target, in patches-unapplied tree.
dgit: Have to apply the patches - making the tree dirty.
push @cmd, qw(-x) unless $honour_ignores;
my $leftovers = cmdoutput @cmd;
if (length $leftovers) {
- print STDERR $leftovers, "\n" or confess $!;
+ print STDERR $leftovers, "\n" or confess "$!";
$message .= $ignmessage if $honour_ignores;
fail $message;
}
$dscfn = dscfn($version);
}
+sub build_or_push_prep_modes () {
+ my ($format,) = get_source_format();
+ printdebug "format $format, quilt mode $quilt_mode\n";
+ if (madformat_wantfixup($format) && quiltmode_splitbrain()) {
+ $do_split_brain = 1;
+ }
+ fail __ "dgit: --include-dirty is not supported in split view quilt mode"
+ if $do_split_brain && $includedirty;
+}
+
sub build_prep_early () {
build_or_push_prep_early();
notpushing();
+ build_or_push_prep_modes();
check_not_dirty();
}
# said -wc we should still do the check.
clean_tree_check();
}
- build_maybe_quilt_fixup();
+ build_check_quilt_splitbrain();
if ($rmchanges) {
my $pat = changespat $version;
foreach my $f (glob "$buildproductsdir/$pat") {
"@changesfiles";
}
printdone f_ "build successful, results in %s\n", $result
- or confess $!;
+ or confess "$!";
}
sub midbuild_checkchanges () {
if ($gbp_make_orig) {
my $priv = dgit_privdir();
my $ok = "$priv/origs-gen-ok";
- unlink $ok or $!==&ENOENT or confess $!;
+ unlink $ok or $!==&ENOENT or confess "$!";
my @origs_cmd = @cmd;
push @origs_cmd, qw(--git-cleaner=true);
push @origs_cmd, "--git-prebuild=".
#
# Note that if we are building a source package in split brain
# mode we do not support including uncommitted changes, because
- # that makes quilt fixup too hard. I.e. ($split_brain && (dgit is
+ # that makes quilt fixup too hard. I.e. ($made_split_brain && (dgit is
# building a source package)) => !$includedirty
return !$includedirty;
}
unlink "$buildproductsdir/$sourcechanges" or $!==ENOENT
or fail f_ "remove %s: %s", $sourcechanges, $!;
}
+# confess unless !!$made_split_brain == !!$do_split_brain;
+
my @cmd = (@dpkgsource, qw(-b --));
my $leafdir;
if (building_source_in_playtree()) {
# If we are in split brain, there is already a playtree with
# the thing we should package into a .dsc (thanks to quilt
# fixup). If not, make a playtree
- prep_ud() unless $split_brain;
+ prep_ud() unless $made_split_brain;
changedir $playground;
- unless ($split_brain) {
+ unless ($made_split_brain) {
my $upstreamversion = upstreamversion $version;
unpack_playtree_linkorigs($upstreamversion, sub { });
- unpack_playtree_mkwork($headref);
+ unpack_playtree_need_cd_work($headref);
changedir '..';
}
} else {
"dgit push-source: --include-dirty/--ignore-dirty does not make".
"sense with push-source!"
if $includedirty;
- build_maybe_quilt_fixup();
+ build_check_quilt_splitbrain();
if ($changesfile) {
my $changes = parsecontrol("$buildproductsdir/$changesfile",
__ "source changes file");
prep_ud();
changedir $playground;
my $uv = upstreamversion $version;
- quilt_make_fake_dsc($uv);
my $u = quilt_fakedsc2unapplied($headref, $uv);
- print $u, "\n" or confess $!;
+ print $u, "\n" or confess "$!";
}
sub import_dsc_result {
"no arguments allowed to dgit print-dgit-repos-server-source-url"
if @ARGV;
my $url = repos_server_url();
- print $url, "\n" or confess $!;
+ print $url, "\n" or confess "$!";
}
sub pre_print_dpkg_source_ignores {
badusage __
"no arguments allowed to dgit print-dpkg-source-ignores"
if @ARGV;
- print "@dpkg_source_ignores\n" or confess $!;
+ print "@dpkg_source_ignores\n" or confess "$!";
}
sub cmd_setup_mergechangelogs {
#---------- argument parsing and main program ----------
sub cmd_version {
- print "dgit version $our_version\n" or confess $!;
+ print "dgit version $our_version\n" or confess "$!";
finish 0;
}
} elsif (m/^--delayed=(\d+)$/s) {
push @ropts, $_;
push @dput, $_;
- } elsif (my ($k,$v) =
- m/^--save-(dgit-view)=(.+)$/s ||
+ } elsif (m/^--save-(dgit-view)=(.+)$/s ||
m/^--(dgit-view)-save=(.+)$/s
) {
+ my ($k,$v) = ($1,$2);
push @ropts, $_;
$v =~ s#^(?!refs/)#refs/heads/#;
$internal_object_save{$k} = $v;
sub check_env_sanity () {
my $blocked = new POSIX::SigSet;
- sigprocmask SIG_UNBLOCK, $blocked, $blocked or confess $!;
+ sigprocmask SIG_UNBLOCK, $blocked, $blocked or confess "$!";
eval {
foreach my $name (qw(PIPE CHLD)) {
$$vr = $v;
}
- fail __ "dgit: --include-dirty is not supported in split view quilt mode"
- if $split_brain && $includedirty;
-
- if (!defined $cleanmode) {
+ {
local $access_forpush;
- $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/;
+ default_from_access_cfg(\$cleanmode, 'clean-mode', 'dpkg-source',
+ $cleanmode_re);
}
$buildproductsdir //= access_cfg('build-products-dir', 'RETURN-UNDEF');
print STDERR __ "DAMP RUN - WILL MAKE LOCAL (UNSIGNED) CHANGES\n"
if $dryrun_level == 1;
if (!@ARGV) {
- print STDERR __ $helpmsg or confess $!;
+ print STDERR __ $helpmsg or confess "$!";
finish 8;
}
$cmd = $subcommand = shift @ARGV;
~ianmdlvl / dgit.git / blobdiff