[differences between cumulative patch application and perl5.004]
[p5sagit/p5-mst-13.2.git] / pp_sys.c
index 6d18ac9..03a10fe 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -154,6 +154,13 @@ 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";
@@ -171,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*/
                ;
        }
@@ -217,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--;
 
@@ -971,16 +989,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");
            }
@@ -1071,12 +1089,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);
@@ -1165,7 +1206,7 @@ PP(pp_sysread)
     MAGIC *mg;
 
     gv = (GV*)*++MARK;
-    if (op->op_type == OP_READ &&
+    if ((op->op_type == OP_READ || op->op_type == OP_SYSREAD) &&
        SvMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q')))
     {
        SV *sv;
@@ -1201,11 +1242,12 @@ PP(pp_sysread)
        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);
@@ -1216,7 +1258,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;
     }
@@ -1240,9 +1282,10 @@ PP(pp_sysread)
     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
@@ -1470,7 +1513,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);
 
@@ -1481,22 +1524,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");
@@ -2631,7 +2671,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);
@@ -3173,7 +3215,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 */
@@ -3304,18 +3346,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)));
@@ -3644,7 +3686,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);
@@ -3714,7 +3756,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);
@@ -3801,7 +3843,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);
@@ -4081,7 +4123,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);