Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Tricky code can bypass Carp overload protections and trigger exceptions #16407

Open
p5pRT opened this issue Feb 7, 2018 · 5 comments
Open

Tricky code can bypass Carp overload protections and trigger exceptions #16407

p5pRT opened this issue Feb 7, 2018 · 5 comments
Labels

Comments

@p5pRT
Copy link
Collaborator

@p5pRT p5pRT commented Feb 7, 2018

Migrated from rt.perl.org#132828 (status was 'open')

Searchable as RT132828$

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Feb 7, 2018

From @demerphq

This produces interesting results​:

perl -MCarp -E 'package OverloadedInXS { my $n = \&overload​::nil; my
$p = __PACKAGE__; *{$p."​::(("} = $n; *{$p.q!​::(""!} = sub { return
"<My Stringify>" }; } for (1, 2) { sub { Carp​::cluck("") }->(bless
{}, "OverloadedInXS"); require overload }'

at -e line 1.
main​::__ANON__(<My Stringify>) called at -e line 1
at -e line 1.
main​::__ANON__(OverloadedInXS=HASH(0xfe6ed8)) called at -e line 1

So one can get around Carp's defenses against overloading. Which means...

perl -MCarp -E 'package OverloadedInXS { my $n = \&overload​::nil; my
$p = __PACKAGE__; *{$p."​::(("} = $n; *{$p.q!​::(""!} = sub {
Carp​::cluck "<My Stringify>" }; } for (1, 2) { sub { Carp​::cluck("")
}->(bless {}, "OverloadedInXS"); require overload }'
Deep recursion on subroutine "Carp​::longmess" at
/home/yorton/perl5/perlbrew/perls/perl-5.18.4/lib/site_perl/5.18.4/Carp.pm
line 170.
Deep recursion on subroutine "Carp​::longmess_heavy" at
/home/yorton/perl5/perlbrew/perls/perl-5.18.4/lib/site_perl/5.18.4/Carp.pm
line 148.
Deep recursion on subroutine "Carp​::ret_backtrace" at
/home/yorton/perl5/perlbrew/perls/perl-5.18.4/lib/site_perl/5.18.4/Carp.pm
line 450.
Deep recursion on subroutine "Carp​::caller_info" at
/home/yorton/perl5/perlbrew/perls/perl-5.18.4/lib/site_perl/5.18.4/Carp.pm
line 467.
Deep recursion on subroutine "Carp​::format_arg" at
/home/yorton/perl5/perlbrew/perls/perl-5.18.4/lib/site_perl/5.18.4/Carp.pm
line 237.
Deep recursion on subroutine "Carp​::caller_info" at
/home/yorton/perl5/perlbrew/perls/perl-5.18.4/lib/site_perl/5.18.4/Carp.pm
line 481.
Deep recursion on subroutine "Carp​::format_arg" at
/home/yorton/perl5/perlbrew/perls/perl-5.18.4/lib/site_perl/5.18.4/Carp.pm
line 237.
Deep recursion on anonymous subroutine at
/home/yorton/perl5/perlbrew/perls/perl-5.18.4/lib/site_perl/5.18.4/Carp.pm
line 282.
Segmentation fault

This applies to the most recent perl as well. The following patch,
against smoke-me/rt52610 version of Carp​:

Inline Patch
diff --git a/dist/Carp/lib/Carp.pm b/dist/Carp/lib/Carp.pm
index f4ae975..6d4df6e 100644
--- a/dist/Carp/lib/Carp.pm
+++ b/dist/Carp/lib/Carp.pm
@@ -322,6 +322,11 @@ sub format_arg {
         }
         else
         {
+            {
+                no strict 'refs';
+                my $pack= ref $arg;
+                if (*{$pack."::(("}{CODE}) { require overload; }
+            }
            my $sub = _fetch_sub(overload => 'StrVal');
            return $sub ? &$sub($arg) : "$arg";
         }

fixes the segault by checking to see if overloading is enabled, and if it is requiring overload\. Even if they had a good reason to avoid loading overload in the first place\, surely doing so to avoid a possible segault in an exception is reasonable\.

Yves
ps​: Brian Fraser found this neat trick. Which I am unfortunately
having to wet-blanket. :-)

--
perl -Mre=debug -e "/just|another|perl|hacker/"

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Feb 7, 2018

From @demerphq

On 7 February 2018 at 21​:56, yves orton <perlbug-followup@​perl.org> wrote​:

# New Ticket Created by yves orton
# Please include the string​: [perl #132828]
# in the subject line of all future correspondence about this issue.
# <URL​: https://rt-archive.perl.org/perl5/Ticket/Display.html?id=132828 >

This produces interesting results​:

perl -MCarp -E 'package OverloadedInXS { my $n = \&overload​::nil; my
$p = __PACKAGE__; *{$p."​::(("} = $n; *{$p.q!​::(""!} = sub { return
"<My Stringify>" }; } for (1, 2) { sub { Carp​::cluck("") }->(bless
{}, "OverloadedInXS"); require overload }'

at -e line 1.
main​::__ANON__(<My Stringify>) called at -e line 1
at -e line 1.
main​::__ANON__(OverloadedInXS=HASH(0xfe6ed8)) called at -e line 1

So one can get around Carp's defenses against overloading. Which means...

perl -MCarp -E 'package OverloadedInXS { my $n = \&overload​::nil; my
$p = __PACKAGE__; *{$p."​::(("} = $n; *{$p.q!​::(""!} = sub {
Carp​::cluck "<My Stringify>" }; } for (1, 2) { sub { Carp​::cluck("")
}->(bless {}, "OverloadedInXS"); require overload }'

Simplifies to​:

perl -MCarp -E 'my $p = "OverloadedInXS"; *{$p."​::(("} = sub{};
*{$p.q!​::(""!} = sub { Carp​::cluck "<My Stringify>" }; sub {
Carp​::cluck("") }->(bless {}, $p);'

This applies to the most recent perl as well. The following patch,
against smoke-me/rt52610 version of Carp​:

diff --git a/dist/Carp/lib/Carp.pm b/dist/Carp/lib/Carp.pm
index f4ae975..6d4df6e 100644
--- a/dist/Carp/lib/Carp.pm
+++ b/dist/Carp/lib/Carp.pm
@​@​ -322,6 +322,11 @​@​ sub format_arg {
}
else
{
+ {
+ no strict 'refs';
+ my $pack= ref $arg;
+ if (*{$pack."​::(("}{CODE}) { require overload; }
+ }
my $sub = _fetch_sub(overload => 'StrVal');
return $sub ? &$sub($arg) : "$arg";
}

fixes the segault by checking to see if overloading is enabled, and if
it is requiring overload. Even if they had a good reason to avoid
loading overload in the first place, surely doing so to avoid a
possible segault in an exception is reasonable.

Yves
ps​: Brian Fraser found this neat trick. Which I am unfortunately
having to wet-blanket. :-)

--
perl -Mre=debug -e "/just|another|perl|hacker/"

--
perl -Mre=debug -e "/just|another|perl|hacker/"

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Feb 23, 2018

From @demerphq

On 7 February 2018 at 22​:09, demerphq <demerphq@​gmail.com> wrote​:

On 7 February 2018 at 21​:56, yves orton <perlbug-followup@​perl.org> wrote​:

# New Ticket Created by yves orton
# Please include the string​: [perl #132828]
Simplifies to​:

perl -MCarp -E 'my $p = "OverloadedInXS"; *{$p."​::(("} = sub{};
*{$p.q!​::(""!} = sub { Carp​::cluck "<My Stringify>" }; sub {
Carp​::cluck("") }->(bless {}, $p);'

Fixed in c99363a

Please don't close the ticket until i can push a patch for testing.

thanks,
Yves

--
perl -Mre=debug -e "/just|another|perl|hacker/"

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Feb 23, 2018

@jkeenan - Status changed from 'new' to 'open'

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Feb 25, 2018

From @demerphq

On 23 February 2018 at 10​:33, demerphq <demerphq@​gmail.com> wrote​:

On 7 February 2018 at 22​:09, demerphq <demerphq@​gmail.com> wrote​:

On 7 February 2018 at 21​:56, yves orton <perlbug-followup@​perl.org> wrote​:

# New Ticket Created by yves orton
# Please include the string​: [perl #132828]
Simplifies to​:

perl -MCarp -E 'my $p = "OverloadedInXS"; *{$p."​::(("} = sub{};
*{$p.q!​::(""!} = sub { Carp​::cluck "<My Stringify>" }; sub {
Carp​::cluck("") }->(bless {}, $p);'

Fixed in c99363a

Please don't close the ticket until i can push a patch for testing.

Pushed as b20e410

Yves

--
perl -Mre=debug -e "/just|another|perl|hacker/"

@p5pRT p5pRT added the Severity Low label Oct 19, 2019
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
Linked pull requests

Successfully merging a pull request may close this issue.

None yet
1 participant
You can’t perform that action at this time.