#endif
#ifdef I_UTIME
-# ifdef WIN32
+# ifdef _MSC_VER
# include <sys/utime.h>
# else
# include <utime.h>
/* 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--;
else
RETPUSHUNDEF;
#else
- if (setmode(PerlIO_fileno(fp), OP_BINARY) != -1)
+ if (setmode(PerlIO_fileno(fp), OP_BINARY) != -1) {
+#if defined(WIN32) && defined(__BORLANDC__)
+ /* The translation mode of the stream is maintained independent
+ * of the translation mode of the fd in the Borland RTL (heavy
+ * digging through their runtime sources reveal). User has to
+ * set the mode explicitly for the stream (though they don't
+ * document this anywhere). GSAR 97-5-24
+ */
+ PerlIO_seek(fp,0L,0);
+ fp->flags |= _F_BIN;
+#endif
RETPUSHYES;
+ }
else
RETPUSHUNDEF;
#endif
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];
+#if defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS)
+ bufsize = sizeof (struct sockaddr_in);
+#else
+ bufsize = sizeof namebuf;
+#endif
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];
+#if defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS)
+ bufsize = sizeof (struct sockaddr_in);
+#else
+ bufsize = sizeof namebuf;
+#endif
length = recvfrom(PerlIO_fileno(IoIFP(io)), buffer+offset, length, 0,
- (struct sockaddr *)buf, &bufsize);
+ (struct sockaddr *)namebuf, &bufsize);
}
else
#endif
}
else
length = send(PerlIO_fileno(IoIFP(io)), buffer, blen, length);
+
#else
else
DIE(no_sock_func, "send");
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;
}
case OP_GETPEERNAME:
if (getpeername(fd, (struct sockaddr *)SvPVX(sv), &len) < 0)
goto nuts2;
+#if defined(VMS_DO_SOCKETS) && defined (DECCRTL_SOCKETS)
+ {
+ static const char nowhere[] = "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0";
+ /* If the call succeeded, make sure we don't have a zeroed port/addr */
+ if (((struct sockaddr *)SvPVX(sv))->sa_family == AF_INET &&
+ !memcmp((char *)SvPVX(sv) + sizeof(u_short), nowhere,
+ sizeof(u_short) + sizeof(struct in_addr))) {
+ goto nuts2;
+ }
+ }
+#endif
break;
}
#ifdef BOGUS_GETNAME_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);
PP(pp_spwent)
{
dSP;
-#ifdef HAS_PASSWD
+#if defined(HAS_PASSWD) && !defined(CYGWIN32)
setpwent();
RETPUSHYES;
#else
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);