This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perluniprops: \p{Greek} is a shortcut for scx:greek
[perl5.git] / doio.c
diff --git a/doio.c b/doio.c
index 5024a32..9f76c10 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -261,7 +261,7 @@ Perl_do_open6(pTHX_ GV *gv, const char *oname, STRLEN len,
             STRLEN nlen = 0;
            /* New style explicit name, type is just mode and layer info */
 #ifdef USE_STDIO
-           if (SvROK(*svp) && !strchr(oname,'&')) {
+           if (SvROK(*svp) && !memchr(oname, '&', len)) {
                if (ckWARN(WARN_IO))
                    Perl_warner(aTHX_ packWARN(WARN_IO),
                            "Can't open a reference");
@@ -621,6 +621,8 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname,
 
     PERL_ARGS_ASSERT_OPENN_CLEANUP;
 
+    Zero(&statbuf, 1, Stat_t);
+
     if (!fp) {
        if (IoTYPE(io) == IoTYPE_RDONLY && ckWARN(WARN_NEWLINE)
            && should_warn_nl(oname)
@@ -850,7 +852,11 @@ S_openindirtemp(pTHX_ GV *gv, SV *orig_name, SV *temp_out_name) {
     else
         sv_setpvs(temp_out_name, "XXXXXXXX");
 
-    fd = Perl_my_mkstemp(SvPVX(temp_out_name));
+    {
+      int old_umask = umask(0177);
+      fd = Perl_my_mkstemp(SvPVX(temp_out_name));
+      umask(old_umask);
+    }
 
     if (fd < 0)
         return FALSE;
@@ -862,42 +868,126 @@ S_openindirtemp(pTHX_ GV *gv, SV *orig_name, SV *temp_out_name) {
     return do_openn(gv, "+>&", 3, 0, 0, 0, fp, NULL, 0);
 }
 
+#if defined(HAS_UNLINKAT) && defined(HAS_RENAMEAT) && defined(HAS_FCHMODAT) && \
+    (defined(HAS_DIRFD) || defined(HAS_DIR_DD_FD)) && !defined(NO_USE_ATFUNCTIONS) && \
+    defined(HAS_LINKAT)
+#  define ARGV_USE_ATFUNCTIONS
+#endif
+
+/* Win32 doesn't necessarily return useful information
+ * in st_dev, st_ino.
+ */
+#ifndef DOSISH
+#  define ARGV_USE_STAT_INO
+#endif
+
 #define ARGVMG_BACKUP_NAME 0
 #define ARGVMG_TEMP_NAME 1
 #define ARGVMG_ORIG_NAME 2
 #define ARGVMG_ORIG_MODE 3
+#define ARGVMG_ORIG_PID 4
+
+/* we store the entire stat_t since the ino_t and dev_t values might
+   not fit in an IV.  I could have created a new structure and
+   transferred them across, but this seemed too much effort for very
+   little win.
+
+   We store it even when the *at() functions are available, since
+   while the C runtime might have definitions for these functions, the
+   operating system or a specific filesystem might not implement them.
+   eg. NetBSD 6 implements linkat() but only where the fds are AT_FDCWD.
+ */
+#ifdef ARGV_USE_STAT_INO
+#  define ARGVMG_ORIG_CWD_STAT 5
+#endif
+
+#ifdef ARGV_USE_ATFUNCTIONS
+#  define ARGVMG_ORIG_DIRP 6
+#endif
+
+#ifdef ENOTSUP
+#define NotSupported(e) ((e) == ENOSYS || (e) == ENOTSUP)
+#else
+#define NotSupported(e) ((e) == ENOSYS)
+#endif
 
 static int
 S_argvout_free(pTHX_ SV *io, MAGIC *mg) {
-    SV **temp_psv;
-
     PERL_UNUSED_ARG(io);
 
     /* note this can be entered once the file has been
        successfully deleted too */
-    assert(mg->mg_obj && SvTYPE(mg->mg_obj) == SVt_PVAV);
     assert(IoTYPE(io) != IoTYPE_PIPE);
 
-    if (IoIFP(io)) {
-        /* if we get here the file hasn't been closed explicitly by the
-           user and hadn't been closed implicitly by nextargv(), so
-           abandon the edit */
+    /* mg_obj can be NULL if a thread is created with the handle open, in which
+     case we leave any clean up to the parent thread */
+    if (mg->mg_obj && IoIFP(io)) {
+        SV **pid_psv;
+#ifdef ARGV_USE_ATFUNCTIONS
+        SV **dir_psv;
+        DIR *dir;
+#endif
         PerlIO *iop = IoIFP(io);
-        (void)PerlIO_close(iop);
-        IoIFP(io) = IoOFP(io) = NULL;
-        temp_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_TEMP_NAME, FALSE);
-        assert(temp_psv && *temp_psv && SvPOK(*temp_psv));
-        (void)UNLINK(SvPVX(*temp_psv));
+
+        assert(SvTYPE(mg->mg_obj) == SVt_PVAV);
+
+        pid_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_ORIG_PID, FALSE);
+
+        assert(pid_psv && *pid_psv);
+
+        if (SvIV(*pid_psv) == (IV)PerlProc_getpid()) {
+            /* if we get here the file hasn't been closed explicitly by the
+               user and hadn't been closed implicitly by nextargv(), so
+               abandon the edit */
+            SV **temp_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_TEMP_NAME, FALSE);
+            const char *temp_pv = SvPVX(*temp_psv);
+
+            assert(temp_psv && *temp_psv && SvPOK(*temp_psv));
+            (void)PerlIO_close(iop);
+            IoIFP(io) = IoOFP(io) = NULL;
+#ifdef ARGV_USE_ATFUNCTIONS
+            dir_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_ORIG_DIRP, FALSE);
+            assert(dir_psv && *dir_psv && SvIOK(*dir_psv));
+            dir = INT2PTR(DIR *, SvIV(*dir_psv));
+            if (dir) {
+                if (unlinkat(my_dirfd(dir), temp_pv, 0) < 0 &&
+                    NotSupported(errno))
+                    (void)UNLINK(temp_pv);
+                closedir(dir);
+            }
+#else
+            (void)UNLINK(temp_pv);
+#endif
+        }
     }
 
     return 0;
 }
 
+static int
+S_argvout_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *param) {
+    PERL_UNUSED_ARG(param);
+
+    /* ideally we could just remove the magic from the SV but we don't get the SV here */
+    SvREFCNT_dec(mg->mg_obj);
+    mg->mg_obj = NULL;
+
+    return 0;
+}
+
 /* Magic of this type has an AV containing the following:
    0: name of the backup file (if any)
    1: name of the temp output file
    2: name of the original file
    3: file mode of the original file
+   4: pid of the process we opened at, to prevent doing the renaming
+      etc in both the child and the parent after a fork
+
+If we have useful inode/device ids in stat_t we also keep:
+   5: a stat of the original current working directory
+
+If we have unlinkat(), renameat(), fchmodat(), dirfd() we also keep:
+   6: the DIR * for the current directory when we open the file, stored as an IV
  */
 
 static const MGVTBL argvout_vtbl =
@@ -908,8 +998,8 @@ static const MGVTBL argvout_vtbl =
         NULL, /* svt_clear */
         S_argvout_free, /* svt_free */
         NULL, /* svt_copy */
-        NULL, /* svt_dup */
-        NULL  /* svt_local */
+        S_argvout_dup,  /* svt_dup */
+        NULL /* svt_local */
     };
 
 PerlIO *
@@ -972,10 +1062,14 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen)
                 int filedev;
                 int fileino;
 #endif
+#ifdef ARGV_USE_ATFUNCTIONS
+                DIR *curdir;
+#endif
                 Uid_t fileuid;
                 Gid_t filegid;
                 AV *magic_av = NULL;
                 SV *temp_name_sv = NULL;
+                MAGIC *mg;
 
                TAINT_PROPER("inplace open");
                if (oldlen == 1 && *PL_oldname == '-') {
@@ -1051,8 +1145,20 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen)
                 av_store(magic_av, ARGVMG_TEMP_NAME, temp_name_sv);
                 av_store(magic_av, ARGVMG_ORIG_NAME, newSVsv(sv));
                 av_store(magic_av, ARGVMG_ORIG_MODE, newSVuv(PL_filemode));
+                av_store(magic_av, ARGVMG_ORIG_PID, newSViv((IV)PerlProc_getpid()));
+#if defined(ARGV_USE_ATFUNCTIONS)
+                curdir = opendir(".");
+                av_store(magic_av, ARGVMG_ORIG_DIRP, newSViv(PTR2IV(curdir)));
+#elif defined(ARGV_USE_STAT_INO)
+                if (PerlLIO_stat(".", &statbuf) >= 0) {
+                    av_store(magic_av, ARGVMG_ORIG_CWD_STAT,
+                             newSVpvn((char *)&statbuf, sizeof(statbuf)));
+                }
+#endif
                setdefout(PL_argvoutgv);
-                sv_magicext((SV*)GvIOp(PL_argvoutgv), (SV*)magic_av, PERL_MAGIC_uvar, &argvout_vtbl, NULL, 0);
+                sv_setsv(GvSVn(PL_argvoutgv), temp_name_sv);
+                mg = sv_magicext((SV*)GvIOp(PL_argvoutgv), (SV*)magic_av, PERL_MAGIC_uvar, &argvout_vtbl, NULL, 0);
+                mg->mg_flags |= MGf_DUP;
                 SvREFCNT_dec(magic_av);
                PL_lastfd = PerlIO_fileno(IoIFP(GvIOp(PL_argvoutgv)));
                 if (PL_lastfd >= 0) {
@@ -1066,11 +1172,9 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen)
                         /* XXX silently ignore failures */
 #ifdef HAS_FCHOWN
                         PERL_UNUSED_RESULT(fchown(PL_lastfd,fileuid,filegid));
-#else
-#ifdef HAS_CHOWN
+#elif defined(HAS_CHOWN)
                         PERL_UNUSED_RESULT(PerlLIO_chown(PL_oldname,fileuid,filegid));
 #endif
-#endif
                     }
                }
                 return IoIFP(GvIOp(gv));
@@ -1108,6 +1212,72 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen)
     return NULL;
 }
 
+#ifdef ARGV_USE_ATFUNCTIONS
+#  if defined(__FreeBSD__)
+
+/* FreeBSD 11 renameat() mis-behaves strangely with absolute paths in cases where the
+ * equivalent rename() succeeds
+ */
+static int
+S_my_renameat(int olddfd, const char *oldpath, int newdfd, const char *newpath) {
+    /* this is intended only for use in Perl_do_close() */
+    assert(olddfd == newdfd);
+    assert(PERL_FILE_IS_ABSOLUTE(oldpath) == PERL_FILE_IS_ABSOLUTE(newpath));
+    if (PERL_FILE_IS_ABSOLUTE(oldpath)) {
+        return PerlLIO_rename(oldpath, newpath);
+    }
+    else {
+        return renameat(olddfd, oldpath, newdfd, newpath);
+    }
+}
+
+#  else
+#    define S_my_renameat(dh1, pv1, dh2, pv2) renameat((dh1), (pv1), (dh2), (pv2))
+#  endif /* if defined(__FreeBSD__) */
+#endif
+
+static bool
+S_dir_unchanged(pTHX_ const char *orig_pv, MAGIC *mg) {
+    Stat_t statbuf;
+
+#ifdef ARGV_USE_STAT_INO
+    SV **stat_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_ORIG_CWD_STAT, FALSE);
+    Stat_t *orig_cwd_stat = stat_psv && *stat_psv ? (Stat_t *)SvPVX(*stat_psv) : NULL;
+
+    /* if the path is absolute the possible moving of cwd (which the file
+       might be in) isn't our problem.
+       This code tries to be reasonably balanced about detecting a changed
+       CWD, if we have the information needed to check that curdir has changed, we
+       check it
+    */
+    if (!PERL_FILE_IS_ABSOLUTE(orig_pv)
+        && orig_cwd_stat
+        && PerlLIO_stat(".", &statbuf) >= 0
+        && ( statbuf.st_dev != orig_cwd_stat->st_dev
+                     || statbuf.st_ino != orig_cwd_stat->st_ino)) {
+        Perl_croak(aTHX_ "Cannot complete in-place edit of %s: %s",
+                   orig_pv, "Current directory has changed");
+    }
+#else
+    SV **temp_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_TEMP_NAME, FALSE);
+
+    /* Some platforms don't have useful st_ino etc, so just
+       check we can see the work file.
+    */
+    if (!PERL_FILE_IS_ABSOLUTE(orig_pv)
+        && PerlLIO_stat(SvPVX(*temp_psv), &statbuf) < 0) {
+        Perl_croak(aTHX_ "Cannot complete in-place edit of %" SVf ": %s",
+                   orig_pv,
+                   "Work file is missing - did you change directory?");
+    }
+#endif
+
+    return TRUE;
+}
+
+#define dir_unchanged(orig_psv, mg) \
+    S_dir_unchanged(aTHX_ (orig_psv), (mg))
+
 /* explicit renamed to avoid C++ conflict    -- kja */
 bool
 Perl_do_close(pTHX_ GV *gv, bool not_implicit)
@@ -1139,6 +1309,12 @@ Perl_do_close(pTHX_ GV *gv, bool not_implicit)
         /* PL_oldname may have been modified by a nested ARGV use at this point */
         SV **orig_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_ORIG_NAME, FALSE);
         SV **mode_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_ORIG_MODE, FALSE);
+        SV **pid_psv  = av_fetch((AV*)mg->mg_obj, ARGVMG_ORIG_PID, FALSE);
+#if defined(ARGV_USE_ATFUNCTIONS)
+        SV **dir_psv  = av_fetch((AV*)mg->mg_obj, ARGVMG_ORIG_DIRP, FALSE);
+        DIR *dir;
+        int dfd;
+#endif
         UV mode;
         int fd;
 
@@ -1147,9 +1323,14 @@ Perl_do_close(pTHX_ GV *gv, bool not_implicit)
         assert(temp_psv && *temp_psv);
         assert(orig_psv && *orig_psv);
         assert(mode_psv && *mode_psv);
+        assert(pid_psv && *pid_psv);
+#ifdef ARGV_USE_ATFUNCTIONS
+        assert(dir_psv && *dir_psv);
+        dir = INT2PTR(DIR *, SvIVX(*dir_psv));
+        dfd = my_dirfd(dir);
+#endif
 
         orig_pv = SvPVX(*orig_psv);
-
         mode = SvUV(*mode_psv);
 
         if ((mode & (S_ISUID|S_ISGID)) != 0
@@ -1164,6 +1345,12 @@ Perl_do_close(pTHX_ GV *gv, bool not_implicit)
 
         retval = io_close(io, NULL, not_implicit, FALSE);
 
+        if (SvIV(*pid_psv) != (IV)PerlProc_getpid()) {
+            /* this is a child process, don't duplicate our rename() etc
+               processing below */
+            goto freext;
+        }
+
         if (retval) {
 #if defined(DOSISH) || defined(__CYGWIN__)
             if (PL_argvgv && GvIOp(PL_argvgv)
@@ -1172,14 +1359,44 @@ Perl_do_close(pTHX_ GV *gv, bool not_implicit)
                 do_close(PL_argvgv, FALSE);
             }
 #endif
+#ifndef ARGV_USE_ATFUNCTIONS
+            if (!dir_unchanged(orig_pv, mg))
+                goto abort_inplace;
+#endif
             if (back_psv && *back_psv) {
 #if defined(HAS_LINK) && !defined(DOSISH) && !defined(__CYGWIN__) && defined(HAS_RENAME)
-                if (link(orig_pv, SvPVX(*back_psv)) < 0)
+                if (
+#  ifdef ARGV_USE_ATFUNCTIONS
+                    linkat(dfd, orig_pv, dfd, SvPVX(*back_psv), 0) < 0 &&
+                    !(UNLIKELY(NotSupported(errno)) &&
+                      dir_unchanged(orig_pv, mg) &&
+                               link(orig_pv, SvPVX(*back_psv)) == 0)
+#  else
+                    link(orig_pv, SvPVX(*back_psv)) < 0
+#  endif
+                    )
 #endif
                 {
 #ifdef HAS_RENAME
-                    if (PerlLIO_rename(orig_pv, SvPVX(*back_psv)) < 0) {
+                    if (
+#  ifdef ARGV_USE_ATFUNCTIONS
+                        S_my_renameat(dfd, orig_pv, dfd, SvPVX(*back_psv)) < 0 &&
+                        !(UNLIKELY(NotSupported(errno)) &&
+                          dir_unchanged(orig_pv, mg) &&
+                          PerlLIO_rename(orig_pv, SvPVX(*back_psv)) == 0)
+#  else
+                        PerlLIO_rename(orig_pv, SvPVX(*back_psv)) < 0
+#  endif
+                        ) {
                         if (!not_implicit) {
+#  ifdef ARGV_USE_ATFUNCTIONS
+                            if (unlinkat(dfd, SvPVX_const(*temp_psv), 0) < 0 &&
+                                UNLIKELY(NotSupported(errno)) &&
+                                dir_unchanged(orig_pv, mg))
+                                (void)UNLINK(SvPVX_const(*temp_psv));
+#  else
+                            UNLINK(SvPVX(*temp_psv));
+#  endif
                             Perl_croak(aTHX_ "Can't rename %s to %s: %s, skipping file",
                                        SvPVX(*orig_psv), SvPVX(*back_psv), Strerror(errno));
                         }
@@ -1207,13 +1424,25 @@ Perl_do_close(pTHX_ GV *gv, bool not_implicit)
             }
 #endif
             if (
-#ifdef HAS_RENAME
-                PerlLIO_rename(SvPVX(*temp_psv), orig_pv) < 0
-#else
+#if !defined(HAS_RENAME)
                 link(SvPVX(*temp_psv), orig_pv) < 0
+#elif defined(ARGV_USE_ATFUNCTIONS)
+               S_my_renameat(dfd, SvPVX(*temp_psv), dfd, orig_pv) < 0 &&
+                !(UNLIKELY(NotSupported(errno)) &&
+                  dir_unchanged(orig_pv, mg) &&
+                  PerlLIO_rename(SvPVX(*temp_psv), orig_pv) == 0)
+#else
+                PerlLIO_rename(SvPVX(*temp_psv), orig_pv) < 0
 #endif
                 ) {
                 if (!not_implicit) {
+#ifdef ARGV_USE_ATFUNCTIONS
+                    if (unlinkat(dfd, SvPVX_const(*temp_psv), 0) < 0 &&
+                        NotSupported(errno))
+                        UNLINK(SvPVX(*temp_psv));
+#else
+                    UNLINK(SvPVX(*temp_psv));
+#endif
                     Perl_croak(aTHX_ "Can't rename in-place work file '%s' to '%s': %s\n",
                                SvPVX(*temp_psv), SvPVX(*orig_psv), Strerror(errno));
                 }
@@ -1226,12 +1455,20 @@ Perl_do_close(pTHX_ GV *gv, bool not_implicit)
 #endif
         }
         else {
+#ifdef ARGV_USE_ATFUNCTIONS
+            if (unlinkat(dfd, SvPVX_const(*temp_psv), 0) &&
+                NotSupported(errno))
+                UNLINK(SvPVX_const(*temp_psv));
+                
+#else
             UNLINK(SvPVX_const(*temp_psv));
+#endif
             if (!not_implicit) {
                 Perl_croak(aTHX_ "Failed to close in-place work file %s: %s",
                            SvPVX(*temp_psv), Strerror(errno));
             }
         }
+    freext:
         mg_freeext((SV*)io, PERL_MAGIC_uvar, &argvout_vtbl);
     }
     else {
@@ -1444,7 +1681,7 @@ Perl_mode_from_discipline(pTHX_ const char *s, STRLEN len)
            else {
                const char *end;
   fail_discipline:
-               end = strchr(s+1, ':');
+               end = (char *) memchr(s+1, ':', len);
                if (!end)
                    end = s+len;
 #ifndef PERLIO_LAYERS
@@ -1593,8 +1830,11 @@ Perl_my_stat_flags(pTHX_ const U32 flags)
     if (PL_op->op_flags & OPf_REF) {
        gv = cGVOP_gv;
       do_fstat:
-        if (gv == PL_defgv)
+        if (gv == PL_defgv) {
+           if (PL_laststatval < 0)
+               SETERRNO(EBADF,RMS_IFI);
             return PL_laststatval;
+       }
        io = GvIO(gv);
         do_fstat_have_io:
         PL_laststype = OP_STAT;
@@ -1605,6 +1845,7 @@ Perl_my_stat_flags(pTHX_ const U32 flags)
                 int fd = PerlIO_fileno(IoIFP(io));
                 if (fd < 0) {
                     /* E.g. PerlIO::scalar has no real fd. */
+                   SETERRNO(EBADF,RMS_IFI);
                     return (PL_laststatval = -1);
                 } else {
                     return (PL_laststatval = PerlLIO_fstat(fd, &PL_statcache));
@@ -1615,6 +1856,7 @@ Perl_my_stat_flags(pTHX_ const U32 flags)
         }
        PL_laststatval = -1;
        report_evil_fh(gv);
+       SETERRNO(EBADF,RMS_IFI);
        return -1;
     }
     else if ((PL_op->op_private & (OPpFT_STACKED|OPpFT_AFTER_t))
@@ -1622,7 +1864,7 @@ Perl_my_stat_flags(pTHX_ const U32 flags)
        return PL_laststatval;
     else {
        SV* const sv = TOPs;
-       const char *s;
+       const char *s, *d;
        STRLEN len;
        if ((gv = MAYBE_DEREF_GV_flags(sv,flags))) {
            goto do_fstat;
@@ -1636,9 +1878,14 @@ Perl_my_stat_flags(pTHX_ const U32 flags)
        s = SvPV_flags_const(sv, len, flags);
        PL_statgv = NULL;
        sv_setpvn(PL_statname, s, len);
-       s = SvPVX_const(PL_statname);           /* s now NUL-terminated */
+       d = SvPVX_const(PL_statname);           /* s now NUL-terminated */
        PL_laststype = OP_STAT;
-       PL_laststatval = PerlLIO_stat(s, &PL_statcache);
+        if (!IS_SAFE_PATHNAME(s, len, OP_NAME(PL_op))) {
+            PL_laststatval = -1;
+        }
+        else {
+            PL_laststatval = PerlLIO_stat(d, &PL_statcache);
+        }
        if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && should_warn_nl(s)) {
             GCC_DIAG_IGNORE(-Wformat-nonliteral); /* PL_warn_nl is constant */
            Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "stat");
@@ -1655,12 +1902,15 @@ Perl_my_lstat_flags(pTHX_ const U32 flags)
     static const char* const no_prev_lstat = "The stat preceding -l _ wasn't an lstat";
     dSP;
     const char *file;
+    STRLEN len;
     SV* const sv = TOPs;
     bool isio = FALSE;
     if (PL_op->op_flags & OPf_REF) {
        if (cGVOP_gv == PL_defgv) {
            if (PL_laststype != OP_LSTAT)
                Perl_croak(aTHX_ "%s", no_prev_lstat);
+           if (PL_laststatval < 0)
+               SETERRNO(EBADF,RMS_IFI);
            return PL_laststatval;
        }
        PL_laststatval = -1;
@@ -1670,6 +1920,7 @@ Perl_my_lstat_flags(pTHX_ const U32 flags)
                              "Use of -l on filehandle %" HEKf,
                              HEKfARG(GvENAME_HEK(cGVOP_gv)));
        }
+       SETERRNO(EBADF,RMS_IFI);
        return -1;
     }
     if ((PL_op->op_private & (OPpFT_STACKED|OPpFT_AFTER_t))
@@ -1698,9 +1949,14 @@ Perl_my_lstat_flags(pTHX_ const U32 flags)
                               HEKfARG(GvENAME_HEK((const GV *)
                                           (SvROK(sv) ? SvRV(sv) : sv))));
     }
-    file = SvPV_flags_const_nolen(sv, flags);
+    file = SvPV_flags_const(sv, len, flags);
     sv_setpv(PL_statname,file);
-    PL_laststatval = PerlLIO_lstat(file,&PL_statcache);
+    if (!IS_SAFE_PATHNAME(file, len, OP_NAME(PL_op))) {
+        PL_laststatval = -1;
+    }
+    else {
+        PL_laststatval = PerlLIO_lstat(file,&PL_statcache);
+    }
     if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && should_warn_nl(file)) {
         GCC_DIAG_IGNORE(-Wformat-nonliteral); /* PL_warn_nl is constant */
         Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "lstat");
@@ -1734,7 +1990,8 @@ Perl_do_aexec5(pTHX_ SV *really, SV **mark, SV **sp,
 #if defined(__SYMBIAN32__) || defined(__LIBCATAMOUNT__)
     Perl_croak(aTHX_ "exec? I'm not *that* kind of operating system");
 #else
-    if (sp > mark) {
+    assert(sp >= mark);
+    {
        const char **a;
        const char *tmps = NULL;
        Newx(PL_Argv, sp - mark + 1, const char*);
@@ -1749,17 +2006,19 @@ Perl_do_aexec5(pTHX_ SV *really, SV **mark, SV **sp,
        *a = NULL;
        if (really)
            tmps = SvPV_nolen_const(really);
-       if ((!really && *PL_Argv[0] != '/') ||
+        if ((!really && PL_Argv[0] && *PL_Argv[0] != '/') ||
            (really && *tmps != '/'))           /* will execvp use PATH? */
            TAINT_ENV();                /* testing IFS here is overkill, probably */
        PERL_FPU_PRE_EXEC
        if (really && *tmps) {
             PerlProc_execvp(tmps,EXEC_ARGV_CAST(PL_Argv));
-       } else {
+        } else if (PL_Argv[0]) {
             PerlProc_execvp(PL_Argv[0],EXEC_ARGV_CAST(PL_Argv));
-       }
+        } else {
+            SETERRNO(ENOENT,RMS_FNF);
+        }
        PERL_FPU_POST_EXEC
-       S_exec_failed(aTHX_ (really ? tmps : PL_Argv[0]), fd, do_report);
+        S_exec_failed(aTHX_ (really ? tmps : PL_Argv[0] ? PL_Argv[0] : ""), fd, do_report);
     }
     do_execfree();
 #endif
@@ -1803,7 +2062,7 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
     {
         char flags[PERL_FLAGS_MAX];
        if (strnEQ(cmd,PL_cshname,PL_cshlen) &&
-           strEQs(cmd+PL_cshlen," -c")) {
+           strBEGINs(cmd+PL_cshlen," -c")) {
           my_strlcpy(flags, "-c", PERL_FLAGS_MAX);
          s = cmd+PL_cshlen+3;
          if (*s == 'f') {
@@ -1839,7 +2098,7 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
     if (*cmd == '.' && isSPACE(cmd[1]))
        goto doshell;
 
-    if (strEQs(cmd,"exec") && isSPACE(cmd[4]))
+    if (strBEGINs(cmd,"exec") && isSPACE(cmd[4]))
        goto doshell;
 
     s = cmd;
@@ -2735,33 +2994,29 @@ Perl_vms_start_glob
     fp = Perl_vms_start_glob(aTHX_ tmpglob, io);
 
 #else /* !VMS */
-#ifdef DOSISH
-#ifdef OS2
+# ifdef DOSISH
+#  if defined(OS2)
     sv_setpv(tmpcmd, "for a in ");
     sv_catsv(tmpcmd, tmpglob);
     sv_catpv(tmpcmd, "; do echo \"$a\\0\\c\"; done |");
-#else
-#ifdef DJGPP
+#  elif defined(DJGPP)
     sv_setpv(tmpcmd, "/dev/dosglob/"); /* File System Extension */
     sv_catsv(tmpcmd, tmpglob);
-#else
+#  else
     sv_setpv(tmpcmd, "perlglob ");
     sv_catsv(tmpcmd, tmpglob);
     sv_catpv(tmpcmd, " |");
-#endif /* !DJGPP */
-#endif /* !OS2 */
-#else /* !DOSISH */
-#if defined(CSH)
+#  endif
+# elif defined(CSH)
     sv_setpvn(tmpcmd, PL_cshname, PL_cshlen);
     sv_catpv(tmpcmd, " -cf 'set nonomatch; glob ");
     sv_catsv(tmpcmd, tmpglob);
     sv_catpv(tmpcmd, "' 2>/dev/null |");
-#else
+# else
     sv_setpv(tmpcmd, "echo ");
     sv_catsv(tmpcmd, tmpglob);
     sv_catpv(tmpcmd, "|tr -s ' \t\f\r' '\\n\\n\\n\\n'|");
-#endif /* !CSH */
-#endif /* !DOSISH */
+# endif /* !DOSISH && !CSH */
     {
         SV ** const svp = hv_fetchs(GvHVn(PL_envgv), "LS_COLORS", 0);
         if (svp && *svp)