Minor Win32 glitch with -S flag

[p5sagit/p5-mst-13.2.git] / pp_sys.c

diff --git a/pp_sys.c b/pp_sys.c
index a03d9a4..6e25a54 100644 (file)
--- 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 <sys/utime.h>
 #  else
 #    include <utime.h>
@@ -224,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--;
 
@@ -458,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
@@ -1195,7 +1217,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;
@@ -1232,7 +1254,11 @@ PP(pp_sysread)
 #ifdef HAS_SOCKET
     if (op->op_type == OP_RECV) {
        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,
@@ -1272,7 +1298,11 @@ PP(pp_sysread)
 #ifdef HAS_SOCKET__bad_code_maybe
     if (IoTYPE(io) == 's') {
        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 *)namebuf, &bufsize);
     }
@@ -1357,6 +1387,7 @@ PP(pp_send)
     }
     else
        length = send(PerlIO_fileno(IoIFP(io)), buffer, blen, length);
+
 #else
     else
        DIE(no_sock_func, "send");
@@ -1975,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
@@ -3204,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 */
@@ -3675,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);
@@ -3745,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);
@@ -3832,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);
@@ -4112,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);