This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Avoid segfault in re::regmust with pluggable RE engines
authorDavid Leadbeater <dgl@dgl.cx>
Thu, 17 Feb 2011 23:31:08 +0000 (23:31 +0000)
committerFather Chrysostomos <sprout@cpan.org>
Fri, 18 Feb 2011 18:08:49 +0000 (10:08 -0800)
re::regmust would segfault if called on a Regexp belonging to a
pluggable regexp engine, only allow on the core and debugging engine.
Also correctly moralize the return values to avoid leaking.

ext/re/re.xs

index 8bc305e..f40e16c 100644 (file)
@@ -78,19 +78,22 @@ PREINIT:
     REGEXP *re;
 PPCODE:
 {
-    if ((re = SvRX(sv))) /* assign deliberate */
+    if ((re = SvRX(sv)) /* assign deliberate */
+       /* only for re engines we know about */
+       && (RX_ENGINE(re) == &my_reg_engine
+           || RX_ENGINE(re) == &PL_core_reg_engine))
     {
         SV *an = &PL_sv_no;
         SV *fl = &PL_sv_no;
         if (RX_ANCHORED_SUBSTR(re)) {
-            an = newSVsv(RX_ANCHORED_SUBSTR(re));
+            an = sv_2mortal(newSVsv(RX_ANCHORED_SUBSTR(re)));
         } else if (RX_ANCHORED_UTF8(re)) {
-            an = newSVsv(RX_ANCHORED_UTF8(re));
+            an = sv_2mortal(newSVsv(RX_ANCHORED_UTF8(re)));
         }
         if (RX_FLOAT_SUBSTR(re)) {
-            fl = newSVsv(RX_FLOAT_SUBSTR(re));
+            fl = sv_2mortal(newSVsv(RX_FLOAT_SUBSTR(re)));
         } else if (RX_FLOAT_UTF8(re)) {
-            fl = newSVsv(RX_FLOAT_UTF8(re));
+            fl = sv_2mortal(newSVsv(RX_FLOAT_UTF8(re)));
         }
         XPUSHs(an);
         XPUSHs(fl);