This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade Socket to 2.002
[perl5.git] / cpan / Socket / Socket.xs
index 665553c..f22c1f3 100644 (file)
 #  include <netinet/tcp.h>
 #endif
 
+#ifdef WIN32
+# include <ws2tcpip.h>
+#endif
+
 #ifdef NETWARE
 NETDB_DEFINE_CONTEXT
 NETINET_DEFINE_CONTEXT
@@ -444,13 +448,13 @@ static void xs_getaddrinfo(pTHX_ CV *cv)
 
                hintshash = (HV*)SvRV(hints);
 
-               if((valp = hv_fetch(hintshash, "flags", 5, 0)) != NULL)
+               if((valp = hv_fetch(hintshash, "flags", 5, 0)) != NULL && SvOK(*valp))
                        hints_s.ai_flags = SvIV(*valp);
-               if((valp = hv_fetch(hintshash, "family", 6, 0)) != NULL)
+               if((valp = hv_fetch(hintshash, "family", 6, 0)) != NULL && SvOK(*valp))
                        hints_s.ai_family = SvIV(*valp);
-               if((valp = hv_fetch(hintshash, "socktype", 8, 0)) != NULL)
+               if((valp = hv_fetch(hintshash, "socktype", 8, 0)) != NULL && SvOK(*valp))
                        hints_s.ai_socktype = SvIV(*valp);
-               if((valp = hv_fetch(hintshash, "protocol", 8, 0)) != NULL)
+               if((valp = hv_fetch(hintshash, "protocol", 8, 0)) != NULL && SvOK(*valp))
                        hints_s.ai_protocol = SvIV(*valp);
        }
 
@@ -707,15 +711,21 @@ unpack_sockaddr_un(sun_sv)
        STRLEN sockaddrlen;
        char * sun_ad = SvPVbyte(sun_sv,sockaddrlen);
        int addr_len;
-#   ifndef __linux__
+#   ifdef __linux__
        /* On Linux sockaddrlen on sockets returned by accept, recvfrom,
           getpeername and getsockname is not equal to sizeof(addr). */
+       if (sockaddrlen < sizeof(addr)) {
+         Copy(sun_ad, &addr, sockaddrlen, char);
+         Zero(((char*)&addr) + sockaddrlen, sizeof(addr) - sockaddrlen, char);
+       } else {
+         Copy(sun_ad, &addr, sizeof(addr), char);
+       }
+#   else
        if (sockaddrlen != sizeof(addr))
                croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf,
                      "Socket::unpack_sockaddr_un", (UV)sockaddrlen, (UV)sizeof(addr));
-#   endif
-
        Copy(sun_ad, &addr, sizeof(addr), char);
+#   endif
 
        if (addr.sun_family != AF_UNIX)
                croak("Bad address family for %s, got %d, should be %d",
@@ -879,7 +889,12 @@ inet_ntop(af, ip_address_sv)
        struct in_addr addr;
        char str[INET_ADDRSTRLEN];
 #endif
-       char *ip_address = SvPV(ip_address_sv, addrlen);
+       char *ip_address;
+
+       if (DO_UTF8(ip_address_sv) && !sv_utf8_downgrade(ip_address_sv, 1))
+               croak("Wide character in %s", "Socket::inet_ntop");
+
+       ip_address = SvPV(ip_address_sv, addrlen);
 
        struct_size = sizeof(addr);
 
@@ -912,17 +927,23 @@ inet_pton(af, host)
        CODE:
 #ifdef HAS_INETPTON
        int ok;
+       int addrlen = 0;
 #ifdef AF_INET6
        struct in6_addr ip_address;
 #else
        struct in_addr ip_address;
 #endif
 
-       if (af != AF_INET
+       switch(af) {
+         case AF_INET:
+           addrlen = 4;
+           break;
 #ifdef AF_INET6
-           && af != AF_INET6
+         case AF_INET6:
+           addrlen = 16;
+           break;
 #endif
-          ) {
+         default:
                croak("Bad address family for %s, got %d, should be"
 #ifdef AF_INET6
                      " either AF_INET or AF_INET6",
@@ -935,34 +956,91 @@ inet_pton(af, host)
 
        ST(0) = sv_newmortal();
        if (ok) {
-               sv_setpvn( ST(0), (char *)&ip_address, sizeof(ip_address) );
+               sv_setpvn( ST(0), (char *)&ip_address, addrlen);
        }
 #else
        ST(0) = (SV*)not_here("inet_pton");
 #endif
 
 void
-pack_ipv6_mreq(addr, interface)
-       SV *    addr
+pack_ip_mreq(multiaddr, interface=&PL_sv_undef)
+       SV *    multiaddr
+       SV *    interface
+       CODE:
+       {
+#ifdef HAS_IP_MREQ
+       struct ip_mreq mreq;
+       char * multiaddrbytes;
+       char * interfacebytes;
+       STRLEN len;
+       if (DO_UTF8(multiaddr) && !sv_utf8_downgrade(multiaddr, 1))
+               croak("Wide character in %s", "Socket::pack_ip_mreq");
+       multiaddrbytes = SvPVbyte(multiaddr, len);
+       if (len != sizeof(mreq.imr_multiaddr))
+               croak("Bad arg length %s, length is %"UVuf", should be %"UVuf,
+                     "Socket::pack_ip_mreq", (UV)len, (UV)sizeof(mreq.imr_multiaddr));
+       Zero(&mreq, sizeof(mreq), char);
+       Copy(multiaddrbytes, &mreq.imr_multiaddr, sizeof(mreq.imr_multiaddr), char);
+       if(SvOK(interface)) {
+               if (DO_UTF8(interface) && !sv_utf8_downgrade(interface, 1))
+                       croak("Wide character in %s", "Socket::pack_ip_mreq");
+               interfacebytes = SvPVbyte(interface, len);
+               if (len != sizeof(mreq.imr_interface))
+                       croak("Bad arg length %s, length is %"UVuf", should be %"UVuf,
+                             "Socket::pack_ip_mreq", (UV)len, (UV)sizeof(mreq.imr_interface));
+               Copy(interfacebytes, &mreq.imr_interface, sizeof(mreq.imr_interface), char);
+       }
+       else
+               mreq.imr_interface.s_addr = INADDR_ANY;
+       ST(0) = sv_2mortal(newSVpvn((char *)&mreq, sizeof(mreq)));
+#else
+       not_here("pack_ip_mreq");
+#endif
+       }
+
+void
+unpack_ip_mreq(mreq_sv)
+       SV * mreq_sv
+       PPCODE:
+       {
+#ifdef HAS_IP_MREQ
+       struct ip_mreq mreq;
+       STRLEN mreqlen;
+       char * mreqbytes = SvPVbyte(mreq_sv, mreqlen);
+       if (mreqlen != sizeof(mreq))
+               croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf,
+                     "Socket::unpack_ip_mreq", (UV)mreqlen, (UV)sizeof(mreq));
+       Copy(mreqbytes, &mreq, sizeof(mreq), char);
+       EXTEND(SP, 2);
+       mPUSHp((char *)&mreq.imr_multiaddr, sizeof(mreq.imr_multiaddr));
+       mPUSHp((char *)&mreq.imr_interface, sizeof(mreq.imr_interface));
+#else
+       not_here("unpack_ip_mreq");
+#endif
+       }
+
+void
+pack_ipv6_mreq(multiaddr, interface)
+       SV *    multiaddr
        unsigned int    interface
        CODE:
        {
 #ifdef HAS_IPV6_MREQ
        struct ipv6_mreq mreq;
-       char * addrbytes;
-       STRLEN addrlen;
-       if (DO_UTF8(addr) && !sv_utf8_downgrade(addr, 1))
+       char * multiaddrbytes;
+       STRLEN len;
+       if (DO_UTF8(multiaddr) && !sv_utf8_downgrade(multiaddr, 1))
                croak("Wide character in %s", "Socket::pack_ipv6_mreq");
-       addrbytes = SvPVbyte(addr, addrlen);
-       if (addrlen != sizeof(mreq.ipv6mr_multiaddr))
+       multiaddrbytes = SvPVbyte(multiaddr, len);
+       if (len != sizeof(mreq.ipv6mr_multiaddr))
                croak("Bad arg length %s, length is %"UVuf", should be %"UVuf,
-                     "Socket::pack_ipv6_mreq", (UV)addrlen, (UV)sizeof(mreq.ipv6mr_multiaddr));
+                     "Socket::pack_ipv6_mreq", (UV)len, (UV)sizeof(mreq.ipv6mr_multiaddr));
        Zero(&mreq, sizeof(mreq), char);
-       Copy(addrbytes, &mreq.ipv6mr_multiaddr, sizeof(mreq.ipv6mr_multiaddr), char);
+       Copy(multiaddrbytes, &mreq.ipv6mr_multiaddr, sizeof(mreq.ipv6mr_multiaddr), char);
        mreq.ipv6mr_interface = interface;
        ST(0) = sv_2mortal(newSVpvn((char *)&mreq, sizeof(mreq)));
 #else
-       ST(0) = (SV*)not_here("pack_ipv6_mreq");
+       not_here("pack_ipv6_mreq");
 #endif
        }