X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=4f0329a49932b21caf94395785b6eb4bf167e551;hp=e5c8eab9a30cc69292cf912252df615549c236ca;hb=e6ce71a87a1ca14ce90fc78023725d9f3bec54ee;hpb=475e31b775275ac895e21afa4143c10596b512d1
diff --git a/dgit b/dgit
index e5c8eab9..4f0329a4 100755
--- a/dgit
+++ b/dgit
@@ -18,6 +18,7 @@
# along with this program. If not, see
; } - die $! if P->error; - if (!close P) { printdebug "=>!$?\n" if $debug>0; return undef; } - chomp $d; - $d =~ m/^.*/; - printdebug "=> \`$&'",(length $' ? '...' : ''),"\n" if $debug>0; #'; - return $d; -} - -sub cmdoutput { - my $d = cmdoutput_errok @_; - defined $d or failedcmd @_; - return $d; -} - sub dryrun_report { printcmd(\*STDERR,$debugprefix."#",@_); } @@ -558,7 +475,7 @@ sub cfg { my @cmd = (@git, qw(config --), $c); my $v; { - local ($debug) = $debug-1; + local ($debuglevel) = $debuglevel-2; $v = cmdoutput_errok @cmd; }; if ($?==0) { @@ -935,9 +852,9 @@ sub sshpsql ($$$) { my @rows; my @cmd = (access_cfg_ssh, $userhost, access_runeinfo("ssh-psql $runeinfo"). - " export LANG=C;". + " export LC_MESSAGES=C; export LC_CTYPE=C;". " ".shellquote qw(psql -A), $dbname, qw(-c), $sql); - printcmd(\*DEBUG,$debugprefix."|",@cmd) if $debug>0; + debugcmd "|",@cmd; open P, "-|", @cmd or die $!; while (
) { chomp or die; @@ -1069,9 +986,9 @@ sub get_archive_dsc () { " archive told us to expect $digest"; } my $dscfh = new IO::File \$dscdata, '<' or die $!; - printdebug Dumper($dscdata) if $debug>1; + printdebug Dumper($dscdata) if $debuglevel>1; $dsc = parsecontrolfh($dscfh,$dscurl,1); - printdebug Dumper($dsc) if $debug>1; + printdebug Dumper($dsc) if $debuglevel>1; my $fmt = getfield $dsc, 'Format'; fail "unsupported source format $fmt, sorry" unless $format_ok{$fmt}; $dsc_checked = !!$digester; @@ -1503,8 +1420,8 @@ sub clone ($) { } fetch_from_archive() or no_such_package; my $vcsgiturl = $dsc->{'Vcs-Git'}; - $vcsgiturl =~ s/\s+-b\s+\S+//g; if (length $vcsgiturl) { + $vcsgiturl =~ s/\s+-b\s+\S+//g; runcmd @git, qw(remote add vcs-git), $vcsgiturl; } runcmd @git, qw(reset --hard), lrref(); @@ -1529,7 +1446,7 @@ sub pull () { sub check_not_dirty () { return if $ignoredirty; my @cmd = (@git, qw(diff --quiet HEAD)); - printcmd(\*DEBUG,$debugprefix."+",@cmd) if $debug>0; + debugcmd "+",@cmd; $!=0; $?=0; system @cmd; return if !$! && !$?; if (!$! && $?==256) { @@ -1684,7 +1601,8 @@ sub sign_changes ($) { } } -sub dopush () { +sub dopush ($) { + my ($forceflag) = @_; printdebug "actually entering push\n"; prep_ud(); @@ -1719,9 +1637,9 @@ sub dopush () { $dscpath =~ m#^/# ? $dscpath : "../../../$dscpath"; my ($tree,$dir) = mktree_in_ud_from_only_subdir(); changedir '../../../..'; - my $diffopt = $debug>0 ? '--exit-code' : '--quiet'; + my $diffopt = $debuglevel>0 ? '--exit-code' : '--quiet'; my @diffcmd = (@git, qw(diff), $diffopt, $tree); - printcmd \*DEBUG,$debugprefix."+",@diffcmd; + debugcmd "+",@diffcmd; $!=0; $?=0; my $r = system @diffcmd; if ($r) { @@ -1763,7 +1681,6 @@ sub dopush () { responder_send_command("param head $head"); responder_send_command("param csuite $csuite"); - my $forceflag = deliberately('not-fast-forward') ? '+' : ''; if ($forceflag && defined $lastpush_hash) { git_for_each_tag_referring($lastpush_hash, sub { my ($objid,$fullrefname,$tagname) = @_; @@ -1928,17 +1845,27 @@ sub cmd_push { if (check_for_git()) { git_fetch_us(); } + my $forceflag = ''; if (fetch_from_archive()) { - is_fast_fwd(lrref(), 'HEAD') or + if (is_fast_fwd(lrref(), 'HEAD')) { + # ok + } elsif (deliberately('not-fast-forward') || + deliberately('TEST-not-fast-forward-dgit-only')) { + $forceflag = '+'; + } else { fail "dgit push: HEAD is not a descendant". " of the archive's version.\n". - "$us: To overwrite it, use git merge -s ours ".lrref()."."; + "dgit: To overwrite its contents,". + " use git merge -s ours ".lrref().".\n". + "dgit: To rewind history, if permitted by the archive,". + " use --deliberately-not-fast-forward"; + } } else { $new_package or fail "package appears to be new in this suite;". " if this is intentional, use --new"; } - dopush(); + dopush($forceflag); } #---------- remote commands' implementation ---------- @@ -1954,6 +1881,7 @@ sub cmd_remote_push_build_host { # offered several) $debugprefix = ' '; $we_are_responder = 1; + $us .= " (build host)"; open PI, "<&STDIN" or die $!; open STDIN, "/dev/null" or die $!; @@ -2019,7 +1947,7 @@ sub cmd_rpush { push @rdgit, qw(remote-push-build-host), (scalar @rargs), @rargs; push @rdgit, @ARGV; my @cmd = (@ssh, $host, shellquote @rdgit); - printcmd \*DEBUG,$debugprefix."+",@cmd; + debugcmd "+",@cmd; if (defined $initiator_tempdir) { rmtree $initiator_tempdir; @@ -2724,6 +2652,7 @@ sub cmd_archive_api_query { badusage "need only 1 subpath argument" unless @ARGV==1; my ($subpath) = @ARGV; my @cmd = archive_api_query_cmd($subpath); + debugcmd ">",@cmd; exec @cmd or fail "exec curl: $!\n"; } @@ -2810,7 +2739,7 @@ sub parseopts () { } elsif (m/^--no-rm-on-error$/s) { push @ropts, $_; $rmonerror = 0; - } elsif (m/^--deliberately-($suite_re)$/s) { + } elsif (m/^--deliberately-($deliberately_re)$/s) { push @ropts, $_; push @deliberatelies, $&; } else { @@ -2828,9 +2757,8 @@ sub parseopts () { cmd_help(); } elsif (s/^-D/-/) { push @ropts, $&; - open DEBUG, ">&STDERR" or die $!; - autoflush DEBUG 1; - $debug++; + $debuglevel++; + enabledebug(); } elsif (s/^-N/-/) { push @ropts, $&; $new_package=1;