Change 30048 by [EMAIL PROTECTED] on 2007/01/28 00:08:17
Integrate:
[ 27951]
Subject: [perl #38709] Opening '|-' triggers unjustified taint check
From: [EMAIL PROTECTED] (via RT) <[EMAIL PROTECTED]>
Date: Fri, 10 Mar 2006 20:10:49 -0800
Message-ID: <[EMAIL PROTECTED]>
[ 28488]
Fix a bug on setting OPpASSIGN_COMMON on a AASSIGN op when the left
side is made out a list declared with our(). In this case OPpLVAL_INTRO
isn't set on the left op, so we just remove that check. Add new tests.
[ 28879]
Subject: RE: Combining UTF-16 output with :crlf is awkward
From: "Jan Dubois" <[EMAIL PROTECTED]>
Date: Thu, 6 Apr 2006 18:37:21 -0700
Message-ID: <[EMAIL PROTECTED]>
[ 29297]
Change #27951 added tests to t/op/taint.t involving taint, opening
"|-". Unfortunately, this usually reacts badly on OpenBSD with
threaded Perls, causing zombie processes nearly every time this is run.
For now, skipping the test seem reasonable while working on a solution
to the problem.
[ 29302]
Change 29297 omitted a semicolon.
Affected files ...
... //depot/maint-5.8/perl/doio.c#101 integrate
... //depot/maint-5.8/perl/op.c#188 integrate
... //depot/maint-5.8/perl/perlio.c#99 integrate
... //depot/maint-5.8/perl/t/op/array.t#9 integrate
... //depot/maint-5.8/perl/t/op/taint.t#18 integrate
Differences ...
==== //depot/maint-5.8/perl/doio.c#101 (text) ====
Index: perl/doio.c
--- perl/doio.c#100~30040~ 2007-01-27 10:56:32.000000000 -0800
+++ perl/doio.c 2007-01-27 16:08:17.000000000 -0800
@@ -247,7 +247,7 @@
errno = EPIPE;
goto say_false;
}
- if ((*name == '-' && name[1] == '\0') || num_svs)
+ if (!(*name == '-' && name[1] == '\0') || num_svs)
TAINT_ENV();
TAINT_PROPER("piped open");
if (!num_svs && name[len-1] == '|') {
==== //depot/maint-5.8/perl/op.c#188 (text) ====
Index: perl/op.c
--- perl/op.c#187~30033~ 2007-01-27 08:40:35.000000000 -0800
+++ perl/op.c 2007-01-27 16:08:17.000000000 -0800
@@ -3411,7 +3411,6 @@
* to store these values, evil chicanery is done with SvCUR().
*/
- if (!(left->op_private & OPpLVAL_INTRO)) {
OP *lastop = o;
PL_generation++;
for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) {
@@ -3465,7 +3464,6 @@
}
if (curop != o)
o->op_private |= OPpASSIGN_COMMON;
- }
if (right && right->op_type == OP_SPLIT) {
OP* tmpop = ((LISTOP*)right)->op_first;
if (tmpop && (tmpop->op_type == OP_PUSHRE)) {
==== //depot/maint-5.8/perl/perlio.c#99 (text) ====
Index: perl/perlio.c
--- perl/perlio.c#98~30045~ 2007-01-27 15:04:25.000000000 -0800
+++ perl/perlio.c 2007-01-27 16:08:17.000000000 -0800
@@ -4134,6 +4134,21 @@
* buffer */
} PerlIOCrlf;
+/* Inherit the PERLIO_F_UTF8 flag from previous layer.
+ * Otherwise the :crlf layer would always revert back to
+ * raw mode.
+ */
+static void
+S_inherit_utf8_flag(PerlIO *f)
+{
+ PerlIO *g = PerlIONext(f);
+ if (PerlIOValid(g)) {
+ if (PerlIOBase(g)->flags & PERLIO_F_UTF8) {
+ PerlIOBase(f)->flags |= PERLIO_F_UTF8;
+ }
+ }
+}
+
IV
PerlIOCrlf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs
*tab)
{
@@ -4151,17 +4166,19 @@
* any given moment at most one CRLF-capable layer being enabled
* in the whole layer stack. */
PerlIO *g = PerlIONext(f);
- while (g && *g) {
+ while (PerlIOValid(g)) {
PerlIOl *b = PerlIOBase(g);
if (b && b->tab == &PerlIO_crlf) {
if (!(b->flags & PERLIO_F_CRLF))
b->flags |= PERLIO_F_CRLF;
+ S_inherit_utf8_flag(g);
PerlIO_pop(aTHX_ f);
return code;
}
g = PerlIONext(g);
}
}
+ S_inherit_utf8_flag(f);
return code;
}
==== //depot/maint-5.8/perl/t/op/array.t#9 (xtext) ====
Index: perl/t/op/array.t
--- perl/t/op/array.t#8~29132~ 2006-10-29 11:16:37.000000000 -0800
+++ perl/t/op/array.t 2007-01-27 16:08:17.000000000 -0800
@@ -7,7 +7,7 @@
require 'test.pl';
-plan (97);
+plan (105);
#
# @foo, @bar, and @ary are also used from tie-stdarray after tie-ing them
@@ -176,7 +176,6 @@
# try the same with my
{
-
my @bee = @bee;
is("@bee", "foo bar burbl blah"); # 54
{
@@ -202,6 +201,29 @@
is("@bee", "foo bar burbl blah"); # 63
}
+# try the same with our (except that previous values aren't restored)
+{
+ our @bee = @bee;
+ is("@bee", "foo bar burbl blah");
+ {
+ our (undef,@bee) = @bee;
+ is("@bee", "bar burbl blah");
+ {
+ our @bee = ('XXX',@bee,'YYY');
+ is("@bee", "XXX bar burbl blah YYY");
+ {
+ our @bee = our @bee = qw(foo bar burbl blah);
+ is("@bee", "foo bar burbl blah");
+ {
+ our (@bim) = our(@bee) = qw(foo bar);
+ is("@bee", "foo bar");
+ is("@bim", "foo bar");
+ }
+ }
+ }
+ }
+}
+
# make sure reification behaves
my $t = curr_test();
sub reify { $_[1] = $t++; print "@_\n"; }
@@ -323,4 +345,18 @@
is ($4[8], 23);
}
+# more tests for AASSIGN_COMMON
+
+{
+ our($x,$y,$z) = (1..3);
+ our($y,$z) = ($x,$y);
+ is("$x $y $z", "1 1 2");
+}
+{
+ our($x,$y,$z) = (1..3);
+ (our $y, our $z) = ($x,$y);
+ is("$x $y $z", "1 1 2");
+}
+
+
"We're included by lib/Tie/Array/std.t so we need to return something true";
==== //depot/maint-5.8/perl/t/op/taint.t#18 (xtext) ====
Index: perl/t/op/taint.t
--- perl/t/op/taint.t#17~30026~ 2007-01-27 03:02:43.000000000 -0800
+++ perl/t/op/taint.t 2007-01-27 16:08:17.000000000 -0800
@@ -17,7 +17,7 @@
use File::Spec::Functions;
BEGIN { require './test.pl'; }
-plan tests => 246;
+plan tests => 249;
$| = 1;
@@ -44,6 +44,7 @@
my $Is_NetWare = $^O eq 'NetWare';
my $Is_Dos = $^O eq 'dos';
my $Is_Cygwin = $^O eq 'cygwin';
+my $Is_OpenBSD = $^O eq 'openbsd';
my $Invoke_Perl = $Is_VMS ? 'MCR Sys$Disk:[]Perl.' :
$Is_MSWin32 ? '.\perl' :
$Is_MacOS ? ':perl' :
@@ -1153,3 +1154,33 @@
$o->untainted;
}
+
+# opening '|-' should not trigger $ENV{PATH} check
+
+{
+ SKIP: {
+ skip "fork() is not available", 3 unless $Config{'d_fork'};
+ skip "opening |- is not stable on threaded OpenBSD with taint", 3
+ if $Config{useithreads} && $Is_OpenBSD;
+
+ $ENV{'PATH'} = $TAINT;
+ local $SIG{'PIPE'} = 'IGNORE';
+ eval {
+ my $pid = open my $pipe, '|-';
+ if (!defined $pid) {
+ die "open failed: $!";
+ }
+ if (!$pid) {
+ kill 'KILL', $$; # child suicide
+ }
+ close $pipe;
+ };
+ test $@ !~ /Insecure \$ENV/, 'fork triggers %ENV check';
+ test $@ eq '', 'pipe/fork/open/close failed';
+ eval {
+ open my $pipe, "|$Invoke_Perl -e 1";
+ close $pipe;
+ };
+ test $@ =~ /Insecure \$ENV/, 'popen neglects %ENV check';
+ }
+}
End of Patch.
