our $our_version = 'UNRELEASED'; ###substituted###
-our @rpushprotovsn_support = qw(2);
+our @rpushprotovsn_support = qw(3 2);
our $protovsn;
our $isuite = 'unstable';
'mergechanges' => \@mergechanges);
our %opts_opt_cmdonly = ('gpg' => 1);
+our %opts_cfg_insertpos = map {
+ $_,
+ scalar @{ $opts_opt_map{$_} }
+} keys %opts_opt_map;
+
+sub finalise_opts_opts();
our $keyid;
autoflush STDOUT 1;
+our $supplementary_message = '';
+
+END {
+ local ($@, $?);
+ print STDERR "! $_\n" foreach $supplementary_message =~ m/^.+$/mg;
+}
+
our $remotename = 'dgit';
our @ourdscfield = qw(Dgit Vcs-Dgit-Master);
our $csuite;
sub protocol_read_bytes ($$) {
my ($fh, $nbytes) = @_;
- $nbytes =~ m/^[1-9]\d{0,5}$/ or badproto \*RO, "bad byte count";
+ $nbytes =~ m/^[1-9]\d{0,5}$|^0$/ or badproto \*RO, "bad byte count";
my $d;
my $got = read $fh, $d, $nbytes;
$got==$nbytes or badproto_badread $fh, "data block";
'dgit-distro.test-dummy.upload-host' => 'test-dummy',
);
-sub git_get_config ($) {
- my ($c) = @_;
+our %gitcfg;
- our %git_get_config_memo;
- if (exists $git_get_config_memo{$c}) {
- return $git_get_config_memo{$c};
- }
+sub git_slurp_config () {
+ local ($debuglevel) = $debuglevel-2;
+ local $/="\0";
- my $v;
- my @cmd = (@git, qw(config --), $c);
- {
- local ($debuglevel) = $debuglevel-2;
- $v = cmdoutput_errok @cmd;
- };
- if ($?==0) {
- } elsif ($?==256) {
- $v = undef;
- } else {
- failedcmd @cmd;
+ my @cmd = (@git, qw(config -z --get-regexp .*));
+ debugcmd "|",@cmd;
+
+ open GITS, "-|", @cmd or failedcmd @cmd;
+ while (<GITS>) {
+ 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 {
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 () {
@l;
}
-sub access_cfg (@) {
+sub access_cfg_cfgs (@) {
my (@keys) = @_;
my @cfgs;
# The nesting of these loops determines the search order. We put
}
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;
}
open P, "-|", @cmd or die $!;
while (<P>) {
chomp or die;
- printdebug("$debugprefix>|$_|\n");
+ printdebug(">|$_|\n");
push @rows, $_;
}
$!=0; $?=0; close P or failedcmd @cmd;
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
prep_ud();
access_giturl(); # check that success is vaguely likely
my $tfn = sub { ".git/dgit/tag$_[0]"; };
my $tagobjfn;
+ 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);
$changesfile,$changesfile,
$tfn);
}
+ 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;
+ 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();
}
$forceflag."HEAD:".rrref(), $forceflag."refs/tags/$tag";
runcmd_ordryrun @git, qw(update-ref -m), 'dgit push', lrref(), 'HEAD';
+ 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',
sign_changes $changesfile;
}
+ supplementary_message(<<'END');
+Push failed, while uploading package(s) to the archive server.
+You can retry the upload of exactly these same files with dput of:
+ $changesfile
+If that .changes file is broken, you will need to use a new version
+number for your next attempt at the upload.
+END
my $host = access_cfg('upload-host','RETURN-UNDEF');
my @hostarg = defined($host) ? ($host,) : ();
runcmd_ordryrun @dput, @hostarg, $changesfile;
printdone "pushed and uploaded $cversion";
+ supplementary_message('');
responder_send_command("complete");
}
sub cmd_clone {
parseopts();
+ notpushing();
my $dstdir;
badusage "-p is not allowed with clone; specify as argument instead"
if defined $package;
}
sub fetchpullargs () {
+ notpushing();
if (!defined $package) {
my $sourcep = parsecontrol('debian/control','debian/control');
$package = getfield $sourcep, 'Source';
}
sub cmd_push {
- pushing();
parseopts();
+ pushing();
badusage "-p is not allowed with dgit push" if defined $package;
check_not_dirty();
my $clogp = parsechangelog();
fail "dgit push: changelog specifies $isuite ($csuite)".
" but command line specifies $specsuite";
}
+ supplementary_message(<<'END');
+Push failed, while checking state of the archive.
+You can retry the push, after fixing the problem, if you like.
+END
if (check_for_git()) {
git_fetch_us();
}
#---------- remote commands' implementation ----------
sub cmd_remote_push_build_host {
- pushing();
my ($nrargs) = shift @ARGV;
my (@rargs) = @ARGV[0..$nrargs-1];
@ARGV = @ARGV[$nrargs..$#ARGV];
$we_are_responder = 1;
$us .= " (build host)";
+ pushing();
+
open PI, "<&STDIN" or die $!;
open STDIN, "/dev/null" or die $!;
open PO, ">&STDOUT" or die $!;
changedir $i_tmp;
($protovsn) = initiator_expect { m/^dgit-remote-push-ready (\S+)/ };
die "$protovsn ?" unless grep { $_ eq $protovsn } @rpushprotovsn_support;
+ $supplementary_message = '' unless $protovsn >= 3;
for (;;) {
my ($icmd,$iargs) = initiator_expect {
m/^(\S+)(?: (.*))?$/;
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
sub cmd_clean () {
badusage "clean takes no additional arguments" if @ARGV;
+ notpushing();
clean_tree();
}
sub build_prep () {
+ notpushing();
badusage "-p is not allowed when building" if defined $package;
check_not_dirty();
clean_tree();
} 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, $_;
}
}
+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"