fd = PerlIO_fileno(fp);
}
#if defined(HAS_FCNTL) && defined(F_SETFD) && defined(FD_CLOEXEC)
- if (fd > PL_maxsysfd && fcntl(fd, F_SETFD, FD_CLOEXEC) < 0) {
+ if (fd >= 0 && fd > PL_maxsysfd && fcntl(fd, F_SETFD, FD_CLOEXEC) < 0) {
PerlLIO_close(fd);
goto say_false;
}
Perl_nextargv(pTHX_ GV *gv, bool nomagicopen)
{
IO * const io = GvIOp(gv);
+ SV *const old_out_name = PL_inplace ? newSVsv(GvSV(gv)) : NULL;
PERL_ARGS_ASSERT_NEXTARGV;
+ if (old_out_name)
+ SAVEFREESV(old_out_name);
+
if (!PL_argvoutgv)
PL_argvoutgv = gv_fetchpvs("ARGVOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO);
if (io && (IoFLAGS(io) & (IOf_ARGV|IOf_START)) == (IOf_ARGV|IOf_START)) {
if (!GvAV(gv))
return NULL;
while (av_tindex(GvAV(gv)) >= 0) {
+ Stat_t statbuf;
STRLEN oldlen;
SV *const sv = av_shift(GvAV(gv));
SAVEFREESV(sv);
}
}
else {
+ {
+ IO * const io = GvIOp(PL_argvoutgv);
+ if (io && IoIFP(io) && old_out_name && !io_close(io, PL_argvoutgv, FALSE, FALSE)) {
+ Perl_croak(aTHX_ "Failed to close in-place edit file %"SVf": %s\n",
+ old_out_name, Strerror(errno));
+ }
+ }
/* This very long block ends with return IoIFP(GvIOp(gv));
Both this block and the block above fall through on open
failure to the warning code, and then the while loop above tries
#endif
}
else {
-#if !defined(DOSISH) && !defined(AMIGAOS)
+#if !defined(DOSISH) && !defined(__amigaos4__)
# ifndef VMS /* Don't delete; use automatic file versioning */
if (UNLINK(PL_oldname) < 0) {
Perl_ck_warner_d(aTHX_ packWARN(WARN_INPLACE),
setdefout(PL_argvoutgv);
PL_lastfd = PerlIO_fileno(IoIFP(GvIOp(PL_argvoutgv)));
if (PL_lastfd >= 0) {
- (void)PerlLIO_fstat(PL_lastfd,&PL_statbuf);
+ (void)PerlLIO_fstat(PL_lastfd,&statbuf);
#ifdef HAS_FCHMOD
(void)fchmod(PL_lastfd,PL_filemode);
#else
(void)PerlLIO_chmod(PL_oldname,PL_filemode);
#endif
- if (fileuid != PL_statbuf.st_uid || filegid != PL_statbuf.st_gid) {
+ if (fileuid != statbuf.st_uid || filegid != statbuf.st_gid) {
/* XXX silently ignore failures */
#ifdef HAS_FCHOWN
PERL_UNUSED_RESULT(fchown(PL_lastfd,fileuid,filegid));
if (ckWARN_d(WARN_INPLACE)) {
const int eno = errno;
- if (PerlLIO_stat(PL_oldname, &PL_statbuf) >= 0
- && !S_ISREG(PL_statbuf.st_mode)) {
+ if (PerlLIO_stat(PL_oldname, &statbuf) >= 0
+ && !S_ISREG(statbuf.st_mode)) {
Perl_warner(aTHX_ packWARN(WARN_INPLACE),
"Can't do inplace edit: %s is not a regular file",
PL_oldname);
if (io && (IoFLAGS(io) & IOf_ARGV))
IoFLAGS(io) |= IOf_START;
if (PL_inplace) {
- (void)do_close(PL_argvoutgv,FALSE);
+ if (old_out_name) {
+ IO * const io = GvIOp(PL_argvoutgv);
+ if (io && IoIFP(io) && !io_close(io, PL_argvoutgv, FALSE, FALSE)) {
+ Perl_croak(aTHX_ "Failed to close in-place edit file %"SVf": %s\n",
+ old_out_name, Strerror(errno));
+ }
+ }
+ else {
+ /* maybe this is no longer wanted */
+ (void)do_close(PL_argvoutgv,FALSE);
+ }
if (io && (IoFLAGS(io) & IOf_ARGV)
&& PL_argvout_stack && AvFILLp(PL_argvout_stack) >= 0)
{
{
const int e = errno;
PERL_ARGS_ASSERT_EXEC_FAILED;
-#ifdef __amigaos4__
- if (e)
-#endif
- {
- if (ckWARN(WARN_EXEC))
- Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't exec \"%s\": %s",
- cmd, Strerror(e));
- }
+
+ if (ckWARN(WARN_EXEC))
+ Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't exec \"%s\": %s",
+ cmd, Strerror(e));
if (do_report) {
/* XXX silently ignore failures */
PERL_UNUSED_RESULT(PerlLIO_write(fd, (void*)&e, sizeof(int)));
}
}
-DO_EXEC_TYPE
+bool
Perl_do_aexec5(pTHX_ SV *really, SV **mark, SV **sp,
int fd, int do_report)
{
dVAR;
- DO_EXEC_TYPE result = DO_EXEC_FAILURE;
PERL_ARGS_ASSERT_DO_AEXEC5;
- PERL_UNUSED_VAR(result); /* if DO_EXEC_TYPE is bool */
#if defined(__SYMBIAN32__) || defined(__LIBCATAMOUNT__)
Perl_croak(aTHX_ "exec? I'm not *that* kind of operating system");
#else
TAINT_ENV(); /* testing IFS here is overkill, probably */
PERL_FPU_PRE_EXEC
if (really && *tmps) {
- result =
- (DO_EXEC_TYPE)
- PerlProc_execvp(tmps,EXEC_ARGV_CAST(PL_Argv));
+ PerlProc_execvp(tmps,EXEC_ARGV_CAST(PL_Argv));
} else {
- result =
- (DO_EXEC_TYPE)
- PerlProc_execvp(PL_Argv[0],EXEC_ARGV_CAST(PL_Argv));
+ PerlProc_execvp(PL_Argv[0],EXEC_ARGV_CAST(PL_Argv));
}
PERL_FPU_POST_EXEC
S_exec_failed(aTHX_ (really ? tmps : PL_Argv[0]), fd, do_report);
}
do_execfree();
#endif
- return DO_EXEC_RETVAL(result);
+ return FALSE;
}
void
#ifdef PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION
-DO_EXEC_TYPE
+bool
Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
{
dVAR;
char *cmd;
/* Make a copy so we can change it */
const Size_t cmdlen = strlen(incmd) + 1;
- DO_EXEC_TYPE result = DO_EXEC_FAILURE;
- PERL_UNUSED_VAR(result); /* if DO_EXEC_TYPE is bool */
PERL_ARGS_ASSERT_DO_EXEC3;
if (s[-1] == '\'') {
*--s = '\0';
PERL_FPU_PRE_EXEC
- result =
- (DO_EXEC_TYPE)
- PerlProc_execl(PL_cshname, "csh", flags, ncmd, (char*)NULL);
+ PerlProc_execl(PL_cshname, "csh", flags, ncmd, (char*)NULL);
PERL_FPU_POST_EXEC
*s = '\'';
S_exec_failed(aTHX_ PL_cshname, fd, do_report);
Safefree(buf);
- return DO_EXEC_RETVAL(result);
+ return FALSE;
}
}
}
}
doshell:
PERL_FPU_PRE_EXEC
- result =
- (DO_EXEC_TYPE)
- PerlProc_execl(PL_sh_path, "sh", "-c", cmd, (char *)NULL);
+ PerlProc_execl(PL_sh_path, "sh", "-c", cmd, (char *)NULL);
PERL_FPU_POST_EXEC
S_exec_failed(aTHX_ PL_sh_path, fd, do_report);
-#if defined (__amigaos4__)
- /* We *must* write something to our pipe or else
- * the other end hangs */
- {
- int e = errno;
-
- if (do_report) {
- PerlLIO_write(fd, (void*)&e, sizeof(int));
- PerlLIO_close(fd);
- }
- }
-#endif
Safefree(buf);
- return DO_EXEC_RETVAL(result);
+ return FALSE;
}
}
*a = NULL;
if (PL_Argv[0]) {
PERL_FPU_PRE_EXEC
- result =
- (DO_EXEC_TYPE)
- PerlProc_execvp(PL_Argv[0],EXEC_ARGV_CAST(PL_Argv));
+ PerlProc_execvp(PL_Argv[0],EXEC_ARGV_CAST(PL_Argv));
PERL_FPU_POST_EXEC
if (errno == ENOEXEC) { /* for system V NIH syndrome */
do_execfree();
}
do_execfree();
Safefree(buf);
- return DO_EXEC_RETVAL(result);
+ return FALSE;
}
#endif /* OS2 || WIN32 */
-#ifdef VMS
-#include <starlet.h> /* for sys$delprc */
-#endif
-
I32
Perl_apply(pTHX_ I32 type, SV **mark, SV **sp)
{
int fd = PerlIO_fileno(IoIFP(GvIOn(gv)));
APPLY_TAINT_PROPER();
if (fd < 0) {
- SETERRNO(EBADF,RMS_IFI);
+ SETERRNO(EBADF,RMS_IFI);
tot--;
+#if Uid_t_sign == 1
+ } else if (val < 0) {
+ SETERRNO(EINVAL,LIB_INVARG);
+ tot--;
+#endif
+#if Gid_t_sign == 1
+ } else if (val2 < 0) {
+ SETERRNO(EINVAL,LIB_INVARG);
+ tot--;
+#endif
} else if (fchown(fd, val, val2))
tot--;
#else
}
APPLY_TAINT_PROPER();
tot = sp - mark;
-#ifdef VMS
- /* kill() doesn't do process groups (job trees?) under VMS */
- if (val == SIGKILL) {
- /* Use native sys$delprc() to insure that target process is
- * deleted; supervisor-mode images don't pay attention to
- * CRTL's emulation of Unix-style signals and kill()
- */
- while (++mark <= sp) {
- I32 proc;
- unsigned long int __vmssts;
- SvGETMAGIC(*mark);
- if (!(SvIOK(*mark) || SvNOK(*mark) || looks_like_number(*mark)))
- Perl_croak(aTHX_ "Can't kill a non-numeric process ID");
- proc = SvIV_nomg(*mark);
- APPLY_TAINT_PROPER();
- if (!((__vmssts = sys$delprc(&proc,0)) & 1)) {
- tot--;
- switch (__vmssts) {
- case SS$_NONEXPR:
- case SS$_NOSUCHNODE:
- SETERRNO(ESRCH,__vmssts);
- break;
- case SS$_NOPRIV:
- SETERRNO(EPERM,__vmssts);
- break;
- default:
- SETERRNO(EVMSERR,__vmssts);
- }
- }
- }
- PERL_ASYNC_CHECK();
- break;
- }
-#endif
+
while (++mark <= sp) {
Pid_t proc;
SvGETMAGIC(*mark);
}
else if (PL_unsafe) {
if (UNLINK(s))
+ {
tot--;
+ }
+#if defined(__amigaos4__) && defined(NEWLIB)
+ else
+ {
+ /* Under AmigaOS4 unlink only 'fails' if the
+ * filename is invalid. It may not remove the file
+ * if it's locked, so check if it's still around. */
+ if ((access(s,F_OK) != -1))
+ {
+ tot--;
+ }
+ }
+#endif
}
else { /* don't let root wipe out directories without -U */
- if (PerlLIO_lstat(s,&PL_statbuf) < 0)
- tot--;
- else if (S_ISDIR(PL_statbuf.st_mode)) {
+ Stat_t statbuf;
+ if (PerlLIO_lstat(s, &statbuf) < 0)
tot--;
+ else if (S_ISDIR(statbuf.st_mode)) {
SETERRNO(EISDIR, SS_NOPRIV);
+ tot--;
}
else {
if (UNLINK(s))
- tot--;
+ {
+ tot--;
+ }
+#if defined(__amigaos4__) && defined(NEWLIB)
+ else
+ {
+ /* Under AmigaOS4 unlink only 'fails' if the filename is invalid */
+ /* It may not remove the file if it's Locked, so check if it's still */
+ /* arround */
+ if((access(s,F_OK) != -1))
+ {
+ tot--;
+ }
+ }
+#endif
}
}
}
Function called by C<do_readline> to spawn a glob (or do the glob inside
perl on VMS). This code used to be inline, but now perl uses C<File::Glob>
-this glob starter is only used by miniperl during the build process.
+this glob starter is only used by miniperl during the build process,
+or when PERL_EXTERNAL_GLOB is defined.
Moving it away shrinks F<pp_hot.c>; shrinking F<pp_hot.c> helps speed perl up.
=cut
https://perl5.git.perl.org / perl5.git / blobdiff