From b5ad485cc167b3b6aa43f83aa92bbf8b8811cb42 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
Date: Fri, 20 Apr 2018 10:20:55 +0200
Subject: [PATCH] Fix RT #52610: Carp: Do not crash when reading @DB::args
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Petr Pisar: Ported from perl after 5.27.8. The unreliable test was
later deleted in a77eff3c and the comments rephrased in 02c84d7:
commit 4764858cb80e76fdba33cc1b3be8fcdef26df754
Author: Pali <pali@cpan.org>
Date: Wed Jan 31 22:43:46 2018 +0100
Fix RT #52610: Carp: Do not crash when reading @DB::args
Trying to read values from array @DB::args can lead to perl fatal error
"Bizarre copy of ARRAY in scalar assignment". But missing, incomplete or
possible incorrect value in @DB::args is not a fatal error for Carp.
Carp is primary used for reporting warnings and errors from other
modules, so it should not crash perl when trying to print error message.
This patch safely iterates all elements of @DB::args array via eval { }
block and replace already freed scalars for Carp usage by string
"** argument not available anymore **".
This prevent crashing perl and allows to use Carp module. It it not a
proper fix but rather workaround for Carp module. At least it allows to
safely use Carp.
Patch amended by Yves Orton
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
lib/Carp.pm | 22 ++++++++++++++++------
1 file changed, 16 insertions(+), 6 deletions(-)
diff --git a/lib/Carp.pm b/lib/Carp.pm
index 05052b9..60b2469 100644
--- a/lib/Carp.pm
+++ b/lib/Carp.pm
@@ -203,11 +203,22 @@ sub caller_info {
my $sub_name = Carp::get_subname( \%call_info );
if ( $call_info{has_args} ) {
- my @args;
- if (CALLER_OVERRIDE_CHECK_OK && @DB::args == 1
- && ref $DB::args[0] eq ref \$i
- && $DB::args[0] == \$i ) {
- @DB::args = (); # Don't let anyone see the address of $i
+ # guard our serialization of the stack from stack refcounting bugs
+ my @args = map {
+ my $arg;
+ local $@= $@;
+ eval {
+ $arg = $_;
+ 1;
+ } or do {
+ $arg = '** argument not available anymore **';
+ };
+ $arg;
+ } @DB::args;
+ if (CALLER_OVERRIDE_CHECK_OK && @args == 1
+ && ref $args[0] eq ref \$i
+ && $args[0] == \$i ) {
+ @args = (); # Don't let anyone see the address of $i
local $@;
my $where = eval {
my $func = $cgc or return '';
@@ -226,7 +237,6 @@ sub caller_info {
= "** Incomplete caller override detected$where; \@DB::args were not set **";
}
else {
- @args = @DB::args;
my $overflow;
if ( $MaxArgNums and @args > $MaxArgNums )
{ # More than we want to show?
--
2.14.3