#ifdef HAS_PASSWD
# ifdef I_PWD
# include <pwd.h>
-# else
-# if !defined(VMS)
+# elif !defined(VMS)
struct passwd *getpwnam (char *);
struct passwd *getpwuid (Uid_t);
-# endif
# endif
# ifdef HAS_GETPWENT
-#ifndef getpwent
+# ifndef getpwent
struct passwd *getpwent (void);
-#elif defined (VMS) && defined (my_getpwent)
+# elif defined (VMS) && defined (my_getpwent)
struct passwd *Perl_my_getpwent (pTHX);
-#endif
+# endif
# endif
#endif
struct group *getgrgid (Gid_t);
# endif
# ifdef HAS_GETGRENT
-#ifndef getgrent
+# ifndef getgrent
struct group *getgrent (void);
-#endif
+# endif
# endif
#endif
# undef my_chsize
# endif
# define my_chsize PerlLIO_chsize
+#elif defined(HAS_TRUNCATE)
+# define my_chsize PerlLIO_chsize
#else
-# ifdef HAS_TRUNCATE
-# define my_chsize PerlLIO_chsize
-# else
I32 my_chsize(int fd, Off_t length);
-# endif
#endif
#ifdef HAS_FLOCK
# if defined(HAS_FCNTL) && defined(FCNTL_CAN_LOCK)
# define FLOCK fcntl_emulate_flock
# define FCNTL_EMULATE_FLOCK
-# else /* no flock() or fcntl(F_SETLK,...) */
-# ifdef HAS_LOCKF
-# define FLOCK lockf_emulate_flock
-# define LOCKF_EMULATE_FLOCK
-# endif /* lockf */
-# endif /* no flock() or fcntl(F_SETLK,...) */
+# elif defined(HAS_LOCKF)
+# define FLOCK lockf_emulate_flock
+# define LOCKF_EMULATE_FLOCK
+# endif
# ifdef FLOCK
static int FLOCK (int, int);
#if !defined(HAS_SETREUID) && !defined(HAS_SETRESUID)
Perl_croak(aTHX_ "switching effective uid is not implemented");
#else
-#ifdef HAS_SETREUID
+# ifdef HAS_SETREUID
if (setreuid(euid, ruid))
-#else
-#ifdef HAS_SETRESUID
+# elif defined(HAS_SETRESUID)
if (setresuid(euid, ruid, (Uid_t)-1))
-#endif
-#endif
+# endif
/* diag_listed_as: entering effective %s failed */
Perl_croak(aTHX_ "entering effective uid failed");
#endif
#if !defined(HAS_SETREGID) && !defined(HAS_SETRESGID)
Perl_croak(aTHX_ "switching effective gid is not implemented");
#else
-#ifdef HAS_SETREGID
+# ifdef HAS_SETREGID
if (setregid(egid, rgid))
-#else
-#ifdef HAS_SETRESGID
+# elif defined(HAS_SETRESGID)
if (setresgid(egid, rgid, (Gid_t)-1))
-#endif
-#endif
+# endif
/* diag_listed_as: entering effective %s failed */
Perl_croak(aTHX_ "entering effective gid failed");
#endif
#ifdef HAS_SETREUID
if (setreuid(ruid, euid))
-#else
-#ifdef HAS_SETRESUID
+#elif defined(HAS_SETRESUID)
if (setresuid(ruid, euid, (Uid_t)-1))
#endif
-#endif
/* diag_listed_as: leaving effective %s failed */
Perl_croak(aTHX_ "leaving effective uid failed");
#ifdef HAS_SETREGID
if (setregid(rgid, egid))
-#else
-#ifdef HAS_SETRESGID
+#elif defined(HAS_SETRESGID)
if (setresgid(rgid, egid, (Gid_t)-1))
#endif
-#endif
/* diag_listed_as: leaving effective %s failed */
Perl_croak(aTHX_ "leaving effective gid failed");
if (ok)
PUSHi( (I32)PL_forkprocess );
else if (PL_forkprocess == 0) /* we are a new child */
- PUSHi(0);
+ PUSHs(&PL_sv_zero);
else
RETPUSHUNDEF;
RETURN;
PP(pp_close)
{
dSP;
+ /* pp_coreargs pushes a NULL to indicate no args passed to
+ * CORE::close() */
GV * const gv =
MAXARG == 0 || (!TOPs && !POPs) ? PL_defoutgv : MUTABLE_GV(POPs);
if ((mg = SvTIED_mg(sv, how))) {
SV * const obj = SvRV(SvTIED_obj(sv, mg));
- if (obj) {
+ if (obj && SvSTASH(obj)) {
GV * const gv = gv_fetchmethod_autoload(SvSTASH(obj), "UNTIE", FALSE);
CV *cv;
if (gv && isGV(gv) && (cv = GvCV(gv))) {
struct timeval *tbuf = &timebuf;
I32 growsize;
char *fd_sets[4];
+ SV *svs[4];
#if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
I32 masksize;
I32 offset;
SP -= 4;
for (i = 1; i <= 3; i++) {
- SV * const sv = SP[i];
+ SV * const sv = svs[i] = SP[i];
SvGETMAGIC(sv);
if (!SvOK(sv))
continue;
if (!SvPOKp(sv))
Perl_ck_warner(aTHX_ packWARN(WARN_MISC),
"Non-string passed as bitmask");
- SvPV_force_nomg_nolen(sv); /* force string conversion */
+ if (SvGAMAGIC(sv)) {
+ svs[i] = sv_newmortal();
+ sv_copypv_nomg(svs[i], sv);
+ }
+ else
+ SvPV_force_nomg_nolen(sv); /* force string conversion */
}
- j = SvCUR(sv);
+ j = SvCUR(svs[i]);
if (maxlen < j)
maxlen = j;
}
tbuf = NULL;
for (i = 1; i <= 3; i++) {
- sv = SP[i];
+ sv = svs[i];
if (!SvOK(sv) || SvCUR(sv) == 0) {
fd_sets[i] = 0;
continue;
#endif
for (i = 1; i <= 3; i++) {
if (fd_sets[i]) {
- sv = SP[i];
+ sv = svs[i];
#if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
s = SvPVX(sv);
for (offset = 0; offset < growsize; offset += masksize) {
}
Safefree(fd_sets[i]);
#endif
- SvSETMAGIC(sv);
+ if (sv != SP[i])
+ SvSetMagicSV(SP[i], sv);
+ else
+ SvSETMAGIC(sv);
}
}
PP(pp_getc)
{
dSP; dTARGET;
+ /* pp_coreargs pushes a NULL to indicate no args passed to
+ * CORE::getc() */
GV * const gv =
MAXARG==0 || (!TOPs && !POPs) ? PL_stdingv : MUTABLE_GV(POPs);
IO *const io = GvIO(gv);
else
#ifndef HAS_FCNTL
DIE(aTHX_ "fcntl is not implemented");
-#else
-#if defined(OS2) && defined(__EMX__)
+#elif defined(OS2) && defined(__EMX__)
retval = fcntl(PerlIO_fileno(IoIFP(io)), func, (int)s);
#else
retval = fcntl(PerlIO_fileno(IoIFP(io)), func, s);
#endif
-#endif
#if defined(HAS_IOCTL) || defined(HAS_FCNTL)
if (SvPOK(argsv)) {
}
else {
const char *file;
+ const char *temp;
+ STRLEN len;
if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVIO) {
io = MUTABLE_IO(SvRV(sv));
if (PL_op->op_type == OP_LSTAT)
goto do_fstat_warning_check;
goto do_fstat_have_io;
}
-
SvTAINTED_off(PL_statname); /* previous tainting irrelevant */
- sv_setpv(PL_statname, SvPV_nomg_const_nolen(sv));
+ temp = SvPV_nomg_const(sv, len);
+ sv_setpv(PL_statname, temp);
PL_statgv = NULL;
PL_laststype = PL_op->op_type;
file = SvPV_nolen_const(PL_statname);
- if (PL_op->op_type == OP_LSTAT)
+ if (!IS_SAFE_PATHNAME(temp, len, OP_NAME(PL_op))) {
+ PL_laststatval = -1;
+ }
+ else if (PL_op->op_type == OP_LSTAT)
PL_laststatval = PerlLIO_lstat(file, &PL_statcache);
else
PL_laststatval = PerlLIO_stat(file, &PL_statcache);
mPUSHi(PL_statcache.st_dev);
#if ST_INO_SIZE > IVSIZE
mPUSHn(PL_statcache.st_ino);
-#else
-# if ST_INO_SIGN <= 0
+#elif ST_INO_SIGN <= 0
mPUSHi(PL_statcache.st_ino);
-# else
+#else
mPUSHu(PL_statcache.st_ino);
-# endif
#endif
mPUSHu(PL_statcache.st_mode);
mPUSHu(PL_statcache.st_nlink);
if (use_access) {
#if defined(HAS_ACCESS) || defined (PERL_EFF_ACCESS)
- const char *name = SvPV_nolen(*PL_stack_sp);
- if (effective) {
+ STRLEN len;
+ const char *name = SvPV(*PL_stack_sp, len);
+ if (!IS_SAFE_PATHNAME(name, len, OP_NAME(PL_op))) {
+ result = -1;
+ }
+ else if (effective) {
# ifdef PERL_EFF_ACCESS
result = PERL_EFF_ACCESS(name, access_mode);
# else
break;
}
SvSETMAGIC(TARG);
- return SvTRUE_nomg(TARG)
+ return SvTRUE_nomg_NN(TARG)
? S_ft_return_true(aTHX_ TARG) : S_ft_return_false(aTHX_ TARG);
}
}
}
else {
const char *file;
+ const char *temp;
+ STRLEN temp_len;
int fd;
assert(sv);
- sv_setpv(PL_statname, SvPV_nomg_const_nolen(sv));
+ temp = SvPV_nomg_const(sv, temp_len);
+ sv_setpv(PL_statname, temp);
+ if (!IS_SAFE_PATHNAME(temp, temp_len, OP_NAME(PL_op))) {
+ PL_laststatval = -1;
+ PL_laststype = OP_STAT;
+ FT_RETURNUNDEF;
+ }
really_filename:
file = SvPVX_const(PL_statname);
PL_statgv = NULL;
"chdir() on unopened filehandle %" SVf, sv);
}
SETERRNO(EBADF,RMS_IFI);
- PUSHi(0);
+ PUSHs(&PL_sv_zero);
TAINT_PROPER("chdir");
RETURN;
}
tmps = SvPV_nolen_const(*svp);
}
else {
- PUSHi(0);
+ PUSHs(&PL_sv_zero);
SETERRNO(EINVAL, LIB_INVARG);
TAINT_PROPER("chdir");
RETURN;
nuts:
report_evil_fh(gv);
SETERRNO(EBADF,RMS_IFI);
- PUSHi(0);
+ PUSHs(&PL_sv_zero);
RETURN;
#endif
}
const char * const tmps = SvPV_nolen_const(TOPs);
TAINT_PROPER(PL_op_desc[op_type]);
result =
-# if defined(HAS_LINK)
-# if defined(HAS_SYMLINK)
+# if defined(HAS_LINK) && defined(HAS_SYMLINK)
/* Both present - need to choose which. */
(op_type == OP_LINK) ?
PerlLIO_link(tmps, tmps2) : symlink(tmps, tmps2);
-# else
+# elif defined(HAS_LINK)
/* Only have link, so calls to pp_symlink will have DIE()d above. */
PerlLIO_link(tmps, tmps2);
-# endif
-# else
-# if defined(HAS_SYMLINK)
+# elif defined(HAS_SYMLINK)
/* Only have symlink, so calls to pp_link will have DIE()d above. */
symlink(tmps, tmps2);
-# endif
# endif
}
}
PUSHi(childpid);
RETURN;
-#else
-# if (defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)) || defined(__amigaos4__)
+#elif (defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)) || defined(__amigaos4__)
dSP; dTARGET;
Pid_t childpid;
RETPUSHUNDEF;
PUSHi(childpid);
RETURN;
-# else
+#else
DIE(aTHX_ PL_no_func, "fork");
-# endif
#endif
}
mPUSHn(((NV)timesbuf.tms_cstime)/(NV)PL_clocktick);
}
RETURN;
-#else
-# ifdef PERL_MICRO
+#elif defined(PERL_MICRO)
dSP;
mPUSHn(0.0);
EXTEND(SP, 4);
mPUSHn(0.0);
}
RETURN;
-# else
+#else
DIE(aTHX_ "times not implemented");
-# endif
#endif /* HAS_TIMES */
}
Perl_ck_warner_d(aTHX_ packWARN(WARN_MISC),
"sleep() with negative argument");
SETERRNO(EINVAL, LIB_INVARG);
- XPUSHi(0);
+ XPUSHs(&PL_sv_zero);
RETURN;
} else {
PerlProc_sleep((unsigned int)duration);
* but we are accursed by our history, alas. --jhi. */
# ifdef PWCHANGE
mPUSHi(pwent->pw_change);
-# else
-# ifdef PWQUOTA
+# elif defined(PWQUOTA)
mPUSHi(pwent->pw_quota);
-# else
-# ifdef PWAGE
+# elif defined(PWAGE)
mPUSHs(newSVpv(pwent->pw_age, 0));
-# else
+# else
/* I think that you can never get this compiled, but just in case. */
PUSHs(sv_mortalcopy(&PL_sv_no));
-# endif
-# endif
# endif
/* pw_class and pw_comment are mutually exclusive--.
* see the above note for pw_change, pw_quota, and pw_age. */
# ifdef PWCLASS
mPUSHs(newSVpv(pwent->pw_class, 0));
-# else
-# ifdef PWCOMMENT
+# elif defined(PWCOMMENT)
mPUSHs(newSVpv(pwent->pw_comment, 0));
-# else
+# else
/* I think that you can never get this compiled, but just in case. */
PUSHs(sv_mortalcopy(&PL_sv_no));
-# endif
# endif
# ifdef PWGECOS
https://perl5.git.perl.org / perl5.git / blobdiff