$^S Doesn't Catch Eval Deaths in Perl

Question

I override dying in Perl for the FastCGI implementation of my code and include a test for $^S in the override:

$SIG{__DIE__} = sub { 
    return if $^S; 
    say STDERR 'Contents of $^S:' . $^S; 
    &SAFARI::Core::safariErrorLogWriter('Dying from error.'); };
}

sub safariErrorLogWriter {
    my $message = shift;

    return if $^S;

    my ($file,$line,$id) = id(2);

    return if ($file =~ /^\(eval/);

    my $datestring = localtime();
    my $ipAddress = ($ENV{'REMOTE_ADDR'} // 'Local') . ': ';    
    $message = $ipAddress . $datestring . ': ' . $message . '; At file: ' . $file . '; line: ' . $line . '; id: ' . $id . "\n"; 

    state $moduleFileHomeDir = require File::HomeDir;
    my $filePath = File::HomeDir->my_home . "/safari_error_log";

    open(my $DATA,">>$filePath") || CORE::die "Couldn't open file file.txt, $!";
    print $DATA $message;
    close($DATA);
    print STDERR $message;
}

The result in each case shows $^S as empty, as would be expected since the routine returns upon $^S being true.:

The result: 
Local: Sat Jul 31 12:00:57 2021: Dying from error.; At file: /usr/local/lib64/perl5/CryptX.pm; line: 14; id:

However, during the normal course of loading modules return if ($file =~ /^\(eval/); is evaluated as true several times, seemingly indicating $^S is not giving the proper result. Several evals slip by both that test and $^S, for example, the one shown above when loading CryptX.pm, which is performing this eval on line 14:

eval { require Cpanel::JSON::XS }

Is there anything that would cause $^S to be inaccurate? Is there a better way to avoid getting evals in the mix here?

I tried to create a minimally reproducible example, but it doesn't seem to exhibit the same behavior, so there must be something else that is messing something up in the much larger code base. I guess that changes my question to: "What could alter the behavior such that $^S doesn't work as expected?

This works as expected:

#!/usr/bin/perl

Core::encodedSessionArray;

package Core;

$SIG{__DIE__} = sub { say STDERR "The result: " . $^S; return if $^S;  &Core::safariErrorLogWriter('Dying from error.'); };


sub safariErrorLogWriter {
    my $message = shift;

    return if $^S;

    my ($file,$line,$id) = id(2);

    state $evalRegEx = qr#^\(eval#;
    return if ($file =~ /$evalRegEx/);

    my $datestring = localtime();
    my $ipAddress = ($ENV{'REMOTE_ADDR'} // 'Local') . ': ';    
    $message = $ipAddress . $datestring . ': ' . $message . '; At file: ' . $file . '; line: ' . $line . '; id: ' . $id . "\n"; 

    state $moduleFileHomeDir = require File::HomeDir;
    my $filePath = File::HomeDir->my_home . "/safari_error_log";

    open(my $DATA,">>$filePath") || CORE::die "Couldn't open file file.txt, $!";
    print $DATA $message;
    close($DATA);
    print STDERR $message;
}

sub _makeIpKeyCryptObject {
    my $ipAddress = $ENV{'REMOTE_ADDR'};
    $ipAddress =~ s/\.//g;

    # Make a 16 byte key out of the IP address info.
    my $key = substr(sprintf("%016d", $ipAddress), 0, 16);

    state $moduleCryptModeCBCEasy = require Crypt::Mode::CBC::Easy;
    return Crypt::Mode::CBC::Easy->new(key => $key);        
}

sub encodedSessionArray {
    my $self = shift;
    my $params = shift;

    $params->{'sessionId'} = 0 unless $params->{'sessionId'};
    $params->{'uid'} = '0' unless $params->{'uid'};

    my $crypt = $self->_makeIpKeyCryptObject;
    my $encrypted = $crypt->encrypt(($params->{'sessionId'}, $params->{'uid'},time()));

    $encrypted =~ s/\n/\n/g;

    return $encrypted;

}

1;

user_4653379 · Answer

For reference, the $^S variable shows

Current state of the interpreter.

$^S         State  
---------   -------------------------------------  
undef       Parsing module, eval, or main program  
true (1)    Executing an eval  
false (0)   Otherwise

The error message shown in the question, apparently triggered when CryptX.pm died inside of an eval statement, is printed from a sub called from the __DIE__ handler. In my tests $^S is 1 in a situation like that, but my tests aren't what is happening there.

When in your code does this happen -- when loading CryptX? What other code gets involved? Does your handler get that die or something re-thrown along the way (not from an eval)? The CryptX loads C code first. Basics:

use warnings;
use strict;
use feature 'say';

$SIG{__DIE__} = sub {
    say "in __DIE__ handler, \$^S = $^S. call a sub";
    handler(@_)
};

sub handler {
    print "in handler(), got: @_";
    say "\$^S = $^S"
}

eval { require NoMod };  # note: in this namespace, not in another package

say "done";

This prints (my @INC suppressed)

in __DIE__ handler, $^S = 1. call a sub
in handler(), got: Can't locate NoMod.pm in @INC (@INC contains:...) at... line 15.
$^S = 1
done

But if a die is thrown from an eval in another package then my handler isn't triggered.^† That appears to be the case in your code -- but then how does that error handling get triggered? This is an additional big complication with what is shown.

Altogether I wouldn't conclude that $^S is wrong but rather that we don't know what is going on, much as stated in the second part of the question.

The question also says

...during the normal course of loading modules return if ($file =~ /^\(eval/); is evaluated as true several times,...

(the quoted return... statement is in a sub shown to be called out of a __DIE__ handler)

It is mentioned in comments that the sub id, which return is assigned to $file, comes from CGI::Carp and is much like caller. Then $file is a (misnamed) name of a sub that's been called? Then in case of a match that would presumably be an eval -- but we don't know how closely that id mimics caller. Then, id(2) is presumably the frame level in the callstack? Are we still in eval execution? This all matters but is unclear. (And why 2?)

But above all note what the docs say by the end of %SIG in perlvar

Having to even think about the $^S variable in your exception handlers is simply wrong. $SIG{__DIE__} as currently implemented invites grievous and difficult to track down errors. Avoid it and use an END{} or CORE::GLOBAL::die override instead.

I'd recommend to heed that advice. Here is an article from Effective Perler on it

A few more notes

Pass @_ from __DIE__ handler to the next sub so to see the error
That & in front of SAFARI::Core::safariErrorLogWriter seems unneeded for that sub. It doesn't affect this discussion but I don't see that you need it there
The ( caller(LEVEL) )[7] says whether this comes from require. Could be useful here

^† Unless it's defined in a BEGIN block, along with subs it uses. But then this is a bad idea since then all code after that point gets affected, libraries included

$^S Doesn't Catch Eval Deaths in Perl

1 Answers