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