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