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