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