develooper Front page | perl.perl5.porters | Postings from December 2001

[PATCH] -t without -w

Thread Next
From:
Michael G Schwern
Date:
December 29, 2001 20:46
Subject:
[PATCH] -t without -w
Message ID:
20011230044625.GA14386@blackrider
Paul came through with a patch that makes -t only turn on WARN_TAINT as
opposed to -w.  That's it below with a little tinkering.  Its as if
everything has a "use warnings qw(taint)" at the top.  The only possibly
controvertial semantics are:

	 -T wins over -t (-Tt == -T)
	 -X wins over -t (-Xt == -X)

I need to throw in some more tests WRT the combinations of -t, -T, -U, -w,
-W and -X on the #! line and on the command line and also check that -t
propogates properly to required libraries.


--- pod/perlrun.pod	2001/12/30 02:29:53	1.1
+++ pod/perlrun.pod	2001/12/30 02:30:33
@@ -700,8 +700,8 @@
 =item B<-t>
 
 Like B<-T>, but taint checks will issue warnings rather than fatal
-errors.  Also, all warnings are turned on as if you had used also
-a B<-w>.
+errors.  These warnings can be controlled normally with C<no warnings
+qw(taint)>.
 
 B<NOTE: this is not a substitute for -T.> This is meant only to be
 used as a temporary development aid while securing legacy code:
--- t/run/switcht.t	2001/12/30 02:27:46	1.1
+++ t/run/switcht.t	2001/12/30 02:29:30
@@ -1,4 +1,4 @@
-#!./perl -tw
+#!./perl -t
 
 BEGIN {
     chdir 't';
@@ -6,7 +6,7 @@
     require './test.pl';
 }
 
-plan tests => 10;
+plan tests => 11;
 
 my $Perl = which_perl();
 
@@ -41,3 +41,5 @@
 like( $warning, qr/^Insecure dependency in unlink $Tmsg/,
                                                   'unlink() taint warn' );
 ok( !-e $file,  'unlink worked' );
+
+ok( !$^W,   "-t doesn't enable regular warnings" );
--- perl.c	2001/12/30 01:55:14	1.1
+++ perl.c	2001/12/30 04:38:40
@@ -1100,11 +1100,15 @@
 	    break;
 
 	case 't':
-	    PL_taint_warn = TRUE;
-	    if (! (PL_dowarn & G_WARN_ALL_MASK))
-	        PL_dowarn |= G_WARN_ON;
+	    if( !PL_tainting ) {
+	         PL_taint_warn = TRUE;
+	         PL_tainting = TRUE;
+	    }
+	    s++;
+	    goto reswitch;
 	case 'T':
 	    PL_tainting = TRUE;
+	    PL_taint_warn = FALSE;
 	    s++;
 	    goto reswitch;
 
@@ -1283,8 +1287,10 @@
     	char *popt = s;
 	while (isSPACE(*s))
 	    s++;
-	if (*s == '-' && *(s+1) == 'T')
+	if (*s == '-' && *(s+1) == 'T') {
 	    PL_tainting = TRUE;
+            PL_taint_warn = FALSE;
+	}
 	else {
 	    char *popt_copy = Nullch;
 	    while (s && *s) {
@@ -1313,8 +1319,10 @@
 		    }
 		}
 		if (*d == 't') {
-		    PL_tainting = TRUE;
-		    PL_taint_warn = TRUE;
+		    if( !PL_tainting ) {
+		        PL_taint_warn = TRUE;
+		        PL_tainting = TRUE;
+		    }
 		} else {
 		    moreswitches(d);
 		}
@@ -1322,6 +1330,10 @@
 	}
     }
 
+    if (PL_taint_warn && PL_dowarn != G_WARN_ALL_OFF) {
+       PL_compiling.cop_warnings = newSVpvn(WARN_TAINTstring, WARNsize);
+    }
+
     if (!scriptname)
 	scriptname = argv[0];
     if (PL_e_script) {
@@ -2509,11 +2521,15 @@
 	return s;
     case 'W':
 	PL_dowarn = G_WARN_ALL_ON|G_WARN_ON;
+        if (!specialWARN(PL_compiling.cop_warnings))
+            SvREFCNT_dec(PL_compiling.cop_warnings);
 	PL_compiling.cop_warnings = pWARN_ALL ;
 	s++;
 	return s;
     case 'X':
 	PL_dowarn = G_WARN_ALL_OFF;
+        if (!specialWARN(PL_compiling.cop_warnings))
+            SvREFCNT_dec(PL_compiling.cop_warnings);
 	PL_compiling.cop_warnings = pWARN_NONE ;
 	s++;
 	return s;
--- pp_ctl.c	2001/12/30 01:58:10	1.1
+++ pp_ctl.c	2001/12/30 01:58:46
@@ -3166,6 +3166,8 @@
         PL_compiling.cop_warnings = pWARN_ALL ;
     else if (PL_dowarn & G_WARN_ALL_OFF)
         PL_compiling.cop_warnings = pWARN_NONE ;
+    else if (PL_taint_warn)
+        PL_compiling.cop_warnings = newSVpvn(WARN_TAINTstring, WARNsize);
     else
         PL_compiling.cop_warnings = pWARN_STD ;
     SAVESPTR(PL_compiling.cop_io);
--- warnings.pl	2001/12/30 01:59:13	1.1
+++ warnings.pl	2001/12/30 02:04:11
@@ -143,9 +143,9 @@
 
 ###########################################################################
 
-sub mkHex
+sub mkHexOct
 {
-    my ($max, @a) = @_ ;
+    my ($f, $max, @a) = @_ ;
     my $mask = "\x00" x $max ;
     my $string = "" ;
 
@@ -153,14 +153,29 @@
 	vec($mask, $_, 1) = 1 ;
     }
 
-    #$string = unpack("H$max", $mask) ;
-    #$string =~ s/(..)/\x$1/g;
     foreach (unpack("C*", $mask)) {
-	$string .= '\x' . sprintf("%2.2x", $_) ;
+        if ($f eq 'x') {
+            $string .= '\x' . sprintf("%2.2x", $_)
+        }
+        else {
+            $string .= '\\' . sprintf("%o", $_)
+        }
     }
     return $string ;
 }
 
+sub mkHex
+{
+    my($max, @a) = @_;
+    return mkHexOct("x", $max, @a);
+}
+
+sub mkOct
+{
+    my($max, @a) = @_;
+    return mkHexOct("o", $max, @a);
+}
+
 ###########################################################################
 
 if (@ARGV && $ARGV[0] eq "tree")
@@ -222,6 +237,9 @@
 #print WARN tab(5, '#define WARN_ALLstring'), '"', ('\377' x $warn_size) , "\"\n" ;
 print WARN tab(5, '#define WARN_ALLstring'), '"', ('\125' x $warn_size) , "\"\n" ;
 print WARN tab(5, '#define WARN_NONEstring'), '"', ('\0' x $warn_size) , "\"\n" ;
+my $WARN_TAINTstring = mkOct($warn_size, map $_ * 2, @{ $list{'taint'} });
+
+print WARN tab(5, '#define WARN_TAINTstring'), qq["$WARN_TAINTstring"\n] ;
 
 print WARN <<'EOM';
 



-- 

Michael G. Schwern   <schwern@pobox.com>    http://www.pobox.com/~schwern/
Perl Quality Assurance	    <perl-qa@perl.org>	       Kwalitee Is Job One
Classical music should probably not involve air horns.

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