This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #80674] Fix compilation with very old versions of glibc
[perl5.git] / ext / Socket / Socket.xs
index 040dda4..c1225ff 100644 (file)
@@ -182,7 +182,7 @@ my_inet_aton(register const char *cp, struct in_addr *addr)
 
 
 static int
-not_here(char *s)
+not_here(const char *s)
 {
     croak("Socket::%s not implemented on this architecture", s);
     return -1;
@@ -231,12 +231,10 @@ inet_aton(host)
        {
        struct in_addr ip_address;
        struct hostent * phe;
-       int ok =
-               (host != NULL) &&
-               (*host != '\0') &&
-               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;
        }
@@ -253,10 +251,9 @@ inet_ntoa(ip_address_sv)
        {
        STRLEN addrlen;
        struct in_addr addr;
-       char * addr_str;
        char * ip_address;
        if (DO_UTF8(ip_address_sv) && !sv_utf8_downgrade(ip_address_sv, 1))
-            croak("Wide character in Socket::inet_ntoa");
+            croak("Wide character in %s", "Socket::inet_ntoa");
        ip_address = SvPVbyte(ip_address_sv, addrlen);
        if (addrlen == sizeof(addr) || addrlen == 4)
                addr.s_addr =
@@ -272,14 +269,11 @@ inet_ntoa(ip_address_sv)
         * in HP-UX + GCC + 64bitint (returns "0.0.0.0"),
         * so let's use this sprintf() workaround everywhere.
         * This is also more threadsafe than using inet_ntoa(). */
-       New(1138, 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),
-               ((addr.s_addr >>  8) & 0xFF),
-               ( addr.s_addr        & 0xFF));
-       ST(0) = sv_2mortal(newSVpvn(addr_str, strlen(addr_str)));
-       Safefree(addr_str);
+       ST(0) = sv_2mortal(Perl_newSVpvf(aTHX_ "%d.%d.%d.%d", /* IPv6? */
+                                        ((addr.s_addr >> 24) & 0xFF),
+                                        ((addr.s_addr >> 16) & 0xFF),
+                                        ((addr.s_addr >>  8) & 0xFF),
+                                        ( addr.s_addr        & 0xFF)));
        }
 
 void
@@ -298,16 +292,18 @@ sockaddr_family(sockaddr)
 
 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;
+       int addr_len;
 
        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! */
@@ -315,16 +311,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;
@@ -333,10 +330,20 @@ 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));
+       if (len > 1 && sun_ad.sun_path[0] == '\0') {
+               /* Linux-style abstract-namespace socket.
+                * The name is not a file name, but an array of arbitrary
+                * character, starting with \0 and possibly including \0s,
+                * therefore the length of the structure must denote the
+                * end of that character array */
+               addr_len = (char *)&(sun_ad.sun_path) - (char *)&sun_ad + len;
+       } else {
+               addr_len = sizeof sun_ad;
+       }
+       ST(0) = newSVpvn_flags((char *)&sun_ad, addr_len, SVs_TEMP);
 #else
        ST(0) = (SV *) not_here("pack_sockaddr_un");
 #endif
@@ -352,7 +359,7 @@ unpack_sockaddr_un(sun_sv)
        struct sockaddr_un addr;
        STRLEN sockaddrlen;
        char * sun_ad = SvPVbyte(sun_sv,sockaddrlen);
-       char * e;
+       int addr_len;
 #   ifndef __linux__
        /* On Linux sockaddrlen on sockets returned by accept, recvfrom,
           getpeername and getsockname is not equal to sizeof(addr). */
@@ -371,10 +378,17 @@ unpack_sockaddr_un(sun_sv)
                        addr.sun_family,
                        AF_UNIX);
        }
-       e = (char*)addr.sun_path;
-       while (*e && e < (char*)addr.sun_path + sizeof addr.sun_path)
-           ++e;
-       ST(0) = sv_2mortal(newSVpvn(addr.sun_path, e - (char*)addr.sun_path));
+
+       if (addr.sun_path[0] == '\0') {
+               /* Linux-style abstract socket address begins with a nul
+                * and can contain nuls. */
+               addr_len = (char *)&addr - (char *)&(addr.sun_path) + sockaddrlen;
+       } else {
+               for (addr_len = 0; addr.sun_path[addr_len]
+                    && addr_len < (int)sizeof(addr.sun_path); addr_len++);
+       }
+
+       ST(0) = newSVpvn_flags(addr.sun_path, addr_len, SVs_TEMP);
 #else
        ST(0) = (SV *) not_here("unpack_sockaddr_un");
 #endif
@@ -391,7 +405,7 @@ pack_sockaddr_in(port, ip_address_sv)
        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");
+            croak("Wide character in %s", "Socket::pack_sockaddr_in");
        ip_address = SvPVbyte(ip_address_sv, addrlen);
        if (addrlen == sizeof(addr) || addrlen == 4)
                addr.s_addr =
@@ -407,7 +421,7 @@ pack_sockaddr_in(port, ip_address_sv)
        sin.sin_family = AF_INET;
        sin.sin_port = htons(port);
        sin.sin_addr.s_addr = htonl(addr.s_addr);
-       ST(0) = sv_2mortal(newSVpvn((char *)&sin, sizeof sin));
+       ST(0) = newSVpvn_flags((char *)&sin, sizeof (sin), SVs_TEMP);
        }
 
 void
@@ -437,5 +451,147 @@ 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(newSVpvn_flags((char *)&ip_address, sizeof(ip_address), SVs_TEMP));
+       }
+
+void
+pack_sockaddr_in6(port, sin6_addr, scope_id=0, flowinfo=0)
+       unsigned short  port
+       SV *    sin6_addr
+       unsigned long   scope_id
+       unsigned long   flowinfo
+       CODE:
+       {
+#ifdef AF_INET6
+       struct sockaddr_in6 sin6;
+       char * addrbytes;
+       STRLEN addrlen;
+       if (DO_UTF8(sin6_addr) && !sv_utf8_downgrade(sin6_addr, 1))
+           croak("Wide character in %s", "Socket::pack_sockaddr_in6");
+       addrbytes = SvPVbyte(sin6_addr, addrlen);
+       if(addrlen != sizeof(sin6.sin6_addr))
+           croak("Bad arg length %s, length is %d, should be %d",
+                 "Socket::pack_sockaddr_in6", addrlen, sizeof(sin6.sin6_addr));
+       Zero(&sin6, sizeof(sin6), char);
+       sin6.sin6_family = AF_INET6;
+       sin6.sin6_port = htons(port);
+       sin6.sin6_flowinfo = htonl(flowinfo);
+       Copy(addrbytes, &sin6.sin6_addr, sizeof(sin6.sin6_addr), char);
+#if !defined(__GLIBC__) || (__GLIBC__ > 2) || (__GLIBC__ == 2 && __GLIBC_MINOR__ >= 3)
+       sin6.sin6_scope_id = scope_id;
+#endif
+       ST(0) = newSVpvn_flags((char *)&sin6, sizeof(sin6), SVs_TEMP);
+#else
+       ST(0) = (SV*)not_here("pack_sockaddr_in6");
+#endif
+       }
+
+void
+unpack_sockaddr_in6(sin6_sv)
+       SV *    sin6_sv
+       PPCODE:
+       {
+#ifdef AF_INET6
+       STRLEN addrlen;
+       struct sockaddr_in6 sin6;
+       char * addrbytes = SvPVbyte(sin6_sv, addrlen);
+       if (addrlen != sizeof(sin6))
+           croak("Bad arg length for %s, length is %d, should be %d",
+                   "Socket::unpack_sockaddr_in6",
+                   addrlen, sizeof(sin6));
+       Copy(addrbytes, &sin6, sizeof(sin6), char);
+       if(sin6.sin6_family != AF_INET6)
+           croak("Bad address family for %s, got %d, should be %d",
+                   "Socket::unpack_sockaddr_in6",
+                   sin6.sin6_family, AF_INET6);
+       EXTEND(SP, 4);
+       mPUSHi(ntohs(sin6.sin6_port));
+       mPUSHp((char *)&sin6.sin6_addr, sizeof(sin6.sin6_addr));
+#if !defined(__GLIBC__) || (__GLIBC__ > 2) || (__GLIBC__ == 2 && __GLIBC_MINOR__ >= 3)
+       mPUSHi(sin6.sin6_scope_id);
+#else
+       mPUSHi(0);
+#endif
+       mPUSHi(ntohl(sin6.sin6_flowinfo));
+#else
+       ST(0) = (SV*)not_here("pack_sockaddr_in6");
+#endif
        }
+
+void
+inet_ntop(af, ip_address_sv)
+        int     af
+        SV *    ip_address_sv
+        CODE:
+#ifdef HAS_INETNTOP
+       STRLEN addrlen, struct_size;
+#ifdef AF_INET6
+       struct in6_addr addr;
+       char str[INET6_ADDRSTRLEN];
+#else
+       struct in_addr addr;
+       char str[INET_ADDRSTRLEN];
+#endif
+       char *ip_address = SvPV(ip_address_sv, addrlen);
+
+       struct_size = sizeof(addr);
+
+       if(af != AF_INET
+#ifdef AF_INET6
+           && af != AF_INET6
+#endif
+         ) {
+           croak("Bad address family for %s, got %d, should be"
+#ifdef AF_INET6
+              " either AF_INET or AF_INET6",
+#else
+              " AF_INET",
+#endif
+               "Socket::inet_ntop",
+               af);
+        }
+
+       Copy( ip_address, &addr, sizeof addr, char );
+       inet_ntop(af, &addr, str, sizeof str);
+
+       ST(0) = newSVpvn_flags(str, strlen(str), SVs_TEMP);
+#else
+        ST(0) = (SV *)not_here("inet_ntop");
+#endif
+
+void
+inet_pton(af, host)
+        int           af
+        const char *  host
+        CODE:
+#ifdef HAS_INETPTON
+        int ok;
+#ifdef AF_INET6
+       struct in6_addr ip_address;
+#else
+       struct in_addr ip_address;
+#endif
+
+       if(af != AF_INET
+#ifdef AF_INET6
+               && af != AF_INET6
+#endif
+         ) {
+               croak("Bad address family for %s, got %d, should be"
+#ifdef AF_INET6
+                       " either AF_INET or AF_INET6",
+#else
+                       " AF_INET",
+#endif
+                        "Socket::inet_pton",
+                        af);
+        }
+        ok = (*host != '\0') && inet_pton(af, host, &ip_address);
+
+        ST(0) = sv_newmortal();
+        if (ok) {
+                sv_setpvn( ST(0), (char *)&ip_address, sizeof(ip_address) );
+        }
+#else
+        ST(0) = (SV *)not_here("inet_pton");
+#endif