*--tend = '\0';
if (num_svs) {
+ const char *p;
+ STRLEN nlen = 0;
/* New style explicit name, type is just mode and layer info */
#ifdef USE_STDIO
if (SvROK(*svp) && !strchr(oname,'&')) {
goto say_false;
}
#endif /* USE_STDIO */
- name = (SvOK(*svp) || SvGMAGICAL(*svp)) ?
- savesvpv (*svp) : savepvs ("");
+ p = (SvOK(*svp) || SvGMAGICAL(*svp)) ? SvPV(*svp, nlen) : NULL;
+
+ if (p && !IS_SAFE_PATHNAME(p, nlen, "open"))
+ goto say_false;
+
+ name = p ? savepvn(p, nlen) : savepvs("");
+
SAVEFREEPV(name);
}
else {
* be optimized away on most platforms;
* only Solaris and Linux seem to flush
* on that. --jhi */
-#ifdef USE_SFIO
- /* sfio fails to clear error on next
- sfwrite, contrary to documentation.
- -- Nicholas Clark */
- if (PerlIO_seek(that_fp, 0, SEEK_CUR) == -1)
- PerlIO_clearerr(that_fp);
-#endif
/* On the other hand, do all platforms
* take gracefully to flushing a read-only
* filehandle? Perhaps we should do
&& strchr(oname, '\n')
)
+ {
+ GCC_DIAG_IGNORE(-Wformat-nonliteral); /* PL_warn_nl is constant */
Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "open");
+ GCC_DIAG_RESTORE;
+ }
goto say_false;
}
PL_filemode = 0;
if (!GvAV(gv))
return NULL;
- while (av_len(GvAV(gv)) >= 0) {
+ while (av_tindex(GvAV(gv)) >= 0) {
STRLEN oldlen;
sv = av_shift(GvAV(gv));
SAVEFREESV(sv);
(void)PerlLIO_chmod(PL_oldname,PL_filemode);
#endif
if (fileuid != PL_statbuf.st_uid || filegid != PL_statbuf.st_gid) {
+ int rc = 0;
#ifdef HAS_FCHOWN
- (void)fchown(PL_lastfd,fileuid,filegid);
+ rc = fchown(PL_lastfd,fileuid,filegid);
#else
#ifdef HAS_CHOWN
- (void)PerlLIO_chown(PL_oldname,fileuid,filegid);
+ rc = PerlLIO_chown(PL_oldname,fileuid,filegid);
#endif
#endif
+ /* XXX silently ignore failures */
+ PERL_UNUSED_VAR(rc);
}
}
return IoIFP(GvIOp(gv));
{
GV * const oldout = MUTABLE_GV(av_pop(PL_argvout_stack));
setdefout(oldout);
- SvREFCNT_dec(oldout);
+ SvREFCNT_dec_NN(oldout);
return NULL;
}
setdefout(gv_fetchpvs("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO));
PERL_ARGS_ASSERT_DO_TELL;
if (io && (fp = IoIFP(io))) {
-#ifdef ULTRIX_STDIO_BOTCH
- if (PerlIO_eof(fp))
- (void)PerlIO_seek(fp, 0L, 2); /* ultrix 1.2 workaround */
-#endif
return PerlIO_tell(fp);
}
report_evil_fh(gv);
PerlIO *fp;
if (io && (fp = IoIFP(io))) {
-#ifdef ULTRIX_STDIO_BOTCH
- if (PerlIO_eof(fp))
- (void)PerlIO_seek(fp, 0L, 2); /* ultrix 1.2 workaround */
-#endif
return PerlIO_seek(fp, pos, whence) >= 0;
}
report_evil_fh(gv);
s = SvPVX_const(PL_statname); /* s now NUL-terminated */
PL_laststype = OP_STAT;
PL_laststatval = PerlLIO_stat(s, &PL_statcache);
- if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(s, '\n'))
+ if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(s, '\n')) {
+ GCC_DIAG_IGNORE(-Wformat-nonliteral); /* PL_warn_nl is constant */
Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "stat");
+ GCC_DIAG_RESTORE;
+ }
return PL_laststatval;
}
}
static const char* const no_prev_lstat = "The stat preceding -l _ wasn't an lstat";
dSP;
const char *file;
+ 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_ no_prev_lstat);
+ Perl_croak(aTHX_ "%s", no_prev_lstat);
return PL_laststatval;
}
PL_laststatval = -1;
if (ckWARN(WARN_IO)) {
+ /* diag_listed_as: Use of -l on filehandle%s */
Perl_warner(aTHX_ packWARN(WARN_IO),
"Use of -l on filehandle %"HEKf,
HEKfARG(GvENAME_HEK(cGVOP_gv)));
if ((PL_op->op_private & (OPpFT_STACKED|OPpFT_AFTER_t))
== OPpFT_STACKED) {
if (PL_laststype != OP_LSTAT)
- Perl_croak(aTHX_ no_prev_lstat);
+ Perl_croak(aTHX_ "%s", no_prev_lstat);
return PL_laststatval;
- }
+ }
PL_laststype = OP_LSTAT;
PL_statgv = NULL;
- file = SvPV_flags_const_nolen(TOPs, flags);
+ if ( ( (SvROK(sv) && ( isGV_with_GP(SvRV(sv))
+ || (isio = SvTYPE(SvRV(sv)) == SVt_PVIO) )
+ )
+ || isGV_with_GP(sv)
+ )
+ && ckWARN(WARN_IO)) {
+ if (isio)
+ /* diag_listed_as: Use of -l on filehandle%s */
+ Perl_warner(aTHX_ packWARN(WARN_IO),
+ "Use of -l on filehandle");
+ else
+ /* diag_listed_as: Use of -l on filehandle%s */
+ Perl_warner(aTHX_ packWARN(WARN_IO),
+ "Use of -l on filehandle %"HEKf,
+ GvENAME_HEK((const GV *)
+ (SvROK(sv) ? SvRV(sv) : sv)));
+ }
+ file = SvPV_flags_const_nolen(sv, flags);
sv_setpv(PL_statname,file);
PL_laststatval = PerlLIO_lstat(file,&PL_statcache);
- if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(file, '\n'))
- Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "lstat");
+ if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(file, '\n')) {
+ GCC_DIAG_IGNORE(-Wformat-nonliteral); /* PL_warn_nl is constant */
+ Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "lstat");
+ GCC_DIAG_RESTORE;
+ }
return PL_laststatval;
}
Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't exec \"%s\": %s",
cmd, Strerror(e));
if (do_report) {
- PerlLIO_write(fd, (void*)&e, sizeof(int));
+ int rc = PerlLIO_write(fd, (void*)&e, sizeof(int));
+ /* silently ignore failures */
+ PERL_UNUSED_VAR(rc);
PerlLIO_close(fd);
}
}
goto doshell;
s = cmd;
- while (isALNUM(*s))
+ while (isWORDCHAR(*s))
s++; /* catch VAR=val gizmo */
if (*s == '=')
goto doshell;
PERL_ARGS_ASSERT_APPLY;
+ PERL_UNUSED_VAR(what); /* may not be used depending on compile options */
+
/* Doing this ahead of the switch statement preserves the old behaviour,
where attempting to use kill as a taint test test would fail on
platforms where kill was not defined. */
}
}
else {
- const char *name = SvPV_nomg_const_nolen(*mark);
+ const char *name = SvPV_nomg_const(*mark, len);
APPLY_TAINT_PROPER();
- if (PerlLIO_chmod(name, val))
- tot--;
+ if (!IS_SAFE_PATHNAME(name, len, "chmod") ||
+ PerlLIO_chmod(name, val)) {
+ tot--;
+ }
}
}
}
}
}
else {
- const char *name = SvPV_nomg_const_nolen(*mark);
+ const char *name = SvPV_nomg_const(*mark, len);
APPLY_TAINT_PROPER();
- if (PerlLIO_chown(name, val, val2))
+ if (!IS_SAFE_PATHNAME(name, len, "chown") ||
+ PerlLIO_chown(name, val, val2)) {
tot--;
+ }
}
}
}
APPLY_TAINT_PROPER();
tot = sp - mark;
while (++mark <= sp) {
- s = SvPV_nolen_const(*mark);
+ s = SvPV_const(*mark, len);
APPLY_TAINT_PROPER();
- if (PerlProc_geteuid() || PL_unsafe) {
+ if (!IS_SAFE_PATHNAME(s, len, "unlink")) {
+ tot--;
+ }
+ else if (PL_unsafe) {
if (UNLINK(s))
tot--;
}
else { /* don't let root wipe out directories without -U */
- if (PerlLIO_lstat(s,&PL_statbuf) < 0 || S_ISDIR(PL_statbuf.st_mode))
+ if (PerlLIO_lstat(s,&PL_statbuf) < 0)
+ tot--;
+ else if (S_ISDIR(PL_statbuf.st_mode)) {
tot--;
+ SETERRNO(EISDIR, SS$_NOPRIV);
+ }
else {
if (UNLINK(s))
tot--;
}
}
else {
- const char * const name = SvPV_nomg_const_nolen(*mark);
+ const char * const name = SvPV_nomg_const(*mark, len);
APPLY_TAINT_PROPER();
+ if (!IS_SAFE_PATHNAME(name, len, "utime")) {
+ tot--;
+ }
+ else
#ifdef HAS_FUTIMES
if (utimes(name, (struct timeval *)utbufp))
#else
#ifdef Semctl
union semun unsemds;
+ if(cmd == SETVAL) {
+ unsemds.val = PTR2nat(a);
+ }
+ else {
#ifdef EXTRA_F_IN_SEMUN_BUF
- unsemds.buff = (struct semid_ds *)a;
+ unsemds.buff = (struct semid_ds *)a;
#else
- unsemds.buf = (struct semid_ds *)a;
+ unsemds.buf = (struct semid_ds *)a;
#endif
+ }
ret = Semctl(id, n, cmd, unsemds);
#else
/* diag_listed_as: sem%s not implemented */
PERL_UNUSED_ARG(mark);
/* diag_listed_as: msg%s not implemented */
Perl_croak(aTHX_ "msgsnd not implemented");
+ return -1;
#endif
}
if (ret >= 0) {
SvCUR_set(mstr, sizeof(long)+ret);
*SvEND(mstr) = '\0';
-#ifndef INCOMPLETE_TAINTS
/* who knows who has been playing with this message? */
SvTAINTED_on(mstr);
-#endif
}
return ret;
#else
PERL_UNUSED_ARG(mark);
/* diag_listed_as: msg%s not implemented */
Perl_croak(aTHX_ "msgrcv not implemented");
+ return -1;
#endif
}
t++;
}
result = semop(id, temps, nsops);
- t = temps;
- o = ops;
- i = nsops;
- while (i--) {
- *o++ = t->sem_num;
- *o++ = t->sem_op;
- *o++ = t->sem_flg;
- t++;
- }
Safefree(temps);
return result;
}
SvCUR_set(mstr, msize);
*SvEND(mstr) = '\0';
SvSETMAGIC(mstr);
-#ifndef INCOMPLETE_TAINTS
/* who knows who has been playing with this shared memory? */
SvTAINTED_on(mstr);
-#endif
}
else {
STRLEN len;
#else
/* diag_listed_as: shm%s not implemented */
Perl_croak(aTHX_ "shm I/O not implemented");
+ return -1;
#endif
}
=for apidoc start_glob
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>
+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.
Moving it away shrinks pp_hot.c; shrinking pp_hot.c helps speed perl up.
dVAR;
SV * const tmpcmd = newSV(0);
PerlIO *fp;
+ STRLEN len;
+ const char *s = SvPV(tmpglob, len);
PERL_ARGS_ASSERT_START_GLOB;
+ if (!IS_SAFE_SYSCALL(s, len, "pattern", "glob"))
+ return NULL;
+
ENTER;
SAVEFREESV(tmpcmd);
#ifdef VMS /* expand the wildcards right here, rather than opening a pipe, */
#else
sv_setpv(tmpcmd, "echo ");
sv_catsv(tmpcmd, tmpglob);
-#if 'z' - 'a' == 25
- sv_catpv(tmpcmd, "|tr -s ' \t\f\r' '\\012\\012\\012\\012'|");
-#else
sv_catpv(tmpcmd, "|tr -s ' \t\f\r' '\\n\\n\\n\\n'|");
-#endif
#endif /* !CSH */
#endif /* !DOSISH */
{
fp = IoIFP(io);
#endif /* !VMS */
LEAVE;
+
+ if (!fp && ckWARN(WARN_GLOB)) {
+ Perl_warner(aTHX_ packWARN(WARN_GLOB), "glob failed (can't start child: %s)",
+ Strerror(errno));
+ }
+
return fp;
}
https://perl5.git.perl.org / perl5.git / blobdiff