X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_sys.c;h=6e25a54d532002404358221d55945e72e256131b;hb=e92c4225b24535b7128dd90f6a3e01d0abc79a1d;hp=00012c315da110d40347aefe1f04feeeafa56f42;hpb=d574b85ef38b533c29517c911f5b03db91196ab8;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp_sys.c b/pp_sys.c index 00012c3..6e25a54 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -71,7 +71,7 @@ extern int h_errno; #endif #ifdef I_UTIME -# ifdef WIN32 +# ifdef _MSC_VER # include # else # include @@ -91,7 +91,7 @@ extern int h_errno; /* Put this after #includes because 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 @@ -154,6 +154,16 @@ static int dooneliner _((char *cmd, char *filename)); #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. */ @@ -168,7 +178,7 @@ PP(pp_backtick) 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*/ ; } @@ -214,6 +224,17 @@ PP(pp_glob) 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--; @@ -448,8 +469,19 @@ PP(pp_binmode) 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 @@ -968,16 +1000,16 @@ PP(pp_leavewrite) 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"); } @@ -1068,12 +1100,35 @@ PP(pp_prtf) 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); @@ -1155,14 +1210,16 @@ PP(pp_sysread) 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); @@ -1196,11 +1253,16 @@ PP(pp_sysread) 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); @@ -1211,7 +1273,7 @@ PP(pp_sysread) if (!(IoFLAGS(io) & IOf_UNTAINT)) SvTAINTED_on(bufsv); SP = ORIGMARK; - sv_setpvn(TARG, buf, bufsize); + sv_setpvn(TARG, namebuf, bufsize); PUSHs(TARG); RETURN; } @@ -1235,9 +1297,14 @@ PP(pp_sysread) 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 @@ -1320,6 +1387,7 @@ PP(pp_send) } else length = send(PerlIO_fileno(IoIFP(io)), buffer, blen, length); + #else else DIE(no_sock_func, "send"); @@ -1368,13 +1436,25 @@ PP(pp_tell) 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; } @@ -1453,7 +1533,7 @@ PP(pp_ioctl) 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); @@ -1464,22 +1544,19 @@ PP(pp_ioctl) 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"); @@ -1515,7 +1592,7 @@ PP(pp_ioctl) PUSHi(retval); } else { - PUSHp("0 but true", 10); + PUSHp(zero_but_true, ZBTLEN); } RETURN; } @@ -1929,6 +2006,17 @@ PP(pp_getpeername) 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 @@ -2614,7 +2702,9 @@ PP(pp_readlink) dSP; dTARGET; #ifdef HAS_SYMLINK char *tmps; + char buf[MAXPATHLEN]; int len; + tmps = POPp; len = readlink(tmps, buf, sizeof buf); EXTEND(SP, 1); @@ -2728,7 +2818,7 @@ PP(pp_mkdir) TAINT_PROPER("mkdir"); #ifdef HAS_MKDIR - SETi( mkdir(tmps, mode) >= 0 ); + SETi( Mkdir(tmps, mode) >= 0 ); #else SETi( dooneliner("mkdir", tmps) ); oldumask = umask(0); @@ -3156,7 +3246,7 @@ PP(pp_setpgrp) #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 */ @@ -3287,18 +3377,18 @@ PP(pp_gmtime) 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))); @@ -3447,7 +3537,7 @@ PP(pp_semctl) PUSHi(anum); } else { - PUSHp("0 but true",10); + PUSHp(zero_but_true, ZBTLEN); } RETURN; #else @@ -3627,7 +3717,7 @@ PP(pp_gnetent) 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); @@ -3697,7 +3787,7 @@ PP(pp_gprotoent) 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); @@ -3784,7 +3874,7 @@ PP(pp_gservent) 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); @@ -3991,7 +4081,7 @@ PP(pp_gpwent) PP(pp_spwent) { dSP; -#ifdef HAS_PASSWD +#if defined(HAS_PASSWD) && !defined(CYGWIN32) setpwent(); RETPUSHYES; #else @@ -4064,7 +4154,7 @@ PP(pp_ggrent) 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);