STRLEN n_a;
char *tmps = POPpx;
I32 gimme = GIMME_V;
+ char *mode = "r";
TAINT_PROPER("``");
- fp = PerlProc_popen(tmps, "r");
+ if (PL_op->op_private & OPpOPEN_IN_RAW)
+ mode = "rb";
+ else if (PL_op->op_private & OPpOPEN_IN_CRLF)
+ mode = "rt";
+ fp = PerlProc_popen(tmps, mode);
if (fp) {
if (gimme == G_VOID) {
char tmpbuf[256];
GV *gv = gv_fetchmethod(stash, "PROPAGATE");
if (gv) {
SV *file = sv_2mortal(newSVpv(CopFILE(PL_curcop),0));
- SV *line = sv_2mortal(newSViv(CopLINE(PL_curcop)));
+ SV *line = sv_2mortal(newSVuv(CopLINE(PL_curcop)));
EXTEND(SP, 3);
PUSHMARK(SP);
PUSHs(error);
IO *io;
PerlIO *fp;
MAGIC *mg;
+ SV *discp = Nullsv;
if (MAXARG < 1)
RETPUSHUNDEF;
+ if (MAXARG > 1)
+ discp = POPs;
gv = (GV*)POPs;
if (gv && (mg = SvTIED_mg((SV*)gv, 'q'))) {
PUSHMARK(SP);
XPUSHs(SvTIED_obj((SV*)gv, mg));
+ if (discp)
+ XPUSHs(discp);
PUTBACK;
ENTER;
call_method("BINMODE", G_SCALAR);
if (!(io = GvIO(gv)) || !(fp = IoIFP(io)))
RETPUSHUNDEF;
- if (do_binmode(fp,IoTYPE(io),TRUE))
+ if (do_binmode(fp,IoTYPE(io),mode_from_discipline(discp)))
RETPUSHYES;
else
RETPUSHUNDEF;
}
-
PP(pp_tie)
{
djSP;
PUSHs(sv);
PUSHs(left);
if (SvIV(right))
- PUSHs(sv_2mortal(newSViv(O_RDWR|O_CREAT)));
+ PUSHs(sv_2mortal(newSVuv(O_RDWR|O_CREAT)));
else
- PUSHs(sv_2mortal(newSViv(O_RDWR)));
+ PUSHs(sv_2mortal(newSVuv(O_RDWR)));
PUSHs(right);
PUTBACK;
call_sv((SV*)GvCV(gv), G_SCALAR);
PUSHMARK(SP);
PUSHs(sv);
PUSHs(left);
- PUSHs(sv_2mortal(newSViv(O_RDONLY)));
+ PUSHs(sv_2mortal(newSVuv(O_RDONLY)));
PUSHs(right);
PUTBACK;
call_sv((SV*)GvCV(gv), G_SCALAR);
djSP; dMARK; dORIGMARK; dTARGET;
GV *gv;
IO *io;
- Off_t offset;
SV *bufsv;
char *buffer;
- Off_t length;
+ Size_t length;
+ SSize_t retval;
+ IV offset;
STRLEN blen;
MAGIC *mg;
goto say_undef;
bufsv = *++MARK;
buffer = SvPV(bufsv, blen);
-#if Off_t_SIZE > IVSIZE
- length = SvNVx(*++MARK);
+#if Size_t_size > IVSIZE
+ length = (Size_t)SvNVx(*++MARK);
#else
- length = SvIVx(*++MARK);
+ length = (Size_t)SvIVx(*++MARK);
#endif
- if (length < 0)
+ if ((SSize_t)length < 0)
DIE(aTHX_ "Negative length");
SETERRNO(0,0);
io = GvIO(gv);
if (!io || !IoIFP(io)) {
- length = -1;
+ retval = -1;
if (ckWARN(WARN_CLOSED)) {
if (PL_op->op_type == OP_SYSWRITE)
report_closed_fh(gv, io, "syswrite", "filehandle");
}
else if (PL_op->op_type == OP_SYSWRITE) {
if (MARK < SP) {
-#if Off_t_SIZE > IVSIZE
- offset = SvNVx(*++MARK);
-#else
offset = SvIVx(*++MARK);
-#endif
if (offset < 0) {
if (-offset > blen)
DIE(aTHX_ "Offset outside string");
length = blen - offset;
#ifdef PERL_SOCK_SYSWRITE_IS_SEND
if (IoTYPE(io) == 's') {
- length = PerlSock_send(PerlIO_fileno(IoIFP(io)),
+ retval = PerlSock_send(PerlIO_fileno(IoIFP(io)),
buffer+offset, length, 0);
}
else
#endif
{
/* See the note at doio.c:do_print about filesize limits. --jhi */
- length = PerlLIO_write(PerlIO_fileno(IoIFP(io)),
+ retval = PerlLIO_write(PerlIO_fileno(IoIFP(io)),
buffer+offset, length);
}
}
char *sockbuf;
STRLEN mlen;
sockbuf = SvPVx(*++MARK, mlen);
- length = PerlSock_sendto(PerlIO_fileno(IoIFP(io)), buffer, blen, length,
- (struct sockaddr *)sockbuf, mlen);
+ retval = PerlSock_sendto(PerlIO_fileno(IoIFP(io)), buffer, blen,
+ length, (struct sockaddr *)sockbuf, mlen);
}
else
- length = PerlSock_send(PerlIO_fileno(IoIFP(io)), buffer, blen, length);
+ retval = PerlSock_send(PerlIO_fileno(IoIFP(io)), buffer, blen, length);
#else
else
DIE(aTHX_ PL_no_sock_func, "send");
#endif
- if (length < 0)
+ if (retval < 0)
goto say_undef;
SP = ORIGMARK;
- PUSHi(length);
+#if Size_t_size > IVSIZE
+ PUSHn(retval);
+#else
+ PUSHi(retval);
+#endif
RETURN;
say_undef:
#if LSEEKSIZE > IVSIZE
XPUSHs(sv_2mortal(newSVnv((NV) offset)));
#else
- XPUSHs(sv_2mortal(newSViv((IV) offset)));
+ XPUSHs(sv_2mortal(newSViv(offset)));
#endif
- XPUSHs(sv_2mortal(newSViv((IV) whence)));
+ XPUSHs(sv_2mortal(newSViv(whence)));
PUTBACK;
ENTER;
call_method("SEEK", G_SCALAR);
if (PL_op->op_type == OP_SEEK)
PUSHs(boolSV(do_seek(gv, offset, whence)));
else {
- Off_t n = do_sysseek(gv, offset, whence);
- if (n < 0)
+ Off_t sought = do_sysseek(gv, offset, whence);
+ if (sought < 0)
PUSHs(&PL_sv_undef);
else {
- SV* sv = n ?
+ SV* sv = sought ?
#if LSEEKSIZE > IVSIZE
- newSVnv((NV)n)
+ newSVnv((NV)sought)
#else
- newSViv((IV)n)
+ newSViv(sought)
#endif
: newSVpvn(zero_but_true, ZBTLEN);
PUSHs(sv_2mortal(sv));
PP(pp_truncate)
{
djSP;
- Off_t len = (Off_t)POPn;
+ /* There seems to be no consensus on the length type of truncate()
+ * and ftruncate(), both off_t and size_t have supporters. In
+ * general one would think that when using large files, off_t is
+ * at least as wide as size_t, so using an off_t should be okay. */
+ /* XXX Configure probe for the length type of *truncate() needed XXX */
+ Off_t len;
int result = 1;
GV *tmpgv;
STRLEN n_a;
+#if Size_t_size > IVSIZE
+ len = (Off_t)POPn;
+#else
+ len = (Off_t)POPi;
+#endif
+ /* Checking for length < 0 is problematic as the type might or
+ * might not be signed: if it is not, clever compilers will moan. */
+ /* XXX Configure probe for the signedness of the length type of *truncate() needed? XXX */
SETERRNO(0,0);
#if defined(HAS_TRUNCATE) || defined(HAS_CHSIZE) || defined(F_FREESP)
if (PL_op->op_flags & OPf_SPECIAL) {
EXTEND_MORTAL(max);
PUSHs(sv_2mortal(newSViv(PL_statcache.st_dev)));
PUSHs(sv_2mortal(newSViv(PL_statcache.st_ino)));
- PUSHs(sv_2mortal(newSViv(PL_statcache.st_mode)));
- PUSHs(sv_2mortal(newSViv(PL_statcache.st_nlink)));
+ PUSHs(sv_2mortal(newSVuv(PL_statcache.st_mode)));
+ PUSHs(sv_2mortal(newSVuv(PL_statcache.st_nlink)));
#if Uid_t_size > IVSIZE
PUSHs(sv_2mortal(newSVnv(PL_statcache.st_uid)));
#else
+# if Uid_t_sign <= 0
PUSHs(sv_2mortal(newSViv(PL_statcache.st_uid)));
+# else
+ PUSHs(sv_2mortal(newSVuv(PL_statcache.st_uid)));
+# endif
#endif
#if Gid_t_size > IVSIZE
PUSHs(sv_2mortal(newSVnv(PL_statcache.st_gid)));
#else
+# if Gid_t_sign <= 0
PUSHs(sv_2mortal(newSViv(PL_statcache.st_gid)));
+# else
+ PUSHs(sv_2mortal(newSVuv(PL_statcache.st_gid)));
+# endif
#endif
#ifdef USE_STAT_RDEV
PUSHs(sv_2mortal(newSViv(PL_statcache.st_rdev)));
PUSHs(sv_2mortal(newSViv(PL_statcache.st_ctime)));
#endif
#ifdef USE_STAT_BLOCKS
- PUSHs(sv_2mortal(newSViv(PL_statcache.st_blksize)));
- PUSHs(sv_2mortal(newSViv(PL_statcache.st_blocks)));
+ PUSHs(sv_2mortal(newSVuv(PL_statcache.st_blksize)));
+ PUSHs(sv_2mortal(newSVuv(PL_statcache.st_blocks)));
#else
PUSHs(sv_2mortal(newSVpvn("", 0)));
PUSHs(sv_2mortal(newSVpvn("", 0)));
(void)PerlIO_close(fp);
RETPUSHUNDEF;
}
- do_binmode(fp, '<', TRUE);
+ do_binmode(fp, '<', O_BINARY);
len = PerlIO_read(fp, tbuf, sizeof(tbuf));
(void)PerlIO_close(fp);
if (len <= 0) {
PUSHs(sv = sv_newmortal());
if (pwent) {
if (which == OP_GPWNAM)
+#if Uid_t_sign <= 0
sv_setiv(sv, (IV)pwent->pw_uid);
+#else
+ sv_setuv(sv, (UV)pwent->pw_uid);
+#endif
else
sv_setpv(sv, pwent->pw_name);
}
sv_setpv(sv, pwent->pw_passwd);
# endif
#endif
+#ifndef INCOMPLETE_TAINTS
+ /* passwd is tainted because user himself can diddle with it. */
+ SvTAINTED_on(sv);
+#endif
PUSHs(sv = sv_mortalcopy(&PL_sv_no));
+#if Uid_t_sign <= 0
sv_setiv(sv, (IV)pwent->pw_uid);
+#else
+ sv_setuv(sv, (UV)pwent->pw_uid);
+#endif
PUSHs(sv = sv_mortalcopy(&PL_sv_no));
+#if Uid_t_sign <= 0
sv_setiv(sv, (IV)pwent->pw_gid);
-
+#else
+ sv_setuv(sv, (UV)pwent->pw_gid);
+#endif
/* pw_change, pw_quota, and pw_age are mutually exclusive. */
PUSHs(sv = sv_mortalcopy(&PL_sv_no));
#ifdef PWCHANGE
PUSHs(sv = sv_mortalcopy(&PL_sv_no));
sv_setpv(sv, pwent->pw_shell);
+#ifndef INCOMPLETE_TAINTS
+ /* pw_shell is tainted because user himself can diddle with it. */
+ SvTAINTED_on(sv);
+#endif
#ifdef PWEXPIRE
PUSHs(sv = sv_mortalcopy(&PL_sv_no));
https://perl5.git.perl.org / perl5.git / blobdiff