From: Craig A. Berry <craigberry@mac.com>
Date: Fri, 2 Jun 2006 23:18:08 +0000 (+0000)
Subject: It's all relative -- better handling of tainted directories
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=326b5008ebd8d91bf6b00d96127d2d711c9f2132;p=p5sagit%2Fp5-mst-13.2.git

It's all relative -- better handling of tainted directories
in PATH on VMS (and scrubbing them in t/test.pl).

p4raw-id: //depot/perl@28348
---

diff --git a/mg.c b/mg.c
index 041a09e..4957a71 100644
--- a/mg.c
+++ b/mg.c
@@ -1103,10 +1103,20 @@ Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg)
 		Stat_t st;
 		I32 i;
 		s = delimcpy(tmpbuf, tmpbuf + sizeof tmpbuf,
-			     s, strend, ':', &i);
+			     s, strend, 
+#ifdef VMS
+                                       '|',  /* Hmm.  How do we get $Config{path_sep} from C? */
+#else
+                                       ':', 
+#endif
+                                            &i);
 		s++;
 		if (i >= (I32)sizeof tmpbuf   /* too long -- assume the worst */
-		      || *tmpbuf != '/'
+#ifdef VMS
+		      || !strchr(tmpbuf, ':') /* no colon thus no device name -- assume relative path */
+#else
+		      || *tmpbuf != '/'       /* no starting slash -- assume relative path */
+#endif
 		      || (PerlLIO_stat(tmpbuf, &st) == 0 && (st.st_mode & 2)) ) {
 		    MgTAINTEDDIR_on(mg);
 		    return 0;
diff --git a/t/test.pl b/t/test.pl
index 495a93d..7b15685 100644
--- a/t/test.pl
+++ b/t/test.pl
@@ -523,10 +523,11 @@ sub runperl {
 	my @keys = grep {exists $ENV{$_}} qw(CDPATH IFS ENV BASH_ENV);
 	local @ENV{@keys} = ();
 	# Untaint, plus take out . and empty string:
+	local $ENV{'DCL$PATH'} = $1 if $is_vms && ($ENV{'DCL$PATH'} =~ /(.*)/s);
 	$ENV{PATH} =~ /(.*)/s;
 	local $ENV{PATH} =
 	    join $sep, grep { $_ ne "" and $_ ne "." and
-		($is_mswin or !(stat && (stat _)[2]&0022)) }
+		($is_mswin or $is_vms or !(stat && (stat _)[2]&0022)) }
 		    split quotemeta ($sep), $1;
 
 	$runperl =~ /(.*)/s;