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
-
[PATCH] harmless_nul warning for open and stat
by Rev. Chip