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");
PERL_ARGS_ASSERT_OPENN_CLEANUP;
+ Zero(&statbuf, 1, Stat_t);
+
if (!fp) {
if (IoTYPE(io) == IoTYPE_RDONLY && ckWARN(WARN_NEWLINE)
&& should_warn_nl(oname)
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;
/* Win32 doesn't necessarily return useful information
* in st_dev, st_ino.
*/
-#ifndef ARGV_USE_ATFUNCTIONS
-# ifndef DOSISH
-# define ARGV_USE_STAT_INO
-# endif
+#ifndef DOSISH
+# define ARGV_USE_STAT_INO
#endif
#define ARGVMG_BACKUP_NAME 0
#define ARGVMG_ORIG_MODE 3
#define ARGVMG_ORIG_PID 4
-#if defined(ARGV_USE_ATFUNCTIONS)
-#define ARGVMG_ORIG_DIRP 5
-#elif defined(ARGV_USE_STAT_INO)
/* 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.
*/
-#define ARGVMG_ORIG_CWD_STAT 5
+#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
/* 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;
- temp_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_TEMP_NAME, FALSE);
- assert(temp_psv && *temp_psv && SvPOK(*temp_psv));
#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) {
- (void)unlinkat(my_dirfd(dir), SvPVX(*temp_psv), 0);
+ if (unlinkat(my_dirfd(dir), temp_pv, 0) < 0 &&
+ NotSupported(errno))
+ (void)UNLINK(temp_pv);
closedir(dir);
}
#else
- (void)UNLINK(SvPVX(*temp_psv));
+ (void)UNLINK(temp_pv);
#endif
}
}
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:
- 5: the DIR * for the current directory when we open the file, stored as an IV
+ 6: the DIR * for the current directory when we open the file, stored as an IV
*/
static const MGVTBL argvout_vtbl =
# 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)
SV **dir_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_ORIG_DIRP, FALSE);
DIR *dir;
int dfd;
-#elif defined(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;
-#endif
-#ifndef ARGV_USE_ATFUNCTIONS
- Stat_t statbuf;
#endif
UV mode;
int fd;
}
if (retval) {
-#ifdef ARGV_USE_STAT_INO
- /* 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 ": %s",
- *orig_psv, "Current directory has changed");
- }
-#endif
-#if !defined(ARGV_USE_ATFUNCTIONS) && !defined(ARGV_USE_STAT_INO)
- /* Some platforms don't have useful st_ino etc, so just
- check we can see the work file.
- */
- if (!PERL_FILE_IS_ABSOLUTE(SvPVX(*orig_psv))
- && PerlLIO_stat(SvPVX(*temp_psv), &statbuf) < 0) {
- Perl_croak(aTHX_ "Cannot complete in-place edit of %" SVf ": %s",
- *orig_psv,
- "Work file is missing - did you change directory?");
- }
-#endif
-
#if defined(DOSISH) || defined(__CYGWIN__)
if (PL_argvgv && GvIOp(PL_argvgv)
&& IoIFP(GvIOp(PL_argvgv))
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 (
# ifdef ARGV_USE_ATFUNCTIONS
- linkat(dfd, orig_pv, dfd, SvPVX(*back_psv), 0) < 0
+ 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
#ifdef HAS_RENAME
if (
# ifdef ARGV_USE_ATFUNCTIONS
- S_my_renameat(dfd, orig_pv, dfd, SvPVX(*back_psv)) < 0
+ 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
- (void)unlinkat(dfd, SvPVX_const(*temp_psv), 0);
+ 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
#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
+ 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
- (void)unlinkat(dfd, SvPVX_const(*temp_psv), 0);
+ if (unlinkat(dfd, SvPVX_const(*temp_psv), 0) < 0 &&
+ NotSupported(errno))
+ UNLINK(SvPVX(*temp_psv));
#else
UNLINK(SvPVX(*temp_psv));
#endif
}
else {
#ifdef ARGV_USE_ATFUNCTIONS
- unlinkat(dfd, SvPVX_const(*temp_psv), 0);
+ if (unlinkat(dfd, SvPVX_const(*temp_psv), 0) &&
+ NotSupported(errno))
+ UNLINK(SvPVX_const(*temp_psv));
+
#else
UNLINK(SvPVX_const(*temp_psv));
#endif
else {
const char *end;
fail_discipline:
- end = strchr(s+1, ':');
+ end = (char *) memchr(s+1, ':', len);
if (!end)
end = s+len;
#ifndef PERLIO_LAYERS
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;
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));
}
PL_laststatval = -1;
report_evil_fh(gv);
+ SETERRNO(EBADF,RMS_IFI);
return -1;
}
else if ((PL_op->op_private & (OPpFT_STACKED|OPpFT_AFTER_t))
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;
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");
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;
"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))
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");
{
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') {
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;
#ifdef VMS /* expand the wildcards right here, rather than opening a pipe, */
/* since spawning off a process is a real performance hit */
+PerlIO *
+Perl_vms_start_glob
+ (pTHX_ SV *tmpglob,
+ IO *io);
+
fp = Perl_vms_start_glob(aTHX_ tmpglob, io);
#else /* !VMS */
https://perl5.git.perl.org / perl5.git / blobdiff