ext/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 #ifndef VMS
   9 # ifdef I_SYS_TYPES
  10 #  include <sys/types.h>
  11 # endif
  12 # if !defined(ultrix) /* Avoid double definition. */
  13 #   include <sys/socket.h>
  14 # endif
  15 # if defined(USE_SOCKS) && defined(I_SOCKS)
  16 #   include <socks.h>
  17 # endif
  18 # ifdef MPE
  19 #  define PF_INET AF_INET
  20 #  define PF_UNIX AF_UNIX
  21 #  define SOCK_RAW 3
  22 # endif
  23 # ifdef I_SYS_UN
  24 #  include <sys/un.h>
  25 # endif
  26 /* XXX Configure test for <netinet/in_systm.h needed XXX */
  27 # if defined(NeXT) || defined(__NeXT__)
  28 #  include <netinet/in_systm.h>
  29 # endif
  30 # if defined(__sgi) && !defined(AF_LINK) && defined(PF_LINK) && PF_LINK == AF_LNK
  31 #  undef PF_LINK
  32 # endif
  33 # if defined(I_NETINET_IN) || defined(__ultrix__)
  34 #  include <netinet/in.h>
  35 # endif
  36 # ifdef I_NETDB
  37 #  if !defined(ultrix)  /* Avoid double definition. */
  38 #   include <netdb.h>
  39 #  endif
  40 # endif
  41 # ifdef I_ARPA_INET
  42 #  include <arpa/inet.h>
  43 # endif
  44 # ifdef I_NETINET_TCP
  45 #  include <netinet/tcp.h>
  46 # endif
  47 #else
  48 # include "sockadapt.h"
  49 #endif
  50
  51 #ifdef NETWARE
  52 NETDB_DEFINE_CONTEXT
  53 NETINET_DEFINE_CONTEXT
  54 #endif
  55
  56 #ifdef I_SYSUIO
  57 # include <sys/uio.h>
  58 #endif
  59
  60 #ifndef AF_NBS
  61 # undef PF_NBS
  62 #endif
  63
  64 #ifndef AF_X25
  65 # undef PF_X25
  66 #endif
  67
  68 #ifndef INADDR_NONE
  69 # define INADDR_NONE    0xffffffff
  70 #endif /* INADDR_NONE */
  71 #ifndef INADDR_BROADCAST
  72 # define INADDR_BROADCAST       0xffffffff
  73 #endif /* INADDR_BROADCAST */
  74 #ifndef INADDR_LOOPBACK
  75 # define INADDR_LOOPBACK         0x7F000001
  76 #endif /* INADDR_LOOPBACK */
  77
  78 #ifndef HAS_INET_ATON
  79
  80 /*
  81  * Check whether "cp" is a valid ascii representation
  82  * of an Internet address and convert to a binary address.
  83  * Returns 1 if the address is valid, 0 if not.
  84  * This replaces inet_addr, the return value from which
  85  * cannot distinguish between failure and a local broadcast address.
  86  */
  87 static int
  88 my_inet_aton(register const char *cp, struct in_addr *addr)
  89 {
  90         dTHX;
  91         register U32 val;
  92         register int base;
  93         register char c;
  94         int nparts;
  95         const char *s;
  96         unsigned int parts[4];
  97         register unsigned int *pp = parts;
  98
  99        if (!cp || !*cp)
 100                 return 0;
 101         for (;;) {
 102                 /*
 103                  * Collect number up to ``.''.
 104                  * Values are specified as for C:
 105                  * 0x=hex, 0=octal, other=decimal.
 106                  */
 107                 val = 0; base = 10;
 108                 if (*cp == '0') {
 109                         if (*++cp == 'x' || *cp == 'X')
 110                                 base = 16, cp++;
 111                         else
 112                                 base = 8;
 113                 }
 114                 while ((c = *cp) != '\0') {
 115                         if (isDIGIT(c)) {
 116                                 val = (val * base) + (c - '0');
 117                                 cp++;
 118                                 continue;
 119                         }
 120                         if (base == 16 && (s=strchr(PL_hexdigit,c))) {
 121                                 val = (val << 4) +
 122                                         ((s - PL_hexdigit) & 15);
 123                                 cp++;
 124                                 continue;
 125                         }
 126                         break;
 127                 }
 128                 if (*cp == '.') {
 129                         /*
 130                          * Internet format:
 131                          *      a.b.c.d
 132                          *      a.b.c   (with c treated as 16-bits)
 133                          *      a.b     (with b treated as 24 bits)
 134                          */
 135                         if (pp >= parts + 3 || val > 0xff)
 136                                 return 0;
 137                         *pp++ = val, cp++;
 138                 } else
 139                         break;
 140         }
 141         /*
 142          * Check for trailing characters.
 143          */
 144         if (*cp && !isSPACE(*cp))
 145                 return 0;
 146         /*
 147          * Concoct the address according to
 148          * the number of parts specified.
 149          */
 150         nparts = pp - parts + 1;        /* force to an int for switch() */
 151         switch (nparts) {
 152
 153         case 1:                         /* a -- 32 bits */
 154                 break;
 155
 156         case 2:                         /* a.b -- 8.24 bits */
 157                 if (val > 0xffffff)
 158                         return 0;
 159                 val |= parts[0] << 24;
 160                 break;
 161
 162         case 3:                         /* a.b.c -- 8.8.16 bits */
 163                 if (val > 0xffff)
 164                         return 0;
 165                 val |= (parts[0] << 24) | (parts[1] << 16);
 166                 break;
 167
 168         case 4:                         /* a.b.c.d -- 8.8.8.8 bits */
 169                 if (val > 0xff)
 170                         return 0;
 171                 val |= (parts[0] << 24) | (parts[1] << 16) | (parts[2] << 8);
 172                 break;
 173         }
 174         addr->s_addr = htonl(val);
 175         return 1;
 176 }
 177
 178 #undef inet_aton
 179 #define inet_aton my_inet_aton
 180
 181 #endif /* ! HAS_INET_ATON */
 182
 183
 184 static int
 185 not_here(const char *s)
 186 {
 187     croak("Socket::%s not implemented on this architecture", s);
 188     return -1;
 189 }
 190
 191 #define PERL_IN_ADDR_S_ADDR_SIZE 4
 192
 193 /*
 194 * Bad assumptions possible here.
 195 *
 196 * Bad Assumption 1: struct in_addr has no other fields
 197 * than the s_addr (which is the field we care about
 198 * in here, really). However, we can be fed either 4-byte
 199 * addresses (from pack("N", ...), or va.b.c.d, or ...),
 200 * or full struct in_addrs (from e.g. pack_sockaddr_in()),
 201 * which may or may not be 4 bytes in size.
 202 *
 203 * Bad Assumption 2: the s_addr field is a simple type
 204 * (such as an int, u_int32_t).  It can be a bit field,
 205 * in which case using & (address-of) on it or taking sizeof()
 206 * wouldn't go over too well.  (Those are not attempted
 207 * now but in case someone thinks to change the below code
 208 * to use addr.s_addr instead of addr, you have been warned.)
 209 *
 210 * Bad Assumption 3: the s_addr is the first field in
 211 * an in_addr, or that its bytes are the first bytes in
 212 * an in_addr.
 213 *
 214 * These bad assumptions are wrong in UNICOS which has
 215 * struct in_addr { struct { u_long  st_addr:32; } s_da };
 216 * #define s_addr s_da.st_addr
 217 * and u_long is 64 bits.
 218 *
 219 * --jhi */
 220
 221 #include "const-c.inc"
 222
 223 #ifdef HAS_GETADDRINFO
 224 static SV *err_to_SV(pTHX_ int err)
 225 {
 226         SV *ret = sv_newmortal();
 227         SvUPGRADE(ret, SVt_PVNV);
 228
 229         if(err) {
 230                 const char *error = gai_strerror(err);
 231                 sv_setpv(ret, error);
 232         }
 233         else {
 234                 sv_setpv(ret, "");
 235         }
 236
 237         SvIV_set(ret, err); SvIOK_on(ret);
 238
 239         return ret;
 240 }
 241
 242 static void xs_getaddrinfo(pTHX_ CV *cv)
 243 {
 244         dVAR;
 245         dXSARGS;
 246
 247         SV   *host;
 248         SV   *service;
 249         SV   *hints;
 250
 251         char *hostname = NULL;
 252         char *servicename = NULL;
 253         STRLEN len;
 254         struct addrinfo hints_s;
 255         struct addrinfo *res;
 256         struct addrinfo *res_iter;
 257         int err;
 258         int n_res;
 259
 260         if(items > 3)
 261                 croak_xs_usage(cv, "host, service, hints");
 262
 263         SP -= items;
 264
 265         if(items < 1)
 266                 host = &PL_sv_undef;
 267         else
 268                 host = ST(0);
 269
 270         if(items < 2)
 271                 service = &PL_sv_undef;
 272         else
 273                 service = ST(1);
 274
 275         if(items < 3)
 276                 hints = NULL;
 277         else
 278                 hints = ST(2);
 279
 280         SvGETMAGIC(host);
 281         if(SvOK(host)) {
 282                 hostname = SvPV_nomg(host, len);
 283                 if (!len)
 284                         hostname = NULL;
 285         }
 286
 287         SvGETMAGIC(service);
 288         if(SvOK(service)) {
 289                 servicename = SvPV_nomg(service, len);
 290                 if (!len)
 291                         servicename = NULL;
 292         }
 293
 294         Zero(&hints_s, sizeof hints_s, char);
 295
 296         if(hints && SvOK(hints)) {
 297                 HV *hintshash;
 298                 SV **valp;
 299
 300                 if(!SvROK(hints) || SvTYPE(SvRV(hints)) != SVt_PVHV)
 301                         croak("hints is not a HASH reference");
 302
 303                 hintshash = (HV*)SvRV(hints);
 304
 305                 if((valp = hv_fetch(hintshash, "flags", 5, 0)) != NULL)
 306                         hints_s.ai_flags = SvIV(*valp);
 307                 if((valp = hv_fetch(hintshash, "family", 6, 0)) != NULL)
 308                         hints_s.ai_family = SvIV(*valp);
 309                 if((valp = hv_fetch(hintshash, "socktype", 8, 0)) != NULL)
 310                         hints_s.ai_socktype = SvIV(*valp);
 311                 if((valp = hv_fetch(hintshash, "protocol", 8, 0)) != NULL)
 312                         hints_s.ai_protocol = SvIV(*valp);
 313         }
 314
 315         err = getaddrinfo(hostname, servicename, &hints_s, &res);
 316
 317         XPUSHs(err_to_SV(aTHX_ err));
 318
 319         if(err)
 320                 XSRETURN(1);
 321
 322         n_res = 0;
 323         for(res_iter = res; res_iter; res_iter = res_iter->ai_next) {
 324                 HV *res_hv = newHV();
 325
 326                 (void)hv_stores(res_hv, "family",   newSViv(res_iter->ai_family));
 327                 (void)hv_stores(res_hv, "socktype", newSViv(res_iter->ai_socktype));
 328                 (void)hv_stores(res_hv, "protocol", newSViv(res_iter->ai_protocol));
 329
 330                 (void)hv_stores(res_hv, "addr",     newSVpvn((char*)res_iter->ai_addr, res_iter->ai_addrlen));
 331
 332                 if(res_iter->ai_canonname)
 333                         (void)hv_stores(res_hv, "canonname", newSVpv(res_iter->ai_canonname, 0));
 334                 else
 335                         (void)hv_stores(res_hv, "canonname", newSV(0));
 336
 337                 XPUSHs(sv_2mortal(newRV_noinc((SV*)res_hv)));
 338                 n_res++;
 339         }
 340
 341         freeaddrinfo(res);
 342
 343         XSRETURN(1 + n_res);
 344 }
 345 #endif
 346
 347 #ifdef HAS_GETNAMEINFO
 348 static void xs_getnameinfo(pTHX_ CV *cv)
 349 {
 350         dVAR;
 351         dXSARGS;
 352
 353         SV  *addr;
 354         int  flags;
 355
 356         char host[1024];
 357         char serv[256];
 358         char *sa; /* we'll cast to struct sockaddr * when necessary */
 359         STRLEN addr_len;
 360         int err;
 361
 362         if(items < 1 || items > 2)
 363                 croak_xs_usage(cv, "addr, flags=0");
 364
 365         SP -= items;
 366
 367         addr = ST(0);
 368
 369         if(items < 2)
 370                 flags = 0;
 371         else
 372                 flags = SvIV(ST(1));
 373
 374         if(!SvPOK(addr))
 375                 croak("addr is not a string");
 376
 377         addr_len = SvCUR(addr);
 378
 379         /* We need to ensure the sockaddr is aligned, because a random SvPV might
 380          * not be due to SvOOK */
 381         Newx(sa, addr_len, char);
 382         Copy(SvPV_nolen(addr), sa, addr_len, char);
 383 #ifdef HAS_SOCKADDR_SA_LEN
 384         ((struct sockaddr *)sa)->sa_len = addr_len;
 385 #endif
 386
 387         err = getnameinfo((struct sockaddr *)sa, addr_len,
 388                         host, sizeof(host),
 389                         serv, sizeof(serv),
 390                         flags);
 391
 392         Safefree(sa);
 393
 394         XPUSHs(err_to_SV(aTHX_ err));
 395
 396         if(err)
 397                 XSRETURN(1);
 398
 399         XPUSHs(sv_2mortal(newSVpv(host, 0)));
 400         XPUSHs(sv_2mortal(newSVpv(serv, 0)));
 401
 402         XSRETURN(3);
 403 }
 404 #endif
 405
 406 MODULE = Socket         PACKAGE = Socket
 407
 408 INCLUDE: const-xs.inc
 409
 410 BOOT:
 411 #ifdef HAS_GETADDRINFO
 412   newXS("Socket::getaddrinfo", xs_getaddrinfo, __FILE__);
 413 #endif
 414 #ifdef HAS_GETNAMEINFO
 415   newXS("Socket::getnameinfo", xs_getnameinfo, __FILE__);
 416 #endif
 417
 418 void
 419 inet_aton(host)
 420         char *  host
 421         CODE:
 422         {
 423         struct in_addr ip_address;
 424         struct hostent * phe;
 425         int ok = (*host != '\0') && inet_aton(host, &ip_address);
 426
 427         if (!ok && (phe = gethostbyname(host)) &&
 428                         phe->h_addrtype == AF_INET && phe->h_length == 4) {
 429                 Copy( phe->h_addr, &ip_address, phe->h_length, char );
 430                 ok = 1;
 431         }
 432
 433         ST(0) = sv_newmortal();
 434         if (ok)
 435                 sv_setpvn( ST(0), (char *)&ip_address, sizeof ip_address );
 436         }
 437
 438 void
 439 inet_ntoa(ip_address_sv)
 440         SV *    ip_address_sv
 441         CODE:
 442         {
 443         STRLEN addrlen;
 444         struct in_addr addr;
 445         char * ip_address;
 446         if (DO_UTF8(ip_address_sv) && !sv_utf8_downgrade(ip_address_sv, 1))
 447              croak("Wide character in %s", "Socket::inet_ntoa");
 448         ip_address = SvPVbyte(ip_address_sv, addrlen);
 449         if (addrlen == sizeof(addr) || addrlen == 4)
 450                 addr.s_addr =
 451                     (ip_address[0] & 0xFF) << 24 |
 452                     (ip_address[1] & 0xFF) << 16 |
 453                     (ip_address[2] & 0xFF) <<  8 |
 454                     (ip_address[3] & 0xFF);
 455         else
 456                 croak("Bad arg length for %s, length is %d, should be %d",
 457                       "Socket::inet_ntoa",
 458                       addrlen, sizeof(addr));
 459         /* We could use inet_ntoa() but that is broken
 460          * in HP-UX + GCC + 64bitint (returns "0.0.0.0"),
 461          * so let's use this sprintf() workaround everywhere.
 462          * This is also more threadsafe than using inet_ntoa(). */
 463         ST(0) = sv_2mortal(Perl_newSVpvf(aTHX_ "%d.%d.%d.%d", /* IPv6? */
 464                                          ((addr.s_addr >> 24) & 0xFF),
 465                                          ((addr.s_addr >> 16) & 0xFF),
 466                                          ((addr.s_addr >>  8) & 0xFF),
 467                                          ( addr.s_addr        & 0xFF)));
 468         }
 469
 470 void
 471 sockaddr_family(sockaddr)
 472         SV *    sockaddr
 473         PREINIT:
 474         STRLEN sockaddr_len;
 475         char *sockaddr_pv = SvPVbyte(sockaddr, sockaddr_len);
 476         CODE:
 477         if (sockaddr_len < offsetof(struct sockaddr, sa_data)) {
 478             croak("Bad arg length for %s, length is %d, should be at least %d",
 479                   "Socket::sockaddr_family", sockaddr_len,
 480                   offsetof(struct sockaddr, sa_data));
 481         }
 482         ST(0) = sv_2mortal(newSViv(((struct sockaddr*)sockaddr_pv)->sa_family));
 483
 484 void
 485 pack_sockaddr_un(pathname)
 486         SV *    pathname
 487         CODE:
 488         {
 489 #ifdef I_SYS_UN
 490         struct sockaddr_un sun_ad; /* fear using sun */
 491         STRLEN len;
 492         char * pathname_pv;
 493         int addr_len;
 494
 495         Zero( &sun_ad, sizeof sun_ad, char );
 496         sun_ad.sun_family = AF_UNIX;
 497         pathname_pv = SvPV(pathname,len);
 498         if (len > sizeof(sun_ad.sun_path))
 499             len = sizeof(sun_ad.sun_path);
 500 #  ifdef OS2    /* Name should start with \socket\ and contain backslashes! */
 501         {
 502             int off;
 503             char *s, *e;
 504
 505             if (pathname_pv[0] != '/' && pathname_pv[0] != '\\')
 506                 croak("Relative UNIX domain socket name '%s' unsupported",
 507                         pathname_pv);
 508             else if (len < 8
 509                      || pathname_pv[7] != '/' && pathname_pv[7] != '\\'
 510                      || !strnicmp(pathname_pv + 1, "socket", 6))
 511                 off = 7;
 512             else
 513                 off = 0;                /* Preserve names starting with \socket\ */
 514             Copy( "\\socket", sun_ad.sun_path, off, char);
 515             Copy( pathname_pv, sun_ad.sun_path + off, len, char );
 516
 517             s = sun_ad.sun_path + off - 1;
 518             e = s + len + 1;
 519             while (++s < e)
 520                 if (*s = '/')
 521                     *s = '\\';
 522         }
 523 #  else /* !( defined OS2 ) */
 524         Copy( pathname_pv, sun_ad.sun_path, len, char );
 525 #  endif
 526         if (0) not_here("dummy");
 527         if (len > 1 && sun_ad.sun_path[0] == '\0') {
 528                 /* Linux-style abstract-namespace socket.
 529                  * The name is not a file name, but an array of arbitrary
 530                  * character, starting with \0 and possibly including \0s,
 531                  * therefore the length of the structure must denote the
 532                  * end of that character array */
 533                 addr_len = (char *)&(sun_ad.sun_path) - (char *)&sun_ad + len;
 534         } else {
 535                 addr_len = sizeof sun_ad;
 536         }
 537 #  ifdef HAS_SOCKADDR_SA_LEN
 538         sun_ad.sun_len = addr_len;
 539 #  endif
 540         ST(0) = newSVpvn_flags((char *)&sun_ad, addr_len, SVs_TEMP);
 541 #else
 542         ST(0) = (SV *) not_here("pack_sockaddr_un");
 543 #endif
 544
 545         }
 546
 547 void
 548 unpack_sockaddr_un(sun_sv)
 549         SV *    sun_sv
 550         CODE:
 551         {
 552 #ifdef I_SYS_UN
 553         struct sockaddr_un addr;
 554         STRLEN sockaddrlen;
 555         char * sun_ad = SvPVbyte(sun_sv,sockaddrlen);
 556         int addr_len;
 557 #   ifndef __linux__
 558         /* On Linux sockaddrlen on sockets returned by accept, recvfrom,
 559            getpeername and getsockname is not equal to sizeof(addr). */
 560         if (sockaddrlen != sizeof(addr)) {
 561             croak("Bad arg length for %s, length is %d, should be %d",
 562                         "Socket::unpack_sockaddr_un",
 563                         sockaddrlen, sizeof(addr));
 564         }
 565 #   endif
 566
 567         Copy( sun_ad, &addr, sizeof addr, char );
 568
 569         if ( addr.sun_family != AF_UNIX ) {
 570             croak("Bad address family for %s, got %d, should be %d",
 571                         "Socket::unpack_sockaddr_un",
 572                         addr.sun_family,
 573                         AF_UNIX);
 574         }
 575
 576         if (addr.sun_path[0] == '\0') {
 577                 /* Linux-style abstract socket address begins with a nul
 578                  * and can contain nuls. */
 579                 addr_len = (char *)&addr - (char *)&(addr.sun_path) + sockaddrlen;
 580         } else {
 581                 for (addr_len = 0; addr.sun_path[addr_len]
 582                      && addr_len < (int)sizeof(addr.sun_path); addr_len++);
 583         }
 584
 585         ST(0) = newSVpvn_flags(addr.sun_path, addr_len, SVs_TEMP);
 586 #else
 587         ST(0) = (SV *) not_here("unpack_sockaddr_un");
 588 #endif
 589         }
 590
 591 void
 592 pack_sockaddr_in(port, ip_address_sv)
 593         unsigned short  port
 594         SV *    ip_address_sv
 595         CODE:
 596         {
 597         struct sockaddr_in sin;
 598         struct in_addr addr;
 599         STRLEN addrlen;
 600         char * ip_address;
 601         if (DO_UTF8(ip_address_sv) && !sv_utf8_downgrade(ip_address_sv, 1))
 602              croak("Wide character in %s", "Socket::pack_sockaddr_in");
 603         ip_address = SvPVbyte(ip_address_sv, addrlen);
 604         if (addrlen == sizeof(addr) || addrlen == 4)
 605                 addr.s_addr =
 606                     (ip_address[0] & 0xFF) << 24 |
 607                     (ip_address[1] & 0xFF) << 16 |
 608                     (ip_address[2] & 0xFF) <<  8 |
 609                     (ip_address[3] & 0xFF);
 610         else
 611                 croak("Bad arg length for %s, length is %d, should be %d",
 612                       "Socket::pack_sockaddr_in",
 613                       addrlen, sizeof(addr));
 614         Zero( &sin, sizeof sin, char );
 615         sin.sin_family = AF_INET;
 616         sin.sin_port = htons(port);
 617         sin.sin_addr.s_addr = htonl(addr.s_addr);
 618 #  ifdef HAS_SOCKADDR_SA_LEN
 619         sin.sin_len = sizeof (sin);
 620 #  endif
 621         ST(0) = newSVpvn_flags((char *)&sin, sizeof (sin), SVs_TEMP);
 622         }
 623
 624 void
 625 unpack_sockaddr_in(sin_sv)
 626         SV *    sin_sv
 627         PPCODE:
 628         {
 629         STRLEN sockaddrlen;
 630         struct sockaddr_in addr;
 631         unsigned short  port;
 632         struct in_addr  ip_address;
 633         char *  sin = SvPVbyte(sin_sv,sockaddrlen);
 634         if (sockaddrlen != sizeof(addr)) {
 635             croak("Bad arg length for %s, length is %d, should be %d",
 636                         "Socket::unpack_sockaddr_in",
 637                         sockaddrlen, sizeof(addr));
 638         }
 639         Copy( sin, &addr,sizeof addr, char );
 640         if ( addr.sin_family != AF_INET ) {
 641             croak("Bad address family for %s, got %d, should be %d",
 642                         "Socket::unpack_sockaddr_in",
 643                         addr.sin_family,
 644                         AF_INET);
 645         }
 646         port = ntohs(addr.sin_port);
 647         ip_address = addr.sin_addr;
 648
 649         EXTEND(SP, 2);
 650         PUSHs(sv_2mortal(newSViv((IV) port)));
 651         PUSHs(newSVpvn_flags((char *)&ip_address, sizeof(ip_address), SVs_TEMP));
 652         }
 653
 654 void
 655 pack_sockaddr_in6(port, sin6_addr, scope_id=0, flowinfo=0)
 656         unsigned short  port
 657         SV *    sin6_addr
 658         unsigned long   scope_id
 659         unsigned long   flowinfo
 660         CODE:
 661         {
 662 #ifdef AF_INET6
 663         struct sockaddr_in6 sin6;
 664         char * addrbytes;
 665         STRLEN addrlen;
 666         if (DO_UTF8(sin6_addr) && !sv_utf8_downgrade(sin6_addr, 1))
 667             croak("Wide character in %s", "Socket::pack_sockaddr_in6");
 668         addrbytes = SvPVbyte(sin6_addr, addrlen);
 669         if(addrlen != sizeof(sin6.sin6_addr))
 670             croak("Bad arg length %s, length is %d, should be %d",
 671                   "Socket::pack_sockaddr_in6", addrlen, sizeof(sin6.sin6_addr));
 672         Zero(&sin6, sizeof(sin6), char);
 673         sin6.sin6_family = AF_INET6;
 674         sin6.sin6_port = htons(port);
 675         sin6.sin6_flowinfo = htonl(flowinfo);
 676         Copy(addrbytes, &sin6.sin6_addr, sizeof(sin6.sin6_addr), char);
 677 #  ifdef HAS_SIN6_SCOPE_ID
 678         sin6.sin6_scope_id = scope_id;
 679 #  else
 680         if(scope_id != 0)
 681             warn("%s cannot represent non-zero scope_id %d",
 682                  "Socket::pack_sockaddr_in6", scope_id);
 683 #  endif
 684 #  ifdef HAS_SOCKADDR_SA_LEN
 685         sin6.sin6_len = sizeof(sin6);
 686 #  endif
 687         ST(0) = newSVpvn_flags((char *)&sin6, sizeof(sin6), SVs_TEMP);
 688 #else
 689         ST(0) = (SV*)not_here("pack_sockaddr_in6");
 690 #endif
 691         }
 692
 693 void
 694 unpack_sockaddr_in6(sin6_sv)
 695         SV *    sin6_sv
 696         PPCODE:
 697         {
 698 #ifdef AF_INET6
 699         STRLEN addrlen;
 700         struct sockaddr_in6 sin6;
 701         char * addrbytes = SvPVbyte(sin6_sv, addrlen);
 702         if (addrlen != sizeof(sin6))
 703             croak("Bad arg length for %s, length is %d, should be %d",
 704                     "Socket::unpack_sockaddr_in6",
 705                     addrlen, sizeof(sin6));
 706         Copy(addrbytes, &sin6, sizeof(sin6), char);
 707         if(sin6.sin6_family != AF_INET6)
 708             croak("Bad address family for %s, got %d, should be %d",
 709                     "Socket::unpack_sockaddr_in6",
 710                     sin6.sin6_family, AF_INET6);
 711         EXTEND(SP, 4);
 712         mPUSHi(ntohs(sin6.sin6_port));
 713         mPUSHp((char *)&sin6.sin6_addr, sizeof(sin6.sin6_addr));
 714 #  ifdef HAS_SIN6_SCOPE_ID
 715         mPUSHi(sin6.sin6_scope_id);
 716 #  else
 717         mPUSHi(0);
 718 #  endif
 719         mPUSHi(ntohl(sin6.sin6_flowinfo));
 720 #else
 721         ST(0) = (SV*)not_here("pack_sockaddr_in6");
 722 #endif
 723         }
 724
 725 void
 726 inet_ntop(af, ip_address_sv)
 727         int     af
 728         SV *    ip_address_sv
 729         CODE:
 730 #ifdef HAS_INETNTOP
 731         STRLEN addrlen, struct_size;
 732 #ifdef AF_INET6
 733         struct in6_addr addr;
 734         char str[INET6_ADDRSTRLEN];
 735 #else
 736         struct in_addr addr;
 737         char str[INET_ADDRSTRLEN];
 738 #endif
 739         char *ip_address = SvPV(ip_address_sv, addrlen);
 740
 741         struct_size = sizeof(addr);
 742
 743         if(af != AF_INET
 744 #ifdef AF_INET6
 745             && af != AF_INET6
 746 #endif
 747           ) {
 748            croak("Bad address family for %s, got %d, should be"
 749 #ifdef AF_INET6
 750                " either AF_INET or AF_INET6",
 751 #else
 752                " AF_INET",
 753 #endif
 754                "Socket::inet_ntop",
 755                af);
 756         }
 757
 758         Copy( ip_address, &addr, sizeof addr, char );
 759         inet_ntop(af, &addr, str, sizeof str);
 760
 761         ST(0) = newSVpvn_flags(str, strlen(str), SVs_TEMP);
 762 #else
 763         ST(0) = (SV *)not_here("inet_ntop");
 764 #endif
 765
 766 void
 767 inet_pton(af, host)
 768         int           af
 769         const char *  host
 770         CODE:
 771 #ifdef HAS_INETPTON
 772         int ok;
 773 #ifdef AF_INET6
 774         struct in6_addr ip_address;
 775 #else
 776         struct in_addr ip_address;
 777 #endif
 778
 779         if(af != AF_INET
 780 #ifdef AF_INET6
 781                 && af != AF_INET6
 782 #endif
 783           ) {
 784                 croak("Bad address family for %s, got %d, should be"
 785 #ifdef AF_INET6
 786                         " either AF_INET or AF_INET6",
 787 #else
 788                         " AF_INET",
 789 #endif
 790                         "Socket::inet_pton",
 791                         af);
 792         }
 793         ok = (*host != '\0') && inet_pton(af, host, &ip_address);
 794
 795         ST(0) = sv_newmortal();
 796         if (ok) {
 797                 sv_setpvn( ST(0), (char *)&ip_address, sizeof(ip_address) );
 798         }
 799 #else
 800         ST(0) = (SV *)not_here("inet_pton");
 801 #endif