This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update Socket to CPAN version 1.96
[perl5.git] / cpan / Socket / Socket.xs
1 #define PERL_NO_GET_CONTEXT
2 #include "EXTERN.h"
3 #include "perl.h"
4 #include "XSUB.h"
5
6 #include <stddef.h>
7
8 #ifdef I_SYS_TYPES
9 #  include <sys/types.h>
10 #endif
11 #if !defined(ultrix) /* Avoid double definition. */
12 #   include <sys/socket.h>
13 #endif
14 #if defined(USE_SOCKS) && defined(I_SOCKS)
15 #   include <socks.h>
16 #endif
17 #ifdef MPE
18 #  define PF_INET AF_INET
19 #  define PF_UNIX AF_UNIX
20 #  define SOCK_RAW 3
21 #endif
22 #ifdef I_SYS_UN
23 #  include <sys/un.h>
24 #endif
25 /* XXX Configure test for <netinet/in_systm.h needed XXX */
26 #if defined(NeXT) || defined(__NeXT__)
27 #  include <netinet/in_systm.h>
28 #endif
29 #if defined(__sgi) && !defined(AF_LINK) && defined(PF_LINK) && PF_LINK == AF_LNK
30 #  undef PF_LINK
31 #endif
32 #if defined(I_NETINET_IN) || defined(__ultrix__)
33 #  include <netinet/in.h>
34 #endif
35 #ifdef I_NETDB
36 #  if !defined(ultrix)  /* Avoid double definition. */
37 #   include <netdb.h>
38 #  endif
39 #endif
40 #ifdef I_ARPA_INET
41 #  include <arpa/inet.h>
42 #endif
43 #ifdef I_NETINET_TCP
44 #  include <netinet/tcp.h>
45 #endif
46
47 #ifdef NETWARE
48 NETDB_DEFINE_CONTEXT
49 NETINET_DEFINE_CONTEXT
50 #endif
51
52 #ifdef I_SYSUIO
53 # include <sys/uio.h>
54 #endif
55
56 #ifndef AF_NBS
57 # undef PF_NBS
58 #endif
59
60 #ifndef AF_X25
61 # undef PF_X25
62 #endif
63
64 #ifndef INADDR_NONE
65 # define INADDR_NONE    0xffffffff
66 #endif /* INADDR_NONE */
67 #ifndef INADDR_BROADCAST
68 # define INADDR_BROADCAST       0xffffffff
69 #endif /* INADDR_BROADCAST */
70 #ifndef INADDR_LOOPBACK
71 # define INADDR_LOOPBACK         0x7F000001
72 #endif /* INADDR_LOOPBACK */
73
74 #ifndef croak_sv
75 # define croak_sv(sv)   croak(SvPV_nolen(sv))
76 #endif
77
78 /* perl < 5.8.9 or == 5.10.0 lacks newSVpvn_flags */
79 #if PERL_VERSION < 8
80 # define NEED_newSVpvn_flags
81 #elif PERL_VERSION == 8 && PERL_SUBVERSION < 9
82 # define NEED_newSVpvn_flags
83 #elif PERL_VERSION == 10 && PERL_SUBVERSION == 0
84 # define NEED_newSVpvn_flags
85 #endif
86
87 #ifdef NEED_newSVpvn_flags
88 static SV *newSVpvn_flags(pTHX_ const char *s, STRLEN len, U32 flags)
89 {
90   SV *sv = newSVpvn(s, len);
91   SvFLAGS(sv) |= (flags & SVf_UTF8);
92   return (flags & SVs_TEMP) ? sv_2mortal(sv) : sv;
93 }
94 #endif
95
96 #ifndef HAS_INET_ATON
97
98 /*
99  * Check whether "cp" is a valid ascii representation
100  * of an Internet address and convert to a binary address.
101  * Returns 1 if the address is valid, 0 if not.
102  * This replaces inet_addr, the return value from which
103  * cannot distinguish between failure and a local broadcast address.
104  */
105 static int
106 my_inet_aton(register const char *cp, struct in_addr *addr)
107 {
108         dTHX;
109         register U32 val;
110         register int base;
111         register char c;
112         int nparts;
113         const char *s;
114         unsigned int parts[4];
115         register unsigned int *pp = parts;
116
117         if (!cp || !*cp)
118                 return 0;
119         for (;;) {
120                 /*
121                  * Collect number up to ".".
122                  * Values are specified as for C:
123                  * 0x=hex, 0=octal, other=decimal.
124                  */
125                 val = 0; base = 10;
126                 if (*cp == '0') {
127                         if (*++cp == 'x' || *cp == 'X')
128                                 base = 16, cp++;
129                         else
130                                 base = 8;
131                 }
132                 while ((c = *cp) != '\0') {
133                         if (isDIGIT(c)) {
134                                 val = (val * base) + (c - '0');
135                                 cp++;
136                                 continue;
137                         }
138                         if (base == 16 && (s=strchr(PL_hexdigit,c))) {
139                                 val = (val << 4) +
140                                         ((s - PL_hexdigit) & 15);
141                                 cp++;
142                                 continue;
143                         }
144                         break;
145                 }
146                 if (*cp == '.') {
147                         /*
148                          * Internet format:
149                          *      a.b.c.d
150                          *      a.b.c   (with c treated as 16-bits)
151                          *      a.b     (with b treated as 24 bits)
152                          */
153                         if (pp >= parts + 3 || val > 0xff)
154                                 return 0;
155                         *pp++ = val, cp++;
156                 } else
157                         break;
158         }
159         /*
160          * Check for trailing characters.
161          */
162         if (*cp && !isSPACE(*cp))
163                 return 0;
164         /*
165          * Concoct the address according to
166          * the number of parts specified.
167          */
168         nparts = pp - parts + 1;        /* force to an int for switch() */
169         switch (nparts) {
170
171         case 1:                         /* a -- 32 bits */
172                 break;
173
174         case 2:                         /* a.b -- 8.24 bits */
175                 if (val > 0xffffff)
176                         return 0;
177                 val |= parts[0] << 24;
178                 break;
179
180         case 3:                         /* a.b.c -- 8.8.16 bits */
181                 if (val > 0xffff)
182                         return 0;
183                 val |= (parts[0] << 24) | (parts[1] << 16);
184                 break;
185
186         case 4:                         /* a.b.c.d -- 8.8.8.8 bits */
187                 if (val > 0xff)
188                         return 0;
189                 val |= (parts[0] << 24) | (parts[1] << 16) | (parts[2] << 8);
190                 break;
191         }
192         addr->s_addr = htonl(val);
193         return 1;
194 }
195
196 #undef inet_aton
197 #define inet_aton my_inet_aton
198
199 #endif /* ! HAS_INET_ATON */
200
201 /* These are not gni() constants; they're extensions for the perl API */
202 /* The definitions in Socket.pm and Socket.xs must match */
203 #define NIx_NOHOST   (1 << 0)
204 #define NIx_NOSERV   (1 << 1)
205
206
207 static int
208 not_here(const char *s)
209 {
210     croak("Socket::%s not implemented on this architecture", s);
211     return -1;
212 }
213
214 #define PERL_IN_ADDR_S_ADDR_SIZE 4
215
216 /*
217 * Bad assumptions possible here.
218 *
219 * Bad Assumption 1: struct in_addr has no other fields
220 * than the s_addr (which is the field we care about
221 * in here, really). However, we can be fed either 4-byte
222 * addresses (from pack("N", ...), or va.b.c.d, or ...),
223 * or full struct in_addrs (from e.g. pack_sockaddr_in()),
224 * which may or may not be 4 bytes in size.
225 *
226 * Bad Assumption 2: the s_addr field is a simple type
227 * (such as an int, u_int32_t).  It can be a bit field,
228 * in which case using & (address-of) on it or taking sizeof()
229 * wouldn't go over too well.  (Those are not attempted
230 * now but in case someone thinks to change the below code
231 * to use addr.s_addr instead of addr, you have been warned.)
232 *
233 * Bad Assumption 3: the s_addr is the first field in
234 * an in_addr, or that its bytes are the first bytes in
235 * an in_addr.
236 *
237 * These bad assumptions are wrong in UNICOS which has
238 * struct in_addr { struct { u_long  st_addr:32; } s_da };
239 * #define s_addr s_da.st_addr
240 * and u_long is 64 bits.
241 *
242 * --jhi */
243
244 #include "const-c.inc"
245
246 #ifdef HAS_GETADDRINFO
247 static SV *err_to_SV(pTHX_ int err)
248 {
249         SV *ret = sv_newmortal();
250         SvUPGRADE(ret, SVt_PVNV);
251
252         if(err) {
253                 const char *error = gai_strerror(err);
254                 sv_setpv(ret, error);
255         }
256         else {
257                 sv_setpv(ret, "");
258         }
259
260         SvIV_set(ret, err); SvIOK_on(ret);
261
262         return ret;
263 }
264
265 static void xs_getaddrinfo(pTHX_ CV *cv)
266 {
267         dXSARGS;
268
269         SV   *host;
270         SV   *service;
271         SV   *hints;
272
273         char *hostname = NULL;
274         char *servicename = NULL;
275         STRLEN len;
276         struct addrinfo hints_s;
277         struct addrinfo *res;
278         struct addrinfo *res_iter;
279         int err;
280         int n_res;
281
282         if(items > 3)
283                 croak("Usage: Socket::getaddrinfo(host, service, hints)");
284
285         SP -= items;
286
287         if(items < 1)
288                 host = &PL_sv_undef;
289         else
290                 host = ST(0);
291
292         if(items < 2)
293                 service = &PL_sv_undef;
294         else
295                 service = ST(1);
296
297         if(items < 3)
298                 hints = NULL;
299         else
300                 hints = ST(2);
301
302         SvGETMAGIC(host);
303         if(SvOK(host)) {
304                 hostname = SvPV_nomg(host, len);
305                 if (!len)
306                         hostname = NULL;
307         }
308
309         SvGETMAGIC(service);
310         if(SvOK(service)) {
311                 servicename = SvPV_nomg(service, len);
312                 if (!len)
313                         servicename = NULL;
314         }
315
316         Zero(&hints_s, sizeof(hints_s), char);
317         hints_s.ai_family = PF_UNSPEC;
318
319         if(hints && SvOK(hints)) {
320                 HV *hintshash;
321                 SV **valp;
322
323                 if(!SvROK(hints) || SvTYPE(SvRV(hints)) != SVt_PVHV)
324                         croak("hints is not a HASH reference");
325
326                 hintshash = (HV*)SvRV(hints);
327
328                 if((valp = hv_fetch(hintshash, "flags", 5, 0)) != NULL)
329                         hints_s.ai_flags = SvIV(*valp);
330                 if((valp = hv_fetch(hintshash, "family", 6, 0)) != NULL)
331                         hints_s.ai_family = SvIV(*valp);
332                 if((valp = hv_fetch(hintshash, "socktype", 8, 0)) != NULL)
333                         hints_s.ai_socktype = SvIV(*valp);
334                 if((valp = hv_fetch(hintshash, "protocol", 8, 0)) != NULL)
335                         hints_s.ai_protocol = SvIV(*valp);
336         }
337
338         err = getaddrinfo(hostname, servicename, &hints_s, &res);
339
340         XPUSHs(err_to_SV(aTHX_ err));
341
342         if(err)
343                 XSRETURN(1);
344
345         n_res = 0;
346         for(res_iter = res; res_iter; res_iter = res_iter->ai_next) {
347                 HV *res_hv = newHV();
348
349                 (void)hv_stores(res_hv, "family",   newSViv(res_iter->ai_family));
350                 (void)hv_stores(res_hv, "socktype", newSViv(res_iter->ai_socktype));
351                 (void)hv_stores(res_hv, "protocol", newSViv(res_iter->ai_protocol));
352
353                 (void)hv_stores(res_hv, "addr",     newSVpvn((char*)res_iter->ai_addr, res_iter->ai_addrlen));
354
355                 if(res_iter->ai_canonname)
356                         (void)hv_stores(res_hv, "canonname", newSVpv(res_iter->ai_canonname, 0));
357                 else
358                         (void)hv_stores(res_hv, "canonname", newSV(0));
359
360                 XPUSHs(sv_2mortal(newRV_noinc((SV*)res_hv)));
361                 n_res++;
362         }
363
364         freeaddrinfo(res);
365
366         XSRETURN(1 + n_res);
367 }
368 #endif
369
370 #ifdef HAS_GETNAMEINFO
371 static void xs_getnameinfo(pTHX_ CV *cv)
372 {
373         dXSARGS;
374
375         SV  *addr;
376         int  flags;
377         int  xflags;
378
379         char host[1024];
380         char serv[256];
381         char *sa; /* we'll cast to struct sockaddr * when necessary */
382         STRLEN addr_len;
383         int err;
384
385         int want_host, want_serv;
386
387         if(items < 1 || items > 3)
388                 croak("Usage: Socket::getnameinfo(addr, flags=0, xflags=0)");
389
390         SP -= items;
391
392         addr = ST(0);
393
394         if(items < 2)
395                 flags = 0;
396         else
397                 flags = SvIV(ST(1));
398
399         if(items < 3)
400                 xflags = 0;
401         else
402                 xflags = SvIV(ST(2));
403
404         want_host = !(xflags & NIx_NOHOST);
405         want_serv = !(xflags & NIx_NOSERV);
406
407         if(!SvPOK(addr))
408                 croak("addr is not a string");
409
410         addr_len = SvCUR(addr);
411
412         /* We need to ensure the sockaddr is aligned, because a random SvPV might
413          * not be due to SvOOK */
414         Newx(sa, addr_len, char);
415         Copy(SvPV_nolen(addr), sa, addr_len, char);
416 #ifdef HAS_SOCKADDR_SA_LEN
417         ((struct sockaddr *)sa)->sa_len = addr_len;
418 #endif
419
420         err = getnameinfo((struct sockaddr *)sa, addr_len,
421                         want_host ? host : NULL, want_host ? sizeof(host) : 0,
422                         want_serv ? serv : NULL, want_serv ? sizeof(serv) : 0,
423                         flags);
424
425         Safefree(sa);
426
427         XPUSHs(err_to_SV(aTHX_ err));
428
429         if(err)
430                 XSRETURN(1);
431
432         XPUSHs(want_host ? sv_2mortal(newSVpv(host, 0)) : &PL_sv_undef);
433         XPUSHs(want_serv ? sv_2mortal(newSVpv(serv, 0)) : &PL_sv_undef);
434
435         XSRETURN(3);
436 }
437 #endif
438
439 MODULE = Socket         PACKAGE = Socket
440
441 INCLUDE: const-xs.inc
442
443 BOOT:
444 #ifdef HAS_GETADDRINFO
445         newXS("Socket::getaddrinfo", xs_getaddrinfo, __FILE__);
446 #endif
447 #ifdef HAS_GETNAMEINFO
448         newXS("Socket::getnameinfo", xs_getnameinfo, __FILE__);
449 #endif
450
451 void
452 inet_aton(host)
453         char *  host
454         CODE:
455         {
456         struct in_addr ip_address;
457         struct hostent * phe;
458
459         if ((*host != '\0') && inet_aton(host, &ip_address)) {
460                 ST(0) = sv_2mortal(newSVpvn((char *)&ip_address, sizeof(ip_address)));
461                 XSRETURN(1);
462         }
463
464         phe = gethostbyname(host);
465         if (phe && phe->h_addrtype == AF_INET && phe->h_length == 4) {
466                 ST(0) = sv_2mortal(newSVpvn((char *)phe->h_addr, phe->h_length));
467                 XSRETURN(1);
468         }
469
470         XSRETURN_UNDEF;
471         }
472
473 void
474 inet_ntoa(ip_address_sv)
475         SV *    ip_address_sv
476         CODE:
477         {
478         STRLEN addrlen;
479         struct in_addr addr;
480         char * ip_address;
481         if (DO_UTF8(ip_address_sv) && !sv_utf8_downgrade(ip_address_sv, 1))
482                 croak("Wide character in %s", "Socket::inet_ntoa");
483         ip_address = SvPVbyte(ip_address_sv, addrlen);
484         if (addrlen == sizeof(addr) || addrlen == 4)
485                 addr.s_addr =
486                     (ip_address[0] & 0xFF) << 24 |
487                     (ip_address[1] & 0xFF) << 16 |
488                     (ip_address[2] & 0xFF) <<  8 |
489                     (ip_address[3] & 0xFF);
490         else
491                 croak("Bad arg length for %s, length is %d, should be %d",
492                       "Socket::inet_ntoa", addrlen, sizeof(addr));
493         /* We could use inet_ntoa() but that is broken
494          * in HP-UX + GCC + 64bitint (returns "0.0.0.0"),
495          * so let's use this sprintf() workaround everywhere.
496          * This is also more threadsafe than using inet_ntoa(). */
497         ST(0) = sv_2mortal(Perl_newSVpvf(aTHX_ "%d.%d.%d.%d", /* IPv6? */
498                                          ((addr.s_addr >> 24) & 0xFF),
499                                          ((addr.s_addr >> 16) & 0xFF),
500                                          ((addr.s_addr >>  8) & 0xFF),
501                                          ( addr.s_addr        & 0xFF)));
502         }
503
504 void
505 sockaddr_family(sockaddr)
506         SV *    sockaddr
507         PREINIT:
508         STRLEN sockaddr_len;
509         char *sockaddr_pv = SvPVbyte(sockaddr, sockaddr_len);
510         CODE:
511         if (sockaddr_len < offsetof(struct sockaddr, sa_data))
512                 croak("Bad arg length for %s, length is %d, should be at least %d",
513                       "Socket::sockaddr_family", sockaddr_len,
514                       offsetof(struct sockaddr, sa_data));
515         ST(0) = sv_2mortal(newSViv(((struct sockaddr*)sockaddr_pv)->sa_family));
516
517 void
518 pack_sockaddr_un(pathname)
519         SV *    pathname
520         CODE:
521         {
522 #ifdef I_SYS_UN
523         struct sockaddr_un sun_ad; /* fear using sun */
524         STRLEN len;
525         char * pathname_pv;
526         int addr_len;
527
528         Zero(&sun_ad, sizeof(sun_ad), char);
529         sun_ad.sun_family = AF_UNIX;
530         pathname_pv = SvPV(pathname,len);
531         if (len > sizeof(sun_ad.sun_path))
532             len = sizeof(sun_ad.sun_path);
533 #  ifdef OS2    /* Name should start with \socket\ and contain backslashes! */
534         {
535                 int off;
536                 char *s, *e;
537
538                 if (pathname_pv[0] != '/' && pathname_pv[0] != '\\')
539                         croak("Relative UNIX domain socket name '%s' unsupported",
540                               pathname_pv);
541                 else if (len < 8
542                          || pathname_pv[7] != '/' && pathname_pv[7] != '\\'
543                          || !strnicmp(pathname_pv + 1, "socket", 6))
544                         off = 7;
545                 else
546                         off = 0;        /* Preserve names starting with \socket\ */
547                 Copy("\\socket", sun_ad.sun_path, off, char);
548                 Copy(pathname_pv, sun_ad.sun_path + off, len, char);
549
550                 s = sun_ad.sun_path + off - 1;
551                 e = s + len + 1;
552                 while (++s < e)
553                         if (*s = '/')
554                                 *s = '\\';
555         }
556 #  else /* !( defined OS2 ) */
557         Copy(pathname_pv, sun_ad.sun_path, len, char);
558 #  endif
559         if (0) not_here("dummy");
560         if (len > 1 && sun_ad.sun_path[0] == '\0') {
561                 /* Linux-style abstract-namespace socket.
562                  * The name is not a file name, but an array of arbitrary
563                  * character, starting with \0 and possibly including \0s,
564                  * therefore the length of the structure must denote the
565                  * end of that character array */
566                 addr_len = (char *)&(sun_ad.sun_path) - (char *)&sun_ad + len;
567         } else {
568                 addr_len = sizeof(sun_ad);
569         }
570 #  ifdef HAS_SOCKADDR_SA_LEN
571         sun_ad.sun_len = addr_len;
572 #  endif
573         ST(0) = sv_2mortal(newSVpvn((char *)&sun_ad, addr_len));
574 #else
575         ST(0) = (SV*)not_here("pack_sockaddr_un");
576 #endif
577         
578         }
579
580 void
581 unpack_sockaddr_un(sun_sv)
582         SV *    sun_sv
583         CODE:
584         {
585 #ifdef I_SYS_UN
586         struct sockaddr_un addr;
587         STRLEN sockaddrlen;
588         char * sun_ad = SvPVbyte(sun_sv,sockaddrlen);
589         int addr_len;
590 #   ifndef __linux__
591         /* On Linux sockaddrlen on sockets returned by accept, recvfrom,
592            getpeername and getsockname is not equal to sizeof(addr). */
593         if (sockaddrlen != sizeof(addr))
594                 croak("Bad arg length for %s, length is %d, should be %d",
595                       "Socket::unpack_sockaddr_un", sockaddrlen, sizeof(addr));
596 #   endif
597
598         Copy(sun_ad, &addr, sizeof(addr), char);
599
600         if (addr.sun_family != AF_UNIX)
601                 croak("Bad address family for %s, got %d, should be %d",
602                       "Socket::unpack_sockaddr_un", addr.sun_family, AF_UNIX);
603
604         if (addr.sun_path[0] == '\0') {
605                 /* Linux-style abstract socket address begins with a nul
606                  * and can contain nuls. */
607                 addr_len = (char *)&addr - (char *)&(addr.sun_path) + sockaddrlen;
608         } else {
609                 for (addr_len = 0; addr.sun_path[addr_len]
610                      && addr_len < (int)sizeof(addr.sun_path); addr_len++);
611         }
612
613         ST(0) = sv_2mortal(newSVpvn(addr.sun_path, addr_len));
614 #else
615         ST(0) = (SV*)not_here("unpack_sockaddr_un");
616 #endif
617         }
618
619 void
620 pack_sockaddr_in(port, ip_address_sv)
621         unsigned short  port
622         SV *    ip_address_sv
623         CODE:
624         {
625         struct sockaddr_in sin;
626         struct in_addr addr;
627         STRLEN addrlen;
628         char * ip_address;
629         if (DO_UTF8(ip_address_sv) && !sv_utf8_downgrade(ip_address_sv, 1))
630                 croak("Wide character in %s", "Socket::pack_sockaddr_in");
631         ip_address = SvPVbyte(ip_address_sv, addrlen);
632         if (addrlen == sizeof(addr) || addrlen == 4)
633                 addr.s_addr =
634                     (ip_address[0] & 0xFF) << 24 |
635                     (ip_address[1] & 0xFF) << 16 |
636                     (ip_address[2] & 0xFF) <<  8 |
637                     (ip_address[3] & 0xFF);
638         else
639                 croak("Bad arg length for %s, length is %d, should be %d",
640                       "Socket::pack_sockaddr_in",
641                       addrlen, sizeof(addr));
642         Zero(&sin, sizeof(sin), char);
643         sin.sin_family = AF_INET;
644         sin.sin_port = htons(port);
645         sin.sin_addr.s_addr = htonl(addr.s_addr);
646 #  ifdef HAS_SOCKADDR_SA_LEN
647         sin.sin_len = sizeof(sin);
648 #  endif
649         ST(0) = sv_2mortal(newSVpvn((char *)&sin, sizeof(sin)));
650         }
651
652 void
653 unpack_sockaddr_in(sin_sv)
654         SV *    sin_sv
655         PPCODE:
656         {
657         STRLEN sockaddrlen;
658         struct sockaddr_in addr;
659         unsigned short  port;
660         struct in_addr  ip_address;
661         char *  sin = SvPVbyte(sin_sv,sockaddrlen);
662         if (sockaddrlen != sizeof(addr)) {
663             croak("Bad arg length for %s, length is %d, should be %d",
664                   "Socket::unpack_sockaddr_in", sockaddrlen, sizeof(addr));
665         }
666         Copy(sin, &addr, sizeof(addr), char);
667         if (addr.sin_family != AF_INET) {
668             croak("Bad address family for %s, got %d, should be %d",
669                   "Socket::unpack_sockaddr_in", addr.sin_family, AF_INET);
670         }
671         port = ntohs(addr.sin_port);
672         ip_address = addr.sin_addr;
673
674         EXTEND(SP, 2);
675         PUSHs(sv_2mortal(newSViv((IV) port)));
676         PUSHs(sv_2mortal(newSVpvn((char *)&ip_address, sizeof(ip_address))));
677         }
678
679 void
680 pack_sockaddr_in6(port, sin6_addr, scope_id=0, flowinfo=0)
681         unsigned short  port
682         SV *    sin6_addr
683         unsigned long   scope_id
684         unsigned long   flowinfo
685         CODE:
686         {
687 #ifdef AF_INET6
688         struct sockaddr_in6 sin6;
689         char * addrbytes;
690         STRLEN addrlen;
691         if (DO_UTF8(sin6_addr) && !sv_utf8_downgrade(sin6_addr, 1))
692                 croak("Wide character in %s", "Socket::pack_sockaddr_in6");
693         addrbytes = SvPVbyte(sin6_addr, addrlen);
694         if (addrlen != sizeof(sin6.sin6_addr))
695                 croak("Bad arg length %s, length is %d, should be %d",
696                       "Socket::pack_sockaddr_in6", addrlen, sizeof(sin6.sin6_addr));
697         Zero(&sin6, sizeof(sin6), char);
698         sin6.sin6_family = AF_INET6;
699         sin6.sin6_port = htons(port);
700         sin6.sin6_flowinfo = htonl(flowinfo);
701         Copy(addrbytes, &sin6.sin6_addr, sizeof(sin6.sin6_addr), char);
702 #  ifdef HAS_SIN6_SCOPE_ID
703         sin6.sin6_scope_id = scope_id;
704 #  else
705         if (scope_id != 0)
706             warn("%s cannot represent non-zero scope_id %d",
707                  "Socket::pack_sockaddr_in6", scope_id);
708 #  endif
709 #  ifdef HAS_SOCKADDR_SA_LEN
710         sin6.sin6_len = sizeof(sin6);
711 #  endif
712         ST(0) = sv_2mortal(newSVpvn((char *)&sin6, sizeof(sin6)));
713 #else
714         ST(0) = (SV*)not_here("pack_sockaddr_in6");
715 #endif
716         }
717
718 void
719 unpack_sockaddr_in6(sin6_sv)
720         SV *    sin6_sv
721         PPCODE:
722         {
723 #ifdef AF_INET6
724         STRLEN addrlen;
725         struct sockaddr_in6 sin6;
726         char * addrbytes = SvPVbyte(sin6_sv, addrlen);
727         if (addrlen != sizeof(sin6))
728                 croak("Bad arg length for %s, length is %d, should be %d",
729                       "Socket::unpack_sockaddr_in6", addrlen, sizeof(sin6));
730         Copy(addrbytes, &sin6, sizeof(sin6), char);
731         if (sin6.sin6_family != AF_INET6)
732                 croak("Bad address family for %s, got %d, should be %d",
733                       "Socket::unpack_sockaddr_in6", sin6.sin6_family, AF_INET6);
734         EXTEND(SP, 4);
735         mPUSHi(ntohs(sin6.sin6_port));
736         mPUSHp((char *)&sin6.sin6_addr, sizeof(sin6.sin6_addr));
737 #  ifdef HAS_SIN6_SCOPE_ID
738         mPUSHi(sin6.sin6_scope_id);
739 #  else
740         mPUSHi(0);
741 #  endif
742         mPUSHi(ntohl(sin6.sin6_flowinfo));
743 #else
744         ST(0) = (SV*)not_here("pack_sockaddr_in6");
745 #endif
746         }
747
748 void
749 inet_ntop(af, ip_address_sv)
750         int     af
751         SV *    ip_address_sv
752         CODE:
753 #ifdef HAS_INETNTOP
754         STRLEN addrlen, struct_size;
755 #ifdef AF_INET6
756         struct in6_addr addr;
757         char str[INET6_ADDRSTRLEN];
758 #else
759         struct in_addr addr;
760         char str[INET_ADDRSTRLEN];
761 #endif
762         char *ip_address = SvPV(ip_address_sv, addrlen);
763
764         struct_size = sizeof(addr);
765
766         if (af != AF_INET
767 #ifdef AF_INET6
768             && af != AF_INET6
769 #endif
770            ) {
771                 croak("Bad address family for %s, got %d, should be"
772 #ifdef AF_INET6
773                       " either AF_INET or AF_INET6",
774 #else
775                       " AF_INET",
776 #endif
777                       "Socket::inet_ntop", af);
778         }
779
780         Copy(ip_address, &addr, sizeof addr, char);
781         inet_ntop(af, &addr, str, sizeof str);
782
783         ST(0) = sv_2mortal(newSVpvn(str, strlen(str)));
784 #else
785         ST(0) = (SV*)not_here("inet_ntop");
786 #endif
787
788 void
789 inet_pton(af, host)
790         int           af
791         const char *  host
792         CODE:
793 #ifdef HAS_INETPTON
794         int ok;
795 #ifdef AF_INET6
796         struct in6_addr ip_address;
797 #else
798         struct in_addr ip_address;
799 #endif
800
801         if (af != AF_INET
802 #ifdef AF_INET6
803             && af != AF_INET6
804 #endif
805            ) {
806                 croak("Bad address family for %s, got %d, should be"
807 #ifdef AF_INET6
808                       " either AF_INET or AF_INET6",
809 #else
810                       " AF_INET",
811 #endif
812                       "Socket::inet_pton", af);
813         }
814         ok = (*host != '\0') && inet_pton(af, host, &ip_address);
815
816         ST(0) = sv_newmortal();
817         if (ok) {
818                 sv_setpvn( ST(0), (char *)&ip_address, sizeof(ip_address) );
819         }
820 #else
821         ST(0) = (SV*)not_here("inet_pton");
822 #endif
823
824 void
825 pack_ipv6_mreq(addr, interface)
826         SV *    addr
827         unsigned int    interface
828         CODE:
829         {
830 #ifdef AF_INET6
831         struct ipv6_mreq mreq;
832         char * addrbytes;
833         STRLEN addrlen;
834         if (DO_UTF8(addr) && !sv_utf8_downgrade(addr, 1))
835                 croak("Wide character in %s", "Socket::pack_ipv6_mreq");
836         addrbytes = SvPVbyte(addr, addrlen);
837         if (addrlen != sizeof(mreq.ipv6mr_multiaddr))
838                 croak("Bad arg length %s, length is %d, should be %d",
839                       "Socket::pack_ipv6_mreq", addrlen, sizeof(mreq.ipv6mr_multiaddr));
840         Zero(&mreq, sizeof(mreq), char);
841         Copy(addrbytes, &mreq.ipv6mr_multiaddr, sizeof(mreq.ipv6mr_multiaddr), char);
842         mreq.ipv6mr_interface = interface;
843         ST(0) = sv_2mortal(newSVpvn((char *)&mreq, sizeof(mreq)));
844 #else
845         ST(0) = (SV*)not_here("pack_ipv6_mreq");
846 #endif
847         }
848
849 void
850 unpack_ipv6_mreq(mreq_sv)
851         SV * mreq_sv
852         PPCODE:
853         {
854 #ifdef AF_INET6
855         struct ipv6_mreq mreq;
856         STRLEN mreqlen;
857         char * mreqbytes = SvPVbyte(mreq_sv, mreqlen);
858         if (mreqlen != sizeof(mreq))
859                 croak("Bad arg length for %s, length is %d, should be %d",
860                       "Socket::unpack_ipv6_mreq", mreqlen, sizeof(mreq));
861         Copy(mreqbytes, &mreq, sizeof(mreq), char);
862         EXTEND(SP, 2);
863         mPUSHp((char *)&mreq.ipv6mr_multiaddr, sizeof(mreq.ipv6mr_multiaddr));
864         mPUSHi(mreq.ipv6mr_interface);
865 #else
866         not_here("unpack_ipv6_mreq");
867 #endif
868         }