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