From 00ac08331f4119b8726748c109ce9a2d50f2887e Mon Sep 17 00:00:00 2001 From: Ian Jackson Date: Mon, 1 Oct 2018 14:11:03 +0100 Subject: [PATCH] dgit: Replace every `die $!;' with confess This may improve error messages in case of internal errors etc., at the cost of producing stack traces when it's just that the user's disk is full. This is probably a good tradeoff. Signed-off-by: Ian Jackson --- dgit | 242 +++++++++++++++++++++++++++++------------------------------ 1 file changed, 121 insertions(+), 121 deletions(-) diff --git a/dgit b/dgit index 051a4be5..8ce43899 100755 --- a/dgit +++ b/dgit @@ -516,7 +516,7 @@ sub protocol_send_file ($$) { print $fh $d or confess $!; } PF->error and die "$ourfn $!"; - print $fh "data-end\n" or die $!; + print $fh "data-end\n" or confess $!; close PF; } @@ -541,9 +541,9 @@ sub protocol_receive_file ($$) { } $fh; last unless $y; my $d = protocol_read_bytes $fh, $l; - print PF $d or die $!; + print PF $d or confess $!; } - close PF or die $!; + close PF or confess $!; } #---------- remote protocol support, responder ---------- @@ -553,7 +553,7 @@ sub responder_send_command ($) { return unless $we_are_responder; # called even without $we_are_responder printdebug ">> $command\n"; - print PO $command, "\n" or die $!; + print PO $command, "\n" or confess $!; } sub responder_send_file ($$) { @@ -588,8 +588,8 @@ sub initiator_expect (&) { sub progress { if ($we_are_responder) { my $m = join '', @_; - responder_send_command "progress ".length($m) or die $!; - print PO $m or die $!; + responder_send_command "progress ".length($m) or confess $!; + print PO $m or confess $!; } else { print @_, "\n"; } @@ -604,7 +604,7 @@ sub url_get { } my $what = $_[$#_]; progress "downloading $what..."; - my $r = $ua->get(@_) or die $!; + 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; @@ -668,7 +668,7 @@ Perhaps the upload is stuck in incoming. Using the version from git. END sub badusage { - print STDERR f_ "%s: %s\n%s", $us, "@_", __ $helpmsg or die $!; + print STDERR f_ "%s: %s\n%s", $us, "@_", __ $helpmsg or confess $!; finish 8; } @@ -681,7 +681,7 @@ sub pre_help () { not_necessarily_a_tree(); } sub cmd_help () { - print __ $helpmsg or die $!; + print __ $helpmsg or confess $!; finish 0; } @@ -928,8 +928,8 @@ sub supplementary_message ($) { return; } elsif ($protovsn >= 3) { responder_send_command "supplementary-message ".length($msg) - or die $!; - print PO $msg or die $!; + or confess $!; + print PO $msg or confess $!; } } @@ -1066,7 +1066,7 @@ sub commit_getclogp ($) { } sub parse_dscdata () { - my $dscfh = new IO::File \$dscdata, '<' or die $!; + 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; @@ -1289,12 +1289,12 @@ sub aptget_prep ($) { access_cfg('mirror'), $aptsuites, access_cfg('aptget-components') - or die $!; + or confess $!; ensuredir "$aptget_base/cache"; ensuredir "$aptget_base/lists"; - open CONF, ">", $aptget_configpath or die $!; + open CONF, ">", $aptget_configpath or confess $!; print CONF <) { next unless stat_exists $oldlist; my ($mtime) = (stat _)[9]; @@ -1417,7 +1417,7 @@ sub dummycatapi_run_in_mirror ($@) { my @cmd = (qw(sh -ec), 'cd "$1"; shift'."\n".$rune, qw(x), $mirror, @$argl); debugcmd "-|", @cmd; - open FIA, "-|", @cmd or die $!; + open FIA, "-|", @cmd or confess $!; my $r = $fn->(); close FIA or ($!==0 && $?==141) or die failedcmd @cmd; return $r; @@ -1520,7 +1520,7 @@ sub sshpsql ($$$) { " export LC_MESSAGES=C; export LC_CTYPE=C;". " ".shellquote qw(psql -A), $dbname, qw(-c), $sql); debugcmd "|",@cmd; - open P, "-|", @cmd or die $!; + open P, "-|", @cmd or confess $!; while (

) { chomp or die; printdebug(">|$_|\n"); @@ -1821,7 +1821,7 @@ sub remove_stray_gits ($) { my ($what) = @_; my @gitscmd = qw(find -name .git -prune -print0); debugcmd "|",@gitscmd; - open GITS, "-|", @gitscmd or die $!; + open GITS, "-|", @gitscmd or confess $!; { local $/="\0"; while () { @@ -2278,9 +2278,9 @@ sub generate_commits_from_dsc () { 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, "-|" // die $!; + my $compr_pid = open $compr_fh, "-|" // confess $!; if (!$compr_pid) { - open STDIN, "<&", $input or die $!; + open STDIN, "<&", $input or confess $!; exec @compr_cmd; die "dgit (child): exec $compr_cmd[0]: $!\n"; } @@ -2288,23 +2288,23 @@ sub generate_commits_from_dsc () { } rmtree "_unpack-tar"; - mkdir "_unpack-tar" or die $!; + 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 // die $!; + my $tar_pid = fork // confess $!; if (!$tar_pid) { - chdir "_unpack-tar" or die $!; - open STDIN, "<&", $input or die $!; + 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 die $!; + $!=0; (waitpid $tar_pid, 0) == $tar_pid or confess $!; !$? or failedcmd @tarcmd; close $input or (@compr_cmd ? ($?==SIGPIPE || failedcmd @compr_cmd) - : die $!); + : confess $!); # finally, we have the results in "tarball", but maybe # with the wrong permissions @@ -2461,14 +2461,14 @@ END_T printdebug "import main commit\n"; - open C, ">../commit.tmp" or die $!; - print C <../commit.tmp" or confess $!; + print C <{Commit} END - print C <{format}) { @@ -2522,7 +2522,7 @@ END progress f_ "%s: trying slow absurd-git-apply...", $us; rename "../../gbp-pq-output","../../gbp-pq-output.0" or $!==ENOENT - or die $!; + or confess $!; } eval { die "forbid absurd git-apply\n" if $use_absurd @@ -2588,7 +2588,7 @@ Version actually in archive: %s (older) Last version pushed with dgit: %s (newer or same) %s END - __ $later_warning_msg or die $!; + __ $later_warning_msg or confess $!; @output = $lastpush_mergeinput; } else { # Same version. Use what's in the server git branch, @@ -2618,7 +2618,7 @@ sub complete_file_from_dsc ($$;$) { open F, "<", "$tf" or die "$tf: $!"; $fi->{Digester}->reset(); $fi->{Digester}->addfile(*F); - F->error and die $!; + F->error and confess $!; $got = $fi->{Digester}->hexdigest(); return $got eq $fi->{Hash}; }; @@ -2752,7 +2752,7 @@ sub git_lrfetch_sane { debugcmd "|",@lcmd; my %wantr; - open GITLS, "-|", @lcmd or die $!; + open GITLS, "-|", @lcmd or confess $!; while () { printdebug "=> ", $_; m/^(\w+)\s+(\S+)\n/ or die "ls-remote $_ ?"; @@ -3173,7 +3173,7 @@ sub fetch_from_archive () { printdebug "del_lrfetchrefs: $objid $fullrefname\n"; if (!$gur) { $gur ||= new IO::Handle; - open $gur, "|-", qw(git update-ref --stdin) or die $!; + open $gur, "|-", qw(git update-ref --stdin) or confess $!; } printf $gur "delete %s %s\n", $fullrefname, $objid; } @@ -3194,7 +3194,7 @@ Commit referred to by archive: %s Last version pushed with dgit: %s %s END - __ $later_warning_msg or die $!; + __ $later_warning_msg or confess $!; @mergeinputs = ($lastpush_mergeinput); } else { # Archive has .dsc which is not a descendant of the last dgit @@ -3229,11 +3229,11 @@ END Package not found in the archive, but has allegedly been pushed using dgit. %s END - __ $later_warning_msg or die $!; + __ $later_warning_msg or confess $!; } else { printdebug "nothing found!\n"; if (defined $skew_warning_vsn) { - print STDERR f_ <", $mcf or die "$mcf $!"; - print MC <{Commit} } @mergeinputs; @parents = reverse @parents if $compat_info->{ReverseParents}; - print MC <{Commit} END - print MC <{Message}) { - print MC $compat_info->{Message} or die $!; + print MC $compat_info->{Message} or confess $!; } else { - print MC f_ <{Info} - or die $!; + or confess $!; }; $message_add_info->($mergeinputs[0]); - print MC __ <($_) foreach @mergeinputs[1..$#mergeinputs]; } - close MC or die $!; + close MC or confess $!; $hash = make_commit $mcf; } else { $hash = $mergeinputs[0]{Commit}; @@ -3362,7 +3362,7 @@ END 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_ <) { chomp; next if m{^debian/changelog\s}; - print NATTRS $_, "\n" or die $!; + print NATTRS $_, "\n" or confess $!; } - ATTRS->error and die $!; + ATTRS->error and confess $!; close ATTRS; } - print NATTRS "debian/changelog merge=$driver\n" or die $!; + print NATTRS "debian/changelog merge=$driver\n" or confess $!; close NATTRS; set_local_git_config "$cb.name", __ 'debian/changelog merge driver'; @@ -3467,7 +3467,7 @@ sub is_gitattrs_setup () { printdebug "is_gitattrs_setup: found old macro\n"; return 0; } - $gai->error and die $!; + $gai->error and confess $!; printdebug "is_gitattrs_setup: found nothing\n"; return undef; } @@ -3488,8 +3488,8 @@ END my $af = "$maindir_gitcommon/info/attributes"; ensuredir "$maindir_gitcommon/info"; - open GAO, "> $af.new" or die $!; - print GAO < $af.new" or confess $!; + print GAO <error and die $!; + $gai->error and confess $!; } - close GAO or die $!; + close GAO or confess $!; rename "$af.new", "$af" or fail f_ "install %s: %s", $af, $!; } @@ -3526,7 +3526,7 @@ sub check_gitattrs ($$) { my @cmd = (@git, qw(ls-tree -lrz --), "${treeish}:"); debugcmd "|",@cmd; my $gafl = new IO::File; - open $gafl, "-|", @cmd or die $!; + open $gafl, "-|", @cmd or confess $!; while (<$gafl>) { chomp or die; s/^\d+\s+\w+\s+\w+\s+(\d+)\t// or die; @@ -3551,7 +3551,7 @@ sub multisuite_suite_child ($$$) { # 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 // die $!; + my $pid = fork // confess $!; if (!$pid) { forkcheck_setup(); $isuite = $tsuite; @@ -3559,17 +3559,17 @@ sub multisuite_suite_child ($$$) { $debugprefix .= " "; progress f_ "fetching %s...", $tsuite; canonicalise_suite(); - print $canonsuitefh $csuite, "\n" or die $!; - close $canonsuitefh or die $!; + print $canonsuitefh $csuite, "\n" or confess $!; + close $canonsuitefh or confess $!; $fn->(); return undef; } - waitpid $pid,0 == $pid or die $!; + waitpid $pid,0 == $pid or confess $!; fail f_ "failed to obtain %s: %s", $tsuite, waitstatusmsg() if $? && $?!=256*4; - seek $canonsuitefh,0,0 or die $!; + seek $canonsuitefh,0,0 or confess $!; local $csuite = <$canonsuitefh>; - die $! unless defined $csuite && chomp $csuite; + confess $! unless defined $csuite && chomp $csuite; if ($? == 256*4) { printdebug "multisuite $tsuite missing\n"; return $csuite; @@ -3712,9 +3712,9 @@ sub fork_for_multisuite ($) { } sub clone_set_head () { - open H, "> .git/HEAD" or die $!; - print H "ref: ".lref()."\n" or die $!; - close H or die $!; + open H, "> .git/HEAD" or confess $!; + print H "ref: ".lref()."\n" or confess $!; + close H or confess $!; } sub clone_finish ($) { my ($dstdir) = @_; @@ -3880,18 +3880,18 @@ sub get_source_format () { $options{$_} = 1; } } - F->error and die $!; + F->error and confess $!; close F; } else { - die $! unless $!==&ENOENT; + confess $! unless $!==&ENOENT; } if (!open F, "debian/source/format") { - die $! unless $!==&ENOENT; + confess $! unless $!==&ENOENT; return ''; } $_ = ; - F->error and die $!; + F->error and confess $!; chomp; return ($_, \%options); } @@ -4028,7 +4028,7 @@ sub pseudomerge_make_commit ($$$$ $$) { # git rev-list --first-parent DTRT. my $pmf = dgit_privdir()."/pseudomerge"; open MC, ">", $pmf or die "$pmf $!"; - print MC <{$ourdscfield[0]} = join " ", $tagwants->[0]{Objid}, $declaredistro, $tagwants->[0]{Tag}, $reader_giturl; - $dsc->save("$dscfn.tmp") or die $!; + $dsc->save("$dscfn.tmp") or confess $!; my $changes = parsecontrol($changesfile,$changesfilewhat); foreach my $field (qw(Source Distribution Version)) { @@ -4242,8 +4242,8 @@ sub push_mktags ($$ $$ $) { my $head = $tw->{Objid}; my $tag = $tw->{Tag}; - open TO, '>', $tfn->('.tmp') or die $!; - print TO <', $tfn->('.tmp') or confess $!; + print TO <('.tmp'); if ($sign) { @@ -4284,7 +4284,7 @@ END if (!defined $keyid) { $keyid = getfield $clogp, 'Maintainer'; } - unlink $tfn->('.tmp.asc') or $!==&ENOENT or die $!; + 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'); @@ -4891,11 +4891,11 @@ sub pre_remote_push_build_host { $we_are_responder = 1; $us .= " (build host)"; - open PI, "<&STDIN" or die $!; - open STDIN, "/dev/null" or die $!; - open PO, ">&STDOUT" or die $!; + open PI, "<&STDIN" or confess $!; + open STDIN, "/dev/null" or confess $!; + open PO, ">&STDOUT" or confess $!; autoflush PO 1; - open STDOUT, ">&STDERR" or die $!; + open STDOUT, ">&STDERR" or confess $!; autoflush STDOUT 1; $vsnwant //= 1; @@ -5019,7 +5019,7 @@ sub i_resp_complete { $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; - die $! unless $got == $pid; + confess $! unless $got == $pid; fail f_ "build host child failed: %s", waitstatusmsg() if $?; i_cleanup(); @@ -5075,7 +5075,7 @@ sub i_resp_want ($) { foreach my $localpath (@localpaths) { protocol_send_file \*RI, $localpath; } - print RI "files-end\n" or die $!; + print RI "files-end\n" or confess $!; } our ($i_clogp, $i_version, $i_dscfn, $i_changesfn, @i_buildinfos); @@ -5182,13 +5182,13 @@ sub quiltify_dpkg_commit ($$$;$) { my $descfn = ".git/dgit/quilt-description.tmp"; open O, '>', $descfn or confess "$descfn: $!"; $msg =~ s/\n+/\n\n/; - print O <>$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 $!; + open SERIES, "+>>", "debian/patches/series" or confess $!; + defined seek SERIES, -1, 2 or $!==EINVAL or confess $!; 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 $!; + 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 +(__ <' or die $!; - print $fakedsc <' or confess $!; + print $fakedsc <addfile($fh); - print $fakedsc " ".$md->hexdigest." $size $b\n" or die $!; + print $fakedsc " ".$md->hexdigest." $size $b\n" or confess $!; }; unpack_playtree_linkorigs($upstreamversion, $dscaddfile); @@ -5843,7 +5843,7 @@ END runcmd qw(env GZIP=-1n tar -zcf), "./$debtar", qw(-C), $maindir, @files; $dscaddfile->($debtar); - close $fakedsc or die $!; + close $fakedsc or confess $!; } sub quilt_fakedsc2unapplied ($$) { @@ -6036,7 +6036,7 @@ END progress __ "Tree already contains .pc - will use it then delete it."; $mustdeletepc=1; } else { - rename '../fake/.pc','.pc' or die $!; + rename '../fake/.pc','.pc' or confess $!; } changedir '../fake'; @@ -6116,7 +6116,7 @@ END quiltify($clogp,$headref,$oldtiptree,\@failsuggestion); if (!open P, '>>', ".pc/applied-patches") { - $!==&ENOENT or die $!; + $!==&ENOENT or confess $!; } else { close P; } @@ -6131,25 +6131,25 @@ END sub quilt_fixup_editor () { my $descfn = $ENV{$fakeeditorenv}; my $editing = $ARGV[$#ARGV]; - open I1, '<', $descfn or die "$descfn: $!"; - open I2, '<', $editing or die "$editing: $!"; - unlink $editing or die "$editing: $!"; - open O, '>', $editing or die "$editing: $!"; - while () { print O or die $!; } I1->error and die $!; + open I1, '<', $descfn or confess "$descfn: $!"; + open I2, '<', $editing or confess "$editing: $!"; + unlink $editing or confess "$editing: $!"; + open O, '>', $editing or confess "$editing: $!"; + while () { print O or confess $!; } I1->error and confess $!; my $copying = 0; while () { $copying ||= m/^\-\-\- /; next unless $copying; - print O or die $!; + print O or confess $!; } - I2->error and die $!; + 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 < 1; print STDERR "DAMP RUN - WILL MAKE LOCAL (UNSIGNED) CHANGES\n" if $dryrun_level == 1; if (!@ARGV) { - print STDERR __ $helpmsg or die $!; + print STDERR __ $helpmsg or confess $!; finish 8; } $cmd = $subcommand = shift @ARGV; -- 2.30.2