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 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 109 static 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 131 static 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 164 NETDB_DEFINE_CONTEXT 165 NETINET_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) 229 static 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) 254 static 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) 280 static 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) 313 static 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) 337 static 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 */ 354 static int 355 my_inet_aton(const char *cp, struct in_addr *addr) 356 { 357 dTHX; 358 U32 val; 359 int base; 360 char c; 361 int nparts; 362 const char *s; 363 unsigned int parts[4]; 364 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 466 static SV * 467 not_here(const char *s) 468 { 469 croak("Socket::%s not implemented on this architecture", s); 470 return NULL; 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) 506 static 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 565 static 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 583 static 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 690 static 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 765 MODULE = Socket PACKAGE = Socket 766 767 INCLUDE: const-xs.inc 768 769 BOOT: 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 777 void 778 inet_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 812 void 813 inet_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 ", should be %" UVuf, 831 "Socket::inet_ntoa", (UV)addrlen, (UV)sizeof(addr)); 832 /* We could use inet_ntoa() but that is broken 833 * in HP-UX + GCC + 64bitint (returns "0.0.0.0"), 834 * so let's use this sprintf() workaround everywhere. 835 * This is also more threadsafe than using inet_ntoa(). */ 836 ST(0) = sv_2mortal(Perl_newSVpvf(aTHX_ "%d.%d.%d.%d", /* IPv6? */ 837 (int)((addr.s_addr >> 24) & 0xFF), 838 (int)((addr.s_addr >> 16) & 0xFF), 839 (int)((addr.s_addr >> 8) & 0xFF), 840 (int)( addr.s_addr & 0xFF))); 841 } 842 843 void 844 sockaddr_family(sockaddr) 845 SV * sockaddr 846 PREINIT: 847 STRLEN sockaddr_len; 848 char *sockaddr_pv = SvPVbyte(sockaddr, sockaddr_len); 849 CODE: 850 if (sockaddr_len < STRUCT_OFFSET(struct sockaddr, sa_data)) 851 croak("Bad arg length for %s, length is %" UVuf ", should be at least %" UVuf, 852 "Socket::sockaddr_family", (UV)sockaddr_len, 853 (UV)STRUCT_OFFSET(struct sockaddr, sa_data)); 854 ST(0) = sv_2mortal(newSViv(((struct sockaddr*)sockaddr_pv)->sa_family)); 855 856 void 857 pack_sockaddr_un(pathname) 858 SV * pathname 859 CODE: 860 { 861 #if defined(I_SYS_UN) || defined(WIN32) 862 struct sockaddr_un sun_ad; /* fear using sun */ 863 STRLEN len; 864 char * pathname_pv; 865 int addr_len; 866 867 if (!SvOK(pathname)) 868 croak("Undefined path for %s", "Socket::pack_sockaddr_un"); 869 870 Zero(&sun_ad, sizeof(sun_ad), char); 871 sun_ad.sun_family = AF_UNIX; 872 pathname_pv = SvPVbyte(pathname,len); 873 if (len > sizeof(sun_ad.sun_path)) { 874 warn("Path length (%" UVuf ") is longer than maximum supported length" 875 " (%" UVuf ") and will be truncated", 876 (UV)len, (UV)sizeof(sun_ad.sun_path)); 877 len = sizeof(sun_ad.sun_path); 878 } 879 # ifdef OS2 /* Name should start with \socket\ and contain backslashes! */ 880 { 881 int off; 882 char *s, *e; 883 884 if (pathname_pv[0] != '/' && pathname_pv[0] != '\\') 885 croak("Relative UNIX domain socket name '%s' unsupported", 886 pathname_pv); 887 else if (len < 8 888 || pathname_pv[7] != '/' && pathname_pv[7] != '\\' 889 || !strnicmp(pathname_pv + 1, "socket", 6)) 890 off = 7; 891 else 892 off = 0; /* Preserve names starting with \socket\ */ 893 Copy("\\socket", sun_ad.sun_path, off, char); 894 Copy(pathname_pv, sun_ad.sun_path + off, len, char); 895 896 s = sun_ad.sun_path + off - 1; 897 e = s + len + 1; 898 while (++s < e) 899 if (*s = '/') 900 *s = '\\'; 901 } 902 # else /* !( defined OS2 ) */ 903 Copy(pathname_pv, sun_ad.sun_path, len, char); 904 # endif 905 if (0) not_here("dummy"); 906 if (len > 1 && sun_ad.sun_path[0] == '\0') { 907 /* Linux-style abstract-namespace socket. 908 * The name is not a file name, but an array of arbitrary 909 * character, starting with \0 and possibly including \0s, 910 * therefore the length of the structure must denote the 911 * end of that character array */ 912 addr_len = (char *)&(sun_ad.sun_path) - (char *)&sun_ad + len; 913 } else { 914 addr_len = sizeof(sun_ad); 915 } 916 # ifdef HAS_SOCKADDR_SA_LEN 917 sun_ad.sun_len = addr_len; 918 # endif 919 ST(0) = sv_2mortal(newSVpvn((char *)&sun_ad, addr_len)); 920 #else 921 ST(0) = not_here("pack_sockaddr_un"); 922 #endif 923 } 924 925 void 926 unpack_sockaddr_un(sun_sv) 927 SV * sun_sv 928 CODE: 929 { 930 #if defined(I_SYS_UN) || defined(WIN32) 931 struct sockaddr_un addr; 932 STRLEN sockaddrlen; 933 char * sun_ad; 934 int addr_len = 0; 935 if (!SvOK(sun_sv)) 936 croak("Undefined address for %s", "Socket::unpack_sockaddr_un"); 937 sun_ad = SvPVbyte(sun_sv,sockaddrlen); 938 # if defined(__linux__) || defined(__CYGWIN__) || defined(sun) || defined(HAS_SOCKADDR_SA_LEN) 939 /* On Linux, Cygwin, Solaris or *BSD sockaddrlen on sockets returned by accept, 940 * recvfrom, getpeername and getsockname is not equal to sizeof(addr). */ 941 if (sockaddrlen < sizeof(addr)) { 942 Copy(sun_ad, &addr, sockaddrlen, char); 943 Zero(((char*)&addr) + sockaddrlen, sizeof(addr) - sockaddrlen, char); 944 } else { 945 Copy(sun_ad, &addr, sizeof(addr), char); 946 } 947 # ifdef HAS_SOCKADDR_SA_LEN 948 /* In this case, sun_len must be checked */ 949 if (sockaddrlen != addr.sun_len) 950 croak("Invalid arg sun_len field for %s, length is %" UVuf ", but sun_len is %" UVuf, 951 "Socket::unpack_sockaddr_un", (UV)sockaddrlen, (UV)addr.sun_len); 952 # endif 953 # else 954 if (sockaddrlen != sizeof(addr)) 955 croak("Bad arg length for %s, length is %" UVuf ", should be %" UVuf, 956 "Socket::unpack_sockaddr_un", (UV)sockaddrlen, (UV)sizeof(addr)); 957 Copy(sun_ad, &addr, sizeof(addr), char); 958 # endif 959 960 if (addr.sun_family != AF_UNIX) 961 croak("Bad address family for %s, got %d, should be %d", 962 "Socket::unpack_sockaddr_un", addr.sun_family, AF_UNIX); 963 # ifdef __linux__ 964 if (addr.sun_path[0] == '\0') { 965 /* Linux-style abstract socket address begins with a nul 966 * and can contain nuls. */ 967 addr_len = (char *)&addr - (char *)&(addr.sun_path) + sockaddrlen; 968 } else 969 # endif 970 { 971 # if defined(HAS_SOCKADDR_SA_LEN) 972 /* On *BSD sun_path not always ends with a '\0' */ 973 int maxlen = addr.sun_len - 2; /* should use STRUCT_OFFSET(struct sockaddr_un, sun_path) instead of 2 */ 974 if (maxlen > (int)sizeof(addr.sun_path)) 975 maxlen = (int)sizeof(addr.sun_path); 976 # else 977 const int maxlen = (int)sizeof(addr.sun_path); 978 # endif 979 while (addr_len < maxlen && addr.sun_path[addr_len]) 980 addr_len++; 981 } 982 983 ST(0) = sv_2mortal(newSVpvn(addr.sun_path, addr_len)); 984 #else 985 ST(0) = not_here("unpack_sockaddr_un"); 986 #endif 987 } 988 989 void 990 pack_sockaddr_in(port_sv, ip_address_sv) 991 SV * port_sv 992 SV * ip_address_sv 993 CODE: 994 { 995 struct sockaddr_in sin; 996 struct in_addr addr; 997 STRLEN addrlen; 998 unsigned short port = 0; 999 char * ip_address; 1000 if (SvOK(port_sv)) { 1001 port = SvUV(port_sv); 1002 if (SvUV(port_sv) > 0xFFFF) 1003 warn("Port number above 0xFFFF, will be truncated to %d for %s", 1004 port, "Socket::pack_sockaddr_in"); 1005 } 1006 if (!SvOK(ip_address_sv)) 1007 croak("Undefined address for %s", "Socket::pack_sockaddr_in"); 1008 if (DO_UTF8(ip_address_sv) && !sv_utf8_downgrade(ip_address_sv, 1)) 1009 croak("Wide character in %s", "Socket::pack_sockaddr_in"); 1010 ip_address = SvPVbyte(ip_address_sv, addrlen); 1011 if (addrlen == sizeof(addr) || addrlen == 4) 1012 addr.s_addr = 1013 (unsigned int)(ip_address[0] & 0xFF) << 24 | 1014 (unsigned int)(ip_address[1] & 0xFF) << 16 | 1015 (unsigned int)(ip_address[2] & 0xFF) << 8 | 1016 (unsigned int)(ip_address[3] & 0xFF); 1017 else 1018 croak("Bad arg length for %s, length is %" UVuf ", should be %" UVuf, 1019 "Socket::pack_sockaddr_in", (UV)addrlen, (UV)sizeof(addr)); 1020 Zero(&sin, sizeof(sin), char); 1021 sin.sin_family = AF_INET; 1022 sin.sin_port = htons(port); 1023 sin.sin_addr.s_addr = htonl(addr.s_addr); 1024 # ifdef HAS_SOCKADDR_SA_LEN 1025 sin.sin_len = sizeof(sin); 1026 # endif 1027 ST(0) = sv_2mortal(newSVpvn((char *)&sin, sizeof(sin))); 1028 } 1029 1030 void 1031 unpack_sockaddr_in(sin_sv) 1032 SV * sin_sv 1033 PPCODE: 1034 { 1035 STRLEN sockaddrlen; 1036 struct sockaddr_in addr; 1037 SV *ip_address_sv; 1038 char * sin; 1039 if (!SvOK(sin_sv)) 1040 croak("Undefined address for %s", "Socket::unpack_sockaddr_in"); 1041 sin = SvPVbyte(sin_sv,sockaddrlen); 1042 if (sockaddrlen != sizeof(addr)) { 1043 croak("Bad arg length for %s, length is %" UVuf ", should be %" UVuf, 1044 "Socket::unpack_sockaddr_in", (UV)sockaddrlen, (UV)sizeof(addr)); 1045 } 1046 Copy(sin, &addr, sizeof(addr), char); 1047 if (addr.sin_family != AF_INET) { 1048 croak("Bad address family for %s, got %d, should be %d", 1049 "Socket::unpack_sockaddr_in", addr.sin_family, AF_INET); 1050 } 1051 ip_address_sv = newSVpvn((char *)&addr.sin_addr, sizeof(addr.sin_addr)); 1052 1053 if(GIMME_V == G_LIST) { 1054 EXTEND(SP, 2); 1055 mPUSHi(ntohs(addr.sin_port)); 1056 mPUSHs(ip_address_sv); 1057 } 1058 else { 1059 mPUSHs(ip_address_sv); 1060 } 1061 } 1062 1063 void 1064 pack_sockaddr_in6(port_sv, sin6_addr, scope_id=0, flowinfo=0) 1065 SV * port_sv 1066 SV * sin6_addr 1067 unsigned long scope_id 1068 unsigned long flowinfo 1069 CODE: 1070 { 1071 #ifdef HAS_SOCKADDR_IN6 1072 unsigned short port = 0; 1073 struct sockaddr_in6 sin6; 1074 char * addrbytes; 1075 STRLEN addrlen; 1076 if (SvOK(port_sv)) { 1077 port = SvUV(port_sv); 1078 if (SvUV(port_sv) > 0xFFFF) 1079 warn("Port number above 0xFFFF, will be truncated to %d for %s", 1080 port, "Socket::pack_sockaddr_in6"); 1081 } 1082 if (!SvOK(sin6_addr)) 1083 croak("Undefined address for %s", "Socket::pack_sockaddr_in6"); 1084 if (DO_UTF8(sin6_addr) && !sv_utf8_downgrade(sin6_addr, 1)) 1085 croak("Wide character in %s", "Socket::pack_sockaddr_in6"); 1086 addrbytes = SvPVbyte(sin6_addr, addrlen); 1087 if (addrlen != sizeof(sin6.sin6_addr)) 1088 croak("Bad arg length %s, length is %" UVuf ", should be %" UVuf, 1089 "Socket::pack_sockaddr_in6", (UV)addrlen, (UV)sizeof(sin6.sin6_addr)); 1090 Zero(&sin6, sizeof(sin6), char); 1091 sin6.sin6_family = AF_INET6; 1092 sin6.sin6_port = htons(port); 1093 sin6.sin6_flowinfo = htonl(flowinfo); 1094 Copy(addrbytes, &sin6.sin6_addr, sizeof(sin6.sin6_addr), char); 1095 # ifdef HAS_SIN6_SCOPE_ID 1096 sin6.sin6_scope_id = scope_id; 1097 # else 1098 if (scope_id != 0) 1099 warn("%s cannot represent non-zero scope_id %d", 1100 "Socket::pack_sockaddr_in6", scope_id); 1101 # endif 1102 # ifdef HAS_SOCKADDR_SA_LEN 1103 sin6.sin6_len = sizeof(sin6); 1104 # endif 1105 ST(0) = sv_2mortal(newSVpvn((char *)&sin6, sizeof(sin6))); 1106 #else 1107 PERL_UNUSED_VAR(port_sv); 1108 PERL_UNUSED_VAR(sin6_addr); 1109 ST(0) = not_here("pack_sockaddr_in6"); 1110 #endif 1111 } 1112 1113 void 1114 unpack_sockaddr_in6(sin6_sv) 1115 SV * sin6_sv 1116 PPCODE: 1117 { 1118 #ifdef HAS_SOCKADDR_IN6 1119 STRLEN addrlen; 1120 struct sockaddr_in6 sin6; 1121 char * addrbytes; 1122 SV *ip_address_sv; 1123 if (!SvOK(sin6_sv)) 1124 croak("Undefined address for %s", "Socket::unpack_sockaddr_in6"); 1125 addrbytes = SvPVbyte(sin6_sv, addrlen); 1126 if (addrlen != sizeof(sin6)) 1127 croak("Bad arg length for %s, length is %" UVuf 1128 ", should be %" UVuf, 1129 "Socket::unpack_sockaddr_in6", (UV)addrlen, (UV)sizeof(sin6)); 1130 Copy(addrbytes, &sin6, sizeof(sin6), char); 1131 if (sin6.sin6_family != AF_INET6) 1132 croak("Bad address family for %s, got %d, should be %d", 1133 "Socket::unpack_sockaddr_in6", sin6.sin6_family, AF_INET6); 1134 ip_address_sv = newSVpvn((char *)&sin6.sin6_addr, sizeof(sin6.sin6_addr)); 1135 1136 if(GIMME_V == G_LIST) { 1137 EXTEND(SP, 4); 1138 mPUSHi(ntohs(sin6.sin6_port)); 1139 mPUSHs(ip_address_sv); 1140 # ifdef HAS_SIN6_SCOPE_ID 1141 mPUSHi(sin6.sin6_scope_id); 1142 # else 1143 mPUSHi(0); 1144 # endif 1145 mPUSHi(ntohl(sin6.sin6_flowinfo)); 1146 } 1147 else { 1148 mPUSHs(ip_address_sv); 1149 } 1150 #else 1151 PERL_UNUSED_VAR(sin6_sv); 1152 ST(0) = not_here("pack_sockaddr_in6"); 1153 #endif 1154 } 1155 1156 void 1157 inet_ntop(af, ip_address_sv) 1158 int af 1159 SV * ip_address_sv 1160 CODE: 1161 { 1162 #ifdef HAS_INETNTOP 1163 STRLEN addrlen; 1164 #ifdef AF_INET6 1165 struct in6_addr addr; 1166 char str[INET6_ADDRSTRLEN]; 1167 #else 1168 struct in_addr addr; 1169 char str[INET_ADDRSTRLEN]; 1170 #endif 1171 char *ip_address; 1172 1173 if (DO_UTF8(ip_address_sv) && !sv_utf8_downgrade(ip_address_sv, 1)) 1174 croak("Wide character in %s", "Socket::inet_ntop"); 1175 1176 ip_address = SvPVbyte(ip_address_sv, addrlen); 1177 1178 switch(af) { 1179 case AF_INET: 1180 if(addrlen != 4) 1181 croak("Bad address length for Socket::inet_ntop on AF_INET;" 1182 " got %" UVuf ", should be 4", (UV)addrlen); 1183 break; 1184 #ifdef AF_INET6 1185 case AF_INET6: 1186 if(addrlen != 16) 1187 croak("Bad address length for Socket::inet_ntop on AF_INET6;" 1188 " got %" UVuf ", should be 16", (UV)addrlen); 1189 break; 1190 #endif 1191 default: 1192 #ifdef AF_INET6 1193 # define WANT_FAMILY "either AF_INET or AF_INET6" 1194 #else 1195 # define WANT_FAMILY "AF_INET" 1196 #endif 1197 croak("Bad address family for %s, got %d, should be " WANT_FAMILY, 1198 "Socket::inet_ntop", af); 1199 #undef WANT_FAMILY 1200 } 1201 1202 if(addrlen < sizeof(addr)) { 1203 Copy(ip_address, &addr, addrlen, char); 1204 Zero(((char*)&addr) + addrlen, sizeof(addr) - addrlen, char); 1205 } 1206 else { 1207 Copy(ip_address, &addr, sizeof addr, char); 1208 } 1209 inet_ntop(af, &addr, str, sizeof str); 1210 1211 ST(0) = sv_2mortal(newSVpvn(str, strlen(str))); 1212 #else 1213 PERL_UNUSED_VAR(af); 1214 PERL_UNUSED_VAR(ip_address_sv); 1215 ST(0) = not_here("inet_ntop"); 1216 #endif 1217 } 1218 1219 void 1220 inet_pton(af, host) 1221 int af 1222 const char * host 1223 CODE: 1224 { 1225 #ifdef HAS_INETPTON 1226 int ok; 1227 int addrlen = 0; 1228 #ifdef AF_INET6 1229 struct in6_addr ip_address; 1230 #else 1231 struct in_addr ip_address; 1232 #endif 1233 1234 switch(af) { 1235 case AF_INET: 1236 addrlen = 4; 1237 break; 1238 #ifdef AF_INET6 1239 case AF_INET6: 1240 addrlen = 16; 1241 break; 1242 #endif 1243 default: 1244 #ifdef AF_INET6 1245 # define WANT_FAMILY "either AF_INET or AF_INET6" 1246 #else 1247 # define WANT_FAMILY "AF_INET" 1248 #endif 1249 croak("Bad address family for %s, got %d, should be " WANT_FAMILY, "Socket::inet_pton", af); 1250 #undef WANT_FAMILY 1251 } 1252 ok = (*host != '\0') && inet_pton(af, host, &ip_address); 1253 1254 ST(0) = sv_newmortal(); 1255 if (ok) { 1256 sv_setpvn( ST(0), (char *)&ip_address, addrlen); 1257 } 1258 #else 1259 PERL_UNUSED_VAR(af); 1260 PERL_UNUSED_VAR(host); 1261 ST(0) = not_here("inet_pton"); 1262 #endif 1263 } 1264 1265 void 1266 pack_ip_mreq(multiaddr, interface=&PL_sv_undef) 1267 SV * multiaddr 1268 SV * interface 1269 CODE: 1270 { 1271 #ifdef HAS_IP_MREQ 1272 struct ip_mreq mreq; 1273 char * multiaddrbytes; 1274 char * interfacebytes; 1275 STRLEN len; 1276 if (DO_UTF8(multiaddr) && !sv_utf8_downgrade(multiaddr, 1)) 1277 croak("Wide character in %s", "Socket::pack_ip_mreq"); 1278 multiaddrbytes = SvPVbyte(multiaddr, len); 1279 if (len != sizeof(mreq.imr_multiaddr)) 1280 croak("Bad arg length %s, length is %" UVuf ", should be %" UVuf, 1281 "Socket::pack_ip_mreq", (UV)len, (UV)sizeof(mreq.imr_multiaddr)); 1282 Zero(&mreq, sizeof(mreq), char); 1283 Copy(multiaddrbytes, &mreq.imr_multiaddr, sizeof(mreq.imr_multiaddr), char); 1284 if(SvOK(interface)) { 1285 if (DO_UTF8(interface) && !sv_utf8_downgrade(interface, 1)) 1286 croak("Wide character in %s", "Socket::pack_ip_mreq"); 1287 interfacebytes = SvPVbyte(interface, len); 1288 if (len != sizeof(mreq.imr_interface)) 1289 croak("Bad arg length %s, length is %" UVuf ", should be %" UVuf, 1290 "Socket::pack_ip_mreq", (UV)len, (UV)sizeof(mreq.imr_interface)); 1291 Copy(interfacebytes, &mreq.imr_interface, sizeof(mreq.imr_interface), char); 1292 } 1293 else 1294 mreq.imr_interface.s_addr = INADDR_ANY; 1295 ST(0) = sv_2mortal(newSVpvn((char *)&mreq, sizeof(mreq))); 1296 #else 1297 not_here("pack_ip_mreq"); 1298 #endif 1299 } 1300 1301 void 1302 unpack_ip_mreq(mreq_sv) 1303 SV * mreq_sv 1304 PPCODE: 1305 { 1306 #ifdef HAS_IP_MREQ 1307 struct ip_mreq mreq; 1308 STRLEN mreqlen; 1309 char * mreqbytes = SvPVbyte(mreq_sv, mreqlen); 1310 if (mreqlen != sizeof(mreq)) 1311 croak("Bad arg length for %s, length is %" UVuf ", should be %" UVuf, 1312 "Socket::unpack_ip_mreq", (UV)mreqlen, (UV)sizeof(mreq)); 1313 Copy(mreqbytes, &mreq, sizeof(mreq), char); 1314 EXTEND(SP, 2); 1315 mPUSHp((char *)&mreq.imr_multiaddr, sizeof(mreq.imr_multiaddr)); 1316 mPUSHp((char *)&mreq.imr_interface, sizeof(mreq.imr_interface)); 1317 #else 1318 not_here("unpack_ip_mreq"); 1319 #endif 1320 } 1321 1322 void 1323 pack_ip_mreq_source(multiaddr, source, interface=&PL_sv_undef) 1324 SV * multiaddr 1325 SV * source 1326 SV * interface 1327 CODE: 1328 { 1329 #if defined(HAS_IP_MREQ_SOURCE) && defined (IP_ADD_SOURCE_MEMBERSHIP) 1330 struct ip_mreq_source mreq; 1331 char * multiaddrbytes; 1332 char * sourcebytes; 1333 char * interfacebytes; 1334 STRLEN len; 1335 if (DO_UTF8(multiaddr) && !sv_utf8_downgrade(multiaddr, 1)) 1336 croak("Wide character in %s", "Socket::pack_ip_mreq_source"); 1337 multiaddrbytes = SvPVbyte(multiaddr, len); 1338 if (len != sizeof(mreq.imr_multiaddr)) 1339 croak("Bad arg length %s, length is %" UVuf ", should be %" UVuf, 1340 "Socket::pack_ip_mreq", (UV)len, (UV)sizeof(mreq.imr_multiaddr)); 1341 if (DO_UTF8(source) && !sv_utf8_downgrade(source, 1)) 1342 croak("Wide character in %s", "Socket::pack_ip_mreq_source"); 1343 if (len != sizeof(mreq.imr_sourceaddr)) 1344 croak("Bad arg length %s, length is %" UVuf ", should be %" UVuf, 1345 "Socket::pack_ip_mreq", (UV)len, (UV)sizeof(mreq.imr_sourceaddr)); 1346 sourcebytes = SvPVbyte(source, len); 1347 Zero(&mreq, sizeof(mreq), char); 1348 Copy(multiaddrbytes, &mreq.imr_multiaddr, sizeof(mreq.imr_multiaddr), char); 1349 Copy(sourcebytes, &mreq.imr_sourceaddr, sizeof(mreq.imr_sourceaddr), char); 1350 if(SvOK(interface)) { 1351 if (DO_UTF8(interface) && !sv_utf8_downgrade(interface, 1)) 1352 croak("Wide character in %s", "Socket::pack_ip_mreq"); 1353 interfacebytes = SvPVbyte(interface, len); 1354 if (len != sizeof(mreq.imr_interface)) 1355 croak("Bad arg length %s, length is %" UVuf ", should be %" UVuf, 1356 "Socket::pack_ip_mreq", (UV)len, (UV)sizeof(mreq.imr_interface)); 1357 Copy(interfacebytes, &mreq.imr_interface, sizeof(mreq.imr_interface), char); 1358 } 1359 else 1360 mreq.imr_interface.s_addr = INADDR_ANY; 1361 ST(0) = sv_2mortal(newSVpvn((char *)&mreq, sizeof(mreq))); 1362 #else 1363 PERL_UNUSED_VAR(multiaddr); 1364 PERL_UNUSED_VAR(source); 1365 not_here("pack_ip_mreq_source"); 1366 #endif 1367 } 1368 1369 void 1370 unpack_ip_mreq_source(mreq_sv) 1371 SV * mreq_sv 1372 PPCODE: 1373 { 1374 #if defined(HAS_IP_MREQ_SOURCE) && defined (IP_ADD_SOURCE_MEMBERSHIP) 1375 struct ip_mreq_source mreq; 1376 STRLEN mreqlen; 1377 char * mreqbytes = SvPVbyte(mreq_sv, mreqlen); 1378 if (mreqlen != sizeof(mreq)) 1379 croak("Bad arg length for %s, length is %" UVuf ", 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 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 ", should be %" UVuf, 1407 "Socket::pack_ipv6_mreq", (UV)len, (UV)sizeof(mreq.ipv6mr_multiaddr)); 1408 Zero(&mreq, sizeof(mreq), char); 1409 Copy(multiaddrbytes, &mreq.ipv6mr_multiaddr, sizeof(mreq.ipv6mr_multiaddr), char); 1410 mreq.ipv6mr_interface = ifindex; 1411 ST(0) = sv_2mortal(newSVpvn((char *)&mreq, sizeof(mreq))); 1412 #else 1413 PERL_UNUSED_VAR(multiaddr); 1414 PERL_UNUSED_VAR(ifindex); 1415 not_here("pack_ipv6_mreq"); 1416 #endif 1417 } 1418 1419 void 1420 unpack_ipv6_mreq(mreq_sv) 1421 SV * mreq_sv 1422 PPCODE: 1423 { 1424 #ifdef HAS_IPV6_MREQ 1425 struct ipv6_mreq mreq; 1426 STRLEN mreqlen; 1427 char * mreqbytes = SvPVbyte(mreq_sv, mreqlen); 1428 if (mreqlen != sizeof(mreq)) 1429 croak("Bad arg length for %s, length is %" UVuf ", should be %" UVuf, 1430 "Socket::unpack_ipv6_mreq", (UV)mreqlen, (UV)sizeof(mreq)); 1431 Copy(mreqbytes, &mreq, sizeof(mreq), char); 1432 EXTEND(SP, 2); 1433 mPUSHp((char *)&mreq.ipv6mr_multiaddr, sizeof(mreq.ipv6mr_multiaddr)); 1434 mPUSHi(mreq.ipv6mr_interface); 1435 #else 1436 PERL_UNUSED_VAR(mreq_sv); 1437 not_here("unpack_ipv6_mreq"); 1438 #endif 1439 } 1440