develooper Front page | perl.perl5.porters | Postings from March 2013

[perl #117267] [PATCH] d37efd2 no warnings 'safenames', check nul in names

Thread Previous | Thread Next
From:
rurban @ cpanel . net
Date:
March 21, 2013 16:30
Subject:
[perl #117267] [PATCH] d37efd2 no warnings 'safenames', check nul in names
Message ID:
rt-3.6.HEAD-28177-1363883417-1084.117267-75-0@perl.org
# New Ticket Created by  rurban@cpanel.net 
# Please include the string:  [perl #117267]
# in the subject line of all future correspondence about this issue. 
# <URL: https://rt.perl.org:443/rt3/Ticket/Display.html?id=117267 >



This is a bug report for perl from rurban@cpanel.net,
generated with the help of perlbug 1.39 running under perl 5.17.8.

>From d37efd2979959450f2f3d96202fe471be862baea Mon Sep 17 00:00:00 2001
From: Reini Urban <rurban@x-ray.at>
Date: Sun, 17 Mar 2013 20:49:24 +0100
Subject: [PATCH] no warnings 'safenames', check \0 in names
MIME-Version: 1.0
Content-Type: multipart/mixed; boundary="------------1.7.10.4"

This is a multi-part message in MIME format.
--------------1.7.10.4
Content-Type: text/plain; charset=UTF-8; format=fixed
Content-Transfer-Encoding: 8bit


Add a new fatal warnings category safenames.
Check for invalid and potentially insecure embedded \0 in
symbol and classnames, which were until 5.16 silently ignored,
and for 5.16 allowed. Since 5.16 names are internally nul-safe,
but such hidden payloads are useless for perl, are hard to detect
and may lead to security problems.
---
 ext/B/t/b.t                              |    3 +-
 ext/XS-APItest/t/autoload.t              |   13 +-
 ext/XS-APItest/t/gv_fetchmeth.t          |   12 +-
 ext/XS-APItest/t/gv_fetchmeth_autoload.t |   11 +-
 ext/XS-APItest/t/gv_fetchmethod_flags.t  |   23 ++-
 gv.c                                     |   23 ++-
 gv.h                                     |   14 ++
 lib/warnings.pm                          |  237 +++++++++++++++---------------
 pod/perldiag.pod                         |   10 ++
 regen/warnings.pl                        |    1 +
 t/lib/warnings/pp_hot                    |   10 +-
 t/op/caller.t                            |    4 +-
 t/op/gv.t                                |    1 +
 t/op/method.t                            |    1 +
 t/op/reset.t                             |   15 +-
 warnings.h                               |    9 +-
 16 files changed, 230 insertions(+), 157 deletions(-)


--------------1.7.10.4
Content-Type: text/x-patch; name="0001-no-warnings-safenames-check-0-in-names.patch"
Content-Transfer-Encoding: 8bit
Content-Disposition: attachment; filename="0001-no-warnings-safenames-check-0-in-names.patch"

diff --git a/ext/B/t/b.t b/ext/B/t/b.t
index a065375..eabd197 100644
--- a/ext/B/t/b.t
+++ b/ext/B/t/b.t
@@ -301,7 +301,7 @@ foo
 }
 
 my $sub1 = sub {die};
-{ no warnings 'once'; no strict; *Peel:: = *{"Pe\0e\x{142}::"} }
+{ no warnings qw(once safenames); no strict; *Peel:: = *{"Pe\0e\x{142}::"} }
 my $sub2 = eval 'package Peel; sub {die}';
 my $cop = B::svref_2object($sub1)->ROOT->first->first;
 my $bobby = B::svref_2object($sub2)->ROOT->first->first;
@@ -310,6 +310,7 @@ is $cop->stashpv, 'main', 'COP->stashpv';
 
 SKIP: {
     skip "no nulls in packages before 5.17", 1 if $] < 5.017;
+    no warnings 'safenames';
     is $bobby->stashpv, "Pe\0e\x{142}", 'COP->stashpv with utf8 and nulls';
 }
 
diff --git a/ext/XS-APItest/t/autoload.t b/ext/XS-APItest/t/autoload.t
index bb670e9..99bb841 100644
--- a/ext/XS-APItest/t/autoload.t
+++ b/ext/XS-APItest/t/autoload.t
@@ -12,17 +12,20 @@ use Test::More tests => 26;
 use XS::APItest;
 
 is XS::APItest::AutoLoader::frob(), 'frob', 'name passed to XS AUTOLOAD';
-is "XS::APItest::AutoLoader::fr\0b"->(), "fr\0b",
-  'name with embedded null passed to XS AUTOLOAD';
+{
+  no warnings 'safenames';
+  is "XS::APItest::AutoLoader::fr\0b"->(), "fr\0b",
+    'name with embedded null passed to XS AUTOLOAD';
+  *AUTOLOAD = *XS::APItest::AutoLoader::AUTOLOADp;
+  is "fr\0b"->(), "fr\0b",
+    'name with embedded null passed to XS AUTOLOAD with proto';
+}
 is "XS::APItest::AutoLoader::fr\x{1ed9}b"->(), "fr\x{1ed9}b",
   'Unicode name passed to XS AUTOLOAD';
 
-*AUTOLOAD = *XS::APItest::AutoLoader::AUTOLOADp;
 
 is frob(), 'frob', 'name passed to XS AUTOLOAD with proto';
 is prototype \&AUTOLOAD, '*$', 'prototype is unchanged';
-is "fr\0b"->(), "fr\0b",
-  'name with embedded null passed to XS AUTOLOAD with proto';
 is prototype \&AUTOLOAD, '*$', 'proto unchanged after embedded-null call';
 is "fr\x{1ed9}b"->(), "fr\x{1ed9}b",
   'Unicode name passed to XS AUTOLOAD with proto';
diff --git a/ext/XS-APItest/t/gv_fetchmeth.t b/ext/XS-APItest/t/gv_fetchmeth.t
index 9f6e884..451c47a 100644
--- a/ext/XS-APItest/t/gv_fetchmeth.t
+++ b/ext/XS-APItest/t/gv_fetchmeth.t
@@ -31,11 +31,13 @@ for my $type ( 0..3 ) {
     no warnings 'once';
     *method = sub { 1 };
 }
-
-ok !XS::APItest::gv_fetchmeth_type(\%::, "method\0not quite!", 0, $level, 0), "gv_fetchmeth() is nul-clean";
-ok !XS::APItest::gv_fetchmeth_type(\%::, "method\0not quite!", 1, $level, 0), "gv_fetchmeth_sv() is nul-clean";
-is XS::APItest::gv_fetchmeth_type(\%::, "method\0not quite!", 2, $level, 0), "*main::method", "gv_fetchmeth_pv() is not nul-clean";
-ok !XS::APItest::gv_fetchmeth_type(\%::, "method\0not quite!", 3, $level, 0), "gv_fetchmeth_pvn() is nul-clean";
+{
+  no warnings 'safenames';
+  ok !XS::APItest::gv_fetchmeth_type(\%::, "method\0not quite!", 0, $level, 0), "gv_fetchmeth() is nul-clean";
+  ok !XS::APItest::gv_fetchmeth_type(\%::, "method\0not quite!", 1, $level, 0), "gv_fetchmeth_sv() is nul-clean";
+  is XS::APItest::gv_fetchmeth_type(\%::, "method\0not quite!", 2, $level, 0), "*main::method", "gv_fetchmeth_pv() is not nul-clean";
+  ok !XS::APItest::gv_fetchmeth_type(\%::, "method\0not quite!", 3, $level, 0), "gv_fetchmeth_pvn() is nul-clean";
+}
 
 {
     use utf8;
diff --git a/ext/XS-APItest/t/gv_fetchmeth_autoload.t b/ext/XS-APItest/t/gv_fetchmeth_autoload.t
index b24bfb1..511451d 100644
--- a/ext/XS-APItest/t/gv_fetchmeth_autoload.t
+++ b/ext/XS-APItest/t/gv_fetchmeth_autoload.t
@@ -42,10 +42,13 @@ for my $type ( 0..3 ) {
     *method = sub { 1 };
 }
 
-ok !XS::APItest::gv_fetchmeth_autoload_type(\%::, "method\0not quite!", 0, $level, 0), "gv_fetchmeth() is nul-clean";
-ok !XS::APItest::gv_fetchmeth_autoload_type(\%::, "method\0not quite!", 1, $level, 0), "gv_fetchmeth_autoload_sv() is nul-clean";
-is XS::APItest::gv_fetchmeth_autoload_type(\%::, "method\0not quite!", 2, $level, 0), "*main::method", "gv_fetchmeth_autoload_pv() is not nul-clean";
-ok !XS::APItest::gv_fetchmeth_autoload_type(\%::, "method\0not quite!", 3, $level, 0), "gv_fetchmeth_autoload_pvn() is nul-clean";
+{
+  no warnings 'safenames';
+  ok !XS::APItest::gv_fetchmeth_autoload_type(\%::, "method\0not quite!", 0, $level, 0), "gv_fetchmeth() is nul-clean";
+  ok !XS::APItest::gv_fetchmeth_autoload_type(\%::, "method\0not quite!", 1, $level, 0), "gv_fetchmeth_autoload_sv() is nul-clean";
+  is XS::APItest::gv_fetchmeth_autoload_type(\%::, "method\0not quite!", 2, $level, 0), "*main::method", "gv_fetchmeth_autoload_pv() is not nul-clean";
+  ok !XS::APItest::gv_fetchmeth_autoload_type(\%::, "method\0not quite!", 3, $level, 0), "gv_fetchmeth_autoload_pvn() is nul-clean";
+}
 
 {
     use utf8;
diff --git a/ext/XS-APItest/t/gv_fetchmethod_flags.t b/ext/XS-APItest/t/gv_fetchmethod_flags.t
index 15d1c41..d13a11f 100644
--- a/ext/XS-APItest/t/gv_fetchmethod_flags.t
+++ b/ext/XS-APItest/t/gv_fetchmethod_flags.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 24;
+use Test::More tests => 26;
 
 use_ok('XS::APItest');
 
@@ -15,11 +15,24 @@ for my $type ( 1..3 ) {
     is XS::APItest::gv_fetchmethod_flags_type(\%::, "method", $type, 0), "*main::method", "Sanity check";
 }
 
-ok !XS::APItest::gv_fetchmethod_flags_type(\%::, "method\0not quite!", 1, 0), "gv_fetchmethod_flags_sv() is nul-clean";
-ok !XS::APItest::gv_fetchmethod_flags_type(\%::, "method\0not quite!", 3, 0), "gv_fetchmethod_flags_pvn() is nul-clean";
+{
+  no warnings 'safenames';
+  ok !XS::APItest::gv_fetchmethod_flags_type(\%::, "method\0not quite!", 1, 0), "gv_fetchmethod_flags_sv() is nul-clean";
+  ok !XS::APItest::gv_fetchmethod_flags_type(\%::, "method\0not quite!", 3, 0), "gv_fetchmethod_flags_pvn() is nul-clean";
+
+  ok XS::APItest::gv_fetchmethod_flags_type(\%::, "method\0not quite!", 0, 0), "gv_fetchmethod_flags() is not nul-clean";
+  is XS::APItest::gv_fetchmethod_flags_type(\%::, "method\0not quite!", 2, 0), "*main::method", "gv_fetchmethod_flags_pv() is not nul-clean";
+}
 
-ok XS::APItest::gv_fetchmethod_flags_type(\%::, "method\0not quite!", 0, 0), "gv_fetchmethod_flags() is not nul-clean";
-is XS::APItest::gv_fetchmethod_flags_type(\%::, "method\0not quite!", 2, 0), "*main::method", "gv_fetchmethod_flags_pv() is not nul-clean";
+eval { XS::APItest::gv_fetchmethod_flags_type(\%::, "method\0not quite!", 1, 0); };
+like("$@", qr/^Invalid \\0 character in symbolname/, "gv_fetchmethod_flags_sv() dies with nul methodname");
+{
+  my $h;
+  no strict 'refs';
+  { no warnings 'safenames'; $h = \%{"main\0xx::"}; }
+  eval { XS::APItest::gv_fetchmethod_flags_type($h, "methodnot quite", 1, 0); };
+}
+like("$@", qr/^Invalid \\0 character in classname/, "gv_fetchmethod_flags_sv() dies with nul stash");
 
 {
     use utf8;
diff --git a/gv.c b/gv.c
index 8ac08ab..61e3a00 100644
--- a/gv.c
+++ b/gv.c
@@ -342,6 +342,7 @@ Perl_gv_init_pvn(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, U32 flag
 
     PERL_ARGS_ASSERT_GV_INIT_PVN;
     assert (!(proto && has_constant));
+    CHECK_SAFESYMNAME(name, len);
 
     if (has_constant) {
 	/* The constant has to be a simple scalar type.  */
@@ -533,8 +534,10 @@ S_maybe_add_coresub(pTHX_ HV * const stash, GV *gv,
            it this order as we need an op number before calling
            new ATTRSUB. */
     (void)core_prototype((SV *)cv, name, code, &opnum);
-    if (stash)
+    if (stash) {
+        CHECK_SAFESTASHNAME(name, len);
 	(void)hv_store(stash,name,len,(SV *)gv,0);
+    }
     if (ampable) {
 	CvLVALUE_on(cv);
 	newATTRSUB_flags(
@@ -585,6 +588,7 @@ Perl_gv_fetchmeth_sv(pTHX_ HV *stash, SV *namesv, I32 level, U32 flags)
    STRLEN namelen;
    PERL_ARGS_ASSERT_GV_FETCHMETH_SV;
    namepv = SvPV(namesv, namelen);
+   CHECK_SAFESYMNAME(namepv, namelen);
    if (SvUTF8(namesv))
        flags |= SVf_UTF8;
    return gv_fetchmeth_pvn(stash, namepv, namelen, level, flags);
@@ -673,6 +677,8 @@ Perl_gv_fetchmeth_pvn(pTHX_ HV *stash, const char *name, STRLEN len, I32 level,
     DEBUG_o( Perl_deb(aTHX_ "Looking for %smethod %s in package %s\n",
 		      flags & GV_SUPER ? "SUPER " : "",name,hvname) );
 
+    CHECK_SAFESTASHNAME(hvname, HvNAMELEN_get(stash));
+    CHECK_SAFESYMNAME(name, len);
     topgen_cmp = HvMROMETA(stash)->cache_gen + PL_sub_generation;
 
     if (flags & GV_SUPER) {
@@ -1107,6 +1113,7 @@ Perl_gv_autoload_pvn(pTHX_ HV *stash, const char *name, STRLEN len, U32 flags)
 	if (SvTYPE(stash) < SVt_PVHV) {
             STRLEN packname_len = 0;
             const char * const packname_ptr = SvPV_const(MUTABLE_SV(stash), packname_len);
+            CHECK_SAFESTASHNAME(packname_ptr, packname_len);
             packname = newSVpvn_flags(packname_ptr, packname_len,
                                       SVs_TEMP | SvUTF8(stash));
 	    stash = NULL;
@@ -1472,18 +1479,22 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
 			if (GvSTASH(gv) == PL_defstash && len == 6
 			 && strnEQ(name, "CORE", 4))
 			    hv_name_set(stash, "CORE", 4, 0);
-			else
+			else {
+			    CHECK_SAFESTASHNAME(nambeg, (int)(name_cursor-nambeg));
 			    hv_name_set(
 				stash, nambeg, name_cursor-nambeg, is_utf8
-			    );
+                                        );
+                        }
 			/* If the containing stash has multiple effective
 			   names, see that this one gets them, too. */
 			if (HvAUX(GvSTASH(gv))->xhv_name_count)
 			    mro_package_moved(stash, NULL, gv, 1);
 		    }
 		}
-		else if (!HvNAME_get(stash))
+		else if (!HvNAME_get(stash)) {
+		    CHECK_SAFESTASHNAME(nambeg, (int)(name_cursor-nambeg));
 		    hv_name_set(stash, nambeg, name_cursor - nambeg, is_utf8);
+                }
 	    }
 
 	    if (*name_cursor == ':')
@@ -1614,6 +1625,8 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
 
     if (!SvREFCNT(stash))	/* symbol table under destruction */
 	return NULL;
+    if (add)
+        CHECK_SAFESYMNAME(name, len);
 
     gvp = (GV**)hv_fetch(stash,name,is_utf8 ? -len : len,add);
     if (!gvp || *gvp == (const GV *)&PL_sv_undef) {
@@ -3085,7 +3098,7 @@ Perl_gv_name_set(pTHX_ GV *gv, const char *name, U32 len, U32 flags)
     if (!(flags & GV_ADD) && GvNAME_HEK(gv)) {
 	unshare_hek(GvNAME_HEK(gv));
     }
-
+    CHECK_SAFESYMNAME(name, len);
     PERL_HASH(hash, name, len);
     GvNAME_HEK(gv) = share_hek(name, (flags & SVf_UTF8 ? -(I32)len : (I32)len), hash);
 }
diff --git a/gv.h b/gv.h
index 1e17f35..ec889ff 100644
--- a/gv.h
+++ b/gv.h
@@ -76,6 +76,20 @@ struct gp {
 	STMT_START { assert(SvTYPE(gv) == SVt_PVGV);	\
 		(((XPV*) SvANY(gv))->xpv_len = (val)); } STMT_END
 
+/* die on embedded \0 characters in symbol or stash names */
+#define CHECK_SAFESYMNAME(p,l)   CHECK_SAFENAME("symbol",p,l)
+#define CHECK_SAFESTASHNAME(p,l) CHECK_SAFENAME("class",p,l)
+/* TODO: need to check all unprintable chars as in the parser */
+#define CHECK_SAFENAME(what,p,l)                                        \
+    if (ckWARN(WARN_SAFENAMES)) {                                       \
+        char *i;                                                        \
+        if ( (i = strchr(p, 0)) && ((i-p) < (int)l) ) { ++i;            \
+            Perl_croak(aTHX_ "Invalid \\0 character in %sname: %s\\0%s", \
+                       what,p,*i ? i : "");                             \
+        }                                                               \
+    }
+
+
 /*
 =head1 GV Functions
 
diff --git a/lib/warnings.pm b/lib/warnings.pm
index 4ddd83a..3d32dd2 100644
--- a/lib/warnings.pm
+++ b/lib/warnings.pm
@@ -232,131 +232,134 @@ our %Offsets = (
     'experimental::lexical_subs'=> 104,
     'experimental::lexical_topic'=> 106,
     'experimental::regex_sets'=> 108,
-    'safesyscalls'	=> 110,
+    'safenames'		=> 110,
+    'safesyscalls'	=> 112,
   );
 
 our %Bits = (
-    'all'		=> "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55", # [0..55]
-    'ambiguous'		=> "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00", # [29]
-    'bareword'		=> "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [30]
-    'closed'		=> "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
-    'closure'		=> "\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
-    'debugging'		=> "\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00", # [22]
-    'deprecated'	=> "\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
-    'digit'		=> "\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00", # [31]
-    'exec'		=> "\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
-    'exiting'		=> "\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
-    'experimental'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x15", # [51..54]
-    'experimental::lexical_subs'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [52]
-    'experimental::lexical_topic'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04", # [53]
-    'experimental::regex_sets'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10", # [54]
-    'glob'		=> "\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
-    'illegalproto'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [47]
-    'imprecision'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00", # [46]
-    'inplace'		=> "\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00", # [23]
-    'internal'		=> "\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00", # [24]
-    'io'		=> "\x00\x54\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..11]
-    'layer'		=> "\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
-    'malloc'		=> "\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00", # [25]
-    'misc'		=> "\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
-    'newline'		=> "\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
-    'non_unicode'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [48]
-    'nonchar'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [49]
-    'numeric'		=> "\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
-    'once'		=> "\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
-    'overflow'		=> "\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
-    'pack'		=> "\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [16]
-    'parenthesis'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00", # [32]
-    'pipe'		=> "\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
-    'portable'		=> "\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [17]
-    'precedence'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00", # [33]
-    'printf'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00", # [34]
-    'prototype'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00", # [35]
-    'qw'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00", # [36]
-    'recursion'		=> "\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [18]
-    'redefine'		=> "\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [19]
-    'regexp'		=> "\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00", # [20]
-    'reserved'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [37]
-    'safesyscalls'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40", # [55]
-    'semicolon'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [38]
-    'severe'		=> "\x00\x00\x00\x00\x00\x54\x05\x00\x00\x00\x00\x00\x00\x40", # [21..25,55]
-    'signal'		=> "\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00", # [26]
-    'substr'		=> "\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00", # [27]
-    'surrogate'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [50]
-    'syntax'		=> "\x00\x00\x00\x00\x00\x00\x00\x55\x55\x15\x00\x40\x00\x00", # [28..38,47]
-    'taint'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00", # [39]
-    'threads'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00", # [40]
-    'uninitialized'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [41]
-    'unopened'		=> "\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
-    'unpack'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00", # [42]
-    'untie'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00", # [43]
-    'utf8'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x15\x00", # [44,48..50]
-    'void'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [45]
+    'all'		=> "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x01", # [0..56]
+    'ambiguous'		=> "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00", # [29]
+    'bareword'		=> "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00", # [30]
+    'closed'		=> "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
+    'closure'		=> "\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
+    'debugging'		=> "\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [22]
+    'deprecated'	=> "\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
+    'digit'		=> "\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00", # [31]
+    'exec'		=> "\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
+    'exiting'		=> "\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
+    'experimental'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x15\x00", # [51..54]
+    'experimental::lexical_subs'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [52]
+    'experimental::lexical_topic'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [53]
+    'experimental::regex_sets'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [54]
+    'glob'		=> "\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
+    'illegalproto'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00", # [47]
+    'imprecision'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00", # [46]
+    'inplace'		=> "\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [23]
+    'internal'		=> "\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00", # [24]
+    'io'		=> "\x00\x54\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..11]
+    'layer'		=> "\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
+    'malloc'		=> "\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00", # [25]
+    'misc'		=> "\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
+    'newline'		=> "\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
+    'non_unicode'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00", # [48]
+    'nonchar'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [49]
+    'numeric'		=> "\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
+    'once'		=> "\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
+    'overflow'		=> "\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
+    'pack'		=> "\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [16]
+    'parenthesis'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00", # [32]
+    'pipe'		=> "\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
+    'portable'		=> "\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [17]
+    'precedence'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00", # [33]
+    'printf'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [34]
+    'prototype'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00", # [35]
+    'qw'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00", # [36]
+    'recursion'		=> "\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [18]
+    'redefine'		=> "\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [19]
+    'regexp'		=> "\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [20]
+    'reserved'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00", # [37]
+    'safenames'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00", # [55]
+    'safesyscalls'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [56]
+    'semicolon'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00", # [38]
+    'severe'		=> "\x00\x00\x00\x00\x00\x54\x05\x00\x00\x00\x00\x00\x00\x40\x01", # [21..25,55,56]
+    'signal'		=> "\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00", # [26]
+    'substr'		=> "\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00", # [27]
+    'surrogate'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00", # [50]
+    'syntax'		=> "\x00\x00\x00\x00\x00\x00\x00\x55\x55\x15\x00\x40\x00\x00\x00", # [28..38,47]
+    'taint'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00", # [39]
+    'threads'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00", # [40]
+    'uninitialized'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [41]
+    'unopened'		=> "\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
+    'unpack'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [42]
+    'untie'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00", # [43]
+    'utf8'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x15\x00\x00", # [44,48..50]
+    'void'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [45]
   );
 
 our %DeadBits = (
-    'all'		=> "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa", # [0..55]
-    'ambiguous'		=> "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00", # [29]
-    'bareword'		=> "\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [30]
-    'closed'		=> "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
-    'closure'		=> "\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
-    'debugging'		=> "\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00", # [22]
-    'deprecated'	=> "\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
-    'digit'		=> "\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00", # [31]
-    'exec'		=> "\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
-    'exiting'		=> "\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
-    'experimental'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x2a", # [51..54]
-    'experimental::lexical_subs'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [52]
-    'experimental::lexical_topic'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08", # [53]
-    'experimental::regex_sets'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20", # [54]
-    'glob'		=> "\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
-    'illegalproto'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [47]
-    'imprecision'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00", # [46]
-    'inplace'		=> "\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00", # [23]
-    'internal'		=> "\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00", # [24]
-    'io'		=> "\x00\xa8\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..11]
-    'layer'		=> "\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
-    'malloc'		=> "\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00", # [25]
-    'misc'		=> "\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
-    'newline'		=> "\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
-    'non_unicode'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [48]
-    'nonchar'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [49]
-    'numeric'		=> "\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
-    'once'		=> "\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
-    'overflow'		=> "\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
-    'pack'		=> "\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [16]
-    'parenthesis'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00", # [32]
-    'pipe'		=> "\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
-    'portable'		=> "\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [17]
-    'precedence'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00", # [33]
-    'printf'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00", # [34]
-    'prototype'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00", # [35]
-    'qw'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00", # [36]
-    'recursion'		=> "\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [18]
-    'redefine'		=> "\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [19]
-    'regexp'		=> "\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00", # [20]
-    'reserved'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [37]
-    'safesyscalls'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80", # [55]
-    'semicolon'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [38]
-    'severe'		=> "\x00\x00\x00\x00\x00\xa8\x0a\x00\x00\x00\x00\x00\x00\x80", # [21..25,55]
-    'signal'		=> "\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00", # [26]
-    'substr'		=> "\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00", # [27]
-    'surrogate'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [50]
-    'syntax'		=> "\x00\x00\x00\x00\x00\x00\x00\xaa\xaa\x2a\x00\x80\x00\x00", # [28..38,47]
-    'taint'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00", # [39]
-    'threads'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00", # [40]
-    'uninitialized'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [41]
-    'unopened'		=> "\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
-    'unpack'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00", # [42]
-    'untie'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00", # [43]
-    'utf8'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x2a\x00", # [44,48..50]
-    'void'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [45]
+    'all'		=> "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\x02", # [0..56]
+    'ambiguous'		=> "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00", # [29]
+    'bareword'		=> "\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00", # [30]
+    'closed'		=> "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
+    'closure'		=> "\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
+    'debugging'		=> "\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [22]
+    'deprecated'	=> "\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
+    'digit'		=> "\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00", # [31]
+    'exec'		=> "\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
+    'exiting'		=> "\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
+    'experimental'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x2a\x00", # [51..54]
+    'experimental::lexical_subs'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [52]
+    'experimental::lexical_topic'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [53]
+    'experimental::regex_sets'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [54]
+    'glob'		=> "\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
+    'illegalproto'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00", # [47]
+    'imprecision'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00", # [46]
+    'inplace'		=> "\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [23]
+    'internal'		=> "\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00", # [24]
+    'io'		=> "\x00\xa8\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..11]
+    'layer'		=> "\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
+    'malloc'		=> "\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00", # [25]
+    'misc'		=> "\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
+    'newline'		=> "\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
+    'non_unicode'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00", # [48]
+    'nonchar'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [49]
+    'numeric'		=> "\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
+    'once'		=> "\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
+    'overflow'		=> "\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
+    'pack'		=> "\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [16]
+    'parenthesis'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00", # [32]
+    'pipe'		=> "\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
+    'portable'		=> "\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [17]
+    'precedence'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00", # [33]
+    'printf'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [34]
+    'prototype'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00", # [35]
+    'qw'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00", # [36]
+    'recursion'		=> "\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [18]
+    'redefine'		=> "\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [19]
+    'regexp'		=> "\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [20]
+    'reserved'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00", # [37]
+    'safenames'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00", # [55]
+    'safesyscalls'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [56]
+    'semicolon'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00", # [38]
+    'severe'		=> "\x00\x00\x00\x00\x00\xa8\x0a\x00\x00\x00\x00\x00\x00\x80\x02", # [21..25,55,56]
+    'signal'		=> "\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00", # [26]
+    'substr'		=> "\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00", # [27]
+    'surrogate'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00", # [50]
+    'syntax'		=> "\x00\x00\x00\x00\x00\x00\x00\xaa\xaa\x2a\x00\x80\x00\x00\x00", # [28..38,47]
+    'taint'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00", # [39]
+    'threads'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00", # [40]
+    'uninitialized'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [41]
+    'unopened'		=> "\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
+    'unpack'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [42]
+    'untie'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00", # [43]
+    'utf8'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x2a\x00\x00", # [44,48..50]
+    'void'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [45]
   );
 
-$NONE     = "\0\0\0\0\0\0\0\0\0\0\0\0\0\0";
-$DEFAULT  = "\x10\x01\x00\x00\x00\x50\x04\x00\x00\x00\x00\x00\x00\x55", # [2,52..54,4,22,23,25,55]
-$LAST_BIT = 112 ;
-$BYTES    = 14 ;
+$NONE     = "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0";
+$DEFAULT  = "\x10\x01\x00\x00\x00\x50\x04\x00\x00\x00\x00\x00\x00\x55\x01", # [2,52..54,4,22,23,25,55,56]
+$LAST_BIT = 114 ;
+$BYTES    = 15 ;
 
 $All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ;
 
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 8f547c5..3ffe568 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -2477,6 +2477,16 @@ may lead to security problems.
 If you know what you are doing you can turn off this warning by
 C<no warnings 'safesyscalls';>.
 
+=item Invalid \0 character in %sname: %s\0%s
+
+(F) Embedded \0 in symbol or class names create now a fatal warning.
+Before 5.16 such names were valid but everything behind the \0 was ignored,
+since 5.16 Perl is now binary safe, but such hidden payload may lead to
+security problems.
+
+If you know what you are doing you can turn off this warning by
+C<no warnings 'safenames';>.
+
 =item Invalid conversion in %s: "%s"
 
 (W printf) Perl does not understand the given format conversion.  See
diff --git a/regen/warnings.pl b/regen/warnings.pl
index 12b0590..75ec75d 100644
--- a/regen/warnings.pl
+++ b/regen/warnings.pl
@@ -57,6 +57,7 @@ my $tree = {
          			'debugging'	=> [ 5.008, DEFAULT_ON],
          			'malloc'	=> [ 5.008, DEFAULT_ON],
 			        'safesyscalls'  => [ 5.017, DEFAULT_ON],
+			        'safenames'     => [ 5.017, DEFAULT_ON],
 			   }],
         'deprecated'	=> [ 5.008, DEFAULT_ON],
        	'void'		=> [ 5.008, DEFAULT_OFF],
diff --git a/t/lib/warnings/pp_hot b/t/lib/warnings/pp_hot
index ad63d2a..23860a6 100644
--- a/t/lib/warnings/pp_hot
+++ b/t/lib/warnings/pp_hot
@@ -61,7 +61,7 @@ EXPECT
 print() on unopened filehandle abc at - line 4.
 ########
 # pp_hot.c [pp_print]
-use warnings 'unopened' ;
+no warnings 'safenames'; use warnings 'unopened';
 $SIG{__WARN__} = sub { warn $_[0] =~ s/\0/\\0/rug; };
 print {"a\0b"} "anc";
 print {"\0b"} "anc";
@@ -70,6 +70,12 @@ print() on unopened filehandle a\0b at - line 4.
 print() on unopened filehandle \0b at - line 5.
 ########
 # pp_hot.c [pp_print]
+use warnings;
+print {"a\0b"} "anc";
+EXPECT
+Invalid \0 character in symbolname: a\0b at - line 3.
+########
+# pp_hot.c [pp_print]
 use warnings 'io' ;
 # There is no guarantee that STDOUT is output only, or STDIN input only.
 # Certainly on some BSDs (at least FreeBSD, Darwin, BSDi) file descriptors
@@ -100,7 +106,7 @@ Filehandle FOO opened only for input at - line 20.
 ########
 # pp_hot.c [pp_print]
 $SIG{__WARN__} = sub { warn $_[0] =~ s/\0/\\0/rug; };
-use warnings 'io' ;
+use warnings 'io'; no warnings 'safenames';
 my $file = "./xcv" ; unlink $file ;
 open (FH, ">$file") or die $! ;
 close FH or die $! ;
diff --git a/t/op/caller.t b/t/op/caller.t
index efce8df..0d7a730 100644
--- a/t/op/caller.t
+++ b/t/op/caller.t
@@ -111,8 +111,8 @@ sub testwarn {
 
     # The repetition number must be set to the value of $BYTES in
     # lib/warnings.pm
-    BEGIN { check_bits( ${^WARNING_BITS}, "\0" x 14, 'all bits off via "no warnings"' ) }
-    testwarn("\0" x 14, 'no bits');
+    BEGIN { check_bits( ${^WARNING_BITS}, "\0" x 15, 'all bits off via "no warnings"' ) }
+    testwarn("\0" x 15, 'no bits');
 
     use warnings;
     BEGIN { check_bits( ${^WARNING_BITS}, $default,
diff --git a/t/op/gv.t b/t/op/gv.t
index 2358392..da43483 100644
--- a/t/op/gv.t
+++ b/t/op/gv.t
@@ -933,6 +933,7 @@ package HTTP::MobileAttribute::Plugin::Locator {
 # contains a null.
 package lrcg {
   use constant x => 3;
+  no warnings 'safenames';
   # These two lines abuse the optimisation that copies the scalar ref from
   # one stash element to another, to get a constant with a null in its name
   *{"yz\0a"} = \&{"x"};
diff --git a/t/op/method.t b/t/op/method.t
index 5ed8f76..b1715fb 100644
--- a/t/op/method.t
+++ b/t/op/method.t
@@ -384,6 +384,7 @@ is $kalled, 1, 'calling a class method via a magic variable';
     sub method { 1 }
 
     package main;
+    no warnings 'safenames';
     eval {
         NulTest->${ \"method\0Whoops" };
     };
diff --git a/t/op/reset.t b/t/op/reset.t
index 291bc39..188f1e2 100644
--- a/t/op/reset.t
+++ b/t/op/reset.t
@@ -96,13 +96,14 @@ is join("-", $scratch::a//'u', $scratch::a2//'u', $scratch::b//'u',
    "u-u-u-sea",
    'reset "range"';
 
-{ no strict; ${"scratch::\0foo"} = "bar" }
-$scratch::a = "foo";
-package scratch { reset "\0a" }
-is join("-", $scratch::a//'u', do { no strict; ${"scratch::\0foo"} }//'u'),
-   "u-u",
-   'reset "\0char"';
-
+{ no warnings 'safenames';
+  { no strict; ${"scratch::\0foo"} = "bar" }
+  $scratch::a = "foo";
+  package scratch { reset "\0a" }
+  is join("-", $scratch::a//'u', do { no strict; ${"scratch::\0foo"} }//'u'),
+  "u-u",
+  'reset "\0char"';
+}
 # This used to crash under threaded builds, because pmops were remembering
 # their stashes by name, rather than by pointer.
 fresh_perl_is( # it crashes more reliably with a smaller script
diff --git a/warnings.h b/warnings.h
index 1f3f8b0..a96f594 100644
--- a/warnings.h
+++ b/warnings.h
@@ -93,11 +93,12 @@
 #define WARN_EXPERIMENTAL__LEXICAL_SUBS 52
 #define WARN_EXPERIMENTAL__LEXICAL_TOPIC 53
 #define WARN_EXPERIMENTAL__REGEX_SETS 54
-#define WARN_SAFESYSCALLS	 55
+#define WARN_SAFENAMES		 55
+#define WARN_SAFESYSCALLS	 56
 
-#define WARNsize		14
-#define WARN_ALLstring		"\125\125\125\125\125\125\125\125\125\125\125\125\125\125"
-#define WARN_NONEstring		"\0\0\0\0\0\0\0\0\0\0\0\0\0\0"
+#define WARNsize		15
+#define WARN_ALLstring		"\125\125\125\125\125\125\125\125\125\125\125\125\125\125\125"
+#define WARN_NONEstring		"\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0"
 
 #define isLEXWARN_on 	(PL_curcop->cop_warnings != pWARN_STD)
 #define isLEXWARN_off	(PL_curcop->cop_warnings == pWARN_STD)

--------------1.7.10.4--


---
Flags:
    category=core
    severity=high
---
This perlbug was built using Perl 5.17.8 - Fri Feb  1 11:00:49 CST 2013
It is being executed now by  Perl 5.17.8 - Wed Jan  9 17:52:45 CST 2013.

Site configuration information for perl 5.17.8:

Configured by rurban at Wed Jan  9 17:52:45 CST 2013.

Summary of my perl5 (revision 5 version 17 subversion 8) configuration:
  Commit id: 1e9a14d0d069d64df71ad32c7174ede653a57801
  Platform:
    osname=linux, osvers=3.2.0-4-amd64, archname=x86_64-linux-thread-multi-debug
    uname='linux reini 3.2.0-4-amd64 #1 smp debian 3.2.32-1 x86_64 gnulinux '
    config_args='-de -Dusedevel -Uversiononly -Dinstallman1dir=none -Dinstallman3dir=none -Dinstallsiteman1dir=none -Dinstallsiteman3dir=none -DEBUGGING -Doptimize=-g3 -Duseithreads -Accflags='-msse4.2' -Accflags='-march=corei7' -Dcf_email='rurban@cpanel.net' -Dperladmin='rurban@cpanel.net' -Duseshrplib'
    hint=recommended, useposix=true, d_sigaction=define
    useithreads=define, usemultiplicity=define
    useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
    use64bitint=define, use64bitall=define, uselongdouble=undef
    usemymalloc=n, bincompat5005=undef
  Compiler:
    cc='cc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -msse4.2 -march=corei7 -DDEBUGGING -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
    optimize='-g3',
    cppflags='-D_REENTRANT -D_GNU_SOURCE -msse4.2 -march=corei7 -DDEBUGGING -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include'
    ccversion='', gccversion='4.7.2', gccosandvers=''
    intsize=4, longsize=8, ptrsize=8, doublesize=8, byteorder=12345678
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
    ivtype='long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
    alignbytes=8, prototype=define
  Linker and Libraries:
    ld='cc', ldflags =' -fstack-protector -L/usr/local/lib'
    libpth=/usr/local/lib /lib/x86_64-linux-gnu /lib/../lib /usr/lib/x86_64-linux-gnu /usr/lib/../lib /lib /usr/lib
    libs=-lnsl -lgdbm -ldb -ldl -lm -lcrypt -lutil -lpthread -lc -lgdbm_compat
    perllibs=-lnsl -ldl -lm -lcrypt -lutil -lpthread -lc
    libc=, so=so, useshrplib=true, libperl=libperl.so
    gnulibc_version='2.13'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E -Wl,-rpath,/usr/local/lib/perl5/5.17.8/x86_64-linux-thread-multi-debug/CORE'
    cccdlflags='-fPIC', lddlflags='-shared -g3 -L/usr/local/lib -fstack-protector'

Locally applied patches:
    

---
@INC for perl 5.17.8:
    /usr/local/lib/perl5/site_perl/5.17.8/x86_64-linux-thread-multi-debug
    /usr/local/lib/perl5/site_perl/5.17.8
    /usr/local/lib/perl5/5.17.8/x86_64-linux-thread-multi-debug
    /usr/local/lib/perl5/5.17.8
    /usr/local/lib/perl5/site_perl/5.17.7
    /usr/local/lib/perl5/site_perl/5.17.6
    /usr/local/lib/perl5/site_perl/5.17.5
    /usr/local/lib/perl5/site_perl/5.17.4
    /usr/local/lib/perl5/site_perl/5.17.3
    /usr/local/lib/perl5/site_perl/5.17.2
    /usr/local/lib/perl5/site_perl/5.17.1
    /usr/local/lib/perl5/site_perl/5.17.0
    /usr/local/lib/perl5/site_perl/5.17
    /usr/local/lib/perl5/site_perl/5.16.2
    /usr/local/lib/perl5/site_perl/5.16.1
    /usr/local/lib/perl5/site_perl/5.16.0
    /usr/local/lib/perl5/site_perl/5.15.9
    /usr/local/lib/perl5/site_perl/5.15.8
    /usr/local/lib/perl5/site_perl/5.15.7
    /usr/local/lib/perl5/site_perl/5.15.6
    /usr/local/lib/perl5/site_perl/5.15.5
    /usr/local/lib/perl5/site_perl/5.15.4
    /usr/local/lib/perl5/site_perl/5.14.3
    /usr/local/lib/perl5/site_perl/5.14.2
    /usr/local/lib/perl5/site_perl/5.14.1
    /usr/local/lib/perl5/site_perl/5.12.4
    /usr/local/lib/perl5/site_perl/5.10.1
    /usr/local/lib/perl5/site_perl/5.8.9
    /usr/local/lib/perl5/site_perl/5.8.8
    /usr/local/lib/perl5/site_perl/5.8.7
    /usr/local/lib/perl5/site_perl/5.8.6
    /usr/local/lib/perl5/site_perl/5.8.5
    /usr/local/lib/perl5/site_perl/5.8.4
    /usr/local/lib/perl5/site_perl/5.8.3
    /usr/local/lib/perl5/site_perl/5.8.2
    /usr/local/lib/perl5/site_perl/5.8.1
    /usr/local/lib/perl5/site_perl/5.6.2
    /usr/local/lib/perl5/site_perl
    .

---
Environment for perl 5.17.8:
    HOME=/home/rurban
    LANG=en_US.UTF-8
    LANGUAGE (unset)
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=/home/rurban/bin:/usr/local/bin:/usr/bin:/bin:/usr/local/games:/usr/games
    PERL_BADLANG (unset)
    SHELL=/bin/bash


Thread Previous | Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About