cpan/Socket/Socket.xs

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