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 (file)
--- 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 (file)
--- 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;