Change 11873 by jhi@alpha on 2001/09/04 21:03:17
Fix Cwd::getcwd() not being tainted, as noticed
by Schwern.
Affected files ...
... //depot/perl/MANIFEST#536 edit
... //depot/perl/ext/Cwd/Cwd.t#2 delete
... //depot/perl/ext/Cwd/Cwd.xs#19 edit
... //depot/perl/ext/Cwd/t/cwd.t#1 add
... //depot/perl/ext/Cwd/t/taint.t#1 add
... //depot/perl/util.c#292 edit
Differences ...
==== //depot/perl/MANIFEST#536 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST.~1~ Tue Sep 4 15:15:05 2001
+++ perl/MANIFEST Tue Sep 4 15:15:05 2001
@@ -103,9 +103,10 @@
ext/ByteLoader/byterun.h Header for byterun.c
ext/ByteLoader/hints/sunos.pl Hints for named architecture
ext/ByteLoader/Makefile.PL Bytecode loader makefile writer
-ext/Cwd/Cwd.t See if Cwd works
-ext/Cwd/Cwd.xs Cwd extension external subroutines
-ext/Cwd/Makefile.PL Cwd extension makefile maker
+ext/Cwd/Cwd.xs Cwd extension external subroutines
+ext/Cwd/t/cwd.t See if Cwd works
+ext/Cwd/t/taint.t See if Cwd works with taint
+ext/Cwd/Makefile.PL Cwd extension makefile maker
ext/Data/Dumper/Changes Data pretty printer, changelog
ext/Data/Dumper/Dumper.pm Data pretty printer, module
ext/Data/Dumper/Dumper.xs Data pretty printer, externals
==== //depot/perl/ext/Cwd/Cwd.xs#19 (text) ====
Index: perl/ext/Cwd/Cwd.xs
--- perl/ext/Cwd/Cwd.xs.~1~ Tue Sep 4 15:15:05 2001
+++ perl/ext/Cwd/Cwd.xs Tue Sep 4 15:15:05 2001
@@ -226,22 +226,20 @@
{
dXSTARG;
char *path;
- STRLEN len;
char buf[MAXPATHLEN];
- if (pathsv)
- path = SvPV(pathsv, len);
- else {
- path = ".";
- len = 1;
- }
+ path = pathsv ? SvPV_nolen(pathsv) : ".";
if (bsd_realpath(path, buf)) {
sv_setpvn(TARG, buf, strlen(buf));
SvPOK_only(TARG);
+ SvTAINTED_on(TARG);
}
else
- sv_setsv(TARG, &PL_sv_undef);
+ sv_setsv(TARG, &PL_sv_undef);
XSprePUSH; PUSHTARG;
+#ifndef INCOMPLETE_TAINTS
+ SvTAINTED_on(TARG);
+#endif
}
==== //depot/perl/util.c#292 (text) ====
Index: perl/util.c
--- perl/util.c.~1~ Tue Sep 4 15:15:05 2001
+++ perl/util.c Tue Sep 4 15:15:05 2001
@@ -3719,6 +3719,10 @@
{
#ifndef PERL_MICRO
+#ifndef INCOMPLETE_TAINTS
+ SvTAINTED_on(sv);
+#endif
+
#ifdef HAS_GETCWD
{
char buf[MAXPATHLEN];
==== //depot/perl/ext/Cwd/t/cwd.t#1 (text) ====
Index: perl/ext/Cwd/t/cwd.t
--- perl/ext/Cwd/t/cwd.t.~1~ Tue Sep 4 15:15:05 2001
+++ perl/ext/Cwd/t/cwd.t Tue Sep 4 15:15:05 2001
@@ -0,0 +1,134 @@
+#!./perl
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+}
+
+use Config;
+use Cwd;
+use strict;
+use warnings;
+
+print "1..14\n";
+
+# check imports
+print +(defined(&cwd) &&
+ defined(&getcwd) &&
+ defined(&fastcwd) &&
+ defined(&fastgetcwd) ?
+ "" : "not "), "ok 1\n";
+print +(!defined(&chdir) &&
+ !defined(&abs_path) &&
+ !defined(&fast_abs_path) ?
+ "" : "not "), "ok 2\n";
+
+# XXX force Cwd to bootsrap its XSUBs since we have set @INC = "../lib"
+# XXX and subsequent chdir()s can make them impossible to find
+eval { fastcwd };
+
+# Must find an external pwd (or equivalent) command.
+
+my $pwd_cmd =
+ ($^O eq "MSWin32" || $^O eq "NetWare") ? "cd" : (grep { -x && -f } map { "$_/pwd"
+}
+ split m/$Config{path_sep}/, $ENV{PATH})[0];
+
+if ($^O eq 'VMS') { $pwd_cmd = 'SHOW DEFAULT'; }
+
+if (defined $pwd_cmd) {
+ chomp(my $start = `$pwd_cmd`);
+ # Win32's cd returns native C:\ style
+ $start =~ s,\\,/,g if ($^O eq 'MSWin32' || $^O eq "NetWare");
+ # DCL SHOW DEFAULT has leading spaces
+ $start =~ s/^\s+// if $^O eq 'VMS';
+ if ($?) {
+ for (3..6) {
+ print "ok $_ # Skip: '$pwd_cmd' failed\n";
+ }
+ } else {
+ my $cwd = cwd;
+ my $getcwd = getcwd;
+ my $fastcwd = fastcwd;
+ my $fastgetcwd = fastgetcwd;
+ print +($cwd eq $start ? "" : "not "), "ok 3\n";
+ print +($getcwd eq $start ? "" : "not "), "ok 4\n";
+ print +($fastcwd eq $start ? "" : "not "), "ok 5\n";
+ print +($fastgetcwd eq $start ? "" : "not "), "ok 6\n";
+ }
+} else {
+ for (3..6) {
+ print "ok $_ # Skip: no pwd command found\n";
+ }
+}
+
+mkdir "pteerslt", 0777;
+mkdir "pteerslt/path", 0777;
+mkdir "pteerslt/path/to", 0777;
+mkdir "pteerslt/path/to/a", 0777;
+mkdir "pteerslt/path/to/a/dir", 0777;
+Cwd::chdir "pteerslt/path/to/a/dir";
+my $cwd = cwd;
+my $getcwd = getcwd;
+my $fastcwd = fastcwd;
+my $fastgetcwd = fastgetcwd;
+my $want = "t/pteerslt/path/to/a/dir";
+print "# cwd = '$cwd'\n";
+print "# getcwd = '$getcwd'\n";
+print "# fastcwd = '$fastcwd'\n";
+print "# fastgetcwd = '$fastgetcwd'\n";
+# This checked out OK on ODS-2 and ODS-5:
+$want = "T\.PTEERSLT\.PATH\.TO\.A\.DIR\]" if $^O eq 'VMS';
+print +($cwd =~ m|$want$| ? "" : "not "), "ok 7\n";
+print +($getcwd =~ m|$want$| ? "" : "not "), "ok 8\n";
+print +($fastcwd =~ m|$want$| ? "" : "not "), "ok 9\n";
+print +($fastgetcwd =~ m|$want$| ? "" : "not "), "ok 10\n";
+
+# Cwd::chdir should also update $ENV{PWD}
+print "#$ENV{PWD}\n";
+print +($ENV{PWD} =~ m|$want$| ? "" : "not "), "ok 11\n";
+Cwd::chdir ".."; rmdir "dir";
+print "#$ENV{PWD}\n";
+Cwd::chdir ".."; rmdir "a";
+print "#$ENV{PWD}\n";
+Cwd::chdir ".."; rmdir "to";
+print "#$ENV{PWD}\n";
+Cwd::chdir ".."; rmdir "path";
+print "#$ENV{PWD}\n";
+Cwd::chdir ".."; rmdir "pteerslt";
+print "#$ENV{PWD}\n";
+if ($^O eq 'VMS') {
+ # This checked out OK on ODS-2 and ODS-5:
+ print +($ENV{PWD} =~ m|\bT\]$| ? "" : "not "), "ok 12\n";
+}
+else {
+ print +($ENV{PWD} =~ m|\bt$| ? "" : "not "), "ok 12\n";
+}
+
+if ($Config{d_symlink}) {
+ mkdir "pteerslt", 0777;
+ mkdir "pteerslt/path", 0777;
+ mkdir "pteerslt/path/to", 0777;
+ mkdir "pteerslt/path/to/a", 0777;
+ mkdir "pteerslt/path/to/a/dir", 0777;
+ symlink "pteerslt/path/to/a/dir" => "linktest";
+
+ my $abs_path = Cwd::abs_path("linktest");
+ my $fast_abs_path = Cwd::fast_abs_path("linktest");
+ my $want = "t/pteerslt/path/to/a/dir";
+
+ print "# abs_path $abs_path\n";
+ print "# fast_abs_path $fast_abs_path\n";
+ print "# want $want\n";
+ print +($abs_path =~ m|$want$| ? "" : "not "), "ok 13\n";
+ print +($fast_abs_path =~ m|$want$| ? "" : "not "), "ok 14\n";
+
+ rmdir "pteerslt/path/to/a/dir";
+ rmdir "pteerslt/path/to/a";
+ rmdir "pteerslt/path/to";
+ rmdir "pteerslt/path";
+ rmdir "pteerslt";
+ unlink "linktest";
+} else {
+ print "ok 13 # skipped\n";
+ print "ok 14 # skipped\n";
+}
==== //depot/perl/ext/Cwd/t/taint.t#1 (text) ====
Index: perl/ext/Cwd/t/taint.t
--- perl/ext/Cwd/t/taint.t.~1~ Tue Sep 4 15:15:05 2001
+++ perl/ext/Cwd/t/taint.t Tue Sep 4 15:15:05 2001
@@ -0,0 +1,21 @@
+#!./perl -Tw
+# Testing Cwd under taint mode.
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+}
+
+use Cwd;
+use Test::More tests => 2;
+
+# The normal kill() trick is not portable.
+sub is_tainted {
+ return ! eval { eval("#" . substr(join("", @_), 0, 0)); 1 };
+}
+
+my $cwd;
+eval { $cwd = getcwd; };
+is( $@, '', 'getcwd() does not explode under taint mode' );
+ok( is_tainted($cwd), "it's return value is tainted" );
+
End of Patch.
