It's all relative -- better handling of tainted directories

[p5sagit/p5-mst-13.2.git] / mg.c

diff --git a/mg.c b/mg.c
index 217eb59..4957a71 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -758,10 +758,13 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
            SvTAINTED_off(sv);
        }
        else if (strEQ(remaining, "PEN")) {
-           if (!PL_compiling.cop_io)
+           if (!(CopHINTS_get(&PL_compiling) & HINT_LEXICAL_IO))
                sv_setsv(sv, &PL_sv_undef);
             else {
-               sv_setsv(sv, PL_compiling.cop_io);
+               sv_setsv(sv,
+                        Perl_refcounted_he_fetch(aTHX_
+                                                 PL_compiling.cop_hints_hash,
+                                                 0, "open", 4, 0, 0));
            }
        }
        break;
@@ -1100,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;
@@ -1659,7 +1672,7 @@ Perl_magic_nextpack(pTHX_ SV *sv, MAGIC *mg, SV *key)
 }
 
 int
-Perl_magic_existspack(pTHX_ SV *sv, MAGIC *mg)
+Perl_magic_existspack(pTHX_ SV *sv, const MAGIC *mg)
 {
     return magic_methpack(sv,mg,"EXISTS");
 }
@@ -2230,10 +2243,11 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
            }
        }
        else if (strEQ(mg->mg_ptr, "\017PEN")) {
-           if (!PL_compiling.cop_io)
-               PL_compiling.cop_io = newSVsv(sv);
-           else
-               sv_setsv(PL_compiling.cop_io,sv);
+           PL_compiling.cop_hints |= HINT_LEXICAL_IO;
+           PL_hints |= HINT_LOCALIZE_HH | HINT_LEXICAL_IO;
+           PL_compiling.cop_hints_hash
+               = Perl_refcounted_he_new(aTHX_ PL_compiling.cop_hints_hash,
+                                        sv_2mortal(newSVpvs("open")), sv);
        }
        break;
     case '\020':       /* ^P */