From 5de8bffdbc0d73b6750568e36033f7168cd88f51 Mon Sep 17 00:00:00 2001 From: David Golden Date: Fri, 8 Oct 2010 11:39:52 -0400 Subject: [PATCH] Change vverify() to return HV or NULL (RT#78286) Multiple code paths were dereferencing version objects without checking the underlying type, which could result in segmentation faults per RT#78286 This patch consolidates all dereferencing into vverify() and has vverify return the underlying HV or NULL instead of a boolean value. --- embed.fnc | 2 +- lib/version.t | 8 +++++++- proto.h | 2 +- util.c | 51 +++++++++++++++++++++++---------------------------- 4 files changed, 32 insertions(+), 31 deletions(-) diff --git a/embed.fnc b/embed.fnc index 704a5dd..6bdc12f 100644 --- a/embed.fnc +++ b/embed.fnc @@ -853,7 +853,7 @@ Apd |const char* |prescan_version |NN const char *s\ |NULLOK int *ssaw_decimal|NULLOK int *swidth|NULLOK bool *salpha Apd |SV* |new_version |NN SV *ver Apd |SV* |upg_version |NN SV *ver|bool qv -Apd |bool |vverify |NN SV *vs +Apd |SV* |vverify |NN SV *vs Apd |SV* |vnumify |NN SV *vs Apd |SV* |vnormal |NN SV *vs Apd |SV* |vstringify |NN SV *vs diff --git a/lib/version.t b/lib/version.t index 7bce0eb..da7a5fd 100644 --- a/lib/version.t +++ b/lib/version.t @@ -96,9 +96,15 @@ like($@, qr/Invalid version object/, eval { my $test = ($testobj > 1.0) }; like($@, qr/Invalid version object/, "Bad subclass vcmp"); -strict_lax_tests(); + +# Invalid structure +eval { $a = \\version->new(1); bless $a, "version"; print "# $a\n" }; +like($@, qr/Invalid version object/, + "Bad internal structure (RT#78286)"); # do strict lax tests in a sub to isolate a package to test importing +strict_lax_tests(); + sub strict_lax_tests { package temp12345; # copied from perl core test t/op/packagev.t diff --git a/proto.h b/proto.h index 999762f..fffbdca 100644 --- a/proto.h +++ b/proto.h @@ -4635,7 +4635,7 @@ PERL_CALLCONV SV* Perl_vstringify(pTHX_ SV *vs) #define PERL_ARGS_ASSERT_VSTRINGIFY \ assert(vs) -PERL_CALLCONV bool Perl_vverify(pTHX_ SV *vs) +PERL_CALLCONV SV* Perl_vverify(pTHX_ SV *vs) __attribute__nonnull__(pTHX_1); #define PERL_ARGS_ASSERT_VVERIFY \ assert(vs) diff --git a/util.c b/util.c index b1b2af5..16fae9a 100644 --- a/util.c +++ b/util.c @@ -5108,27 +5108,30 @@ Perl_upg_version(pTHX_ SV *ver, bool qv) /* =for apidoc vverify -Validates that the SV contains a valid version object. +Validates that the SV contains valid internal structure for a version object. +It may be passed either the version object (RV) or the hash itself (HV). If +the structure is valid, it returns the HV. If the structure is invalid, +it returns NULL. - bool vverify(SV *vobj); + SV *hv = vverify(sv); Note that it only confirms the bare minimum structure (so as not to get confused by derived classes which may contain additional hash entries): =over 4 -=item * The SV contains a [reference to a] hash +=item * The SV is an HV or a reference to an HV =item * The hash contains a "version" key -=item * The "version" key has [a reference to] an AV as its value +=item * The "version" key has a reference to an AV as its value =back =cut */ -bool +SV * Perl_vverify(pTHX_ SV *vs) { SV *sv; @@ -5143,9 +5146,9 @@ Perl_vverify(pTHX_ SV *vs) && hv_exists(MUTABLE_HV(vs), "version", 7) && (sv = SvRV(*hv_fetchs(MUTABLE_HV(vs), "version", FALSE))) && SvTYPE(sv) == SVt_PVAV ) - return TRUE; + return vs; else - return FALSE; + return NULL; } /* @@ -5173,10 +5176,9 @@ Perl_vnumify(pTHX_ SV *vs) PERL_ARGS_ASSERT_VNUMIFY; - if ( SvROK(vs) ) - vs = SvRV(vs); - - if ( !vverify(vs) ) + /* extract the HV from the object */ + vs = vverify(vs); + if ( ! vs ) Perl_croak(aTHX_ "Invalid version object"); /* see if various flags exist */ @@ -5252,10 +5254,9 @@ Perl_vnormal(pTHX_ SV *vs) PERL_ARGS_ASSERT_VNORMAL; - if ( SvROK(vs) ) - vs = SvRV(vs); - - if ( !vverify(vs) ) + /* extract the HV from the object */ + vs = vverify(vs); + if ( ! vs ) Perl_croak(aTHX_ "Invalid version object"); if ( hv_exists(MUTABLE_HV(vs), "alpha", 5 ) ) @@ -5307,10 +5308,9 @@ Perl_vstringify(pTHX_ SV *vs) { PERL_ARGS_ASSERT_VSTRINGIFY; - if ( SvROK(vs) ) - vs = SvRV(vs); - - if ( !vverify(vs) ) + /* extract the HV from the object */ + vs = vverify(vs); + if ( ! vs ) Perl_croak(aTHX_ "Invalid version object"); if (hv_exists(MUTABLE_HV(vs), "original", sizeof("original") - 1)) { @@ -5350,15 +5350,10 @@ Perl_vcmp(pTHX_ SV *lhv, SV *rhv) PERL_ARGS_ASSERT_VCMP; - if ( SvROK(lhv) ) - lhv = SvRV(lhv); - if ( SvROK(rhv) ) - rhv = SvRV(rhv); - - if ( !vverify(lhv) ) - Perl_croak(aTHX_ "Invalid version object"); - - if ( !vverify(rhv) ) + /* extract the HVs from the objects */ + lhv = vverify(lhv); + rhv = vverify(rhv); + if ( ! ( lhv && rhv ) ) Perl_croak(aTHX_ "Invalid version object"); /* get the left hand term */ -- 2.7.4