This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Win32 inet_pton fallback misc fixes
[perl5.git] / cpan / Socket / Socket.xs
CommitLineData
c5be433b 1#define PERL_NO_GET_CONTEXT
a0d0e21e
LW
2#include "EXTERN.h"
3#include "perl.h"
4#include "XSUB.h"
5
fc87b71c
NIS
6#include <stddef.h>
7
046cc26c 8#ifdef I_SYS_TYPES
8e07c86e 9# include <sys/types.h>
046cc26c
CB
10#endif
11#if !defined(ultrix) /* Avoid double definition. */
43db6828 12# include <sys/socket.h>
046cc26c
CB
13#endif
14#if defined(USE_SOCKS) && defined(I_SOCKS)
86959918 15# include <socks.h>
046cc26c
CB
16#endif
17#ifdef MPE
9cc6feab
JH
18# define PF_INET AF_INET
19# define PF_UNIX AF_UNIX
20# define SOCK_RAW 3
046cc26c
CB
21#endif
22#ifdef I_SYS_UN
9cc6feab 23# include <sys/un.h>
046cc26c 24#endif
bf9b2f8f 25/* XXX Configure test for <netinet/in_systm.h needed XXX */
046cc26c 26#if defined(NeXT) || defined(__NeXT__)
bf9b2f8f 27# include <netinet/in_systm.h>
046cc26c
CB
28#endif
29#if defined(__sgi) && !defined(AF_LINK) && defined(PF_LINK) && PF_LINK == AF_LNK
3b8fd1d5 30# undef PF_LINK
046cc26c
CB
31#endif
32#if defined(I_NETINET_IN) || defined(__ultrix__)
8e07c86e 33# include <netinet/in.h>
046cc26c 34#endif
a5c69419
AP
35#if defined(I_NETINET_IP)
36# include <netinet/ip.h>
37#endif
046cc26c 38#ifdef I_NETDB
c2654555 39# if !defined(ultrix) /* Avoid double definition. */
87edd446
JH
40# include <netdb.h>
41# endif
046cc26c
CB
42#endif
43#ifdef I_ARPA_INET
9cc6feab 44# include <arpa/inet.h>
046cc26c
CB
45#endif
46#ifdef I_NETINET_TCP
9cc6feab 47# include <netinet/tcp.h>
8e07c86e 48#endif
a0d0e21e 49
406cccc2 50#if defined(WIN32) && !defined(UNDER_CE)
3be135d8
TC
51# include <ws2tcpip.h>
52#endif
53
0d06df21 54#ifdef WIN32
e45189ae
DD
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
66struct sockaddr_storage {
67 short ss_family;
68 char __ss_pad1[_SS_PAD1SIZE];
69 __int64 __ss_align;
70 char __ss_pad2[_SS_PAD2SIZE];
71};
72
73typedef 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
82static int inet_pton(int af, const char *src, void *dst)
0d06df21
CBW
83{
84 struct sockaddr_storage ss;
85 int size = sizeof(ss);
e45189ae 86 ss.ss_family = af; /* per MSDN */
0d06df21 87
e45189ae 88 if (WSAStringToAddress((char*)src, af, NULL, (struct sockaddr *)&ss, &size) != 0)
0d06df21
CBW
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;
e45189ae
DD
98 default:
99 WSASetLastError(WSAEAFNOSUPPORT);
100 return -1;
0d06df21
CBW
101 }
102}
103
e45189ae 104static const char *inet_ntop(int af, const void *src, char *dst, socklen_t size)
0d06df21
CBW
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
2986a63f
JH
134#ifdef NETWARE
135NETDB_DEFINE_CONTEXT
136NETINET_DEFINE_CONTEXT
137#endif
138
6b1016b5
JH
139#ifdef I_SYSUIO
140# include <sys/uio.h>
141#endif
142
a0d0e21e 143#ifndef AF_NBS
9cc6feab 144# undef PF_NBS
a0d0e21e
LW
145#endif
146
147#ifndef AF_X25
9cc6feab 148# undef PF_X25
a0d0e21e
LW
149#endif
150
8e07c86e 151#ifndef INADDR_NONE
9cc6feab 152# define INADDR_NONE 0xffffffff
8e07c86e 153#endif /* INADDR_NONE */
7e1af8bc 154#ifndef INADDR_BROADCAST
9cc6feab 155# define INADDR_BROADCAST 0xffffffff
7e1af8bc 156#endif /* INADDR_BROADCAST */
8e07c86e 157#ifndef INADDR_LOOPBACK
c2654555 158# define INADDR_LOOPBACK 0x7F000001
8e07c86e
AD
159#endif /* INADDR_LOOPBACK */
160
b8311542
AB
161#ifndef INET_ADDRSTRLEN
162#define INET_ADDRSTRLEN 16
163#endif
164
9dea6244
CBW
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
50e79584
SH
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
4c3d8e12 189#ifndef croak_sv
17673bf5 190# define croak_sv(sv) croak(SvPVx_nolen(sv))
4c3d8e12
PLE
191#endif
192
9dea6244
CBW
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 */
c2654555 197
9dea6244
CBW
198#ifndef newSVpvn_flags
199# define newSVpvn_flags(s,len,flags) my_newSVpvn_flags(aTHX_ s,len,flags)
37b1de1b 200static SV *my_newSVpvn_flags(pTHX_ const char *s, STRLEN len, U32 flags)
c2654555
CBW
201{
202 SV *sv = newSVpvn(s, len);
203 SvFLAGS(sv) |= (flags & SVf_UTF8);
204 return (flags & SVs_TEMP) ? sv_2mortal(sv) : sv;
205}
9dea6244 206#endif /* !newSVpvn_flags */
37b1de1b 207
9dea6244
CBW
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)
229static 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)
255static 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 */
aff163d9
SH
277#ifndef mPUSHs
278# define mPUSHs(s) PUSHs(sv_2mortal(s))
279#endif /* !mPUSHs */
9dea6244
CBW
280
281#ifndef CvCONST_on
282# undef newCONSTSUB
283# define newCONSTSUB(stash, name, val) my_newCONSTSUB(aTHX_ stash, name, val)
284static 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)
308static 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 */
c2654555 315
7e1af8bc
PP
316#ifndef HAS_INET_ATON
317
a062834f 318/*
7e1af8bc
PP
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 */
325static int
f0f333f4 326my_inet_aton(register const char *cp, struct in_addr *addr)
7e1af8bc 327{
c5be433b 328 dTHX;
0caed002 329 register U32 val;
7e1af8bc
PP
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
c2654555 337 if (!cp || !*cp)
0caed002 338 return 0;
7e1af8bc
PP
339 for (;;) {
340 /*
882ce583 341 * Collect number up to ".".
7e1af8bc
PP
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 }
3280af22 358 if (base == 16 && (s=strchr(PL_hexdigit,c))) {
a062834f 359 val = (val << 4) +
3280af22 360 ((s - PL_hexdigit) & 15);
7e1af8bc
PP
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
c2654555
CBW
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
406cccc2
SH
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
c6d5e127
CBW
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
8e07c86e 436
a0d0e21e 437static int
d3f5e399 438not_here(const char *s)
a0d0e21e
LW
439{
440 croak("Socket::%s not implemented on this architecture", s);
441 return -1;
442}
443
2528d3bc
JH
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
c2654555 457* (such as an int, u_int32_t). It can be a bit field,
2528d3bc
JH
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
1cb0fb50 474#include "const-c.inc"
8e07c86e 475
eccda089
PLE
476#ifdef HAS_GETADDRINFO
477static SV *err_to_SV(pTHX_ int err)
478{
0f41f5e2 479 SV *ret = sv_newmortal();
9dea6244 480 (void) SvUPGRADE(ret, SVt_PVNV);
eccda089 481
0f41f5e2
PLE
482 if(err) {
483 const char *error = gai_strerror(err);
484 sv_setpv(ret, error);
485 }
486 else {
487 sv_setpv(ret, "");
488 }
eccda089 489
0f41f5e2 490 SvIV_set(ret, err); SvIOK_on(ret);
eccda089 491
0f41f5e2 492 return ret;
eccda089
PLE
493}
494
495static void xs_getaddrinfo(pTHX_ CV *cv)
496{
0f41f5e2
PLE
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
9dea6244 512 PERL_UNUSED_ARG(cv);
0f41f5e2 513 if(items > 3)
1584259f 514 croak("Usage: Socket::getaddrinfo(host, service, hints)");
0f41f5e2
PLE
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
c2654555 547 Zero(&hints_s, sizeof(hints_s), char);
0cd14f2e 548 hints_s.ai_family = PF_UNSPEC;
0f41f5e2
PLE
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
23296748 559 if((valp = hv_fetch(hintshash, "flags", 5, 0)) != NULL && SvOK(*valp))
0f41f5e2 560 hints_s.ai_flags = SvIV(*valp);
23296748 561 if((valp = hv_fetch(hintshash, "family", 6, 0)) != NULL && SvOK(*valp))
0f41f5e2 562 hints_s.ai_family = SvIV(*valp);
23296748 563 if((valp = hv_fetch(hintshash, "socktype", 8, 0)) != NULL && SvOK(*valp))
0f41f5e2 564 hints_s.ai_socktype = SvIV(*valp);
23296748 565 if((valp = hv_fetch(hintshash, "protocol", 8, 0)) != NULL && SvOK(*valp))
0f41f5e2
PLE
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);
eccda089
PLE
598}
599#endif
600
601#ifdef HAS_GETNAMEINFO
602static void xs_getnameinfo(pTHX_ CV *cv)
603{
0f41f5e2 604 dXSARGS;
eccda089 605
0f41f5e2
PLE
606 SV *addr;
607 int flags;
c2654555 608 int xflags;
eccda089 609
0f41f5e2
PLE
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;
eccda089 615
c2654555
CBW
616 int want_host, want_serv;
617
9dea6244 618 PERL_UNUSED_ARG(cv);
c2654555
CBW
619 if(items < 1 || items > 3)
620 croak("Usage: Socket::getnameinfo(addr, flags=0, xflags=0)");
eccda089 621
0f41f5e2 622 SP -= items;
eccda089 623
0f41f5e2 624 addr = ST(0);
17673bf5 625 SvGETMAGIC(addr);
eccda089 626
0f41f5e2
PLE
627 if(items < 2)
628 flags = 0;
629 else
630 flags = SvIV(ST(1));
eccda089 631
c2654555
CBW
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
7ec80894 640 if(!SvPOKp(addr))
0f41f5e2 641 croak("addr is not a string");
eccda089 642
0f41f5e2 643 addr_len = SvCUR(addr);
eccda089 644
0f41f5e2
PLE
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);
eccda089 649#ifdef HAS_SOCKADDR_SA_LEN
0f41f5e2 650 ((struct sockaddr *)sa)->sa_len = addr_len;
eccda089
PLE
651#endif
652
0f41f5e2 653 err = getnameinfo((struct sockaddr *)sa, addr_len,
c2654555
CBW
654 want_host ? host : NULL, want_host ? sizeof(host) : 0,
655 want_serv ? serv : NULL, want_serv ? sizeof(serv) : 0,
0f41f5e2 656 flags);
eccda089 657
0f41f5e2 658 Safefree(sa);
eccda089 659
0f41f5e2 660 XPUSHs(err_to_SV(aTHX_ err));
eccda089 661
0f41f5e2
PLE
662 if(err)
663 XSRETURN(1);
eccda089 664
c2654555
CBW
665 XPUSHs(want_host ? sv_2mortal(newSVpv(host, 0)) : &PL_sv_undef);
666 XPUSHs(want_serv ? sv_2mortal(newSVpv(serv, 0)) : &PL_sv_undef);
eccda089 667
0f41f5e2 668 XSRETURN(3);
eccda089
PLE
669}
670#endif
671
a0d0e21e
LW
672MODULE = Socket PACKAGE = Socket
673
1cb0fb50 674INCLUDE: const-xs.inc
8e07c86e 675
eccda089
PLE
676BOOT:
677#ifdef HAS_GETADDRINFO
c2654555 678 newXS("Socket::getaddrinfo", xs_getaddrinfo, __FILE__);
eccda089
PLE
679#endif
680#ifdef HAS_GETNAMEINFO
c2654555 681 newXS("Socket::getnameinfo", xs_getnameinfo, __FILE__);
eccda089
PLE
682#endif
683
8e07c86e
AD
684void
685inet_aton(host)
686 char * host
687 CODE:
688 {
fbf77aee 689 struct in_addr ip_address;
8e07c86e
AD
690 struct hostent * phe;
691
4596752b 692 if ((*host != '\0') && inet_aton(host, &ip_address)) {
c2654555 693 ST(0) = sv_2mortal(newSVpvn((char *)&ip_address, sizeof(ip_address)));
4596752b
NC
694 XSRETURN(1);
695 }
696
697 phe = gethostbyname(host);
698 if (phe && phe->h_addrtype == AF_INET && phe->h_length == 4) {
c2654555 699 ST(0) = sv_2mortal(newSVpvn((char *)phe->h_addr, phe->h_length));
4596752b 700 XSRETURN(1);
8e07c86e
AD
701 }
702
4596752b 703 XSRETURN_UNDEF;
8e07c86e 704 }
8e07c86e
AD
705
706void
707inet_ntoa(ip_address_sv)
708 SV * ip_address_sv
709 CODE:
710 {
711 STRLEN addrlen;
712 struct in_addr addr;
1d68b939
JH
713 char * ip_address;
714 if (DO_UTF8(ip_address_sv) && !sv_utf8_downgrade(ip_address_sv, 1))
c2654555 715 croak("Wide character in %s", "Socket::inet_ntoa");
f780604f 716 ip_address = SvPVbyte(ip_address_sv, addrlen);
2528d3bc 717 if (addrlen == sizeof(addr) || addrlen == 4)
c2654555 718 addr.s_addr =
2528d3bc
JH
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
9dea6244
CBW
724 croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf,
725 "Socket::inet_ntoa", (UV)addrlen, (UV)sizeof(addr));
2528d3bc
JH
726 /* We could use inet_ntoa() but that is broken
727 * in HP-UX + GCC + 64bitint (returns "0.0.0.0"),
1d88b533
JH
728 * so let's use this sprintf() workaround everywhere.
729 * This is also more threadsafe than using inet_ntoa(). */
8063d419 730 ST(0) = sv_2mortal(Perl_newSVpvf(aTHX_ "%d.%d.%d.%d", /* IPv6? */
17673bf5
CBW
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)));
8e07c86e
AD
735 }
736
737void
2a84dff3
GA
738sockaddr_family(sockaddr)
739 SV * sockaddr
740 PREINIT:
741 STRLEN sockaddr_len;
f780604f 742 char *sockaddr_pv = SvPVbyte(sockaddr, sockaddr_len);
2a84dff3 743 CODE:
c6d5e127 744 if (sockaddr_len < STRUCT_OFFSET(struct sockaddr, sa_data))
9dea6244
CBW
745 croak("Bad arg length for %s, length is %"UVuf", should be at least %"UVuf,
746 "Socket::sockaddr_family", (UV)sockaddr_len,
c6d5e127 747 (UV)STRUCT_OFFSET(struct sockaddr, sa_data));
2a84dff3
GA
748 ST(0) = sv_2mortal(newSViv(((struct sockaddr*)sockaddr_pv)->sa_family));
749
750void
4633a7c4 751pack_sockaddr_un(pathname)
7513c55b 752 SV * pathname
4633a7c4
LW
753 CODE:
754 {
25f94b33 755#ifdef I_SYS_UN
4633a7c4 756 struct sockaddr_un sun_ad; /* fear using sun */
fcdb74fc 757 STRLEN len;
7513c55b 758 char * pathname_pv;
99f13d4c 759 int addr_len;
202975e6 760
c2654555 761 Zero(&sun_ad, sizeof(sun_ad), char);
4633a7c4 762 sun_ad.sun_family = AF_UNIX;
7513c55b 763 pathname_pv = SvPV(pathname,len);
20408e3c
GS
764 if (len > sizeof(sun_ad.sun_path))
765 len = sizeof(sun_ad.sun_path);
202975e6
IZ
766# ifdef OS2 /* Name should start with \socket\ and contain backslashes! */
767 {
c2654555
CBW
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 = '\\';
202975e6 788 }
a062834f 789# else /* !( defined OS2 ) */
c2654555 790 Copy(pathname_pv, sun_ad.sun_path, len, char);
202975e6 791# endif
a062834f 792 if (0) not_here("dummy");
99f13d4c
LR
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 */
178e6016 799 addr_len = (char *)&(sun_ad.sun_path) - (char *)&sun_ad + len;
99f13d4c 800 } else {
c2654555 801 addr_len = sizeof(sun_ad);
99f13d4c 802 }
5897b17c
PLE
803# ifdef HAS_SOCKADDR_SA_LEN
804 sun_ad.sun_len = addr_len;
805# endif
c2654555 806 ST(0) = sv_2mortal(newSVpvn((char *)&sun_ad, addr_len));
25f94b33 807#else
c2654555 808 ST(0) = (SV*)not_here("pack_sockaddr_un");
25f94b33 809#endif
c2654555 810
4633a7c4
LW
811 }
812
813void
814unpack_sockaddr_un(sun_sv)
815 SV * sun_sv
f13e1b2f 816 CODE:
4633a7c4 817 {
25f94b33 818#ifdef I_SYS_UN
4633a7c4 819 struct sockaddr_un addr;
fcdb74fc 820 STRLEN sockaddrlen;
f780604f 821 char * sun_ad = SvPVbyte(sun_sv,sockaddrlen);
89904c08 822 int addr_len;
669d990b
SH
823# if defined(__linux__) || defined(HAS_SOCKADDR_SA_LEN)
824 /* On Linux or *BSD sockaddrlen on sockets returned by accept, recvfrom,
36902e12 825 getpeername and getsockname is not equal to sizeof(addr). */
eabcd9c8
A
826 if (sockaddrlen < sizeof(addr)) {
827 Copy(sun_ad, &addr, sockaddrlen, char);
23296748 828 Zero(((char*)&addr) + sockaddrlen, sizeof(addr) - sockaddrlen, char);
eabcd9c8
A
829 } else {
830 Copy(sun_ad, &addr, sizeof(addr), char);
831 }
669d990b
SH
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
eabcd9c8 838# else
c2654555 839 if (sockaddrlen != sizeof(addr))
9dea6244
CBW
840 croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf,
841 "Socket::unpack_sockaddr_un", (UV)sockaddrlen, (UV)sizeof(addr));
c2654555 842 Copy(sun_ad, &addr, sizeof(addr), char);
eabcd9c8 843# endif
4633a7c4 844
c2654555
CBW
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);
669d990b 848# ifdef __linux__
89904c08
LR
849 if (addr.sun_path[0] == '\0') {
850 /* Linux-style abstract socket address begins with a nul
851 * and can contain nuls. */
178e6016 852 addr_len = (char *)&addr - (char *)&(addr.sun_path) + sockaddrlen;
669d990b
SH
853 } else
854# endif
855 {
856# if defined(HAS_SOCKADDR_SA_LEN)
857 /* On *BSD sun_path not always ends with a '\0' */
c6d5e127 858 int maxlen = addr.sun_len - 2; /* should use STRUCT_OFFSET(struct sockaddr_un, sun_path) instead of 2 */
669d990b
SH
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
89904c08 864 for (addr_len = 0; addr.sun_path[addr_len]
669d990b 865 && addr_len < maxlen; addr_len++);
89904c08
LR
866 }
867
c2654555 868 ST(0) = sv_2mortal(newSVpvn(addr.sun_path, addr_len));
25f94b33 869#else
c2654555 870 ST(0) = (SV*)not_here("unpack_sockaddr_un");
25f94b33 871#endif
4633a7c4
LW
872 }
873
874void
2528d3bc 875pack_sockaddr_in(port, ip_address_sv)
2c129a17 876 unsigned short port
2528d3bc 877 SV * ip_address_sv
8e07c86e
AD
878 CODE:
879 {
880 struct sockaddr_in sin;
2528d3bc
JH
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))
c2654555 885 croak("Wide character in %s", "Socket::pack_sockaddr_in");
f780604f 886 ip_address = SvPVbyte(ip_address_sv, addrlen);
2528d3bc 887 if (addrlen == sizeof(addr) || addrlen == 4)
c2654555 888 addr.s_addr =
17673bf5
CBW
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);
2528d3bc 893 else
9dea6244 894 croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf,
2528d3bc 895 "Socket::pack_sockaddr_in",
9dea6244 896 (UV)addrlen, (UV)sizeof(addr));
c2654555 897 Zero(&sin, sizeof(sin), char);
4633a7c4 898 sin.sin_family = AF_INET;
8e07c86e 899 sin.sin_port = htons(port);
2528d3bc 900 sin.sin_addr.s_addr = htonl(addr.s_addr);
5897b17c 901# ifdef HAS_SOCKADDR_SA_LEN
c2654555 902 sin.sin_len = sizeof(sin);
5897b17c 903# endif
c2654555 904 ST(0) = sv_2mortal(newSVpvn((char *)&sin, sizeof(sin)));
8e07c86e
AD
905 }
906
907void
908unpack_sockaddr_in(sin_sv)
909 SV * sin_sv
910 PPCODE:
911 {
912 STRLEN sockaddrlen;
913 struct sockaddr_in addr;
aff163d9 914 SV *ip_address_sv;
f780604f 915 char * sin = SvPVbyte(sin_sv,sockaddrlen);
8e07c86e 916 if (sockaddrlen != sizeof(addr)) {
9dea6244 917 croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf,
c6d5e127 918 "Socket::unpack_sockaddr_in", (UV)sockaddrlen, (UV)sizeof(addr));
8e07c86e 919 }
c2654555
CBW
920 Copy(sin, &addr, sizeof(addr), char);
921 if (addr.sin_family != AF_INET) {
4633a7c4 922 croak("Bad address family for %s, got %d, should be %d",
c2654555 923 "Socket::unpack_sockaddr_in", addr.sin_family, AF_INET);
a062834f 924 }
aff163d9 925 ip_address_sv = newSVpvn((char *)&addr.sin_addr, sizeof(addr.sin_addr));
8e07c86e 926
aff163d9
SH
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 }
8e07c86e 935 }
036d8bd4
SP
936
937void
9987e04d
PLE
938pack_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 {
9dea6244 945#ifdef HAS_SOCKADDR_IN6
9987e04d
PLE
946 struct sockaddr_in6 sin6;
947 char * addrbytes;
948 STRLEN addrlen;
949 if (DO_UTF8(sin6_addr) && !sv_utf8_downgrade(sin6_addr, 1))
c2654555 950 croak("Wide character in %s", "Socket::pack_sockaddr_in6");
9987e04d 951 addrbytes = SvPVbyte(sin6_addr, addrlen);
c2654555 952 if (addrlen != sizeof(sin6.sin6_addr))
9dea6244
CBW
953 croak("Bad arg length %s, length is %"UVuf", should be %"UVuf,
954 "Socket::pack_sockaddr_in6", (UV)addrlen, (UV)sizeof(sin6.sin6_addr));
9987e04d
PLE
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);
24b8ee2e 960# ifdef HAS_SIN6_SCOPE_ID
9987e04d 961 sin6.sin6_scope_id = scope_id;
79c932f0 962# else
c2654555 963 if (scope_id != 0)
79c932f0 964 warn("%s cannot represent non-zero scope_id %d",
c2654555 965 "Socket::pack_sockaddr_in6", scope_id);
24b8ee2e 966# endif
5897b17c
PLE
967# ifdef HAS_SOCKADDR_SA_LEN
968 sin6.sin6_len = sizeof(sin6);
969# endif
c2654555 970 ST(0) = sv_2mortal(newSVpvn((char *)&sin6, sizeof(sin6)));
9987e04d 971#else
17673bf5
CBW
972 PERL_UNUSED_VAR(port);
973 PERL_UNUSED_VAR(sin6_addr);
9987e04d
PLE
974 ST(0) = (SV*)not_here("pack_sockaddr_in6");
975#endif
976 }
977
978void
979unpack_sockaddr_in6(sin6_sv)
980 SV * sin6_sv
981 PPCODE:
982 {
9dea6244 983#ifdef HAS_SOCKADDR_IN6
9987e04d
PLE
984 STRLEN addrlen;
985 struct sockaddr_in6 sin6;
986 char * addrbytes = SvPVbyte(sin6_sv, addrlen);
aff163d9 987 SV *ip_address_sv;
9987e04d 988 if (addrlen != sizeof(sin6))
9dea6244
CBW
989 croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf,
990 "Socket::unpack_sockaddr_in6", (UV)addrlen, (UV)sizeof(sin6));
9987e04d 991 Copy(addrbytes, &sin6, sizeof(sin6), char);
c2654555
CBW
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);
aff163d9
SH
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);
24b8ee2e 1001# ifdef HAS_SIN6_SCOPE_ID
aff163d9 1002 mPUSHi(sin6.sin6_scope_id);
24b8ee2e 1003# else
aff163d9 1004 mPUSHi(0);
24b8ee2e 1005# endif
aff163d9
SH
1006 mPUSHi(ntohl(sin6.sin6_flowinfo));
1007 }
1008 else {
1009 mPUSHs(ip_address_sv);
1010 }
9987e04d 1011#else
17673bf5 1012 PERL_UNUSED_VAR(sin6_sv);
9987e04d
PLE
1013 ST(0) = (SV*)not_here("pack_sockaddr_in6");
1014#endif
1015 }
1016
1017void
036d8bd4 1018inet_ntop(af, ip_address_sv)
c2654555
CBW
1019 int af
1020 SV * ip_address_sv
1021 CODE:
036d8bd4 1022#ifdef HAS_INETNTOP
5b05192f 1023 STRLEN addrlen;
a5addb16 1024#ifdef AF_INET6
036d8bd4
SP
1025 struct in6_addr addr;
1026 char str[INET6_ADDRSTRLEN];
a5addb16
PG
1027#else
1028 struct in_addr addr;
1029 char str[INET_ADDRSTRLEN];
1030#endif
eabcd9c8
A
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);
036d8bd4 1037
aff163d9
SH
1038 switch(af) {
1039 case AF_INET:
1040 if(addrlen != 4)
1041 croak("Bad address length for Socket::inet_ntop on AF_INET;"
5b05192f 1042 " got %"UVuf", should be 4", (UV)addrlen);
aff163d9 1043 break;
a5addb16 1044#ifdef AF_INET6
aff163d9
SH
1045 case AF_INET6:
1046 if(addrlen != 16)
1047 croak("Bad address length for Socket::inet_ntop on AF_INET6;"
5b05192f 1048 " got %"UVuf", should be 16", (UV)addrlen);
aff163d9 1049 break;
a5addb16 1050#endif
aff163d9 1051 default:
c2654555 1052 croak("Bad address family for %s, got %d, should be"
a5addb16 1053#ifdef AF_INET6
c2654555 1054 " either AF_INET or AF_INET6",
a5addb16 1055#else
c2654555 1056 " AF_INET",
a5addb16 1057#endif
c2654555
CBW
1058 "Socket::inet_ntop", af);
1059 }
036d8bd4 1060
5b05192f
CBW
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 }
a5addb16 1068 inet_ntop(af, &addr, str, sizeof str);
036d8bd4 1069
c2654555 1070 ST(0) = sv_2mortal(newSVpvn(str, strlen(str)));
036d8bd4 1071#else
17673bf5
CBW
1072 PERL_UNUSED_VAR(af);
1073 PERL_UNUSED_VAR(ip_address_sv);
c2654555 1074 ST(0) = (SV*)not_here("inet_ntop");
036d8bd4
SP
1075#endif
1076
1077void
1078inet_pton(af, host)
c2654555
CBW
1079 int af
1080 const char * host
1081 CODE:
036d8bd4 1082#ifdef HAS_INETPTON
c2654555 1083 int ok;
eabcd9c8 1084 int addrlen = 0;
a5addb16
PG
1085#ifdef AF_INET6
1086 struct in6_addr ip_address;
1087#else
1088 struct in_addr ip_address;
1089#endif
1090
eabcd9c8
A
1091 switch(af) {
1092 case AF_INET:
1093 addrlen = 4;
1094 break;
a5addb16 1095#ifdef AF_INET6
eabcd9c8
A
1096 case AF_INET6:
1097 addrlen = 16;
1098 break;
a5addb16 1099#endif
eabcd9c8 1100 default:
a5addb16
PG
1101 croak("Bad address family for %s, got %d, should be"
1102#ifdef AF_INET6
c2654555 1103 " either AF_INET or AF_INET6",
a5addb16 1104#else
c2654555 1105 " AF_INET",
a5addb16 1106#endif
c2654555
CBW
1107 "Socket::inet_pton", af);
1108 }
1109 ok = (*host != '\0') && inet_pton(af, host, &ip_address);
036d8bd4 1110
c2654555
CBW
1111 ST(0) = sv_newmortal();
1112 if (ok) {
eabcd9c8 1113 sv_setpvn( ST(0), (char *)&ip_address, addrlen);
c2654555 1114 }
036d8bd4 1115#else
17673bf5
CBW
1116 PERL_UNUSED_VAR(af);
1117 PERL_UNUSED_VAR(host);
c2654555 1118 ST(0) = (SV*)not_here("inet_pton");
036d8bd4 1119#endif
4f5bb87f
PLE
1120
1121void
3be135d8
TC
1122pack_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
1157void
1158unpack_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
1178void
d4ada64a
SH
1179pack_ip_mreq_source(multiaddr, source, interface=&PL_sv_undef)
1180 SV * multiaddr
1181 SV * source
1182 SV * interface
1183 CODE:
1184 {
aff163d9 1185#if defined(HAS_IP_MREQ_SOURCE) && defined (IP_ADD_SOURCE_MEMBERSHIP)
d4ada64a
SH
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
17673bf5
CBW
1219 PERL_UNUSED_VAR(multiaddr);
1220 PERL_UNUSED_VAR(source);
d4ada64a
SH
1221 not_here("pack_ip_mreq_source");
1222#endif
1223 }
1224
1225void
1226unpack_ip_mreq_source(mreq_sv)
1227 SV * mreq_sv
1228 PPCODE:
1229 {
aff163d9 1230#if defined(HAS_IP_MREQ_SOURCE) && defined (IP_ADD_SOURCE_MEMBERSHIP)
d4ada64a
SH
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
17673bf5 1243 PERL_UNUSED_VAR(mreq_sv);
d4ada64a
SH
1244 not_here("unpack_ip_mreq_source");
1245#endif
1246 }
1247
1248void
406cccc2 1249pack_ipv6_mreq(multiaddr, ifindex)
3be135d8 1250 SV * multiaddr
406cccc2 1251 unsigned int ifindex
4f5bb87f
PLE
1252 CODE:
1253 {
9dea6244 1254#ifdef HAS_IPV6_MREQ
4f5bb87f 1255 struct ipv6_mreq mreq;
3be135d8
TC
1256 char * multiaddrbytes;
1257 STRLEN len;
1258 if (DO_UTF8(multiaddr) && !sv_utf8_downgrade(multiaddr, 1))
c2654555 1259 croak("Wide character in %s", "Socket::pack_ipv6_mreq");
3be135d8
TC
1260 multiaddrbytes = SvPVbyte(multiaddr, len);
1261 if (len != sizeof(mreq.ipv6mr_multiaddr))
9dea6244 1262 croak("Bad arg length %s, length is %"UVuf", should be %"UVuf,
3be135d8 1263 "Socket::pack_ipv6_mreq", (UV)len, (UV)sizeof(mreq.ipv6mr_multiaddr));
4f5bb87f 1264 Zero(&mreq, sizeof(mreq), char);
3be135d8 1265 Copy(multiaddrbytes, &mreq.ipv6mr_multiaddr, sizeof(mreq.ipv6mr_multiaddr), char);
406cccc2 1266 mreq.ipv6mr_interface = ifindex;
c2654555 1267 ST(0) = sv_2mortal(newSVpvn((char *)&mreq, sizeof(mreq)));
4f5bb87f 1268#else
17673bf5
CBW
1269 PERL_UNUSED_VAR(multiaddr);
1270 PERL_UNUSED_VAR(ifindex);
3be135d8 1271 not_here("pack_ipv6_mreq");
4f5bb87f
PLE
1272#endif
1273 }
1274
1275void
1276unpack_ipv6_mreq(mreq_sv)
1277 SV * mreq_sv
1278 PPCODE:
1279 {
9dea6244 1280#ifdef HAS_IPV6_MREQ
4f5bb87f
PLE
1281 struct ipv6_mreq mreq;
1282 STRLEN mreqlen;
1283 char * mreqbytes = SvPVbyte(mreq_sv, mreqlen);
1284 if (mreqlen != sizeof(mreq))
9dea6244
CBW
1285 croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf,
1286 "Socket::unpack_ipv6_mreq", (UV)mreqlen, (UV)sizeof(mreq));
4f5bb87f
PLE
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
17673bf5 1292 PERL_UNUSED_VAR(mreq_sv);
4f5bb87f
PLE
1293 not_here("unpack_ipv6_mreq");
1294#endif
1295 }