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 f571ac7..f22c1f3 100644 (file)
@@ -33,7 +33,7 @@
 #  include <netinet/in.h>
 #endif
 #ifdef I_NETDB
-#  if !defined(ultrix)  /* Avoid double definition. */
+#  if !defined(ultrix) /* Avoid double definition. */
 #   include <netdb.h>
 #  endif
 #endif
 #  include <netinet/tcp.h>
 #endif
 
+#ifdef WIN32
+# include <ws2tcpip.h>
+#endif
+
 #ifdef NETWARE
 NETDB_DEFINE_CONTEXT
 NETINET_DEFINE_CONTEXT
@@ -68,13 +72,149 @@ NETINET_DEFINE_CONTEXT
 # define INADDR_BROADCAST      0xffffffff
 #endif /* INADDR_BROADCAST */
 #ifndef INADDR_LOOPBACK
-# define INADDR_LOOPBACK         0x7F000001
+# define INADDR_LOOPBACK        0x7F000001
 #endif /* INADDR_LOOPBACK */
 
+#ifndef C_ARRAY_LENGTH
+#define C_ARRAY_LENGTH(arr) (sizeof(arr) / sizeof(*(arr)))
+#endif /* !C_ARRAY_LENGTH */
+
+#ifndef PERL_UNUSED_VAR
+# define PERL_UNUSED_VAR(x) ((void)x)
+#endif /* !PERL_UNUSED_VAR */
+
+#ifndef PERL_UNUSED_ARG
+# define PERL_UNUSED_ARG(x) PERL_UNUSED_VAR(x)
+#endif /* !PERL_UNUSED_ARG */
+
+#ifndef Newx
+# define Newx(v,n,t) New(0,v,n,t)
+#endif /* !Newx */
+
 #ifndef croak_sv
 # define croak_sv(sv)  croak(SvPV_nolen(sv))
 #endif
 
+#ifndef hv_stores
+# define hv_stores(hv, keystr, val) \
+       hv_store(hv, ""keystr"", sizeof(keystr)-1, val, 0)
+#endif /* !hv_stores */
+
+#ifndef newSVpvn_flags
+# define newSVpvn_flags(s,len,flags) my_newSVpvn_flags(aTHX_ s,len,flags)
+static SV *my_newSVpvn_flags(pTHX_ const char *s, STRLEN len, U32 flags)
+{
+  SV *sv = newSVpvn(s, len);
+  SvFLAGS(sv) |= (flags & SVf_UTF8);
+  return (flags & SVs_TEMP) ? sv_2mortal(sv) : sv;
+}
+#endif /* !newSVpvn_flags */
+
+#ifndef SvRV_set
+# define SvRV_set(sv, val) (SvRV(sv) = (val))
+#endif /* !SvRV_set */
+
+#ifndef SvPV_nomg
+# define SvPV_nomg SvPV
+#endif /* !SvPV_nomg */
+
+#ifndef HEK_FLAGS
+# define HEK_FLAGS(hek) 0
+# define HVhek_UTF8 1
+#endif /* !HEK_FLAGS */
+
+#ifndef hv_common
+/* These magic numbers are arbitrarily chosen (copied from perl core in fact)
+ * and only have to match between this definition and the code that uses them
+ */
+# define HV_FETCH_ISSTORE 0x04
+# define HV_FETCH_LVALUE  0x10
+# define hv_common(hv, keysv, key, klen, flags, act, val, hash) \
+       my_hv_common(aTHX_ hv, keysv, key, klen, flags, act, val, hash)
+static void *my_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
+       int flags, int act, SV *val, U32 hash)
+{
+       /*
+        * This only handles the usage actually made by the code
+        * generated by ExtUtils::Constant.  EU:C really ought to arrange
+        * portability of its generated code itself.
+        */
+       if (!keysv) {
+               keysv = sv_2mortal(newSVpvn(key, klen));
+               if (flags & HVhek_UTF8)
+                       SvUTF8_on(keysv);
+       }
+       if (act == HV_FETCH_LVALUE) {
+               return (void*)hv_fetch_ent(hv, keysv, 1, hash);
+       } else if (act == HV_FETCH_ISSTORE) {
+               return (void*)hv_store_ent(hv, keysv, val, hash);
+       } else {
+               croak("panic: my_hv_common: act=0x%x", act);
+       }
+}
+#endif /* !hv_common */
+
+#ifndef hv_common_key_len
+# define hv_common_key_len(hv, key, kl, act, val, hash) \
+       my_hv_common_key_len(aTHX_ hv, key, kl, act, val, hash)
+static void *my_hv_common_key_len(pTHX_ HV *hv, const char *key, I32 kl,
+       int act, SV *val, U32 hash)
+{
+       STRLEN klen;
+       int flags;
+       if (kl < 0) {
+               klen = -kl;
+               flags = HVhek_UTF8;
+       } else {
+               klen = kl;
+               flags = 0;
+       }
+       return hv_common(hv, NULL, key, klen, flags, act, val, hash);
+}
+#endif /* !hv_common_key_len */
+
+#ifndef mPUSHi
+# define mPUSHi(i) sv_setiv_mg(PUSHs(sv_newmortal()), (IV)(i))
+#endif /* !mPUSHi */
+#ifndef mPUSHp
+# define mPUSHp(p,l) sv_setpvn_mg(PUSHs(sv_newmortal()), (p), (l))
+#endif /* !mPUSHp */
+
+#ifndef CvCONST_on
+# undef newCONSTSUB
+# define newCONSTSUB(stash, name, val) my_newCONSTSUB(aTHX_ stash, name, val)
+static CV *my_newCONSTSUB(pTHX_ HV *stash, char *name, SV *val)
+{
+       /*
+        * This has to satisfy code generated by ExtUtils::Constant.
+        * It depends on the 5.8+ layout of constant subs.  It has
+        * two calls to newCONSTSUB(): one for real constants, and one
+        * for undefined constants.  In the latter case, it turns the
+        * initially-generated constant subs into something else, and
+        * it needs the return value from newCONSTSUB() which Perl 5.6
+        * doesn't provide.
+        */
+       GV *gv;
+       CV *cv;
+       Perl_newCONSTSUB(aTHX_ stash, name, val);
+       ENTER;
+       SAVESPTR(PL_curstash);
+       PL_curstash = stash;
+       gv = gv_fetchpv(name, 0, SVt_PVCV);
+       cv = GvCV(gv);
+       LEAVE;
+       CvXSUBANY(cv).any_ptr = &PL_sv_undef;
+       return cv;
+}
+# define CvCONST_off(cv) my_CvCONST_off(aTHX_ cv)
+static void my_CvCONST_off(pTHX_ CV *cv)
+{
+       op_free(CvROOT(cv));
+       CvROOT(cv) = NULL;
+       CvSTART(cv) = NULL;
+}
+#endif /* !CvCONST_on */
+
 #ifndef HAS_INET_ATON
 
 /*
@@ -96,7 +236,7 @@ my_inet_aton(register const char *cp, struct in_addr *addr)
        unsigned int parts[4];
        register unsigned int *pp = parts;
 
-       if (!cp || !*cp)
+       if (!cp || !*cp)
                return 0;
        for (;;) {
                /*
@@ -180,6 +320,11 @@ my_inet_aton(register const char *cp, struct in_addr *addr)
 
 #endif /* ! HAS_INET_ATON */
 
+/* These are not gni() constants; they're extensions for the perl API */
+/* The definitions in Socket.pm and Socket.xs must match */
+#define NIx_NOHOST   (1 << 0)
+#define NIx_NOSERV   (1 << 1)
+
 
 static int
 not_here(const char *s)
@@ -201,7 +346,7 @@ not_here(const char *s)
 * 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,
+* (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
@@ -224,7 +369,7 @@ not_here(const char *s)
 static SV *err_to_SV(pTHX_ int err)
 {
        SV *ret = sv_newmortal();
-       SvUPGRADE(ret, SVt_PVNV);
+       (void) SvUPGRADE(ret, SVt_PVNV);
 
        if(err) {
                const char *error = gai_strerror(err);
@@ -241,7 +386,6 @@ static SV *err_to_SV(pTHX_ int err)
 
 static void xs_getaddrinfo(pTHX_ CV *cv)
 {
-       dVAR;
        dXSARGS;
 
        SV   *host;
@@ -257,8 +401,9 @@ static void xs_getaddrinfo(pTHX_ CV *cv)
        int err;
        int n_res;
 
+       PERL_UNUSED_ARG(cv);
        if(items > 3)
-               croak_xs_usage(cv, "host, service, hints");
+               croak("Usage: Socket::getaddrinfo(host, service, hints)");
 
        SP -= items;
 
@@ -291,7 +436,7 @@ static void xs_getaddrinfo(pTHX_ CV *cv)
                        servicename = NULL;
        }
 
-       Zero(&hints_s, sizeof hints_s, char);
+       Zero(&hints_s, sizeof(hints_s), char);
        hints_s.ai_family = PF_UNSPEC;
 
        if(hints && SvOK(hints)) {
@@ -303,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);
        }
 
@@ -348,11 +493,11 @@ static void xs_getaddrinfo(pTHX_ CV *cv)
 #ifdef HAS_GETNAMEINFO
 static void xs_getnameinfo(pTHX_ CV *cv)
 {
-       dVAR;
        dXSARGS;
 
        SV  *addr;
        int  flags;
+       int  xflags;
 
        char host[1024];
        char serv[256];
@@ -360,8 +505,11 @@ static void xs_getnameinfo(pTHX_ CV *cv)
        STRLEN addr_len;
        int err;
 
-       if(items < 1 || items > 2)
-               croak_xs_usage(cv, "addr, flags=0");
+       int want_host, want_serv;
+
+       PERL_UNUSED_ARG(cv);
+       if(items < 1 || items > 3)
+               croak("Usage: Socket::getnameinfo(addr, flags=0, xflags=0)");
 
        SP -= items;
 
@@ -372,6 +520,14 @@ static void xs_getnameinfo(pTHX_ CV *cv)
        else
                flags = SvIV(ST(1));
 
+       if(items < 3)
+               xflags = 0;
+       else
+               xflags = SvIV(ST(2));
+
+       want_host = !(xflags & NIx_NOHOST);
+       want_serv = !(xflags & NIx_NOSERV);
+
        if(!SvPOK(addr))
                croak("addr is not a string");
 
@@ -386,8 +542,8 @@ static void xs_getnameinfo(pTHX_ CV *cv)
 #endif
 
        err = getnameinfo((struct sockaddr *)sa, addr_len,
-                       host, sizeof(host),
-                       serv, sizeof(serv),
+                       want_host ? host : NULL, want_host ? sizeof(host) : 0,
+                       want_serv ? serv : NULL, want_serv ? sizeof(serv) : 0,
                        flags);
 
        Safefree(sa);
@@ -397,8 +553,8 @@ static void xs_getnameinfo(pTHX_ CV *cv)
        if(err)
                XSRETURN(1);
 
-       XPUSHs(sv_2mortal(newSVpv(host, 0)));
-       XPUSHs(sv_2mortal(newSVpv(serv, 0)));
+       XPUSHs(want_host ? sv_2mortal(newSVpv(host, 0)) : &PL_sv_undef);
+       XPUSHs(want_serv ? sv_2mortal(newSVpv(serv, 0)) : &PL_sv_undef);
 
        XSRETURN(3);
 }
@@ -410,10 +566,10 @@ INCLUDE: const-xs.inc
 
 BOOT:
 #ifdef HAS_GETADDRINFO
-  newXS("Socket::getaddrinfo", xs_getaddrinfo, __FILE__);
+       newXS("Socket::getaddrinfo", xs_getaddrinfo, __FILE__);
 #endif
 #ifdef HAS_GETNAMEINFO
-  newXS("Socket::getnameinfo", xs_getnameinfo, __FILE__);
+       newXS("Socket::getnameinfo", xs_getnameinfo, __FILE__);
 #endif
 
 void
@@ -425,13 +581,13 @@ inet_aton(host)
        struct hostent * phe;
 
        if ((*host != '\0') && inet_aton(host, &ip_address)) {
-               ST(0) = newSVpvn_flags((char *)&ip_address, sizeof ip_address, SVs_TEMP);
+               ST(0) = sv_2mortal(newSVpvn((char *)&ip_address, sizeof(ip_address)));
                XSRETURN(1);
        }
 
        phe = gethostbyname(host);
        if (phe && phe->h_addrtype == AF_INET && phe->h_length == 4) {
-               ST(0) = newSVpvn_flags((char *)phe->h_addr, phe->h_length, SVs_TEMP);
+               ST(0) = sv_2mortal(newSVpvn((char *)phe->h_addr, phe->h_length));
                XSRETURN(1);
        }
 
@@ -447,18 +603,17 @@ inet_ntoa(ip_address_sv)
        struct in_addr addr;
        char * ip_address;
        if (DO_UTF8(ip_address_sv) && !sv_utf8_downgrade(ip_address_sv, 1))
-            croak("Wide character in %s", "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 =
+               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::inet_ntoa",
-                     addrlen, sizeof(addr));
+               croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf,
+                     "Socket::inet_ntoa", (UV)addrlen, (UV)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.
@@ -477,11 +632,10 @@ sockaddr_family(sockaddr)
        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));
-       }
+       if (sockaddr_len < offsetof(struct sockaddr, sa_data))
+               croak("Bad arg length for %s, length is %"UVuf", should be at least %"UVuf,
+                     "Socket::sockaddr_family", (UV)sockaddr_len,
+                     (UV)offsetof(struct sockaddr, sa_data));
        ST(0) = sv_2mortal(newSViv(((struct sockaddr*)sockaddr_pv)->sa_family));
 
 void
@@ -495,36 +649,36 @@ pack_sockaddr_un(pathname)
        char * pathname_pv;
        int addr_len;
 
-       Zero( &sun_ad, sizeof sun_ad, char );
+       Zero(&sun_ad, sizeof(sun_ad), char);
        sun_ad.sun_family = AF_UNIX;
        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! */
        {
-           int off;
-           char *s, *e;
-
-           if (pathname_pv[0] != '/' && pathname_pv[0] != '\\')
-               croak("Relative UNIX domain socket name '%s' unsupported",
-                       pathname_pv);
-           else if (len < 8
-                    || 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_pv, sun_ad.sun_path + off, len, char );
-
-           s = sun_ad.sun_path + off - 1;
-           e = s + len + 1;
-           while (++s < e)
-               if (*s = '/')
-                   *s = '\\';
+               int off;
+               char *s, *e;
+
+               if (pathname_pv[0] != '/' && pathname_pv[0] != '\\')
+                       croak("Relative UNIX domain socket name '%s' unsupported",
+                             pathname_pv);
+               else if (len < 8
+                        || 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_pv, sun_ad.sun_path + off, len, char);
+
+               s = sun_ad.sun_path + off - 1;
+               e = s + len + 1;
+               while (++s < e)
+                       if (*s = '/')
+                               *s = '\\';
        }
 #  else        /* !( defined OS2 ) */
-       Copy( pathname_pv, sun_ad.sun_path, len, char );
+       Copy(pathname_pv, sun_ad.sun_path, len, char);
 #  endif
        if (0) not_here("dummy");
        if (len > 1 && sun_ad.sun_path[0] == '\0') {
@@ -535,16 +689,16 @@ pack_sockaddr_un(pathname)
                 * end of that character array */
                addr_len = (char *)&(sun_ad.sun_path) - (char *)&sun_ad + len;
        } else {
-               addr_len = sizeof sun_ad;
+               addr_len = sizeof(sun_ad);
        }
 #  ifdef HAS_SOCKADDR_SA_LEN
        sun_ad.sun_len = addr_len;
 #  endif
-       ST(0) = newSVpvn_flags((char *)&sun_ad, addr_len, SVs_TEMP);
+       ST(0) = sv_2mortal(newSVpvn((char *)&sun_ad, addr_len));
 #else
-       ST(0) = (SV *) not_here("pack_sockaddr_un");
+       ST(0) = (SV*)not_here("pack_sockaddr_un");
 #endif
-
+       
        }
 
 void
@@ -557,24 +711,25 @@ 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)) {
-           croak("Bad arg length for %s, length is %d, should be %d",
-                       "Socket::unpack_sockaddr_un",
-                       sockaddrlen, 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));
+       Copy(sun_ad, &addr, sizeof(addr), char);
 #   endif
 
-       Copy( sun_ad, &addr, sizeof addr, char );
-
-       if ( addr.sun_family != AF_UNIX ) {
-           croak("Bad address family for %s, got %d, should be %d",
-                       "Socket::unpack_sockaddr_un",
-                       addr.sun_family,
-                       AF_UNIX);
-       }
+       if (addr.sun_family != AF_UNIX)
+               croak("Bad address family for %s, got %d, should be %d",
+                     "Socket::unpack_sockaddr_un", addr.sun_family, AF_UNIX);
 
        if (addr.sun_path[0] == '\0') {
                /* Linux-style abstract socket address begins with a nul
@@ -585,9 +740,9 @@ unpack_sockaddr_un(sun_sv)
                     && addr_len < (int)sizeof(addr.sun_path); addr_len++);
        }
 
-       ST(0) = newSVpvn_flags(addr.sun_path, addr_len, SVs_TEMP);
+       ST(0) = sv_2mortal(newSVpvn(addr.sun_path, addr_len));
 #else
-       ST(0) = (SV *) not_here("unpack_sockaddr_un");
+       ST(0) = (SV*)not_here("unpack_sockaddr_un");
 #endif
        }
 
@@ -602,26 +757,26 @@ 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 %s", "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 =
+               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",
+               croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf,
                      "Socket::pack_sockaddr_in",
-                     addrlen, sizeof(addr));
-       Zero( &sin, sizeof sin, char );
+                     (UV)addrlen, (UV)sizeof(addr));
+       Zero(&sin, sizeof(sin), char);
        sin.sin_family = AF_INET;
        sin.sin_port = htons(port);
        sin.sin_addr.s_addr = htonl(addr.s_addr);
 #  ifdef HAS_SOCKADDR_SA_LEN
-       sin.sin_len = sizeof (sin);
+       sin.sin_len = sizeof(sin);
 #  endif
-       ST(0) = newSVpvn_flags((char *)&sin, sizeof (sin), SVs_TEMP);
+       ST(0) = sv_2mortal(newSVpvn((char *)&sin, sizeof(sin)));
        }
 
 void
@@ -632,26 +787,23 @@ unpack_sockaddr_in(sin_sv)
        STRLEN sockaddrlen;
        struct sockaddr_in addr;
        unsigned short  port;
-       struct in_addr  ip_address;
+       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",
-                       sockaddrlen, sizeof(addr));
+           croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf,
+                 "Socket::unpack_sockaddr_in", sockaddrlen, sizeof(addr));
        }
-       Copy( sin, &addr,sizeof addr, char );
-       if ( addr.sin_family != AF_INET ) {
+       Copy(sin, &addr, sizeof(addr), char);
+       if (addr.sin_family != AF_INET) {
            croak("Bad address family for %s, got %d, should be %d",
-                       "Socket::unpack_sockaddr_in",
-                       addr.sin_family,
-                       AF_INET);
+                 "Socket::unpack_sockaddr_in", addr.sin_family, AF_INET);
        }
        port = ntohs(addr.sin_port);
        ip_address = addr.sin_addr;
 
        EXTEND(SP, 2);
        PUSHs(sv_2mortal(newSViv((IV) port)));
-       PUSHs(newSVpvn_flags((char *)&ip_address, sizeof(ip_address), SVs_TEMP));
+       PUSHs(sv_2mortal(newSVpvn((char *)&ip_address, sizeof(ip_address))));
        }
 
 void
@@ -662,16 +814,16 @@ pack_sockaddr_in6(port, sin6_addr, scope_id=0, flowinfo=0)
        unsigned long   flowinfo
        CODE:
        {
-#ifdef AF_INET6
+#ifdef HAS_SOCKADDR_IN6
        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");
+               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));
+       if (addrlen != sizeof(sin6.sin6_addr))
+               croak("Bad arg length %s, length is %"UVuf", should be %"UVuf,
+                     "Socket::pack_sockaddr_in6", (UV)addrlen, (UV)sizeof(sin6.sin6_addr));
        Zero(&sin6, sizeof(sin6), char);
        sin6.sin6_family = AF_INET6;
        sin6.sin6_port = htons(port);
@@ -680,14 +832,14 @@ pack_sockaddr_in6(port, sin6_addr, scope_id=0, flowinfo=0)
 #  ifdef HAS_SIN6_SCOPE_ID
        sin6.sin6_scope_id = scope_id;
 #  else
-       if(scope_id != 0)
+       if (scope_id != 0)
            warn("%s cannot represent non-zero scope_id %d",
-                "Socket::pack_sockaddr_in6", scope_id);
+                "Socket::pack_sockaddr_in6", scope_id);
 #  endif
 #  ifdef HAS_SOCKADDR_SA_LEN
        sin6.sin6_len = sizeof(sin6);
 #  endif
-       ST(0) = newSVpvn_flags((char *)&sin6, sizeof(sin6), SVs_TEMP);
+       ST(0) = sv_2mortal(newSVpvn((char *)&sin6, sizeof(sin6)));
 #else
        ST(0) = (SV*)not_here("pack_sockaddr_in6");
 #endif
@@ -698,19 +850,17 @@ unpack_sockaddr_in6(sin6_sv)
        SV *    sin6_sv
        PPCODE:
        {
-#ifdef AF_INET6
+#ifdef HAS_SOCKADDR_IN6
        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));
+               croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf,
+                     "Socket::unpack_sockaddr_in6", (UV)addrlen, (UV)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);
+       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));
@@ -727,9 +877,9 @@ unpack_sockaddr_in6(sin6_sv)
 
 void
 inet_ntop(af, ip_address_sv)
-        int     af
-        SV *    ip_address_sv
-        CODE:
+       int     af
+       SV *    ip_address_sv
+       CODE:
 #ifdef HAS_INETNTOP
        STRLEN addrlen, struct_size;
 #ifdef AF_INET6
@@ -739,92 +889,158 @@ 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);
 
-       if(af != AF_INET
+       if (af != AF_INET
 #ifdef AF_INET6
            && af != AF_INET6
 #endif
-         ) {
-           croak("Bad address family for %s, got %d, should be"
+          ) {
+               croak("Bad address family for %s, got %d, should be"
 #ifdef AF_INET6
-              " either AF_INET or AF_INET6",
+                     " either AF_INET or AF_INET6",
 #else
-              " AF_INET",
+                     " AF_INET",
 #endif
-               "Socket::inet_ntop",
-               af);
-        }
+                     "Socket::inet_ntop", af);
+       }
 
-       Copy( ip_address, &addr, sizeof addr, char );
+       Copy(ip_address, &addr, sizeof addr, char);
        inet_ntop(af, &addr, str, sizeof str);
 
-       ST(0) = newSVpvn_flags(str, strlen(str), SVs_TEMP);
+       ST(0) = sv_2mortal(newSVpvn(str, strlen(str)));
 #else
-        ST(0) = (SV *)not_here("inet_ntop");
+       ST(0) = (SV*)not_here("inet_ntop");
 #endif
 
 void
 inet_pton(af, host)
-        int           af
-        const char *  host
-        CODE:
+       int           af
+       const char *  host
+       CODE:
 #ifdef HAS_INETPTON
-        int ok;
+       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",
+                     " either AF_INET or AF_INET6",
 #else
-                       " AF_INET",
+                     " AF_INET",
 #endif
-                        "Socket::inet_pton",
-                        af);
-        }
-        ok = (*host != '\0') && inet_pton(af, host, &ip_address);
+                     "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) );
-        }
+       ST(0) = sv_newmortal();
+       if (ok) {
+               sv_setpvn( ST(0), (char *)&ip_address, addrlen);
+       }
 #else
-        ST(0) = (SV *)not_here("inet_pton");
+       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 AF_INET6
+#ifdef HAS_IPV6_MREQ
        struct ipv6_mreq mreq;
-       char * addrbytes;
-       STRLEN addrlen;
-       if (DO_UTF8(addr) && !sv_utf8_downgrade(addr, 1))
-           croak("Wide character in %s", "Socket::pack_ipv6_mreq");
-       addrbytes = SvPVbyte(addr, addrlen);
-       if(addrlen != sizeof(mreq.ipv6mr_multiaddr))
-           croak("Bad arg length %s, length is %d, should be %d",
-                 "Socket::pack_ipv6_mreq", addrlen, sizeof(mreq.ipv6mr_multiaddr));
+       char * multiaddrbytes;
+       STRLEN len;
+       if (DO_UTF8(multiaddr) && !sv_utf8_downgrade(multiaddr, 1))
+               croak("Wide character in %s", "Socket::pack_ipv6_mreq");
+       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)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) = newSVpvn_flags((char *)&mreq, sizeof(mreq), SVs_TEMP);
+       ST(0) = sv_2mortal(newSVpvn((char *)&mreq, sizeof(mreq)));
 #else
-       ST(0) = (SV*)not_here("pack_ipv6_mreq");
+       not_here("pack_ipv6_mreq");
 #endif
        }
 
@@ -833,14 +1049,13 @@ unpack_ipv6_mreq(mreq_sv)
        SV * mreq_sv
        PPCODE:
        {
-#ifdef AF_INET6
+#ifdef HAS_IPV6_MREQ
        struct ipv6_mreq mreq;
        STRLEN mreqlen;
        char * mreqbytes = SvPVbyte(mreq_sv, mreqlen);
        if (mreqlen != sizeof(mreq))
-           croak("Bad arg length for %s, length is %d, should be %d",
-                   "Socket::unpack_ipv6_mreq",
-                   mreqlen, sizeof(mreq));
+               croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf,
+                     "Socket::unpack_ipv6_mreq", (UV)mreqlen, (UV)sizeof(mreq));
        Copy(mreqbytes, &mreq, sizeof(mreq), char);
        EXTEND(SP, 2);
        mPUSHp((char *)&mreq.ipv6mr_multiaddr, sizeof(mreq.ipv6mr_multiaddr));