/* Put this after #includes because <unistd.h> defines _XOPEN_*. */
#ifndef Sock_size_t
-# if _XOPEN_VERSION >= 5 || defined(_XOPEN_SOURCE_EXTENDED)
+# if _XOPEN_VERSION >= 5 || defined(_XOPEN_SOURCE_EXTENDED) || defined(__GLIBC__)
# define Sock_size_t Size_t
# else
# define Sock_size_t int
#endif /* no flock() */
+#ifndef MAXPATHLEN
+# ifdef PATH_MAX
+# define MAXPATHLEN PATH_MAX
+# else
+# define MAXPATHLEN 1024
+# endif
+#endif
+
+#define ZBTLEN 10
+static char zero_but_true[ZBTLEN + 1] = "0 but true";
/* Pushy I/O. */
fp = my_popen(tmps, "r");
if (fp) {
if (gimme == G_VOID) {
- while (PerlIO_read(fp, buf, sizeof buf) > 0)
+ while (PerlIO_read(fp, tokenbuf, sizeof tokenbuf) > 0)
/*SUPPRESS 530*/
;
}
OP *result;
ENTER;
+#ifndef VMS
+ if (tainting) {
+ /*
+ * The external globbing program may use things we can't control,
+ * so for security reasons we must assume the worst.
+ */
+ TAINT;
+ taint_proper(no_security, "glob");
+ }
+#endif /* !VMS */
+
SAVESPTR(last_in_gv); /* We don't want this to be permanent. */
last_in_gv = (GV*)*stack_sp--;
CATCH_SET(TRUE);
ENTER;
- SAVESPTR(op);
+ SAVEOP();
op = (OP *) &myop;
if (perldb && curstash != debstash)
op->op_private |= OPpENTERSUB_DB;
XPUSHs((SV*)GvCV(gv));
PUTBACK;
- if (op = pp_entersub())
+ if (op = pp_entersub(ARGS))
runops();
SPAGAIN;
CATCH_SET(TRUE);
ENTER;
- SAVESPTR(op);
+ SAVEOP();
op = (OP *) &myop;
if (perldb && curstash != debstash)
op->op_private |= OPpENTERSUB_DB;
PUTBACK;
- pp_pushmark();
+ pp_pushmark(ARGS);
EXTEND(sp, 5);
PUSHs(sv);
PUSHs((SV*)GvCV(gv));
PUTBACK;
- if (op = pp_entersub())
+ if (op = pp_entersub(ARGS))
runops();
SPAGAIN;
sp--;
op = (OP *) &myop;
PUTBACK;
- pp_pushmark();
+ pp_pushmark(ARGS);
PUSHs(sv);
PUSHs(left);
PUSHs((SV*)GvCV(gv));
PUTBACK;
- if (op = pp_entersub())
+ if (op = pp_entersub(ARGS))
runops();
SPAGAIN;
}
setdefout(gv)
GV *gv;
{
+ dTHR;
if (gv)
(void)SvREFCNT_inc(gv);
if (defoutgv)
GV *gv;
OP *retop;
{
+ dTHR;
register CONTEXT *cx;
I32 gimme = GIMME_V;
AV* padlist = CvPADLIST(cv);
CV *cv;
if (!IoTOP_GV(io)) {
GV *topgv;
- char tmpbuf[256];
+ SV *topname;
if (!IoTOP_NAME(io)) {
if (!IoFMT_NAME(io))
IoFMT_NAME(io) = savepv(GvNAME(gv));
- sprintf(tmpbuf, "%s_TOP", IoFMT_NAME(io));
- topgv = gv_fetchpv(tmpbuf,FALSE, SVt_PVFM);
+ topname = sv_2mortal(newSVpvf("%s_TOP", IoFMT_NAME(io)));
+ topgv = gv_fetchpv(SvPVX(topname), FALSE, SVt_PVFM);
if ((topgv && GvFORM(topgv)) ||
!gv_fetchpv("top",FALSE,SVt_PVFM))
- IoTOP_NAME(io) = savepv(tmpbuf);
+ IoTOP_NAME(io) = savepv(SvPVX(topname));
else
IoTOP_NAME(io) = savepv("top");
}
GV *gv;
IO *io;
PerlIO *fp;
- SV *sv = NEWSV(0,0);
+ SV *sv;
+ MAGIC *mg;
if (op->op_flags & OPf_STACKED)
gv = (GV*)*++MARK;
else
gv = defoutgv;
+
+ if (SvMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) {
+ if (MARK == ORIGMARK) {
+ EXTEND(SP, 1);
+ ++MARK;
+ Move(MARK, MARK + 1, (SP - MARK) + 1, SV*);
+ ++SP;
+ }
+ PUSHMARK(MARK - 1);
+ *MARK = mg->mg_obj;
+ PUTBACK;
+ ENTER;
+ perl_call_method("PRINTF", G_SCALAR);
+ LEAVE;
+ SPAGAIN;
+ MARK = ORIGMARK + 1;
+ *MARK = *SP;
+ SP = MARK;
+ RETURN;
+ }
+
+ sv = NEWSV(0,0);
if (!(io = GvIO(gv))) {
if (dowarn) {
gv_fullname3(sv, gv, Nullch);
GV *gv;
IO *io;
char *buffer;
- int length;
+ SSize_t length;
Sock_size_t bufsize;
SV *bufsv;
STRLEN blen;
MAGIC *mg;
gv = (GV*)*++MARK;
- if (SvMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) {
+ if ((op->op_type == OP_READ || op->op_type == OP_SYSREAD) &&
+ SvMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q')))
+ {
SV *sv;
PUSHMARK(MARK-1);
goto say_undef;
#ifdef HAS_SOCKET
if (op->op_type == OP_RECV) {
- bufsize = sizeof buf;
+ char namebuf[MAXPATHLEN];
+ bufsize = sizeof namebuf;
buffer = SvGROW(bufsv, length+1);
/* 'offset' means 'flags' here */
length = recvfrom(PerlIO_fileno(IoIFP(io)), buffer, length, offset,
- (struct sockaddr *)buf, &bufsize);
+ (struct sockaddr *)namebuf, &bufsize);
if (length < 0)
RETPUSHUNDEF;
SvCUR_set(bufsv, length);
if (!(IoFLAGS(io) & IOf_UNTAINT))
SvTAINTED_on(bufsv);
SP = ORIGMARK;
- sv_setpvn(TARG, buf, bufsize);
+ sv_setpvn(TARG, namebuf, bufsize);
PUSHs(TARG);
RETURN;
}
else
#ifdef HAS_SOCKET__bad_code_maybe
if (IoTYPE(io) == 's') {
- bufsize = sizeof buf;
+ char namebuf[MAXPATHLEN];
+ bufsize = sizeof namebuf;
length = recvfrom(PerlIO_fileno(IoIFP(io)), buffer+offset, length, 0,
- (struct sockaddr *)buf, &bufsize);
+ (struct sockaddr *)namebuf, &bufsize);
}
else
#endif
PP(pp_seek)
{
+ return pp_sysseek(ARGS);
+}
+
+PP(pp_sysseek)
+{
dSP;
GV *gv;
int whence = POPi;
long offset = POPl;
gv = last_in_gv = (GV*)POPs;
- PUSHs(boolSV(do_seek(gv, offset, whence)));
+ if (op->op_type == OP_SEEK)
+ PUSHs(boolSV(do_seek(gv, offset, whence)));
+ else {
+ long n = do_sysseek(gv, offset, whence);
+ PUSHs((n < 0) ? &sv_undef
+ : sv_2mortal(n ? newSViv((IV)n)
+ : newSVpv(zero_but_true, ZBTLEN)));
+ }
RETURN;
}
unsigned int func = U_I(POPn);
int optype = op->op_type;
char *s;
- int retval;
+ IV retval;
GV *gv = (GV*)POPs;
IO *io = GvIOn(gv);
if (SvPOK(argsv) || !SvNIOK(argsv)) {
STRLEN len;
+ STRLEN need;
s = SvPV_force(argsv, len);
- retval = IOCPARM_LEN(func);
- if (len < retval) {
- s = Sv_Grow(argsv, retval+1);
- SvCUR_set(argsv, retval);
+ need = IOCPARM_LEN(func);
+ if (len < need) {
+ s = Sv_Grow(argsv, need + 1);
+ SvCUR_set(argsv, need);
}
s[SvCUR(argsv)] = 17; /* a little sanity check here */
}
else {
retval = SvIV(argsv);
-#ifdef DOSISH
- s = (char*)(long)retval; /* ouch */
-#else
s = (char*)retval; /* ouch */
-#endif
}
TAINT_PROPER(optype == OP_IOCTL ? "ioctl" : "fcntl");
PUSHi(retval);
}
else {
- PUSHp("0 but true", 10);
+ PUSHp(zero_but_true, ZBTLEN);
}
RETURN;
}
dSP; dTARGET;
#ifdef HAS_SYMLINK
char *tmps;
+ char buf[MAXPATHLEN];
int len;
+
tmps = POPp;
len = readlink(tmps, buf, sizeof buf);
EXTEND(SP, 1);
TAINT_PROPER("mkdir");
#ifdef HAS_MKDIR
- SETi( mkdir(tmps, mode) >= 0 );
+ SETi( Mkdir(tmps, mode) >= 0 );
#else
SETi( dooneliner("mkdir", tmps) );
oldumask = umask(0);
#ifdef BSD_SETPGRP
SETi( BSD_SETPGRP(pid, pgrp) >= 0 );
#else
- if ((pgrp != 0 && pgrp != getpid())) || (pid != 0 && pid != getpid()))
+ if ((pgrp != 0 && pgrp != getpid()) || (pid != 0 && pid != getpid()))
DIE("POSIX setpgrp can't take an argument");
SETi( setpgrp() >= 0 );
#endif /* USE_BSDPGRP */
EXTEND_MORTAL(9);
if (GIMME != G_ARRAY) {
dTARGET;
- char mybuf[30];
+ SV *tsv;
if (!tmbuf)
RETPUSHUNDEF;
- sprintf(mybuf, "%s %s %2d %02d:%02d:%02d %d",
- dayname[tmbuf->tm_wday],
- monname[tmbuf->tm_mon],
- tmbuf->tm_mday,
- tmbuf->tm_hour,
- tmbuf->tm_min,
- tmbuf->tm_sec,
- tmbuf->tm_year + 1900);
- PUSHp(mybuf, strlen(mybuf));
+ tsv = newSVpvf("%s %s %2d %02d:%02d:%02d %d",
+ dayname[tmbuf->tm_wday],
+ monname[tmbuf->tm_mon],
+ tmbuf->tm_mday,
+ tmbuf->tm_hour,
+ tmbuf->tm_min,
+ tmbuf->tm_sec,
+ tmbuf->tm_year + 1900);
+ PUSHs(sv_2mortal(tsv));
}
else if (tmbuf) {
PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_sec)));
PUSHi(anum);
}
else {
- PUSHp("0 but true",10);
+ PUSHp(zero_but_true, ZBTLEN);
}
RETURN;
#else
PUSHs(sv = sv_mortalcopy(&sv_no));
sv_setpv(sv, nent->n_name);
PUSHs(sv = sv_mortalcopy(&sv_no));
- for (elem = nent->n_aliases; *elem; elem++) {
+ for (elem = nent->n_aliases; elem && *elem; elem++) {
sv_catpv(sv, *elem);
if (elem[1])
sv_catpvn(sv, " ", 1);
PUSHs(sv = sv_mortalcopy(&sv_no));
sv_setpv(sv, pent->p_name);
PUSHs(sv = sv_mortalcopy(&sv_no));
- for (elem = pent->p_aliases; *elem; elem++) {
+ for (elem = pent->p_aliases; elem && *elem; elem++) {
sv_catpv(sv, *elem);
if (elem[1])
sv_catpvn(sv, " ", 1);
PUSHs(sv = sv_mortalcopy(&sv_no));
sv_setpv(sv, sent->s_name);
PUSHs(sv = sv_mortalcopy(&sv_no));
- for (elem = sent->s_aliases; *elem; elem++) {
+ for (elem = sent->s_aliases; elem && *elem; elem++) {
sv_catpv(sv, *elem);
if (elem[1])
sv_catpvn(sv, " ", 1);
PUSHs(sv = sv_mortalcopy(&sv_no));
sv_setiv(sv, (IV)grent->gr_gid);
PUSHs(sv = sv_mortalcopy(&sv_no));
- for (elem = grent->gr_mem; *elem; elem++) {
+ for (elem = grent->gr_mem; elem && *elem; elem++) {
sv_catpv(sv, *elem);
if (elem[1])
sv_catpvn(sv, " ", 1);
projects / p5sagit/p5-mst-13.2.git / blobdiff