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