develooper Front page | perl.perl5.porters | Postings from October 2012

[PATCH] harmless_nul warning for open and stat

Thread Next
From:
Rev. Chip
Date:
October 3, 2012 23:43
Subject:
[PATCH] harmless_nul warning for open and stat
Message ID:
20121004064341.GA742@tytlal.tinsaucer.com
commit 2ca5de162a1319646af9d3326af52a44031b6d96
Author: Chip Salzenberg <chip@pobox.com>
Date:   Wed Oct 3 23:32:12 2012 -0700

    harmless_nul warning for open and stat

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index f12264c..790e4d8 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -2633,6 +2633,15 @@ insufficient.  You may wish to switch to using L<Math::BigInt> explicitly.
 by that?  lstat() makes sense only on filenames.  (Perl did a fstat()
 instead on the filehandle.)
 
+=item Harmless NUL found in pathname; no action required
+
+(W io) Reini Urban and Aristotle Pagaltzis are deeply concerned about NULs
+in pathnames.  The NULs are harmless and simply terminate the pathname early
+as they have always done since Perl was invented (that was in 1987).  But
+we're all one big happy family, and we hate to see people deeply concerned.
+So, to make Reini and Aristotle feel better, Perl issues this warning.  The
+only action recommended is to disable this warning.
+
 =item lvalue attribute %s already-defined subroutine
 
 (W misc) Although L<attributes.pm|attributes> allows this, turning the lvalue
diff --git a/pod/perllexwarn.pod b/pod/perllexwarn.pod
index c6494db..bde4dc9 100644
--- a/pod/perllexwarn.pod
+++ b/pod/perllexwarn.pod
@@ -241,6 +241,8 @@ The current hierarchy is:
          |                 +- pipe
          |                 |
          |                 +- unopened
+         |                 |
+         |                 +- harmless_nul
          |
          +- misc
          |
diff --git a/doio.c b/doio.c
index 94f2003..5c6dce5 100644
--- a/doio.c
+++ b/doio.c
@@ -83,6 +83,8 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
 
     PERL_ARGS_ASSERT_DO_OPENN;
 
+    warn_about_harmless_nul(oname, len);
+
     Zero(mode,sizeof(mode),char);
     PL_forkprocess = 1;		/* assume true if no fork */
 
diff --git a/lib/warnings.pm b/lib/warnings.pm
index 2c47a71..e9f71d1 100644
--- a/lib/warnings.pm
+++ b/lib/warnings.pm
@@ -230,10 +230,11 @@ our %Offsets = (
 
     'experimental'	=> 102,
     'experimental::lexical_subs'=> 104,
+    'harmless_nul'	=> 106,
   );
 
 our %Bits = (
-    'all'		=> "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x01", # [0..52]
+    'all'		=> "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x05", # [0..53]
     '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]
@@ -246,11 +247,12 @@ our %Bits = (
     'experimental'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x01", # [51,52]
     'experimental::lexical_subs'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [52]
     'glob'		=> "\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
+    'harmless_nul'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04", # [53]
     '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]
+    'io'		=> "\x00\x54\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04", # [5..11,53]
     '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]
@@ -289,7 +291,7 @@ our %Bits = (
   );
 
 our %DeadBits = (
-    'all'		=> "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\x02", # [0..52]
+    'all'		=> "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\x0a", # [0..53]
     '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]
@@ -302,11 +304,12 @@ our %DeadBits = (
     'experimental'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x02", # [51,52]
     'experimental::lexical_subs'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [52]
     'glob'		=> "\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
+    'harmless_nul'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08", # [53]
     '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]
+    'io'		=> "\x00\xa8\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08", # [5..11,53]
     '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]
@@ -346,7 +349,7 @@ our %DeadBits = (
 
 $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\x01", # [2,52,4,22,23,25]
-$LAST_BIT = 106 ;
+$LAST_BIT = 108 ;
 $BYTES    = 14 ;
 
 $All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ;
diff --git a/perl.h b/perl.h
index bf96a8e..09a0638 100644
--- a/perl.h
+++ b/perl.h
@@ -5722,8 +5722,14 @@ extern void moncontrol(int);
 #pragma message disable (mainparm) /* Perl uses the envp in main(). */
 #endif
 
+#define warn_about_harmless_nul(p, n) \
+    (!memchr(p, '\0', n) ? (void)0 : \
+     Perl_ck_warner(aTHX_ packWARN(WARN_HARMLESS_NUL), \
+                    "Harmless NUL found in pathname; no action required"))
+
 #define do_open(g, n, l, a, rm, rp, sf) \
 	do_openn(g, n, l, a, rm, rp, sf, (SV **) NULL, 0)
+
 #ifdef PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION
 #  define do_exec(cmd)			do_exec3(cmd,0,0)
 #endif
diff --git a/pp_sys.c b/pp_sys.c
index 8fb75f5..4b9a10e 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -2811,6 +2811,9 @@ PP(pp_stat)
 	}
     }
     else {
+	const char *name;
+	STRLEN namelen;
+
 	if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVIO) { 
             io = MUTABLE_IO(SvRV(sv));
             if (PL_op->op_type == OP_LSTAT)
@@ -2822,12 +2825,14 @@ PP(pp_stat)
 	sv_setpv(PL_statname, SvPV_nomg_const_nolen(sv));
 	PL_statgv = NULL;
 	PL_laststype = PL_op->op_type;
+	name = SvPV_const(PL_statname, namelen);
+        warn_about_harmless_nul(name, namelen);
 	if (PL_op->op_type == OP_LSTAT)
-	    PL_laststatval = PerlLIO_lstat(SvPV_nolen_const(PL_statname), &PL_statcache);
+	    PL_laststatval = PerlLIO_lstat(name, &PL_statcache);
 	else
-	    PL_laststatval = PerlLIO_stat(SvPV_nolen_const(PL_statname), &PL_statcache);
+	    PL_laststatval = PerlLIO_stat(name, &PL_statcache);
 	if (PL_laststatval < 0) {
-	    if (ckWARN(WARN_NEWLINE) && strchr(SvPV_nolen_const(PL_statname), '\n'))
+	    if (ckWARN(WARN_NEWLINE) && memchr(name, '\n', namelen))
 		Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "stat");
 	    max = 0;
 	}
diff --git a/regen/warnings.pl b/regen/warnings.pl
index e99ff4b..1c4c840 100644
--- a/regen/warnings.pl
+++ b/regen/warnings.pl
@@ -37,6 +37,7 @@ my $tree = {
        				'newline'	=> [ 5.008, DEFAULT_OFF],
        				'exec'		=> [ 5.008, DEFAULT_OFF],
        				'layer'		=> [ 5.008, DEFAULT_OFF],
+       				'harmless_nul'	=> [ 5.017, DEFAULT_OFF],
 			   }],
      	'syntax'	=> [ 5.008, { 	
 				'ambiguous'	=> [ 5.008, DEFAULT_OFF],
diff --git a/warnings.h b/warnings.h
index 974f451..c5ddc38 100644
--- a/warnings.h
+++ b/warnings.h
@@ -91,6 +91,7 @@
 
 #define WARN_EXPERIMENTAL	 51
 #define WARN_EXPERIMENTAL__LEXICAL_SUBS 52
+#define WARN_HARMLESS_NUL	 53
 
 #define WARNsize		14
 #define WARN_ALLstring		"\125\125\125\125\125\125\125\125\125\125\125\125\125\125"

-- 
Chip Salzenberg

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