Change 13684 by jhi@alpha on 2001/12/14 14:43:40
Subject: [PATCH taint.c intrpvar.h perl.c ...] -t taint warnings
From: Michael G Schwern <[EMAIL PROTECTED]>
Date: Thu, 13 Dec 2001 19:27:08 -0500
Message-ID: <20011214002707.GA10532@blackrider>
(reword the perlrun -t description a bit,
and move the Itaint_warn to the bottom of
the intrpvar.h for binary compatibility)
Affected files ...
.... //depot/perl/MANIFEST#663 edit
.... //depot/perl/embedvar.h#134 edit
.... //depot/perl/intrpvar.h#96 edit
.... //depot/perl/lib/Test/Harness.pm#55 edit
.... //depot/perl/perl.c#400 edit
.... //depot/perl/perlapi.h#56 edit
.... //depot/perl/pod/perlrun.pod#46 edit
.... //depot/perl/t/TEST#66 edit
.... //depot/perl/t/run/switcht.t#1 add
.... //depot/perl/taint.c#27 edit
Differences ...
==== //depot/perl/MANIFEST#663 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST.~1~ Fri Dec 14 08:00:05 2001
+++ perl/MANIFEST Fri Dec 14 08:00:05 2001
@@ -2313,6 +2313,7 @@
t/run/switchp.t Test the -p switch
t/run/switchPx.aux Data for switchPx.t
t/run/switchPx.t Test the -Px combination
+t/run/switcht.t Test the -t switch
t/run/switchx.aux Data for switchx.t
t/run/switchx.t Test the -x switch
t/TEST The regression tester
==== //depot/perl/embedvar.h#134 (text+w) ====
Index: perl/embedvar.h
--- perl/embedvar.h.~1~ Fri Dec 14 08:00:05 2001
+++ perl/embedvar.h Fri Dec 14 08:00:05 2001
@@ -399,6 +399,7 @@
#define PL_sv_yes (PERL_GET_INTERP->Isv_yes)
#define PL_svref_mutex (PERL_GET_INTERP->Isvref_mutex)
#define PL_sys_intern (PERL_GET_INTERP->Isys_intern)
+#define PL_taint_warn (PERL_GET_INTERP->Itaint_warn)
#define PL_tainting (PERL_GET_INTERP->Itainting)
#define PL_threadnum (PERL_GET_INTERP->Ithreadnum)
#define PL_threads_mutex (PERL_GET_INTERP->Ithreads_mutex)
@@ -693,6 +694,7 @@
#define PL_sv_yes (vTHX->Isv_yes)
#define PL_svref_mutex (vTHX->Isvref_mutex)
#define PL_sys_intern (vTHX->Isys_intern)
+#define PL_taint_warn (vTHX->Itaint_warn)
#define PL_tainting (vTHX->Itainting)
#define PL_threadnum (vTHX->Ithreadnum)
#define PL_threads_mutex (vTHX->Ithreads_mutex)
@@ -990,6 +992,7 @@
#define PL_Isv_yes PL_sv_yes
#define PL_Isvref_mutex PL_svref_mutex
#define PL_Isys_intern PL_sys_intern
+#define PL_Itaint_warn PL_taint_warn
#define PL_Itainting PL_tainting
#define PL_Ithreadnum PL_threadnum
#define PL_Ithreads_mutex PL_threads_mutex
==== //depot/perl/intrpvar.h#96 (text) ====
Index: perl/intrpvar.h
--- perl/intrpvar.h.~1~ Fri Dec 14 08:00:05 2001
+++ perl/intrpvar.h Fri Dec 14 08:00:05 2001
@@ -4,6 +4,10 @@
/* Don't forget to re-run embed.pl to propagate changes! */
+/* New variables must be added to the very end for binary compatibility.
+ * XSUB.h provides wrapper functions via perlapi.h that make this
+ * irrelevant, but not all code may be expected to #include XSUB.h. */
+
/* The 'I' prefix is only needed for vars that need appropriate #defines
* generated when built with or without MULTIPLICITY. It is also used
* to generate the appropriate export list for win32.
@@ -504,8 +508,9 @@
PERLVAR(Idebug_pad, struct perl_debug_pad) /* always needed because of the re
extension */
+PERLVAR(Itaint_warn, bool) /* taint warns instead of dying */
+
/* New variables must be added to the very end for binary compatibility.
* XSUB.h provides wrapper functions via perlapi.h that make this
* irrelevant, but not all code may be expected to #include XSUB.h. */
-
==== //depot/perl/lib/Test/Harness.pm#55 (text) ====
Index: perl/lib/Test/Harness.pm
--- perl/lib/Test/Harness.pm.~1~ Fri Dec 14 08:00:05 2001
+++ perl/lib/Test/Harness.pm Fri Dec 14 08:00:05 2001
@@ -834,8 +834,8 @@
my $s = $Switches;
$s .= " $ENV{'HARNESS_PERL_SWITCHES'}"
if exists $ENV{'HARNESS_PERL_SWITCHES'};
- $s .= join " ", q[ "-T"], map {qq["-I$_"]} @INC
- if $first =~ /^#!.*\bperl.*-\w*T/;
+ $s .= join " ", qq[ "-$1"], map {qq["-I$_"]} @INC
+ if $first =~ /^#!.*\bperl.*-\w*([tT])/;
close(TEST) or print "can't close $test. $!\n";
==== //depot/perl/perl.c#400 (text) ====
Index: perl/perl.c
--- perl/perl.c.~1~ Fri Dec 14 08:00:05 2001
+++ perl/perl.c Fri Dec 14 08:00:05 2001
@@ -1099,6 +1099,8 @@
goto reswitch;
break;
+ case 't':
+ PL_taint_warn = TRUE;
case 'T':
PL_tainting = TRUE;
s++;
@@ -2373,6 +2375,11 @@
PL_doswitches = TRUE;
s++;
return s;
+ case 't':
+ if (!PL_tainting)
+ Perl_croak(aTHX_ "Too late for \"-t\" option");
+ s++;
+ return s;
case 'T':
if (!PL_tainting)
Perl_croak(aTHX_ "Too late for \"-T\" option");
==== //depot/perl/perlapi.h#56 (text+w) ====
Index: perl/perlapi.h
--- perl/perlapi.h.~1~ Fri Dec 14 08:00:05 2001
+++ perl/perlapi.h Fri Dec 14 08:00:05 2001
@@ -535,6 +535,8 @@
#define PL_svref_mutex (*Perl_Isvref_mutex_ptr(aTHX))
#undef PL_sys_intern
#define PL_sys_intern (*Perl_Isys_intern_ptr(aTHX))
+#undef PL_taint_warn
+#define PL_taint_warn (*Perl_Itaint_warn_ptr(aTHX))
#undef PL_tainting
#define PL_tainting (*Perl_Itainting_ptr(aTHX))
#undef PL_threadnum
==== //depot/perl/pod/perlrun.pod#46 (text) ====
Index: perl/pod/perlrun.pod
--- perl/pod/perlrun.pod.~1~ Fri Dec 14 08:00:05 2001
+++ perl/pod/perlrun.pod Fri Dec 14 08:00:05 2001
@@ -4,7 +4,7 @@
=head1 SYNOPSIS
-B<perl> S<[ B<-CsTuUWX> ]>
+B<perl> S<[ B<-CsTtuUWX> ]>
S<[ B<-hv> ] [ B<-V>[:I<configvar>] ]>
S<[ B<-cw> ] [ B<-d>[:I<debugger>] ] [ B<-D>[I<number/list>] ]>
S<[ B<-pna> ] [ B<-F>I<pattern> ] [ B<-l>[I<octal>] ] [ B<-0>[I<octal>] ]>
@@ -697,6 +697,14 @@
before being searched for on the PATH. On Unix platforms, the
program will be searched for strictly on the PATH.
+=item B<-t>
+
+Like B<-T>, but taint checks will issue warnings rather than fatal
+errors. Since these are warnings, the B<-w> switch (or C<use warnings>)
+must be used along with this option. This is meant only to be used as
+a temporary aid while securing code: for real production code always
+use the real B<-T>.
+
=item B<-T>
forces "taint" checks to be turned on so you can test them. Ordinarily
==== //depot/perl/t/TEST#66 (xtext) ====
Index: perl/t/TEST
--- perl/t/TEST.~1~ Fri Dec 14 08:00:05 2001
+++ perl/t/TEST Fri Dec 14 08:00:05 2001
@@ -166,8 +166,8 @@
open(SCRIPT,"<$test") or die "Can't run $test.\n";
$_ = <SCRIPT>;
close(SCRIPT) unless ($type eq 'deparse');
- if (/#!.*\bperl.*-\w*T/) {
- $switch = '"-T"';
+ if (/#!.*\bperl.*-\w*([tT])/) {
+ $switch = qq{"-$1"};
}
else {
$switch = '';
==== //depot/perl/taint.c#27 (text) ====
Index: perl/taint.c
--- perl/taint.c.~1~ Fri Dec 14 08:00:05 2001
+++ perl/taint.c Fri Dec 14 08:00:05 2001
@@ -25,12 +25,17 @@
ug = " while running setuid";
else if (PL_egid != PL_gid)
ug = " while running setgid";
- else
+ else if (PL_taint_warn)
+ ug = " while running with -t switch";
+ else
ug = " while running with -T switch";
- if (!PL_unsafe)
- Perl_croak(aTHX_ f, s, ug);
- else if (ckWARN(WARN_TAINT))
- Perl_warner(aTHX_ WARN_TAINT, f, s, ug);
+ if (PL_unsafe || PL_taint_warn) {
+ if(ckWARN(WARN_TAINT))
+ Perl_warner(aTHX_ WARN_TAINT, f, s, ug);
+ }
+ else {
+ Perl_croak(aTHX_ f, s, ug);
+ }
}
}
==== //depot/perl/t/run/switcht.t#1 (text) ====
Index: perl/t/run/switcht.t
--- perl/t/run/switcht.t.~1~ Fri Dec 14 08:00:05 2001
+++ perl/t/run/switcht.t Fri Dec 14 08:00:05 2001
@@ -0,0 +1,43 @@
+#!./perl -tw
+
+BEGIN {
+ chdir 't';
+ @INC = '../lib';
+ require './test.pl';
+}
+
+plan tests => 10;
+
+my $Perl = which_perl();
+
+my $warning;
+local $SIG{__WARN__} = sub { $warning = join "\n", @_; };
+my $Tmsg = 'while running with -t switch';
+
+ok( ${^TAINT}, '${^TAINT} defined' );
+
+my $out = `$Perl -le "print q{Hello}"`;
+is( $out, "Hello\n", '`` worked' );
+like( $warning, qr/^Insecure .* $Tmsg/, ' taint warn' );
+
+{
+ no warnings 'taint';
+ $warning = '';
+ my $out = `$Perl -le "print q{Hello}"`;
+ is( $out, "Hello\n", '`` worked' );
+ is( $warning, '', ' no warnings "taint"' );
+}
+
+# Get ourselves a tainted variable.
+$file = $0;
+$file =~ s/.*/some.tmp/;
+ok( open(FILE, ">$file"), 'open >' ) or DIE $!;
+print FILE "Stuff\n";
+close FILE;
+like( $warning, qr/^Insecure dependency in open $Tmsg/, 'open > taint warn' );
+ok( -e $file, ' file written' );
+
+unlink($file);
+like( $warning, qr/^Insecure dependency in unlink $Tmsg/,
+ 'unlink() taint warn' );
+ok( !-e $file, 'unlink worked' );
End of Patch.
