This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update Changes
[perl5.git] / ext / Socket / Socket.xs
index 9f60040..f86c5ae 100644 (file)
@@ -3,11 +3,15 @@
 #include "perl.h"
 #include "XSUB.h"
 
+#include <stddef.h>
+
 #ifndef VMS
 # ifdef I_SYS_TYPES
 #  include <sys/types.h>
 # endif
-# include <sys/socket.h>
+# if !defined(ultrix) /* Avoid double definition. */
+#   include <sys/socket.h>
+# endif
 # if defined(USE_SOCKS) && defined(I_SOCKS)
 #   include <socks.h>
 # endif
 # if defined(NeXT) || defined(__NeXT__)
 #  include <netinet/in_systm.h>
 # endif
-# ifdef I_NETINET_IN
+# if defined(__sgi) && !defined(AF_LINK) && defined(PF_LINK) && PF_LINK == AF_LNK
+#  undef PF_LINK
+# endif
+# if defined(I_NETINET_IN) || defined(__ultrix__)
 #  include <netinet/in.h>
 # endif
 # ifdef I_NETDB
-#  include <netdb.h>
+#  if !defined(ultrix)  /* Avoid double definition. */
+#   include <netdb.h>
+#  endif
 # endif
 # ifdef I_ARPA_INET
 #  include <arpa/inet.h>
@@ -87,7 +96,7 @@ my_inet_aton(register const char *cp, struct in_addr *addr)
        unsigned int parts[4];
        register unsigned int *pp = parts;
 
-       if (!cp)
+       if (!cp || !*cp)
                return 0;
        for (;;) {
                /*
@@ -179,11 +188,41 @@ not_here(char *s)
     return -1;
 }
 
-#include "constants.c"
+#define PERL_IN_ADDR_S_ADDR_SIZE 4
+
+/*
+* Bad assumptions possible here.
+*
+* Bad Assumption 1: struct in_addr has no other fields
+* than the s_addr (which is the field we care about
+* in here, really). However, we can be fed either 4-byte
+* addresses (from pack("N", ...), or va.b.c.d, or ...),
+* or full struct in_addrs (from e.g. pack_sockaddr_in()),
+* which may or may not be 4 bytes in size.
+*
+* Bad Assumption 2: the s_addr field is a simple type
+* (such as an int, u_int32_t).  It can be a bit field,
+* in which case using & (address-of) on it or taking sizeof()
+* wouldn't go over too well.  (Those are not attempted
+* now but in case someone thinks to change the below code
+* to use addr.s_addr instead of addr, you have been warned.)
+*
+* Bad Assumption 3: the s_addr is the first field in
+* an in_addr, or that its bytes are the first bytes in
+* an in_addr.
+*
+* These bad assumptions are wrong in UNICOS which has
+* struct in_addr { struct { u_long  st_addr:32; } s_da };
+* #define s_addr s_da.st_addr
+* and u_long is 64 bits.
+*
+* --jhi */
+
+#include "const-c.inc"
 
 MODULE = Socket                PACKAGE = Socket
 
-INCLUDE: constants.xs
+INCLUDE: const-xs.inc
 
 void
 inet_aton(host)
@@ -192,18 +231,18 @@ inet_aton(host)
        {
        struct in_addr ip_address;
        struct hostent * phe;
-       int ok = inet_aton(host, &ip_address);
+       int ok = (*host != '\0') && inet_aton(host, &ip_address);
 
-       if (!ok && (phe = gethostbyname(host))) {
+       if (!ok && (phe = gethostbyname(host)) &&
+                       phe->h_addrtype == AF_INET && phe->h_length == 4) {
                Copy( phe->h_addr, &ip_address, phe->h_length, char );
                ok = 1;
        }
 
        ST(0) = sv_newmortal();
-       if (ok) {
+       if (ok)
                sv_setpvn( ST(0), (char *)&ip_address, sizeof ip_address );
        }
-       }
 
 void
 inet_ntoa(ip_address_sv)
@@ -216,60 +255,22 @@ inet_ntoa(ip_address_sv)
        char * ip_address;
        if (DO_UTF8(ip_address_sv) && !sv_utf8_downgrade(ip_address_sv, 1))
             croak("Wide character in Socket::inet_ntoa");
-       ip_address = SvPV(ip_address_sv, addrlen);
-       /*
-        * Bad assumptions possible here.
-        *
-        * Bad Assumption 1: struct in_addr has no other fields
-        * than the s_addr (which is the field we care about
-        * in here, really). However, we can be fed either 4-byte
-        * addresses (from pack("N", ...), or va.b.c.d, or ...),
-        * or full struct in_addrs (from e.g. pack_sockaddr_in()),
-        * which may or may not be 4 bytes in size.
-        *
-        * Bad Assumption 2: the s_addr field is a simple type
-        * (such as an int, u_int32_t).  It can be a bit field,
-        * in which case using & (address-of) on it or taking sizeof()
-        * wouldn't go over too well.  (Those are not attempted
-        * now but in case someone thinks to change the below code
-        * to use addr.s_addr instead of addr, you have warned.)
-        *
-        * Bad Assumption 3: the s_addr is the first field in
-        * an in_addr, or that its bytes are the first bytes in
-        * an in_addr.
-        *
-        * These bad assumptions are wrong in UNICOS which has
-        * struct in_addr { struct { u_long  st_addr:32; } s_da };
-        * #define s_addr s_da.st_addr
-        * and u_long is 64 bits.
-        *
-        * --jhi */
-#define PERL_IN_ADDR_S_ADDR_SIZE 4
-#if INTSIZE == PERL_IN_ADDR_S_ADDR_SIZE
-       if (addrlen == PERL_IN_ADDR_S_ADDR_SIZE)
-            addr.s_addr = ntohl(*(int*)ip_address);
+       ip_address = SvPVbyte(ip_address_sv, addrlen);
+       if (addrlen == sizeof(addr) || addrlen == 4)
+               addr.s_addr =
+                   (ip_address[0] & 0xFF) << 24 |
+                   (ip_address[1] & 0xFF) << 16 |
+                   (ip_address[2] & 0xFF) <<  8 |
+                   (ip_address[3] & 0xFF);
        else
-#endif
-       {
-            /* The following could be optimized away if we knew
-             * during compile time what size is struct in_addr. */
-            if (addrlen == sizeof(addr))
-                 Copy( ip_address, &addr, sizeof addr, char );
-            else {
-                 if (PERL_IN_ADDR_S_ADDR_SIZE == sizeof(addr))
-                      croak("Bad arg length for %s, length is %d, should be %d",
-                            "Socket::inet_ntoa",
-                            addrlen, PERL_IN_ADDR_S_ADDR_SIZE);
-                 else
-                      croak("Bad arg length for %s, length is %d, should be %d or %d",
-                            "Socket::inet_ntoa",
-                            addrlen, PERL_IN_ADDR_S_ADDR_SIZE, sizeof(addr));
-            }
-       }
+               croak("Bad arg length for %s, length is %d, should be %d",
+                     "Socket::inet_ntoa",
+                     addrlen, sizeof(addr));
        /* We could use inet_ntoa() but that is broken
         * in HP-UX + GCC + 64bitint (returns "0.0.0.0"),
-        * so let's use this sprintf() workaround everywhere. */
-       New(1138, addr_str, 4 * 3 + 3 + 1, char);
+        * so let's use this sprintf() workaround everywhere.
+        * This is also more threadsafe than using inet_ntoa(). */
+       Newx(addr_str, 4 * 3 + 3 + 1, char); /* IPv6? */
        sprintf(addr_str, "%d.%d.%d.%d",
                ((addr.s_addr >> 24) & 0xFF),
                ((addr.s_addr >> 16) & 0xFF),
@@ -280,17 +281,32 @@ inet_ntoa(ip_address_sv)
        }
 
 void
+sockaddr_family(sockaddr)
+       SV *    sockaddr
+       PREINIT:
+       STRLEN sockaddr_len;
+       char *sockaddr_pv = SvPVbyte(sockaddr, sockaddr_len);
+       CODE:
+       if (sockaddr_len < offsetof(struct sockaddr, sa_data)) {
+           croak("Bad arg length for %s, length is %d, should be at least %d",
+                 "Socket::sockaddr_family", sockaddr_len,
+                 offsetof(struct sockaddr, sa_data));
+       }
+       ST(0) = sv_2mortal(newSViv(((struct sockaddr*)sockaddr_pv)->sa_family));
+
+void
 pack_sockaddr_un(pathname)
-       char *  pathname
+       SV *    pathname
        CODE:
        {
 #ifdef I_SYS_UN
        struct sockaddr_un sun_ad; /* fear using sun */
        STRLEN len;
+       char * pathname_pv;
 
        Zero( &sun_ad, sizeof sun_ad, char );
        sun_ad.sun_family = AF_UNIX;
-       len = strlen(pathname);
+       pathname_pv = SvPV(pathname,len);
        if (len > sizeof(sun_ad.sun_path))
            len = sizeof(sun_ad.sun_path);
 #  ifdef OS2   /* Name should start with \socket\ and contain backslashes! */
@@ -298,16 +314,17 @@ pack_sockaddr_un(pathname)
            int off;
            char *s, *e;
 
-           if (pathname[0] != '/' && pathname[0] != '\\')
-               croak("Relative UNIX domain socket name '%s' unsupported", pathname);
+           if (pathname_pv[0] != '/' && pathname_pv[0] != '\\')
+               croak("Relative UNIX domain socket name '%s' unsupported",
+                       pathname_pv);
            else if (len < 8
-                    || pathname[7] != '/' && pathname[7] != '\\'
-                    || !strnicmp(pathname + 1, "socket", 6))
+                    || pathname_pv[7] != '/' && pathname_pv[7] != '\\'
+                    || !strnicmp(pathname_pv + 1, "socket", 6))
                off = 7;
            else
                off = 0;                /* Preserve names starting with \socket\ */
            Copy( "\\socket", sun_ad.sun_path, off, char);
-           Copy( pathname, sun_ad.sun_path + off, len, char );
+           Copy( pathname_pv, sun_ad.sun_path + off, len, char );
 
            s = sun_ad.sun_path + off - 1;
            e = s + len + 1;
@@ -316,7 +333,7 @@ pack_sockaddr_un(pathname)
                    *s = '\\';
        }
 #  else        /* !( defined OS2 ) */
-       Copy( pathname, sun_ad.sun_path, len, char );
+       Copy( pathname_pv, sun_ad.sun_path, len, char );
 #  endif
        if (0) not_here("dummy");
        ST(0) = sv_2mortal(newSVpvn((char *)&sun_ad, sizeof sun_ad));
@@ -334,7 +351,7 @@ unpack_sockaddr_un(sun_sv)
 #ifdef I_SYS_UN
        struct sockaddr_un addr;
        STRLEN sockaddrlen;
-       char * sun_ad = SvPV(sun_sv,sockaddrlen);
+       char * sun_ad = SvPVbyte(sun_sv,sockaddrlen);
        char * e;
 #   ifndef __linux__
        /* On Linux sockaddrlen on sockets returned by accept, recvfrom,
@@ -354,28 +371,45 @@ unpack_sockaddr_un(sun_sv)
                        addr.sun_family,
                        AF_UNIX);
        }
-       e = addr.sun_path;
-       while (*e && e < addr.sun_path + sizeof addr.sun_path)
+       e = (char*)addr.sun_path;
+       /* On Linux, the name of abstract unix domain sockets begins
+        * with a '\0', so allow this. */
+       while ((*e || (e == addr.sun_path && e[1] && sockaddrlen > 1))
+               && e < (char*)addr.sun_path + sizeof addr.sun_path)
            ++e;
-       ST(0) = sv_2mortal(newSVpvn(addr.sun_path, e - addr.sun_path));
+       ST(0) = sv_2mortal(newSVpvn(addr.sun_path, e - (char*)addr.sun_path));
 #else
        ST(0) = (SV *) not_here("unpack_sockaddr_un");
 #endif
        }
 
 void
-pack_sockaddr_in(port,ip_address)
+pack_sockaddr_in(port, ip_address_sv)
        unsigned short  port
-       char *  ip_address
+       SV *    ip_address_sv
        CODE:
        {
        struct sockaddr_in sin;
-
+       struct in_addr addr;
+       STRLEN addrlen;
+       char * ip_address;
+       if (DO_UTF8(ip_address_sv) && !sv_utf8_downgrade(ip_address_sv, 1))
+            croak("Wide character in Socket::pack_sockaddr_in");
+       ip_address = SvPVbyte(ip_address_sv, addrlen);
+       if (addrlen == sizeof(addr) || addrlen == 4)
+               addr.s_addr =
+                   (ip_address[0] & 0xFF) << 24 |
+                   (ip_address[1] & 0xFF) << 16 |
+                   (ip_address[2] & 0xFF) <<  8 |
+                   (ip_address[3] & 0xFF);
+       else
+               croak("Bad arg length for %s, length is %d, should be %d",
+                     "Socket::pack_sockaddr_in",
+                     addrlen, sizeof(addr));
        Zero( &sin, sizeof sin, char );
        sin.sin_family = AF_INET;
        sin.sin_port = htons(port);
-       Copy( ip_address, &sin.sin_addr, sizeof sin.sin_addr, char );
-
+       sin.sin_addr.s_addr = htonl(addr.s_addr);
        ST(0) = sv_2mortal(newSVpvn((char *)&sin, sizeof sin));
        }
 
@@ -387,8 +421,8 @@ unpack_sockaddr_in(sin_sv)
        STRLEN sockaddrlen;
        struct sockaddr_in addr;
        unsigned short  port;
-       struct in_addr  ip_address;
-       char *  sin = SvPV(sin_sv,sockaddrlen);
+       struct in_addr  ip_address;
+       char *  sin = SvPVbyte(sin_sv,sockaddrlen);
        if (sockaddrlen != sizeof(addr)) {
            croak("Bad arg length for %s, length is %d, should be %d",
                        "Socket::unpack_sockaddr_in",
@@ -406,5 +440,5 @@ unpack_sockaddr_in(sin_sv)
 
        EXTEND(SP, 2);
        PUSHs(sv_2mortal(newSViv((IV) port)));
-       PUSHs(sv_2mortal(newSVpvn((char *)&ip_address,sizeof ip_address)));
+       PUSHs(sv_2mortal(newSVpvn((char *)&ip_address, sizeof ip_address)));
        }