This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
5f60afaf82473cddba531fae34e18769b8279945
[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 #if defined(I_NETINET_IP)
36 #  include <netinet/ip.h>
37 #endif
38 #ifdef I_NETDB
39 #  if !defined(ultrix)  /* Avoid double definition. */
40 #   include <netdb.h>
41 #  endif
42 #endif
43 #ifdef I_ARPA_INET
44 #  include <arpa/inet.h>
45 #endif
46 #ifdef I_NETINET_TCP
47 #  include <netinet/tcp.h>
48 #endif
49
50 #if defined(WIN32) && !defined(UNDER_CE)
51 # include <ws2tcpip.h>
52 #endif
53
54 #ifdef WIN32
55 int inet_pton(int af, const char *src, void *dst)
56 {
57   struct sockaddr_storage ss;
58   int size = sizeof(ss);
59   char src_copy[INET6_ADDRSTRLEN+1];
60
61   ZeroMemory(&ss, sizeof(ss));
62   /* stupid non-const API */
63   strncpy(src_copy, src, INET6_ADDRSTRLEN+1);
64   src_copy[INET6_ADDRSTRLEN] = 0;
65
66   if (WSAStringToAddress(src_copy, af, NULL, (struct sockaddr *)&ss, &size) != 0)
67     return 0;
68
69   switch(af) {
70     case AF_INET:
71       *(struct in_addr *)dst = ((struct sockaddr_in *)&ss)->sin_addr;
72       return 1;
73     case AF_INET6:
74       *(struct in6_addr *)dst = ((struct sockaddr_in6 *)&ss)->sin6_addr;
75       return 1;
76   }
77 }
78
79 const char *inet_ntop(int af, const void *src, char *dst, socklen_t size)
80 {
81   struct sockaddr_storage ss;
82   unsigned long s = size;
83
84   ZeroMemory(&ss, sizeof(ss));
85   ss.ss_family = af;
86
87   switch(af) {
88     case AF_INET:
89       ((struct sockaddr_in *)&ss)->sin_addr = *(struct in_addr *)src;
90       break;
91     case AF_INET6:
92       ((struct sockaddr_in6 *)&ss)->sin6_addr = *(struct in6_addr *)src;
93       break;
94     default:
95       return NULL;
96   }
97
98   /* cannot directly use &size because of strict aliasing rules */
99   if (WSAAddressToString((struct sockaddr *)&ss, sizeof(ss), NULL, dst, &s) != 0)
100     return NULL;
101   else
102     return dst;
103 }
104
105 #define HAS_INETPTON
106 #define HAS_INETNTOP
107 #endif
108
109 #ifdef NETWARE
110 NETDB_DEFINE_CONTEXT
111 NETINET_DEFINE_CONTEXT
112 #endif
113
114 #ifdef I_SYSUIO
115 # include <sys/uio.h>
116 #endif
117
118 #ifndef AF_NBS
119 # undef PF_NBS
120 #endif
121
122 #ifndef AF_X25
123 # undef PF_X25
124 #endif
125
126 #ifndef INADDR_NONE
127 # define INADDR_NONE    0xffffffff
128 #endif /* INADDR_NONE */
129 #ifndef INADDR_BROADCAST
130 # define INADDR_BROADCAST       0xffffffff
131 #endif /* INADDR_BROADCAST */
132 #ifndef INADDR_LOOPBACK
133 # define INADDR_LOOPBACK         0x7F000001
134 #endif /* INADDR_LOOPBACK */
135
136 #ifndef INET_ADDRSTRLEN
137 #define INET_ADDRSTRLEN 16
138 #endif
139
140 #ifndef C_ARRAY_LENGTH
141 #define C_ARRAY_LENGTH(arr) (sizeof(arr) / sizeof(*(arr)))
142 #endif /* !C_ARRAY_LENGTH */
143
144 #ifndef PERL_UNUSED_VAR
145 # define PERL_UNUSED_VAR(x) ((void)x)
146 #endif /* !PERL_UNUSED_VAR */
147
148 #ifndef PERL_UNUSED_ARG
149 # define PERL_UNUSED_ARG(x) PERL_UNUSED_VAR(x)
150 #endif /* !PERL_UNUSED_ARG */
151
152 #ifndef Newx
153 # define Newx(v,n,t) New(0,v,n,t)
154 #endif /* !Newx */
155
156 #ifndef SvPVx_nolen
157 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
158 #  define SvPVx_nolen(sv) ({SV *_sv = (sv); SvPV_nolen(_sv); })
159 #else /* __GNUC__ */
160 #  define SvPVx_nolen(sv) ((PL_Sv = (sv)), SvPV_nolen(PL_Sv))
161 #endif /* __GNU__ */
162 #endif /* !SvPVx_nolen */
163
164 #ifndef croak_sv
165 # define croak_sv(sv)   croak(SvPVx_nolen(sv))
166 #endif
167
168 #ifndef hv_stores
169 # define hv_stores(hv, keystr, val) \
170         hv_store(hv, ""keystr"", sizeof(keystr)-1, val, 0)
171 #endif /* !hv_stores */
172
173 #ifndef newSVpvn_flags
174 # define newSVpvn_flags(s,len,flags) my_newSVpvn_flags(aTHX_ s,len,flags)
175 static SV *my_newSVpvn_flags(pTHX_ const char *s, STRLEN len, U32 flags)
176 {
177   SV *sv = newSVpvn(s, len);
178   SvFLAGS(sv) |= (flags & SVf_UTF8);
179   return (flags & SVs_TEMP) ? sv_2mortal(sv) : sv;
180 }
181 #endif /* !newSVpvn_flags */
182
183 #ifndef SvRV_set
184 # define SvRV_set(sv, val) (SvRV(sv) = (val))
185 #endif /* !SvRV_set */
186
187 #ifndef SvPV_nomg
188 # define SvPV_nomg SvPV
189 #endif /* !SvPV_nomg */
190
191 #ifndef HEK_FLAGS
192 # define HEK_FLAGS(hek) 0
193 # define HVhek_UTF8 1
194 #endif /* !HEK_FLAGS */
195
196 #ifndef hv_common
197 /* These magic numbers are arbitrarily chosen (copied from perl core in fact)
198  * and only have to match between this definition and the code that uses them
199  */
200 # define HV_FETCH_ISSTORE 0x04
201 # define HV_FETCH_LVALUE  0x10
202 # define hv_common(hv, keysv, key, klen, flags, act, val, hash) \
203         my_hv_common(aTHX_ hv, keysv, key, klen, flags, act, val, hash)
204 static void *my_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
205         int flags, int act, SV *val, U32 hash)
206 {
207         /*
208          * This only handles the usage actually made by the code
209          * generated by ExtUtils::Constant.  EU:C really ought to arrange
210          * portability of its generated code itself.
211          */
212         if (!keysv) {
213                 keysv = sv_2mortal(newSVpvn(key, klen));
214                 if (flags & HVhek_UTF8)
215                         SvUTF8_on(keysv);
216         }
217         if (act == HV_FETCH_LVALUE) {
218                 return (void*)hv_fetch_ent(hv, keysv, 1, hash);
219         } else if (act == HV_FETCH_ISSTORE) {
220                 return (void*)hv_store_ent(hv, keysv, val, hash);
221         } else {
222                 croak("panic: my_hv_common: act=0x%x", act);
223         }
224 }
225 #endif /* !hv_common */
226
227 #ifndef hv_common_key_len
228 # define hv_common_key_len(hv, key, kl, act, val, hash) \
229         my_hv_common_key_len(aTHX_ hv, key, kl, act, val, hash)
230 static void *my_hv_common_key_len(pTHX_ HV *hv, const char *key, I32 kl,
231         int act, SV *val, U32 hash)
232 {
233         STRLEN klen;
234         int flags;
235         if (kl < 0) {
236                 klen = -kl;
237                 flags = HVhek_UTF8;
238         } else {
239                 klen = kl;
240                 flags = 0;
241         }
242         return hv_common(hv, NULL, key, klen, flags, act, val, hash);
243 }
244 #endif /* !hv_common_key_len */
245
246 #ifndef mPUSHi
247 # define mPUSHi(i) sv_setiv_mg(PUSHs(sv_newmortal()), (IV)(i))
248 #endif /* !mPUSHi */
249 #ifndef mPUSHp
250 # define mPUSHp(p,l) sv_setpvn_mg(PUSHs(sv_newmortal()), (p), (l))
251 #endif /* !mPUSHp */
252 #ifndef mPUSHs
253 # define mPUSHs(s) PUSHs(sv_2mortal(s))
254 #endif /* !mPUSHs */
255
256 #ifndef CvCONST_on
257 # undef newCONSTSUB
258 # define newCONSTSUB(stash, name, val) my_newCONSTSUB(aTHX_ stash, name, val)
259 static CV *my_newCONSTSUB(pTHX_ HV *stash, char *name, SV *val)
260 {
261         /*
262          * This has to satisfy code generated by ExtUtils::Constant.
263          * It depends on the 5.8+ layout of constant subs.  It has
264          * two calls to newCONSTSUB(): one for real constants, and one
265          * for undefined constants.  In the latter case, it turns the
266          * initially-generated constant subs into something else, and
267          * it needs the return value from newCONSTSUB() which Perl 5.6
268          * doesn't provide.
269          */
270         GV *gv;
271         CV *cv;
272         Perl_newCONSTSUB(aTHX_ stash, name, val);
273         ENTER;
274         SAVESPTR(PL_curstash);
275         PL_curstash = stash;
276         gv = gv_fetchpv(name, 0, SVt_PVCV);
277         cv = GvCV(gv);
278         LEAVE;
279         CvXSUBANY(cv).any_ptr = &PL_sv_undef;
280         return cv;
281 }
282 # define CvCONST_off(cv) my_CvCONST_off(aTHX_ cv)
283 static void my_CvCONST_off(pTHX_ CV *cv)
284 {
285         op_free(CvROOT(cv));
286         CvROOT(cv) = NULL;
287         CvSTART(cv) = NULL;
288 }
289 #endif /* !CvCONST_on */
290
291 #ifndef HAS_INET_ATON
292
293 /*
294  * Check whether "cp" is a valid ascii representation
295  * of an Internet address and convert to a binary address.
296  * Returns 1 if the address is valid, 0 if not.
297  * This replaces inet_addr, the return value from which
298  * cannot distinguish between failure and a local broadcast address.
299  */
300 static int
301 my_inet_aton(register const char *cp, struct in_addr *addr)
302 {
303         dTHX;
304         register U32 val;
305         register int base;
306         register char c;
307         int nparts;
308         const char *s;
309         unsigned int parts[4];
310         register unsigned int *pp = parts;
311
312         if (!cp || !*cp)
313                 return 0;
314         for (;;) {
315                 /*
316                  * Collect number up to ".".
317                  * Values are specified as for C:
318                  * 0x=hex, 0=octal, other=decimal.
319                  */
320                 val = 0; base = 10;
321                 if (*cp == '0') {
322                         if (*++cp == 'x' || *cp == 'X')
323                                 base = 16, cp++;
324                         else
325                                 base = 8;
326                 }
327                 while ((c = *cp) != '\0') {
328                         if (isDIGIT(c)) {
329                                 val = (val * base) + (c - '0');
330                                 cp++;
331                                 continue;
332                         }
333                         if (base == 16 && (s=strchr(PL_hexdigit,c))) {
334                                 val = (val << 4) +
335                                         ((s - PL_hexdigit) & 15);
336                                 cp++;
337                                 continue;
338                         }
339                         break;
340                 }
341                 if (*cp == '.') {
342                         /*
343                          * Internet format:
344                          *      a.b.c.d
345                          *      a.b.c   (with c treated as 16-bits)
346                          *      a.b     (with b treated as 24 bits)
347                          */
348                         if (pp >= parts + 3 || val > 0xff)
349                                 return 0;
350                         *pp++ = val, cp++;
351                 } else
352                         break;
353         }
354         /*
355          * Check for trailing characters.
356          */
357         if (*cp && !isSPACE(*cp))
358                 return 0;
359         /*
360          * Concoct the address according to
361          * the number of parts specified.
362          */
363         nparts = pp - parts + 1;        /* force to an int for switch() */
364         switch (nparts) {
365
366         case 1:                         /* a -- 32 bits */
367                 break;
368
369         case 2:                         /* a.b -- 8.24 bits */
370                 if (val > 0xffffff)
371                         return 0;
372                 val |= parts[0] << 24;
373                 break;
374
375         case 3:                         /* a.b.c -- 8.8.16 bits */
376                 if (val > 0xffff)
377                         return 0;
378                 val |= (parts[0] << 24) | (parts[1] << 16);
379                 break;
380
381         case 4:                         /* a.b.c.d -- 8.8.8.8 bits */
382                 if (val > 0xff)
383                         return 0;
384                 val |= (parts[0] << 24) | (parts[1] << 16) | (parts[2] << 8);
385                 break;
386         }
387         addr->s_addr = htonl(val);
388         return 1;
389 }
390
391 #undef inet_aton
392 #define inet_aton my_inet_aton
393
394 #endif /* ! HAS_INET_ATON */
395
396 /* These are not gni() constants; they're extensions for the perl API */
397 /* The definitions in Socket.pm and Socket.xs must match */
398 #define NIx_NOHOST   (1 << 0)
399 #define NIx_NOSERV   (1 << 1)
400
401 /* On Windows, ole2.h defines a macro called "interface". We don't need that,
402  * and it will complicate the variables in pack_ip_mreq() etc. (RT87389)
403  */
404 #undef interface
405
406 /* STRUCT_OFFSET should have come from from perl.h, but if not,
407  * roll our own (not using offsetof() since that is C99). */
408 #ifndef STRUCT_OFFSET
409 #  define STRUCT_OFFSET(s,m)  (Size_t)(&(((s *)0)->m))
410 #endif
411
412 static int
413 not_here(const char *s)
414 {
415     croak("Socket::%s not implemented on this architecture", s);
416     return -1;
417 }
418
419 #define PERL_IN_ADDR_S_ADDR_SIZE 4
420
421 /*
422 * Bad assumptions possible here.
423 *
424 * Bad Assumption 1: struct in_addr has no other fields
425 * than the s_addr (which is the field we care about
426 * in here, really). However, we can be fed either 4-byte
427 * addresses (from pack("N", ...), or va.b.c.d, or ...),
428 * or full struct in_addrs (from e.g. pack_sockaddr_in()),
429 * which may or may not be 4 bytes in size.
430 *
431 * Bad Assumption 2: the s_addr field is a simple type
432 * (such as an int, u_int32_t).  It can be a bit field,
433 * in which case using & (address-of) on it or taking sizeof()
434 * wouldn't go over too well.  (Those are not attempted
435 * now but in case someone thinks to change the below code
436 * to use addr.s_addr instead of addr, you have been warned.)
437 *
438 * Bad Assumption 3: the s_addr is the first field in
439 * an in_addr, or that its bytes are the first bytes in
440 * an in_addr.
441 *
442 * These bad assumptions are wrong in UNICOS which has
443 * struct in_addr { struct { u_long  st_addr:32; } s_da };
444 * #define s_addr s_da.st_addr
445 * and u_long is 64 bits.
446 *
447 * --jhi */
448
449 #include "const-c.inc"
450
451 #ifdef HAS_GETADDRINFO
452 static SV *err_to_SV(pTHX_ int err)
453 {
454         SV *ret = sv_newmortal();
455         (void) SvUPGRADE(ret, SVt_PVNV);
456
457         if(err) {
458                 const char *error = gai_strerror(err);
459                 sv_setpv(ret, error);
460         }
461         else {
462                 sv_setpv(ret, "");
463         }
464
465         SvIV_set(ret, err); SvIOK_on(ret);
466
467         return ret;
468 }
469
470 static void xs_getaddrinfo(pTHX_ CV *cv)
471 {
472         dXSARGS;
473
474         SV   *host;
475         SV   *service;
476         SV   *hints;
477
478         char *hostname = NULL;
479         char *servicename = NULL;
480         STRLEN len;
481         struct addrinfo hints_s;
482         struct addrinfo *res;
483         struct addrinfo *res_iter;
484         int err;
485         int n_res;
486
487         PERL_UNUSED_ARG(cv);
488         if(items > 3)
489                 croak("Usage: Socket::getaddrinfo(host, service, hints)");
490
491         SP -= items;
492
493         if(items < 1)
494                 host = &PL_sv_undef;
495         else
496                 host = ST(0);
497
498         if(items < 2)
499                 service = &PL_sv_undef;
500         else
501                 service = ST(1);
502
503         if(items < 3)
504                 hints = NULL;
505         else
506                 hints = ST(2);
507
508         SvGETMAGIC(host);
509         if(SvOK(host)) {
510                 hostname = SvPV_nomg(host, len);
511                 if (!len)
512                         hostname = NULL;
513         }
514
515         SvGETMAGIC(service);
516         if(SvOK(service)) {
517                 servicename = SvPV_nomg(service, len);
518                 if (!len)
519                         servicename = NULL;
520         }
521
522         Zero(&hints_s, sizeof(hints_s), char);
523         hints_s.ai_family = PF_UNSPEC;
524
525         if(hints && SvOK(hints)) {
526                 HV *hintshash;
527                 SV **valp;
528
529                 if(!SvROK(hints) || SvTYPE(SvRV(hints)) != SVt_PVHV)
530                         croak("hints is not a HASH reference");
531
532                 hintshash = (HV*)SvRV(hints);
533
534                 if((valp = hv_fetch(hintshash, "flags", 5, 0)) != NULL && SvOK(*valp))
535                         hints_s.ai_flags = SvIV(*valp);
536                 if((valp = hv_fetch(hintshash, "family", 6, 0)) != NULL && SvOK(*valp))
537                         hints_s.ai_family = SvIV(*valp);
538                 if((valp = hv_fetch(hintshash, "socktype", 8, 0)) != NULL && SvOK(*valp))
539                         hints_s.ai_socktype = SvIV(*valp);
540                 if((valp = hv_fetch(hintshash, "protocol", 8, 0)) != NULL && SvOK(*valp))
541                         hints_s.ai_protocol = SvIV(*valp);
542         }
543
544         err = getaddrinfo(hostname, servicename, &hints_s, &res);
545
546         XPUSHs(err_to_SV(aTHX_ err));
547
548         if(err)
549                 XSRETURN(1);
550
551         n_res = 0;
552         for(res_iter = res; res_iter; res_iter = res_iter->ai_next) {
553                 HV *res_hv = newHV();
554
555                 (void)hv_stores(res_hv, "family",   newSViv(res_iter->ai_family));
556                 (void)hv_stores(res_hv, "socktype", newSViv(res_iter->ai_socktype));
557                 (void)hv_stores(res_hv, "protocol", newSViv(res_iter->ai_protocol));
558
559                 (void)hv_stores(res_hv, "addr",     newSVpvn((char*)res_iter->ai_addr, res_iter->ai_addrlen));
560
561                 if(res_iter->ai_canonname)
562                         (void)hv_stores(res_hv, "canonname", newSVpv(res_iter->ai_canonname, 0));
563                 else
564                         (void)hv_stores(res_hv, "canonname", newSV(0));
565
566                 XPUSHs(sv_2mortal(newRV_noinc((SV*)res_hv)));
567                 n_res++;
568         }
569
570         freeaddrinfo(res);
571
572         XSRETURN(1 + n_res);
573 }
574 #endif
575
576 #ifdef HAS_GETNAMEINFO
577 static void xs_getnameinfo(pTHX_ CV *cv)
578 {
579         dXSARGS;
580
581         SV  *addr;
582         int  flags;
583         int  xflags;
584
585         char host[1024];
586         char serv[256];
587         char *sa; /* we'll cast to struct sockaddr * when necessary */
588         STRLEN addr_len;
589         int err;
590
591         int want_host, want_serv;
592
593         PERL_UNUSED_ARG(cv);
594         if(items < 1 || items > 3)
595                 croak("Usage: Socket::getnameinfo(addr, flags=0, xflags=0)");
596
597         SP -= items;
598
599         addr = ST(0);
600         SvGETMAGIC(addr);
601
602         if(items < 2)
603                 flags = 0;
604         else
605                 flags = SvIV(ST(1));
606
607         if(items < 3)
608                 xflags = 0;
609         else
610                 xflags = SvIV(ST(2));
611
612         want_host = !(xflags & NIx_NOHOST);
613         want_serv = !(xflags & NIx_NOSERV);
614
615         if(!SvPOKp(addr))
616                 croak("addr is not a string");
617
618         addr_len = SvCUR(addr);
619
620         /* We need to ensure the sockaddr is aligned, because a random SvPV might
621          * not be due to SvOOK */
622         Newx(sa, addr_len, char);
623         Copy(SvPV_nolen(addr), sa, addr_len, char);
624 #ifdef HAS_SOCKADDR_SA_LEN
625         ((struct sockaddr *)sa)->sa_len = addr_len;
626 #endif
627
628         err = getnameinfo((struct sockaddr *)sa, addr_len,
629                         want_host ? host : NULL, want_host ? sizeof(host) : 0,
630                         want_serv ? serv : NULL, want_serv ? sizeof(serv) : 0,
631                         flags);
632
633         Safefree(sa);
634
635         XPUSHs(err_to_SV(aTHX_ err));
636
637         if(err)
638                 XSRETURN(1);
639
640         XPUSHs(want_host ? sv_2mortal(newSVpv(host, 0)) : &PL_sv_undef);
641         XPUSHs(want_serv ? sv_2mortal(newSVpv(serv, 0)) : &PL_sv_undef);
642
643         XSRETURN(3);
644 }
645 #endif
646
647 MODULE = Socket         PACKAGE = Socket
648
649 INCLUDE: const-xs.inc
650
651 BOOT:
652 #ifdef HAS_GETADDRINFO
653         newXS("Socket::getaddrinfo", xs_getaddrinfo, __FILE__);
654 #endif
655 #ifdef HAS_GETNAMEINFO
656         newXS("Socket::getnameinfo", xs_getnameinfo, __FILE__);
657 #endif
658
659 void
660 inet_aton(host)
661         char *  host
662         CODE:
663         {
664         struct in_addr ip_address;
665         struct hostent * phe;
666
667         if ((*host != '\0') && inet_aton(host, &ip_address)) {
668                 ST(0) = sv_2mortal(newSVpvn((char *)&ip_address, sizeof(ip_address)));
669                 XSRETURN(1);
670         }
671
672         phe = gethostbyname(host);
673         if (phe && phe->h_addrtype == AF_INET && phe->h_length == 4) {
674                 ST(0) = sv_2mortal(newSVpvn((char *)phe->h_addr, phe->h_length));
675                 XSRETURN(1);
676         }
677
678         XSRETURN_UNDEF;
679         }
680
681 void
682 inet_ntoa(ip_address_sv)
683         SV *    ip_address_sv
684         CODE:
685         {
686         STRLEN addrlen;
687         struct in_addr addr;
688         char * ip_address;
689         if (DO_UTF8(ip_address_sv) && !sv_utf8_downgrade(ip_address_sv, 1))
690                 croak("Wide character in %s", "Socket::inet_ntoa");
691         ip_address = SvPVbyte(ip_address_sv, addrlen);
692         if (addrlen == sizeof(addr) || addrlen == 4)
693                 addr.s_addr =
694                     (ip_address[0] & 0xFF) << 24 |
695                     (ip_address[1] & 0xFF) << 16 |
696                     (ip_address[2] & 0xFF) <<  8 |
697                     (ip_address[3] & 0xFF);
698         else
699                 croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf,
700                       "Socket::inet_ntoa", (UV)addrlen, (UV)sizeof(addr));
701         /* We could use inet_ntoa() but that is broken
702          * in HP-UX + GCC + 64bitint (returns "0.0.0.0"),
703          * so let's use this sprintf() workaround everywhere.
704          * This is also more threadsafe than using inet_ntoa(). */
705         ST(0) = sv_2mortal(Perl_newSVpvf(aTHX_ "%d.%d.%d.%d", /* IPv6? */
706                                          (int)((addr.s_addr >> 24) & 0xFF),
707                                          (int)((addr.s_addr >> 16) & 0xFF),
708                                          (int)((addr.s_addr >>  8) & 0xFF),
709                                          (int)( addr.s_addr        & 0xFF)));
710         }
711
712 void
713 sockaddr_family(sockaddr)
714         SV *    sockaddr
715         PREINIT:
716         STRLEN sockaddr_len;
717         char *sockaddr_pv = SvPVbyte(sockaddr, sockaddr_len);
718         CODE:
719         if (sockaddr_len < STRUCT_OFFSET(struct sockaddr, sa_data))
720                 croak("Bad arg length for %s, length is %"UVuf", should be at least %"UVuf,
721                       "Socket::sockaddr_family", (UV)sockaddr_len,
722                       (UV)STRUCT_OFFSET(struct sockaddr, sa_data));
723         ST(0) = sv_2mortal(newSViv(((struct sockaddr*)sockaddr_pv)->sa_family));
724
725 void
726 pack_sockaddr_un(pathname)
727         SV *    pathname
728         CODE:
729         {
730 #ifdef I_SYS_UN
731         struct sockaddr_un sun_ad; /* fear using sun */
732         STRLEN len;
733         char * pathname_pv;
734         int addr_len;
735
736         Zero(&sun_ad, sizeof(sun_ad), char);
737         sun_ad.sun_family = AF_UNIX;
738         pathname_pv = SvPV(pathname,len);
739         if (len > sizeof(sun_ad.sun_path))
740             len = sizeof(sun_ad.sun_path);
741 #  ifdef OS2    /* Name should start with \socket\ and contain backslashes! */
742         {
743                 int off;
744                 char *s, *e;
745
746                 if (pathname_pv[0] != '/' && pathname_pv[0] != '\\')
747                         croak("Relative UNIX domain socket name '%s' unsupported",
748                               pathname_pv);
749                 else if (len < 8
750                          || pathname_pv[7] != '/' && pathname_pv[7] != '\\'
751                          || !strnicmp(pathname_pv + 1, "socket", 6))
752                         off = 7;
753                 else
754                         off = 0;        /* Preserve names starting with \socket\ */
755                 Copy("\\socket", sun_ad.sun_path, off, char);
756                 Copy(pathname_pv, sun_ad.sun_path + off, len, char);
757
758                 s = sun_ad.sun_path + off - 1;
759                 e = s + len + 1;
760                 while (++s < e)
761                         if (*s = '/')
762                                 *s = '\\';
763         }
764 #  else /* !( defined OS2 ) */
765         Copy(pathname_pv, sun_ad.sun_path, len, char);
766 #  endif
767         if (0) not_here("dummy");
768         if (len > 1 && sun_ad.sun_path[0] == '\0') {
769                 /* Linux-style abstract-namespace socket.
770                  * The name is not a file name, but an array of arbitrary
771                  * character, starting with \0 and possibly including \0s,
772                  * therefore the length of the structure must denote the
773                  * end of that character array */
774                 addr_len = (char *)&(sun_ad.sun_path) - (char *)&sun_ad + len;
775         } else {
776                 addr_len = sizeof(sun_ad);
777         }
778 #  ifdef HAS_SOCKADDR_SA_LEN
779         sun_ad.sun_len = addr_len;
780 #  endif
781         ST(0) = sv_2mortal(newSVpvn((char *)&sun_ad, addr_len));
782 #else
783         ST(0) = (SV*)not_here("pack_sockaddr_un");
784 #endif
785         
786         }
787
788 void
789 unpack_sockaddr_un(sun_sv)
790         SV *    sun_sv
791         CODE:
792         {
793 #ifdef I_SYS_UN
794         struct sockaddr_un addr;
795         STRLEN sockaddrlen;
796         char * sun_ad = SvPVbyte(sun_sv,sockaddrlen);
797         int addr_len;
798 #   if defined(__linux__) || defined(HAS_SOCKADDR_SA_LEN)
799         /* On Linux or *BSD sockaddrlen on sockets returned by accept, recvfrom,
800            getpeername and getsockname is not equal to sizeof(addr). */
801         if (sockaddrlen < sizeof(addr)) {
802           Copy(sun_ad, &addr, sockaddrlen, char);
803           Zero(((char*)&addr) + sockaddrlen, sizeof(addr) - sockaddrlen, char);
804         } else {
805           Copy(sun_ad, &addr, sizeof(addr), char);
806         }
807 #     ifdef HAS_SOCKADDR_SA_LEN
808         /* In this case, sun_len must be checked */
809         if (sockaddrlen != addr.sun_len)
810                 croak("Invalid arg sun_len field for %s, length is %"UVuf", but sun_len is %"UVuf,
811                       "Socket::unpack_sockaddr_un", (UV)sockaddrlen, (UV)addr.sun_len);
812 #     endif
813 #   else
814         if (sockaddrlen != sizeof(addr))
815                 croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf,
816                       "Socket::unpack_sockaddr_un", (UV)sockaddrlen, (UV)sizeof(addr));
817         Copy(sun_ad, &addr, sizeof(addr), char);
818 #   endif
819
820         if (addr.sun_family != AF_UNIX)
821                 croak("Bad address family for %s, got %d, should be %d",
822                       "Socket::unpack_sockaddr_un", addr.sun_family, AF_UNIX);
823 #   ifdef __linux__
824         if (addr.sun_path[0] == '\0') {
825                 /* Linux-style abstract socket address begins with a nul
826                  * and can contain nuls. */
827                 addr_len = (char *)&addr - (char *)&(addr.sun_path) + sockaddrlen;
828         } else
829 #   endif
830         {
831 #   if defined(HAS_SOCKADDR_SA_LEN)
832                 /* On *BSD sun_path not always ends with a '\0' */
833                 int maxlen = addr.sun_len - 2; /* should use STRUCT_OFFSET(struct sockaddr_un, sun_path) instead of 2 */
834                 if (maxlen > (int)sizeof(addr.sun_path))
835                   maxlen = (int)sizeof(addr.sun_path);
836 #   else
837                 const int maxlen = (int)sizeof(addr.sun_path);
838 #   endif
839                 for (addr_len = 0; addr.sun_path[addr_len]
840                      && addr_len < maxlen; addr_len++);
841         }
842
843         ST(0) = sv_2mortal(newSVpvn(addr.sun_path, addr_len));
844 #else
845         ST(0) = (SV*)not_here("unpack_sockaddr_un");
846 #endif
847         }
848
849 void
850 pack_sockaddr_in(port, ip_address_sv)
851         unsigned short  port
852         SV *    ip_address_sv
853         CODE:
854         {
855         struct sockaddr_in sin;
856         struct in_addr addr;
857         STRLEN addrlen;
858         char * ip_address;
859         if (DO_UTF8(ip_address_sv) && !sv_utf8_downgrade(ip_address_sv, 1))
860                 croak("Wide character in %s", "Socket::pack_sockaddr_in");
861         ip_address = SvPVbyte(ip_address_sv, addrlen);
862         if (addrlen == sizeof(addr) || addrlen == 4)
863                 addr.s_addr =
864                     (unsigned int)(ip_address[0] & 0xFF) << 24 |
865                     (unsigned int)(ip_address[1] & 0xFF) << 16 |
866                     (unsigned int)(ip_address[2] & 0xFF) <<  8 |
867                     (unsigned int)(ip_address[3] & 0xFF);
868         else
869                 croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf,
870                       "Socket::pack_sockaddr_in",
871                       (UV)addrlen, (UV)sizeof(addr));
872         Zero(&sin, sizeof(sin), char);
873         sin.sin_family = AF_INET;
874         sin.sin_port = htons(port);
875         sin.sin_addr.s_addr = htonl(addr.s_addr);
876 #  ifdef HAS_SOCKADDR_SA_LEN
877         sin.sin_len = sizeof(sin);
878 #  endif
879         ST(0) = sv_2mortal(newSVpvn((char *)&sin, sizeof(sin)));
880         }
881
882 void
883 unpack_sockaddr_in(sin_sv)
884         SV *    sin_sv
885         PPCODE:
886         {
887         STRLEN sockaddrlen;
888         struct sockaddr_in addr;
889         SV *ip_address_sv;
890         char *  sin = SvPVbyte(sin_sv,sockaddrlen);
891         if (sockaddrlen != sizeof(addr)) {
892             croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf,
893                   "Socket::unpack_sockaddr_in", (UV)sockaddrlen, (UV)sizeof(addr));
894         }
895         Copy(sin, &addr, sizeof(addr), char);
896         if (addr.sin_family != AF_INET) {
897             croak("Bad address family for %s, got %d, should be %d",
898                   "Socket::unpack_sockaddr_in", addr.sin_family, AF_INET);
899         }
900         ip_address_sv = newSVpvn((char *)&addr.sin_addr, sizeof(addr.sin_addr));
901
902         if(GIMME_V == G_ARRAY) {
903             EXTEND(SP, 2);
904             mPUSHi(ntohs(addr.sin_port));
905             mPUSHs(ip_address_sv);
906         }
907         else {
908             mPUSHs(ip_address_sv);
909         }
910         }
911
912 void
913 pack_sockaddr_in6(port, sin6_addr, scope_id=0, flowinfo=0)
914         unsigned short  port
915         SV *    sin6_addr
916         unsigned long   scope_id
917         unsigned long   flowinfo
918         CODE:
919         {
920 #ifdef HAS_SOCKADDR_IN6
921         struct sockaddr_in6 sin6;
922         char * addrbytes;
923         STRLEN addrlen;
924         if (DO_UTF8(sin6_addr) && !sv_utf8_downgrade(sin6_addr, 1))
925                 croak("Wide character in %s", "Socket::pack_sockaddr_in6");
926         addrbytes = SvPVbyte(sin6_addr, addrlen);
927         if (addrlen != sizeof(sin6.sin6_addr))
928                 croak("Bad arg length %s, length is %"UVuf", should be %"UVuf,
929                       "Socket::pack_sockaddr_in6", (UV)addrlen, (UV)sizeof(sin6.sin6_addr));
930         Zero(&sin6, sizeof(sin6), char);
931         sin6.sin6_family = AF_INET6;
932         sin6.sin6_port = htons(port);
933         sin6.sin6_flowinfo = htonl(flowinfo);
934         Copy(addrbytes, &sin6.sin6_addr, sizeof(sin6.sin6_addr), char);
935 #  ifdef HAS_SIN6_SCOPE_ID
936         sin6.sin6_scope_id = scope_id;
937 #  else
938         if (scope_id != 0)
939             warn("%s cannot represent non-zero scope_id %d",
940                  "Socket::pack_sockaddr_in6", scope_id);
941 #  endif
942 #  ifdef HAS_SOCKADDR_SA_LEN
943         sin6.sin6_len = sizeof(sin6);
944 #  endif
945         ST(0) = sv_2mortal(newSVpvn((char *)&sin6, sizeof(sin6)));
946 #else
947         PERL_UNUSED_VAR(port);
948         PERL_UNUSED_VAR(sin6_addr);
949         ST(0) = (SV*)not_here("pack_sockaddr_in6");
950 #endif
951         }
952
953 void
954 unpack_sockaddr_in6(sin6_sv)
955         SV *    sin6_sv
956         PPCODE:
957         {
958 #ifdef HAS_SOCKADDR_IN6
959         STRLEN addrlen;
960         struct sockaddr_in6 sin6;
961         char * addrbytes = SvPVbyte(sin6_sv, addrlen);
962         SV *ip_address_sv;
963         if (addrlen != sizeof(sin6))
964                 croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf,
965                       "Socket::unpack_sockaddr_in6", (UV)addrlen, (UV)sizeof(sin6));
966         Copy(addrbytes, &sin6, sizeof(sin6), char);
967         if (sin6.sin6_family != AF_INET6)
968                 croak("Bad address family for %s, got %d, should be %d",
969                       "Socket::unpack_sockaddr_in6", sin6.sin6_family, AF_INET6);
970         ip_address_sv = newSVpvn((char *)&sin6.sin6_addr, sizeof(sin6.sin6_addr));
971
972         if(GIMME_V == G_ARRAY) {
973             EXTEND(SP, 4);
974             mPUSHi(ntohs(sin6.sin6_port));
975             mPUSHs(ip_address_sv);
976 #  ifdef HAS_SIN6_SCOPE_ID
977             mPUSHi(sin6.sin6_scope_id);
978 #  else
979             mPUSHi(0);
980 #  endif
981             mPUSHi(ntohl(sin6.sin6_flowinfo));
982         }
983         else {
984             mPUSHs(ip_address_sv);
985         }
986 #else
987         PERL_UNUSED_VAR(sin6_sv);
988         ST(0) = (SV*)not_here("pack_sockaddr_in6");
989 #endif
990         }
991
992 void
993 inet_ntop(af, ip_address_sv)
994         int     af
995         SV *    ip_address_sv
996         CODE:
997 #ifdef HAS_INETNTOP
998         STRLEN addrlen;
999 #ifdef AF_INET6
1000         struct in6_addr addr;
1001         char str[INET6_ADDRSTRLEN];
1002 #else
1003         struct in_addr addr;
1004         char str[INET_ADDRSTRLEN];
1005 #endif
1006         char *ip_address;
1007
1008         if (DO_UTF8(ip_address_sv) && !sv_utf8_downgrade(ip_address_sv, 1))
1009                 croak("Wide character in %s", "Socket::inet_ntop");
1010
1011         ip_address = SvPV(ip_address_sv, addrlen);
1012
1013         switch(af) {
1014           case AF_INET:
1015             if(addrlen != 4)
1016                 croak("Bad address length for Socket::inet_ntop on AF_INET;"
1017                       " got %"UVuf", should be 4", (UV)addrlen);
1018             break;
1019 #ifdef AF_INET6
1020           case AF_INET6:
1021             if(addrlen != 16)
1022                 croak("Bad address length for Socket::inet_ntop on AF_INET6;"
1023                       " got %"UVuf", should be 16", (UV)addrlen);
1024             break;
1025 #endif
1026           default:
1027                 croak("Bad address family for %s, got %d, should be"
1028 #ifdef AF_INET6
1029                       " either AF_INET or AF_INET6",
1030 #else
1031                       " AF_INET",
1032 #endif
1033                       "Socket::inet_ntop", af);
1034         }
1035
1036         if(addrlen < sizeof(addr)) {
1037             Copy(ip_address, &addr, addrlen, char);
1038             Zero(((char*)&addr) + addrlen, sizeof(addr) - addrlen, char);
1039         }
1040         else {
1041             Copy(ip_address, &addr, sizeof addr, char);
1042         }
1043         inet_ntop(af, &addr, str, sizeof str);
1044
1045         ST(0) = sv_2mortal(newSVpvn(str, strlen(str)));
1046 #else
1047         PERL_UNUSED_VAR(af);
1048         PERL_UNUSED_VAR(ip_address_sv);
1049         ST(0) = (SV*)not_here("inet_ntop");
1050 #endif
1051
1052 void
1053 inet_pton(af, host)
1054         int           af
1055         const char *  host
1056         CODE:
1057 #ifdef HAS_INETPTON
1058         int ok;
1059         int addrlen = 0;
1060 #ifdef AF_INET6
1061         struct in6_addr ip_address;
1062 #else
1063         struct in_addr ip_address;
1064 #endif
1065
1066         switch(af) {
1067           case AF_INET:
1068             addrlen = 4;
1069             break;
1070 #ifdef AF_INET6
1071           case AF_INET6:
1072             addrlen = 16;
1073             break;
1074 #endif
1075           default:
1076                 croak("Bad address family for %s, got %d, should be"
1077 #ifdef AF_INET6
1078                       " either AF_INET or AF_INET6",
1079 #else
1080                       " AF_INET",
1081 #endif
1082                       "Socket::inet_pton", af);
1083         }
1084         ok = (*host != '\0') && inet_pton(af, host, &ip_address);
1085
1086         ST(0) = sv_newmortal();
1087         if (ok) {
1088                 sv_setpvn( ST(0), (char *)&ip_address, addrlen);
1089         }
1090 #else
1091         PERL_UNUSED_VAR(af);
1092         PERL_UNUSED_VAR(host);
1093         ST(0) = (SV*)not_here("inet_pton");
1094 #endif
1095
1096 void
1097 pack_ip_mreq(multiaddr, interface=&PL_sv_undef)
1098         SV *    multiaddr
1099         SV *    interface
1100         CODE:
1101         {
1102 #ifdef HAS_IP_MREQ
1103         struct ip_mreq mreq;
1104         char * multiaddrbytes;
1105         char * interfacebytes;
1106         STRLEN len;
1107         if (DO_UTF8(multiaddr) && !sv_utf8_downgrade(multiaddr, 1))
1108                 croak("Wide character in %s", "Socket::pack_ip_mreq");
1109         multiaddrbytes = SvPVbyte(multiaddr, len);
1110         if (len != sizeof(mreq.imr_multiaddr))
1111                 croak("Bad arg length %s, length is %"UVuf", should be %"UVuf,
1112                       "Socket::pack_ip_mreq", (UV)len, (UV)sizeof(mreq.imr_multiaddr));
1113         Zero(&mreq, sizeof(mreq), char);
1114         Copy(multiaddrbytes, &mreq.imr_multiaddr, sizeof(mreq.imr_multiaddr), char);
1115         if(SvOK(interface)) {
1116                 if (DO_UTF8(interface) && !sv_utf8_downgrade(interface, 1))
1117                         croak("Wide character in %s", "Socket::pack_ip_mreq");
1118                 interfacebytes = SvPVbyte(interface, len);
1119                 if (len != sizeof(mreq.imr_interface))
1120                         croak("Bad arg length %s, length is %"UVuf", should be %"UVuf,
1121                               "Socket::pack_ip_mreq", (UV)len, (UV)sizeof(mreq.imr_interface));
1122                 Copy(interfacebytes, &mreq.imr_interface, sizeof(mreq.imr_interface), char);
1123         }
1124         else
1125                 mreq.imr_interface.s_addr = INADDR_ANY;
1126         ST(0) = sv_2mortal(newSVpvn((char *)&mreq, sizeof(mreq)));
1127 #else
1128         not_here("pack_ip_mreq");
1129 #endif
1130         }
1131
1132 void
1133 unpack_ip_mreq(mreq_sv)
1134         SV * mreq_sv
1135         PPCODE:
1136         {
1137 #ifdef HAS_IP_MREQ
1138         struct ip_mreq mreq;
1139         STRLEN mreqlen;
1140         char * mreqbytes = SvPVbyte(mreq_sv, mreqlen);
1141         if (mreqlen != sizeof(mreq))
1142                 croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf,
1143                       "Socket::unpack_ip_mreq", (UV)mreqlen, (UV)sizeof(mreq));
1144         Copy(mreqbytes, &mreq, sizeof(mreq), char);
1145         EXTEND(SP, 2);
1146         mPUSHp((char *)&mreq.imr_multiaddr, sizeof(mreq.imr_multiaddr));
1147         mPUSHp((char *)&mreq.imr_interface, sizeof(mreq.imr_interface));
1148 #else
1149         not_here("unpack_ip_mreq");
1150 #endif
1151         }
1152
1153 void
1154 pack_ip_mreq_source(multiaddr, source, interface=&PL_sv_undef)
1155         SV *    multiaddr
1156         SV *    source
1157         SV *    interface
1158         CODE:
1159         {
1160 #if defined(HAS_IP_MREQ_SOURCE) && defined (IP_ADD_SOURCE_MEMBERSHIP)
1161         struct ip_mreq_source mreq;
1162         char * multiaddrbytes;
1163         char * sourcebytes;
1164         char * interfacebytes;
1165         STRLEN len;
1166         if (DO_UTF8(multiaddr) && !sv_utf8_downgrade(multiaddr, 1))
1167                 croak("Wide character in %s", "Socket::pack_ip_mreq_source");
1168         multiaddrbytes = SvPVbyte(multiaddr, len);
1169         if (len != sizeof(mreq.imr_multiaddr))
1170                 croak("Bad arg length %s, length is %"UVuf", should be %"UVuf,
1171                       "Socket::pack_ip_mreq", (UV)len, (UV)sizeof(mreq.imr_multiaddr));
1172         if (DO_UTF8(source) && !sv_utf8_downgrade(source, 1))
1173                 croak("Wide character in %s", "Socket::pack_ip_mreq_source");
1174         if (len != sizeof(mreq.imr_sourceaddr))
1175                 croak("Bad arg length %s, length is %"UVuf", should be %"UVuf,
1176                       "Socket::pack_ip_mreq", (UV)len, (UV)sizeof(mreq.imr_sourceaddr));
1177         sourcebytes = SvPVbyte(source, len);
1178         Zero(&mreq, sizeof(mreq), char);
1179         Copy(multiaddrbytes, &mreq.imr_multiaddr, sizeof(mreq.imr_multiaddr), char);
1180         Copy(sourcebytes, &mreq.imr_sourceaddr, sizeof(mreq.imr_sourceaddr), char);
1181         if(SvOK(interface)) {
1182                 if (DO_UTF8(interface) && !sv_utf8_downgrade(interface, 1))
1183                         croak("Wide character in %s", "Socket::pack_ip_mreq");
1184                 interfacebytes = SvPVbyte(interface, len);
1185                 if (len != sizeof(mreq.imr_interface))
1186                         croak("Bad arg length %s, length is %"UVuf", should be %"UVuf,
1187                               "Socket::pack_ip_mreq", (UV)len, (UV)sizeof(mreq.imr_interface));
1188                 Copy(interfacebytes, &mreq.imr_interface, sizeof(mreq.imr_interface), char);
1189         }
1190         else
1191                 mreq.imr_interface.s_addr = INADDR_ANY;
1192         ST(0) = sv_2mortal(newSVpvn((char *)&mreq, sizeof(mreq)));
1193 #else
1194         PERL_UNUSED_VAR(multiaddr);
1195         PERL_UNUSED_VAR(source);
1196         not_here("pack_ip_mreq_source");
1197 #endif
1198         }
1199
1200 void
1201 unpack_ip_mreq_source(mreq_sv)
1202         SV * mreq_sv
1203         PPCODE:
1204         {
1205 #if defined(HAS_IP_MREQ_SOURCE) && defined (IP_ADD_SOURCE_MEMBERSHIP)
1206         struct ip_mreq_source mreq;
1207         STRLEN mreqlen;
1208         char * mreqbytes = SvPVbyte(mreq_sv, mreqlen);
1209         if (mreqlen != sizeof(mreq))
1210                 croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf,
1211                       "Socket::unpack_ip_mreq_source", (UV)mreqlen, (UV)sizeof(mreq));
1212         Copy(mreqbytes, &mreq, sizeof(mreq), char);
1213         EXTEND(SP, 3);
1214         mPUSHp((char *)&mreq.imr_multiaddr, sizeof(mreq.imr_multiaddr));
1215         mPUSHp((char *)&mreq.imr_sourceaddr, sizeof(mreq.imr_sourceaddr));
1216         mPUSHp((char *)&mreq.imr_interface, sizeof(mreq.imr_interface));
1217 #else
1218         PERL_UNUSED_VAR(mreq_sv);
1219         not_here("unpack_ip_mreq_source");
1220 #endif
1221         }
1222
1223 void
1224 pack_ipv6_mreq(multiaddr, ifindex)
1225         SV *    multiaddr
1226         unsigned int    ifindex
1227         CODE:
1228         {
1229 #ifdef HAS_IPV6_MREQ
1230         struct ipv6_mreq mreq;
1231         char * multiaddrbytes;
1232         STRLEN len;
1233         if (DO_UTF8(multiaddr) && !sv_utf8_downgrade(multiaddr, 1))
1234                 croak("Wide character in %s", "Socket::pack_ipv6_mreq");
1235         multiaddrbytes = SvPVbyte(multiaddr, len);
1236         if (len != sizeof(mreq.ipv6mr_multiaddr))
1237                 croak("Bad arg length %s, length is %"UVuf", should be %"UVuf,
1238                       "Socket::pack_ipv6_mreq", (UV)len, (UV)sizeof(mreq.ipv6mr_multiaddr));
1239         Zero(&mreq, sizeof(mreq), char);
1240         Copy(multiaddrbytes, &mreq.ipv6mr_multiaddr, sizeof(mreq.ipv6mr_multiaddr), char);
1241         mreq.ipv6mr_interface = ifindex;
1242         ST(0) = sv_2mortal(newSVpvn((char *)&mreq, sizeof(mreq)));
1243 #else
1244         PERL_UNUSED_VAR(multiaddr);
1245         PERL_UNUSED_VAR(ifindex);
1246         not_here("pack_ipv6_mreq");
1247 #endif
1248         }
1249
1250 void
1251 unpack_ipv6_mreq(mreq_sv)
1252         SV * mreq_sv
1253         PPCODE:
1254         {
1255 #ifdef HAS_IPV6_MREQ
1256         struct ipv6_mreq mreq;
1257         STRLEN mreqlen;
1258         char * mreqbytes = SvPVbyte(mreq_sv, mreqlen);
1259         if (mreqlen != sizeof(mreq))
1260                 croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf,
1261                       "Socket::unpack_ipv6_mreq", (UV)mreqlen, (UV)sizeof(mreq));
1262         Copy(mreqbytes, &mreq, sizeof(mreq), char);
1263         EXTEND(SP, 2);
1264         mPUSHp((char *)&mreq.ipv6mr_multiaddr, sizeof(mreq.ipv6mr_multiaddr));
1265         mPUSHi(mreq.ipv6mr_interface);
1266 #else
1267         PERL_UNUSED_VAR(mreq_sv);
1268         not_here("unpack_ipv6_mreq");
1269 #endif
1270         }