This is a live mirror of the Perl 5 development currently hosted at
https://github.com/perl/perl5
https://perl5.git.perl.org
/
perl5.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Fix -Wformat-security issues
[perl5.git]
/
doio.c
diff --git
a/doio.c
b/doio.c
index
e8eafdc
..
aa87c81
100644
(file)
--- a/
doio.c
+++ b/
doio.c
@@
-61,7
+61,7
@@
#include <signal.h>
bool
#include <signal.h>
bool
-Perl_do_openn(pTHX_ GV *gv,
register
const char *oname, I32 len, int as_raw,
+Perl_do_openn(pTHX_ GV *gv, const char *oname, I32 len, int as_raw,
int rawmode, int rawperm, PerlIO *supplied_fp, SV **svp,
I32 num_svs)
{
int rawmode, int rawperm, PerlIO *supplied_fp, SV **svp,
I32 num_svs)
{
@@
-706,7
+706,7
@@
say_false:
}
PerlIO *
}
PerlIO *
-Perl_nextargv(pTHX_
register
GV *gv)
+Perl_nextargv(pTHX_ GV *gv)
{
dVAR;
SV *sv;
{
dVAR;
SV *sv;
@@
-806,7
+806,7
@@
Perl_nextargv(pTHX_ register GV *gv)
}
#endif
#ifdef HAS_RENAME
}
#endif
#ifdef HAS_RENAME
-#if !defined(DOSISH) && !defined(__CYGWIN__)
&& !defined(EPOC)
+#if !defined(DOSISH) && !defined(__CYGWIN__)
if (PerlLIO_rename(PL_oldname,SvPVX_const(sv)) < 0) {
Perl_ck_warner_d(aTHX_ packWARN(WARN_INPLACE),
"Can't rename %s to %"SVf": %s, skipping file",
if (PerlLIO_rename(PL_oldname,SvPVX_const(sv)) < 0) {
Perl_ck_warner_d(aTHX_ packWARN(WARN_INPLACE),
"Can't rename %s to %"SVf": %s, skipping file",
@@
-908,7
+908,7
@@
Perl_nextargv(pTHX_ register GV *gv)
{
GV * const oldout = MUTABLE_GV(av_pop(PL_argvout_stack));
setdefout(oldout);
{
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));
return NULL;
}
setdefout(gv_fetchpvs("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO));
@@
-1199,7
+1199,7
@@
my_chsize(int fd, Off_t length)
#endif /* !HAS_TRUNCATE && !HAS_CHSIZE */
bool
#endif /* !HAS_TRUNCATE && !HAS_CHSIZE */
bool
-Perl_do_print(pTHX_
register
SV *sv, PerlIO *fp)
+Perl_do_print(pTHX_ SV *sv, PerlIO *fp)
{
dVAR;
{
dVAR;
@@
-1333,13
+1333,14
@@
I32
Perl_my_lstat_flags(pTHX_ const U32 flags)
{
dVAR;
Perl_my_lstat_flags(pTHX_ const U32 flags)
{
dVAR;
- static const char
no_prev_lstat[]
= "The stat preceding -l _ wasn't an lstat";
+ static const char
* const no_prev_lstat
= "The stat preceding -l _ wasn't an lstat";
dSP;
const char *file;
dSP;
const char *file;
+ SV* const sv = TOPs;
if (PL_op->op_flags & OPf_REF) {
if (cGVOP_gv == PL_defgv) {
if (PL_laststype != OP_LSTAT)
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;
return PL_laststatval;
}
PL_laststatval = -1;
@@
-1353,13
+1354,17
@@
Perl_my_lstat_flags(pTHX_ const U32 flags)
if ((PL_op->op_private & (OPpFT_STACKED|OPpFT_AFTER_t))
== OPpFT_STACKED) {
if (PL_laststype != OP_LSTAT)
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;
return PL_laststatval;
- }
+ }
PL_laststype = OP_LSTAT;
PL_statgv = NULL;
PL_laststype = OP_LSTAT;
PL_statgv = NULL;
- file = SvPV_flags_const_nolen(TOPs, flags);
+ if (SvROK(sv) && isGV_with_GP(SvRV(sv)) && ckWARN(WARN_IO)) {
+ Perl_warner(aTHX_ packWARN(WARN_IO), "Use of -l on filehandle %s",
+ GvENAME((const GV *)SvRV(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'))
sv_setpv(PL_statname,file);
PL_laststatval = PerlLIO_lstat(file,&PL_statcache);
if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(file, '\n'))
@@
-1382,7
+1387,7
@@
S_exec_failed(pTHX_ const char *cmd, int fd, int do_report)
}
bool
}
bool
-Perl_do_aexec5(pTHX_ SV *really,
register SV **mark, register
SV **sp,
+Perl_do_aexec5(pTHX_ SV *really,
SV **mark,
SV **sp,
int fd, int do_report)
{
dVAR;
int fd, int do_report)
{
dVAR;
@@
-1499,7
+1504,7
@@
Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
goto doshell;
s = cmd;
goto doshell;
s = cmd;
- while (is
ALNUM
(*s))
+ while (is
WORDCHAR
(*s))
s++; /* catch VAR=val gizmo */
if (*s == '=')
goto doshell;
s++; /* catch VAR=val gizmo */
if (*s == '=')
goto doshell;
@@
-1571,7
+1576,7
@@
Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
#endif
I32
#endif
I32
-Perl_apply(pTHX_ I32 type,
register SV **mark, register
SV **sp)
+Perl_apply(pTHX_ I32 type,
SV **mark,
SV **sp)
{
dVAR;
I32 val;
{
dVAR;
I32 val;
@@
-1584,6
+1589,8
@@
Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp)
PERL_ARGS_ASSERT_APPLY;
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. */
/* 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. */
@@
-1599,11
+1606,11
@@
Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp)
#define APPLY_TAINT_PROPER() \
STMT_START { \
#define APPLY_TAINT_PROPER() \
STMT_START { \
- if (
PL_tainted) { TAINT_PROPER(what); }
\
+ if (
TAINT_get) { TAINT_PROPER(what); }
\
} STMT_END
/* This is a first heuristic; it doesn't catch tainting magic. */
} STMT_END
/* This is a first heuristic; it doesn't catch tainting magic. */
- if (
PL_tainting
) {
+ if (
TAINTING_get
) {
while (++mark <= sp) {
if (SvTAINTED(*mark)) {
TAINT;
while (++mark <= sp) {
if (SvTAINTED(*mark)) {
TAINT;
@@
-1874,7
+1881,7
@@
nothing in the core.
/* Do the permissions allow some operation? Assumes statcache already set. */
#ifndef VMS /* VMS' cando is in vms.c */
bool
/* Do the permissions allow some operation? Assumes statcache already set. */
#ifndef VMS /* VMS' cando is in vms.c */
bool
-Perl_cando(pTHX_ Mode_t mode, bool effective,
register
const Stat_t *statbufp)
+Perl_cando(pTHX_ Mode_t mode, bool effective, const Stat_t *statbufp)
/* effective is a flag, true for EUID, or for checking if the effective gid
* is in the list of groups returned from getgroups().
*/
/* effective is a flag, true for EUID, or for checking if the effective gid
* is in the list of groups returned from getgroups().
*/
@@
-2155,6
+2162,7
@@
Perl_do_msgsnd(pTHX_ SV **mark, SV **sp)
PERL_UNUSED_ARG(mark);
/* diag_listed_as: msg%s not implemented */
Perl_croak(aTHX_ "msgsnd not implemented");
PERL_UNUSED_ARG(mark);
/* diag_listed_as: msg%s not implemented */
Perl_croak(aTHX_ "msgsnd not implemented");
+ return -1;
#endif
}
#endif
}
@@
-2197,6
+2205,7
@@
Perl_do_msgrcv(pTHX_ SV **mark, SV **sp)
PERL_UNUSED_ARG(mark);
/* diag_listed_as: msg%s not implemented */
Perl_croak(aTHX_ "msgrcv not implemented");
PERL_UNUSED_ARG(mark);
/* diag_listed_as: msg%s not implemented */
Perl_croak(aTHX_ "msgrcv not implemented");
+ return -1;
#endif
}
#endif
}
@@
-2313,6
+2322,7
@@
Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp)
#else
/* diag_listed_as: shm%s not implemented */
Perl_croak(aTHX_ "shm I/O not implemented");
#else
/* diag_listed_as: shm%s not implemented */
Perl_croak(aTHX_ "shm I/O not implemented");
+ return -1;
#endif
}
#endif
}