Skip to content
This repository has been archived by the owner on Jun 1, 2023. It is now read-only.

Commit

Permalink
Disallow pad_findmy_pvn flags, no UTF8
Browse files Browse the repository at this point in the history
With cperl all pads are stored as utf8. Fix one
forgotten call in ck_sort, caught by afl-fuzzing
id:000113,sig:06,src:029639+026337,op:splice,rep:4
id:000142,sig:11,src:027004,op:havoc,rep:32
in #293
  • Loading branch information
rurban committed Jun 18, 2017
1 parent 27c9cdd commit d7abc28
Show file tree
Hide file tree
Showing 2 changed files with 12 additions and 5 deletions.
2 changes: 1 addition & 1 deletion op.c
Original file line number Diff line number Diff line change
Expand Up @@ -12974,7 +12974,7 @@ Perl_ck_sort(pTHX_ OP *o)
*tmpbuf = '&';
assert (len < TOKENBUF_SIZE);
Copy(name, tmpbuf+1, len, char);
off = pad_findmy_pvn(tmpbuf, len+1, SvUTF8(kSVOP_sv));
off = pad_findmy_pvn(tmpbuf, len+1, 0); /* all pads are UTF8 */
if (off != NOT_IN_PAD) {
if (PAD_COMPNAME_FLAGS_isOUR(off)) {
SV * const fq =
Expand Down
15 changes: 11 additions & 4 deletions pad.c
Original file line number Diff line number Diff line change
Expand Up @@ -945,7 +945,7 @@ S_pad_check_dup(pTHX_ PADNAME *name, U32 flags, const HV *ourstash)
Given the name of a lexical variable, find its position in the
currently-compiling pad.
C<namepv>/C<namelen> specify the variable's name, including leading sigil.
C<flags> is reserved and must be zero.
C<flags> is reserved and must be zero. (Pads are all UTF8 in cperl)
If it is not in the current pad but appears in the pad of any lexically
enclosing scope, then a pseudo-entry for it is added in the current pad.
Returns the offset in the current pad,
Expand All @@ -966,16 +966,16 @@ Perl_pad_findmy_pvn(pTHX_ const char *namepv, STRLEN namelen, U32 flags)
PERL_ARGS_ASSERT_PAD_FINDMY_PVN;

pad_peg("pad_findmy_pvn");

if (flags)
/* With cperl all PADs are UTF8 */
Perl_croak(aTHX_ "panic: pad_findmy_pvn illegal flag bits 0x%" UVxf,
(UV)flags);

/* compilation errors can zero PL_compcv */
if (!PL_compcv)
return NOT_IN_PAD;

offset = pad_findlex(namepv, namelen, flags,
offset = pad_findlex(namepv, namelen, 0,
PL_compcv, PL_cop_seqmax, 1, NULL, &out_pn, &out_flags);
if (offset != NOT_IN_PAD)
return offset;
Expand Down Expand Up @@ -1010,13 +1010,15 @@ Perl_pad_findmy_pvn(pTHX_ const char *namepv, STRLEN namelen, U32 flags)
Exactly like L</pad_findmy_pvn>, but takes a nul-terminated string
instead of a string/length pair.
flags must be 0.
=cut
*/

PADOFFSET
Perl_pad_findmy_pv(pTHX_ const char *name, U32 flags)
{
PERL_ARGS_ASSERT_PAD_FINDMY_PV;
assert(!flags);
return pad_findmy_pvn(name, strlen(name), flags);
}

Expand All @@ -1026,6 +1028,7 @@ Perl_pad_findmy_pv(pTHX_ const char *name, U32 flags)
Exactly like L</pad_findmy_pvn>, but takes the name string in the form
of an SV instead of a string/length pair.
flags must be 0, all pads are utf8
=cut
*/

Expand All @@ -1036,6 +1039,7 @@ Perl_pad_findmy_sv(pTHX_ SV *name, U32 flags)
STRLEN namelen;
PERL_ARGS_ASSERT_PAD_FINDMY_SV;
namepv = SvPVutf8(name, namelen);
assert(!flags);
return pad_findmy_pvn(namepv, namelen, flags);
}

Expand Down Expand Up @@ -1125,6 +1129,8 @@ as it goes. It has to be this way
because fake names in anon protoypes have to store in C<xpadn_low> the
index into the parent pad.
PADs are with cperl all UTF8 so the flags argument must be 0 or padadd_STALEOK.
=cut
*/

Expand Down Expand Up @@ -1159,8 +1165,9 @@ S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV* cv,

PERL_ARGS_ASSERT_PAD_FINDLEX;

flags &= ~ padadd_STALEOK; /* one-shot flag */
flags &= ~padadd_STALEOK; /* one-shot flag */
if (flags)
/* With cperl all PADs are utf8 */
Perl_croak(aTHX_ "panic: pad_findlex illegal flag bits 0x%" UVxf,
(UV)flags);

Expand Down

0 comments on commit d7abc28

Please sign in to comment.