From f79810bac1a3a45abe488e975b06bd867105e26e Mon Sep 17 00:00:00 2001 From: Nikola Knezevic Date: Tue, 26 May 2020 10:56:24 +0200 Subject: [PATCH] Improve handling of Perl's block eval errors Taken from `Perl::Critic`: A common idiom in perl for dealing with possible errors is to use `eval` followed by a check of `$@`/`$EVAL_ERROR`: eval { ... }; if ($EVAL_ERROR) { ... } There's a problem with this: the value of `$EVAL_ERROR` (`$@`) can change between the end of the `eval` and the `if` statement. The issue are object destructors: package Foo; ... sub DESTROY { ... eval { ... }; ... } package main; eval { my $foo = Foo->new(); ... }; if ($EVAL_ERROR) { ... } Assuming there are no other references to `$foo` created, when the `eval` block in `main` is exited, `Foo::DESTROY()` will be invoked, regardless of whether the `eval` finished normally or not. If the `eval` in `main` fails, but the `eval` in `Foo::DESTROY()` succeeds, then `$EVAL_ERROR` will be empty by the time that the `if` is executed. Additional issues arise if you depend upon the exact contents of `$EVAL_ERROR` and both `eval`s fail, because the messages from both will be concatenated. Even if there isn't an `eval` directly in the `DESTROY()` method code, it may invoke code that does use `eval` or otherwise affects `$EVAL_ERROR`. The solution is to ensure that, upon normal exit, an `eval` returns a true value and to test that value: # Constructors are no problem. my $object = eval { Class->new() }; # To cover the possiblity that an operation may correctly return a # false value, end the block with "1": if ( eval { something(); 1 } ) { ... } eval { ... 1; } or do { # Error handling here }; Unfortunately, you can't use the `defined` function to test the result; `eval` returns an empty string on failure. Various modules have been written to take some of the pain out of properly localizing and checking `$@`/`$EVAL_ERROR`. For example: use Try::Tiny; try { ... } catch { # Error handling here; # The exception is in $_/$ARG, not $@/$EVAL_ERROR. }; # Note semicolon. "But we don't use DESTROY() anywhere in our code!" you say. That may be the case, but do any of the third-party modules you use have them? What about any you may use in the future or updated versions of the ones you already use? --- src/lib/Hydra/Helper/AddBuilds.pm | 17 +++++++++-------- src/lib/Hydra/Helper/Nix.pm | 22 ++++++++++------------ src/script/hydra-notify | 28 +++++++++++++++++----------- src/script/hydra-send-stats | 6 ++++-- 4 files changed, 40 insertions(+), 33 deletions(-) diff --git a/src/lib/Hydra/Helper/AddBuilds.pm b/src/lib/Hydra/Helper/AddBuilds.pm index ca161350..4257c2ab 100644 --- a/src/lib/Hydra/Helper/AddBuilds.pm +++ b/src/lib/Hydra/Helper/AddBuilds.pm @@ -74,11 +74,11 @@ sub handleDeclarativeJobsetBuild { my $declPath = ($build->buildoutputs)[0]->path; my $declText = eval { readNixFile($declPath) - }; - if ($@) { + } or do { + # If readNixFile errors or returns an undef or an empty string print STDERR "ERROR: failed to readNixFile $declPath: ", $@, "\n"; die; - } + }; my $declSpec = decode_json($declText); $db->txn_do(sub { @@ -88,16 +88,17 @@ sub handleDeclarativeJobsetBuild { while ((my $jobsetName, my $spec) = each %$declSpec) { eval { updateDeclarativeJobset($db, $project, $jobsetName, $spec); - }; - if ($@) { + 1; + } or do { print STDERR "ERROR: failed to process declarative jobset ", $project->name, ":${jobsetName}, ", $@, "\n"; } } }); + 1; + } or do { + # note the error in the database in the case eval fails for whatever reason + $project->jobsets->find({ name => ".jobsets" })->update({ errormsg => $@, errortime => time, fetcherrormsg => undef }) }; - $project->jobsets->find({ name => ".jobsets" })->update({ errormsg => $@, errortime => time, fetcherrormsg => undef }) - if defined $@; - }; diff --git a/src/lib/Hydra/Helper/Nix.pm b/src/lib/Hydra/Helper/Nix.pm index ccda9e1d..b7a9bf43 100644 --- a/src/lib/Hydra/Helper/Nix.pm +++ b/src/lib/Hydra/Helper/Nix.pm @@ -356,14 +356,13 @@ sub captureStdoutStderr { alarm $timeout; IPC::Run::run(\@cmd, \$stdin, \$stdout, \$stderr); alarm 0; - }; - - if ($@) { + 1; + } or do { die unless $@ eq "timeout\n"; # propagate unexpected errors return (-1, $stdout, ($stderr // "") . "timeout\n"); - } else { - return ($?, $stdout, $stderr); - } + }; + + return ($?, $stdout, $stderr); } @@ -391,16 +390,15 @@ sub run { } }); alarm 0; - }; + $res->{status} = $?; + chomp $res->{stdout} if $args{chomp} // 0; - if ($@) { + 1; + } or do { die unless $@ eq "timeout\n"; # propagate unexpected errors $res->{status} = -1; $res->{stderr} = "timeout\n"; - } else { - $res->{status} = $?; - chomp $res->{stdout} if $args{chomp} // 0; - } + }; return $res; } diff --git a/src/script/hydra-notify b/src/script/hydra-notify index c8b5b0de..f2a48902 100755 --- a/src/script/hydra-notify +++ b/src/script/hydra-notify @@ -29,9 +29,11 @@ sub buildStarted { or die "build $buildId does not exist\n"; foreach my $plugin (@plugins) { - eval { $plugin->buildStarted($build); }; - if ($@) { - print STDERR "$plugin->buildStarted: $@\n"; + eval { + $plugin->buildStarted($build); + 1; + } or do { + print STDERR "error with $plugin->buildStarted: $@\n"; } } } @@ -53,9 +55,11 @@ sub buildFinished { } foreach my $plugin (@plugins) { - eval { $plugin->buildFinished($build, [@dependents]); }; - if ($@) { - print STDERR "$plugin->buildFinished: $@\n"; + eval { + $plugin->buildFinished($build, [@dependents]); + 1; + } or do { + print STDERR "error with $plugin->buildFinished: $@\n"; } } @@ -74,9 +78,11 @@ sub stepFinished { $logPath = undef if $logPath eq "-"; foreach my $plugin (@plugins) { - eval { $plugin->stepFinished($step, $logPath); }; - if ($@) { - print STDERR "$plugin->stepFinished: $@\n"; + eval { + $plugin->stepFinished($step, $logPath); + 1; + } or do { + print STDERR "error with $plugin->stepFinished: $@\n"; } } } @@ -115,8 +121,8 @@ while (1) { } elsif ($channelName eq "step_finished") { stepFinished(int($payload[0]), int($payload[1])); } - }; - if ($@) { + 1; + } or do { print STDERR "error processing message '$payload' on channel '$channelName': $@\n"; } } diff --git a/src/script/hydra-send-stats b/src/script/hydra-send-stats index cf653865..ba02e50c 100755 --- a/src/script/hydra-send-stats +++ b/src/script/hydra-send-stats @@ -60,8 +60,10 @@ sub sendQueueRunnerStats { } while (1) { - eval { sendQueueRunnerStats(); }; - if ($@) { warn "$@"; } + eval { + sendQueueRunnerStats(); + 1; + } or do { warn "$@"; } my $meminfo = read_file("/proc/meminfo", err_mode => 'quiet') // ""; $meminfo =~ m/Dirty:\s*(\d+) kB/;