In perl.git, the branch blead has been updated <https://perl5.git.perl.org/perl.git/commitdiff/d90bd2cf701d08f6acfea11ab39eb0a20f9a6c3e?hp=807c5598a03d2cd87b685a099c1e2ee197615df8>
- Log ----------------------------------------------------------------- commit d90bd2cf701d08f6acfea11ab39eb0a20f9a6c3e Author: David Mitchell <[email protected]> Date: Wed Apr 3 16:11:54 2019 +0100 Avoid leaks in Perl_custom_op_get_field() In 5.14.0 a new API was introduced to register details for custom ops. Normally the caller supplies a pointer to a static xop struct with details for the op, which gets gets added via a hidden newSViv(PTR2IV(xop)) to PL_custom_ops values. However, Perl_custom_op_get_field() also supports the older interface, where name and desc entries were registered in PL_custom_op_names and PL_custom_op_descs. If it doesn't find an entry in PL_custom_ops, but does in PL_custom_op_names, it fakes up a new-API registration in PL_custom_ops. In this case the xop struct, and the name and description attached to it, were leaking. This commit fixes the leak by attaching magic to such newSViv(PTR2IV(xop)) SVs which frees the struct and strings. ----------------------------------------------------------------------- Summary of changes: op.c | 46 +++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 45 insertions(+), 1 deletion(-) diff --git a/op.c b/op.c index ce769c561f..3b0cc76423 100644 --- a/op.c +++ b/op.c @@ -16632,6 +16632,38 @@ function. =cut */ + +/* use PERL_MAGIC_ext to call a function to free the xop structure when + * freeing PL_custom_ops */ + +static int +custom_op_register_free(pTHX_ SV *sv, MAGIC *mg) +{ + XOP *xop; + + PERL_UNUSED_ARG(mg); + xop = INT2PTR(XOP *, SvIV(sv)); + safefree((void*)xop->xop_name); + safefree((void*)xop->xop_desc); + safefree(xop); + return 0; +} + + +static const MGVTBL custom_op_register_vtbl = { + 0, /* get */ + 0, /* set */ + 0, /* len */ + 0, /* clear */ + custom_op_register_free, /* free */ + 0, /* copy */ + 0, /* dup */ +#ifdef MGf_LOCAL + 0, /* local */ +#endif +}; + + XOPRETANY Perl_custom_op_get_field(pTHX_ const OP *o, const xop_flags_enum field) { @@ -16655,7 +16687,12 @@ Perl_custom_op_get_field(pTHX_ const OP *o, const xop_flags_enum field) if (PL_custom_ops) he = hv_fetch_ent(PL_custom_ops, keysv, 0, 0); - /* assume noone will have just registered a desc */ + /* See if the op isn't registered, but its name *is* registered. + * That implies someone is using the pre-5.14 API,where only name and + * description could be registered. If so, fake up a real + * registration. + * We only check for an existing name, and assume no one will have + * just registered a desc */ if (!he && PL_custom_op_names && (he = hv_fetch_ent(PL_custom_op_names, keysv, 0, 0)) ) { @@ -16673,6 +16710,13 @@ Perl_custom_op_get_field(pTHX_ const OP *o, const xop_flags_enum field) XopENTRY_set(xop, xop_desc, savepvn(pv, l)); } Perl_custom_op_register(aTHX_ o->op_ppaddr, xop); + he = hv_fetch_ent(PL_custom_ops, keysv, 0, 0); + /* add magic to the SV so that the xop struct (pointed to by + * SvIV(sv)) is freed. Normally a static xop is registered, but + * for this backcompat hack, we've alloced one */ + (void)sv_magicext(HeVAL(he), NULL, PERL_MAGIC_ext, + &custom_op_register_vtbl, NULL, 0); + } else { if (!he) -- Perl5 Master Repository
