$^S 不会在 Perl 中捕获 eval 死亡
$^S Doesn't Catch Eval Deaths in Perl
我为我的代码的 FastCGI 实现覆盖了 Perl 中的死亡，并在覆盖中包含了 $^S 的测试：
$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;
}
每种情况下的结果 显示 $^S 为空，正如例程 returns 在 $^S 为真时所预期的那样。:
The result:
Local: Sat Jul 31 12:00:57 2021: Dying from error.; At file: /usr/local/lib64/perl5/CryptX.pm; line: 14; id:
然而，在加载模块的正常过程中，return if ($file =~ /^\(eval/); 被评估为 true 几次，似乎表明 $^S 没有给出正确的结果。该测试 和 $^S 都有几个评估失败，例如，加载 CryptX.pm 时上面显示的那个在第 14 行执行此评估：
eval { require Cpanel::JSON::XS }
有什么会导致 $^S 不准确的吗？有没有更好的方法来避免混入 eval？
我试图创建一个最低限度可重现的示例，但它似乎没有表现出相同的行为，因此一定有其他东西在更大的代码库中搞砸了。我想这会将我的问题更改为：“什么可以改变行为，使 $^S 无法按预期工作？
这按预期工作：
#!/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;
作为参考，$^S variable 显示
Current state of the interpreter.
$^S State
--------- -------------------------------------
undef Parsing module, eval, or main program
true (1) Executing an eval
false (0) Otherwise
问题中显示的错误消息，显然是在 CryptX.pm 在 eval 语句中死亡时触发的，是从 __DIE__ 处理程序调用的子程序中打印出来的。在我的测试中 $^S 是 1 在这种情况下，但我的测试不是那里发生的事情。
在您的代码中什么时候发生这种情况 - 加载时 CryptX？还涉及哪些其他代码？您的处理程序是否收到 that die 或沿途重新抛出的东西（不是来自 eval）？ CryptX 首先加载 C 代码。基础知识：
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";
这会打印（我的 @INC 被抑制）
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
但是如果 die 从另一个包 eval 中抛出 那么我的处理程序就不会被触发。† 在您的代码中似乎就是这种情况——但是错误处理是如何触发的呢？这是所显示内容的另一个大并发症。
总而言之，我不会得出 $^S 错误的结论，而是我们不知道发生了什么，正如问题第二部分所述。
问题也说
...during the normal course of loading modules return if ($file =~ /^\(eval/); is evaluated as true several times,...
（引用的 return... 语句在显示为从 __DIE__ 处理程序调用的子程序中）
评论中提到 return 分配给 $file 的子 id 来自 CGI::Carp，很像 caller .那么 $file 是被调用的 sub 的（错误命名的）名称？然后如果匹配可能是 eval——但我们不知道 id 与 caller 的相似程度。然后，id(2) 大概是调用堆栈中的帧级别？我们还在 eval 执行中吗？这一切都很重要，但还不清楚。 （还有 为什么 2？）
但最重要的是要注意文档在 %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.
我建议听从这个建议。这是一个 article from Effective Perler on it
更多注意事项
将 @_ 从 __DIE__ 处理程序传递到下一个子程序以便查看错误
SAFARI::Core::safariErrorLogWriter 前面的 & 似乎不需要那个子。它不会影响此讨论，但我看不到您在那里需要它
( caller(LEVEL) )[7]表示这是否来自require。在这里可能会有用
† 除非它在 BEGIN 块中定义，连同它使用的 subs。但这是个坏主意，因为 所有 之后的代码都会受到影响，包括库
我为我的代码的 FastCGI 实现覆盖了 Perl 中的死亡，并在覆盖中包含了 $^S 的测试：
$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;
}
每种情况下的结果 显示 $^S 为空，正如例程 returns 在 $^S 为真时所预期的那样。:
The result:
Local: Sat Jul 31 12:00:57 2021: Dying from error.; At file: /usr/local/lib64/perl5/CryptX.pm; line: 14; id:
然而，在加载模块的正常过程中，return if ($file =~ /^\(eval/); 被评估为 true 几次，似乎表明 $^S 没有给出正确的结果。该测试 和 $^S 都有几个评估失败，例如，加载 CryptX.pm 时上面显示的那个在第 14 行执行此评估：
eval { require Cpanel::JSON::XS }
有什么会导致 $^S 不准确的吗？有没有更好的方法来避免混入 eval？
我试图创建一个最低限度可重现的示例，但它似乎没有表现出相同的行为，因此一定有其他东西在更大的代码库中搞砸了。我想这会将我的问题更改为：“什么可以改变行为，使 $^S 无法按预期工作？
这按预期工作：
#!/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;
作为参考，$^S variable 显示
Current state of the interpreter.
$^S State --------- ------------------------------------- undef Parsing module, eval, or main program true (1) Executing an eval false (0) Otherwise
问题中显示的错误消息，显然是在 CryptX.pm 在 eval 语句中死亡时触发的，是从 __DIE__ 处理程序调用的子程序中打印出来的。在我的测试中 $^S 是 1 在这种情况下，但我的测试不是那里发生的事情。
在您的代码中什么时候发生这种情况 - 加载时 CryptX？还涉及哪些其他代码？您的处理程序是否收到 that die 或沿途重新抛出的东西（不是来自 eval）？ CryptX 首先加载 C 代码。基础知识：
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";
这会打印（我的 @INC 被抑制）
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
但是如果 die 从另一个包 eval 中抛出 那么我的处理程序就不会被触发。† 在您的代码中似乎就是这种情况——但是错误处理是如何触发的呢？这是所显示内容的另一个大并发症。
总而言之，我不会得出 $^S 错误的结论，而是我们不知道发生了什么，正如问题第二部分所述。
问题也说
...during the normal course of loading modules
return if ($file =~ /^\(eval/);is evaluated as true several times,...
（引用的 return... 语句在显示为从 __DIE__ 处理程序调用的子程序中）
评论中提到 return 分配给 $file 的子 id 来自 CGI::Carp，很像 caller .那么 $file 是被调用的 sub 的（错误命名的）名称？然后如果匹配可能是 eval——但我们不知道 id 与 caller 的相似程度。然后，id(2) 大概是调用堆栈中的帧级别？我们还在 eval 执行中吗？这一切都很重要，但还不清楚。 （还有 为什么 2？）
但最重要的是要注意文档在 %SIG in perlvar
末尾所说的内容Having to even think about the
$^Svariable in your exception handlers is simply wrong.$SIG{__DIE__}as currently implemented invites grievous and difficult to track down errors. Avoid it and use anEND{}orCORE::GLOBAL::dieoverride instead.
我建议听从这个建议。这是一个 article from Effective Perler on it
更多注意事项
将
@_从__DIE__处理程序传递到下一个子程序以便查看错误SAFARI::Core::safariErrorLogWriter前面的&似乎不需要那个子。它不会影响此讨论，但我看不到您在那里需要它( caller(LEVEL) )[7]表示这是否来自require。在这里可能会有用
† 除非它在 BEGIN 块中定义，连同它使用的 subs。但这是个坏主意，因为 所有 之后的代码都会受到影响，包括库