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
Apply #30197 to win32/makefile.mk too
[perl5.git]
/
pp_sys.c
diff --git
a/pp_sys.c
b/pp_sys.c
index
cdc9385
..
44adca6
100644
(file)
--- a/
pp_sys.c
+++ b/
pp_sys.c
@@
-1,7
+1,7
@@
/* pp_sys.c
*
/* pp_sys.c
*
- * Copyright (C) 1995, 1996, 1997, 1998, 1999,
- * 200
0, 2001, 2002, 2003, 2004, 2005, 2006,
by Larry Wall and others
+ * Copyright (C) 1995, 1996, 1997, 1998, 1999,
2000, 2001, 2002, 2003,
+ * 200
4, 2005, 2006, 2007
by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
@@
-453,7
+453,7
@@
PP(pp_warn)
if (!tmps || !len)
tmpsv = sv_2mortal(newSVpvs("Warning: something's wrong"));
if (!tmps || !len)
tmpsv = sv_2mortal(newSVpvs("Warning: something's wrong"));
- Perl_warn(aTHX_ "%"SVf,
(void*)tmpsv
);
+ Perl_warn(aTHX_ "%"SVf,
SVfARG(tmpsv)
);
RETSETYES;
}
RETSETYES;
}
@@
-517,7
+517,7
@@
PP(pp_die)
if (!tmps || !len)
tmpsv = sv_2mortal(newSVpvs("Died"));
if (!tmps || !len)
tmpsv = sv_2mortal(newSVpvs("Died"));
- DIE(aTHX_ "%"SVf,
(void*)tmpsv
);
+ DIE(aTHX_ "%"SVf,
SVfARG(tmpsv)
);
}
/* I/O. */
}
/* I/O. */
@@
-707,8
+707,12
@@
PP(pp_umask)
Mode_t anum;
if (MAXARG < 1) {
Mode_t anum;
if (MAXARG < 1) {
- anum = PerlLIO_umask(0);
- (void)PerlLIO_umask(anum);
+ anum = PerlLIO_umask(022);
+ /* setting it to 022 between the two calls to umask avoids
+ * to have a window where the umask is set to 0 -- meaning
+ * that another thread could create world-writeable files. */
+ if (anum != 022)
+ (void)PerlLIO_umask(anum);
}
else
anum = PerlLIO_umask(POPi);
}
else
anum = PerlLIO_umask(POPi);
@@
-840,10
+844,10
@@
PP(pp_tie)
/* Not clear why we don't call call_method here too.
* perhaps to get different error message ?
*/
/* Not clear why we don't call call_method here too.
* perhaps to get different error message ?
*/
- stash = gv_stashsv(*MARK,
FALSE
);
+ stash = gv_stashsv(*MARK,
0
);
if (!stash || !(gv = gv_fetchmethod(stash, methname))) {
DIE(aTHX_ "Can't locate object method \"%s\" via package \"%"SVf"\"",
if (!stash || !(gv = gv_fetchmethod(stash, methname))) {
DIE(aTHX_ "Can't locate object method \"%s\" via package \"%"SVf"\"",
- methname,
(void*)*MARK
);
+ methname,
SVfARG(*MARK)
);
}
ENTER;
PUSHSTACKi(PERLSI_MAGIC);
}
ENTER;
PUSHSTACKi(PERLSI_MAGIC);
@@
-942,7
+946,7
@@
PP(pp_dbmopen)
HV * const hv = (HV*)POPs;
SV * const sv = sv_2mortal(newSVpvs("AnyDBM_File"));
HV * const hv = (HV*)POPs;
SV * const sv = sv_2mortal(newSVpvs("AnyDBM_File"));
- stash = gv_stashsv(sv,
FALSE
);
+ stash = gv_stashsv(sv,
0
);
if (!stash || !(gv = gv_fetchmethod(stash, "TIEHASH"))) {
PUTBACK;
require_pv("AnyDBM_File.pm");
if (!stash || !(gv = gv_fetchmethod(stash, "TIEHASH"))) {
PUTBACK;
require_pv("AnyDBM_File.pm");
@@
-1485,6
+1489,8
@@
PP(pp_prtf)
goto just_say_no;
}
else {
goto just_say_no;
}
else {
+ if (SvTAINTED(MARK[1]))
+ TAINT_PROPER("printf");
do_sprintf(sv, SP - MARK, MARK + 1);
if (!do_print(sv, fp))
goto just_say_no;
do_sprintf(sv, SP - MARK, MARK + 1);
if (!do_print(sv, fp))
goto just_say_no;
@@
-1827,10
+1833,14
@@
PP(pp_send)
SETERRNO(0,0);
io = GvIO(gv);
SETERRNO(0,0);
io = GvIO(gv);
- if (!io || !IoIFP(io)) {
+ if (!io || !IoIFP(io)
|| IoTYPE(io) == IoTYPE_RDONLY
) {
retval = -1;
retval = -1;
- if (ckWARN(WARN_CLOSED))
- report_evil_fh(gv, io, PL_op->op_type);
+ if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) {
+ if (io && IoIFP(io))
+ report_evil_fh(gv, io, OP_phoney_INPUT_ONLY);
+ else
+ report_evil_fh(gv, io, PL_op->op_type);
+ }
SETERRNO(EBADF,RMS_IFI);
goto say_undef;
}
SETERRNO(EBADF,RMS_IFI);
goto say_undef;
}
@@
-2908,9
+2918,9
@@
PP(pp_stat)
PUSHs(sv_2mortal(newSVnv(PL_statcache.st_mtime)));
PUSHs(sv_2mortal(newSVnv(PL_statcache.st_ctime)));
#else
PUSHs(sv_2mortal(newSVnv(PL_statcache.st_mtime)));
PUSHs(sv_2mortal(newSVnv(PL_statcache.st_ctime)));
#else
- PUSHs(sv_2mortal(newSViv(PL_statcache.st_atime)));
- PUSHs(sv_2mortal(newSViv(PL_statcache.st_mtime)));
- PUSHs(sv_2mortal(newSViv(PL_statcache.st_ctime)));
+ PUSHs(sv_2mortal(newSViv(
(IV)
PL_statcache.st_atime)));
+ PUSHs(sv_2mortal(newSViv(
(IV)
PL_statcache.st_mtime)));
+ PUSHs(sv_2mortal(newSViv(
(IV)
PL_statcache.st_ctime)));
#endif
#ifdef USE_STAT_BLOCKS
PUSHs(sv_2mortal(newSVuv(PL_statcache.st_blksize)));
#endif
#ifdef USE_STAT_BLOCKS
PUSHs(sv_2mortal(newSVuv(PL_statcache.st_blksize)));
@@
-3011,7
+3021,7
@@
PP(pp_ftrread)
if (use_access) {
#if defined(HAS_ACCESS) || defined (PERL_EFF_ACCESS)
if (use_access) {
#if defined(HAS_ACCESS) || defined (PERL_EFF_ACCESS)
- const char *
const
name = POPpx;
+ const char *name = POPpx;
if (effective) {
# ifdef PERL_EFF_ACCESS
result = PERL_EFF_ACCESS(name, access_mode);
if (effective) {
# ifdef PERL_EFF_ACCESS
result = PERL_EFF_ACCESS(name, access_mode);