(perl #127663) reject a changed directory for relative in-place filenames

based in the inode/device numbers when we don't have the *at()
functions.

2 files changed, 59 insertions, 2 deletions

diff --git a/doio.c b/doio.c
index d1f033b3e1..8eca9a07b9 100644
--- a/doio.c
+++ b/doio.c
@@ -872,7 +872,17 @@ S_openindirtemp(pTHX_ GV *gv, SV *orig_name, SV *temp_out_name) {
 #define ARGVMG_ORIG_NAME 2
 #define ARGVMG_ORIG_MODE 3
 #define ARGVMG_ORIG_PID 4
+
+#ifdef ARGV_USE_ATFUNCTIONS
 #define ARGVMG_ORIG_DIRP 5
+#else
+/* 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.
+ */
+#define ARGVMG_ORIG_CWD_STAT 5
+#endif
 
 static int
 S_argvout_free(pTHX_ SV *io, MAGIC *mg) {
@@ -1107,6 +1117,11 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen)
 #ifdef ARGV_USE_ATFUNCTIONS
                 curdir = opendir(".");
                 av_store(magic_av, ARGVMG_ORIG_DIRP, newSViv(PTR2IV(curdir)));
+#else
+                if (PerlLIO_stat(".", &statbuf) >= 0) {
+                    av_store(magic_av, ARGVMG_ORIG_CWD_STAT,
+                             newSVpvn((char *)&statbuf, sizeof(statbuf)));
+                }
 #endif
 		setdefout(PL_argvoutgv);
                 sv_setsv(GvSVn(PL_argvoutgv), temp_name_sv);
@@ -1203,6 +1218,10 @@ Perl_do_close(pTHX_ GV *gv, bool not_implicit)
         SV **dir_psv  = av_fetch((AV*)mg->mg_obj, ARGVMG_ORIG_DIRP, FALSE);
         DIR *dir;
         int dfd;
+#else
+        Stat_t statbuf;
+        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;
 #endif
         UV mode;
         int fd;
@@ -1241,6 +1260,23 @@ Perl_do_close(pTHX_ GV *gv, bool not_implicit)
         }
 
         if (retval) {
+#ifndef ARGV_USE_ATFUNCTIONS
+            /* 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(SvPVX(*orig_psv))
+                && 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 %" SVf ": "
+                           "Current directory has changed", *orig_psv);
+            }
+#endif
+
 #if defined(DOSISH) || defined(__CYGWIN__)
             if (PL_argvgv && GvIOp(PL_argvgv)
                 && IoIFP(GvIOp(PL_argvgv))
diff --git a/t/run/switches.t b/t/run/switches.t
index 08747efff8..12c618e146 100644
--- a/t/run/switches.t
+++ b/t/run/switches.t
@@ -12,7 +12,7 @@ BEGIN {
 
 BEGIN { require "./test.pl";  require "./loc_tools.pl"; }
 
-plan(tests => 135);
+plan(tests => 136);
 
 use Config;
 
@@ -560,6 +560,8 @@ CODE
     is(scalar(@names), 0, "no extra files")
       or diag "Found @names, expected none";
 
+    # the following tests might leave work files behind
+
     # this test can leave the work file in the directory, since making
     # the directory non-writable also prevents removing the work file
   SKIP:
@@ -586,10 +588,29 @@ CODE
         chmod 0700, "inplacetmp" or die "Cannot make inplacetmp writable again: $!";
     }
 
+  SKIP:
+    {
+        # this needs to reverse match how ARGV_USE_ATFUNCTIONS is defined in doio.c
+        skip "Testing without *at functions", 1
+          if $Config{d_unlinkat} && $Config{d_renameat} && $Config{d_fchmodat}
+              && ($Config{d_dirfd} || $Config{d_dir_dd_fd})
+              && $Config{ccflags} !~ /-DNO_USE_ATFUNCTIONS\b/;
+        fresh_perl_is(<<'CODE', "Cannot complete in-place edit of inplacetmp/foo: Current directory has changed at - line 5, <> line 1.\n", { },
+@ARGV = ("inplacetmp/foo");
+$^I = "";
+while (<>) {
+  chdir "..";
+  print "xx\n";
+}
+print "ok\n";
+CODE
+                       "chdir while in-place editing (no at-functions)");
+    }
+
     unlink $work;
 
     opendir $d, "inplacetmp" or die "Cannot opendir inplacetmp: $!";
-    @names = grep !/^\.\.?$/, readdir $d;
+    @names = grep !/^\.\.?$/ && !/foo$/aai, readdir $d;
     closedir $d;
 
     # clean up in case the above failed