diff options
Diffstat (limited to 'Debian')
-rw-r--r-- | Debian/Dgit.pm | 101 |
1 files changed, 97 insertions, 4 deletions
diff --git a/Debian/Dgit.pm b/Debian/Dgit.pm index 829725c..2c76263 100644 --- a/Debian/Dgit.pm +++ b/Debian/Dgit.pm @@ -55,7 +55,8 @@ BEGIN { must_getcwd executable_on_path waitstatusmsg failedcmd_waitstatus failedcmd_report_cmd failedcmd - runcmd shell_cmd cmdoutput cmdoutput_errok + runcmd runcmd_quieten + shell_cmd cmdoutput cmdoutput_errok @git git_rev_parse changedir_git_toplevel git_cat_file git_get_ref git_get_symref git_for_each_ref @@ -66,6 +67,7 @@ BEGIN { read_tree_debian read_tree_upstream make_commit hash_commit hash_commit_text reflog_cache_insert reflog_cache_lookup + $failmsg_prefix $package_re $component_re $suite_re $deliberately_re $distro_re $versiontag_re $series_filename_re $orig_f_comp_re $orig_f_sig_re @@ -82,6 +84,7 @@ BEGIN { $negate_harmful_gitattrs changedir git_slurp_config_src gdr_ffq_prev_branchinfo + tainted_objects_message parsecontrolfh parsecontrol parsechangelog getfield parsechangelog_loop playtree_setup playtree_write_gbp_conf); @@ -131,6 +134,12 @@ sub NOFFCHECK () { return 0x2; } sub FRESHREPO () { return 0x4; } sub NOCOMMITCHECK () { return 0x8; } +# Set this variable (locally) at the top of an `eval { }` when +# - general code within the eval might call fail +# - these errors are nonfatal and maybe not even errors +# This replaces `dgit: error: ` at the start of the message. +our $failmsg_prefix; + our $debugprefix; our $debuglevel = 0; @@ -150,6 +159,17 @@ sub forkcheck_mainprocess () { } sub setup_sigwarn () { + # $SIG{__WARN__} affects `warn` but not `-w` (`use warnings`). + # Ideally we would fatalise all warnings. However: + # 1. warnings(3perl) has a long discussion of why this is + # a bad idea due to bugs in, well, everything. + # 2. So maybe we would want to do that only when running the tests, + # 3. However, because it's a lexical keyword it's difficult to + # manipulate at runtime. We could use the caller's ^H + # via caller, but that would take effect only in the main + # program (which calls setup_sigwarn, eg dgit.git/dgit), + # and not in the modules. + # This is all swimming too much upstream. forkcheck_setup(); $SIG{__WARN__} = sub { confess $_[0] if forkcheck_mainprocess; @@ -295,11 +315,21 @@ sub _us () { } sub failmsg { - my $s = f_ "error: %s\n", "@_"; + my $s = "@_"; $s =~ s/\n\n$/\n/g; - my $prefix = _us().": "; + my $prefix; + my $prefixnl; + if (defined $failmsg_prefix) { + $prefixnl = ''; + $prefix = $failmsg_prefix; + $s .= "\n"; + } else { + $prefixnl = "\n"; + $s = f_ "error: %s\n", "$s"; + $prefix = _us().": "; + } $s =~ s/^/$prefix/gm; - return "\n".$s; + return $prefixnl.$s; } sub fail { @@ -396,6 +426,20 @@ sub shell_cmd { return qw(sh -ec), $first_shell.'; exec "$@"', 'x', @cmd; } +# Runs the command in @_, but capturing its stdout and stderr. +# Prints those to our stderr only if the command fails. +sub runcmd_quieten { + debugcmd "+",@_; + $!=0; $?=-1; + my @real_cmd = shell_cmd <<'END', @_; + set +e; output=$("$@" 2>&1); rc=$?; set -e + if [ $rc = 0 ]; then exit 0; fi + printf >&2 "%s\n" "$output" + exit $rc +END + failedcmd @_ if system @real_cmd; +} + sub cmdoutput_errok { confess Dumper(\@_)." ?" if grep { !defined } @_; local $printdebug_when_debuglevel = $debugcmd_when_debuglevel; @@ -951,6 +995,55 @@ sub reflog_cache_lookup ($$) { return undef; } +sub tainted_objects_message ($$$) { + my ($ti, $override_status, $hinted_dedup) = @_; + # $override_status: + # undef, not overriddeable + # '', not overridden + # $deliberately, overridden + + my $msg = ''; + + my $timeshow = defined $ti->{time} + ? strftime("%Y-%m-%d %H:%M:%S Z", gmtime $ti->{time}) + : ""; + + my $infoshow = length $timeshow && length $ti->{package} ? + f_ "Taint recorded at time %s for package %s", $timeshow, $ti->{package}, + : length $timeshow && !length $ti->{package} ? + f_ "Taint recorded at time %s for any package", $timeshow, + : !length $timeshow && length $ti->{package} ? + f_ "Taint recorded for package %s", $ti->{package}, + : !length $timeshow && !length $ti->{package} ? + __ "Taint recorded for any package" + : confess; + + $msg .= <<END; + +History contains tainted $ti->{gitobjtype} $ti->{gitobjid} +$infoshow +Reason: $ti->{comment} +END + + $msg .= + !defined $override_status ? __ <<END +Uncorrectable error. If confused, consult administrator. +END + : !length $override_status ? __ <<END +Could perhaps be forced using --deliberately. Consult documentation. +END + : f_ <<END, $override_status; +Forcing due to %s +END + + my $hint = $ti->{hint}; + if (defined $hint and !$hinted_dedup->{$hint}++) { + $msg .= $hint; + } + + return $msg; +} + # ========== playground handling ========== # terminology: |