Skip to content

Commit

Permalink
Change vverify() to return HV or NULL (RT#78286)
Browse files Browse the repository at this point in the history
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.
  • Loading branch information
xdg committed Oct 8, 2010
1 parent e771aaa commit 5de8bff
Show file tree
Hide file tree
Showing 4 changed files with 32 additions and 31 deletions.
2 changes: 1 addition & 1 deletion embed.fnc
Expand Up @@ -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
Expand Down
8 changes: 7 additions & 1 deletion lib/version.t
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion proto.h
Expand Up @@ -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)
Expand Down
51 changes: 23 additions & 28 deletions util.c
Expand Up @@ -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;
Expand All @@ -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;
}

/*
Expand Down Expand Up @@ -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 */
Expand Down Expand Up @@ -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 ) )
Expand Down Expand Up @@ -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)) {
Expand Down Expand Up @@ -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 */
Expand Down

0 comments on commit 5de8bff

Please sign in to comment.