contrib/perl5/ext/Socket/Socket.xs

   1 #include "EXTERN.h"
   2 #include "perl.h"
   3 #include "XSUB.h"
   4
   5 #ifndef VMS
   6 # ifdef I_SYS_TYPES
   7 #  include <sys/types.h>
   8 # endif
   9 #include <sys/socket.h>
  10 #ifdef MPE
  11 # define PF_INET AF_INET
  12 # define PF_UNIX AF_UNIX
  13 # define SOCK_RAW 3
  14 #endif
  15 #ifdef I_SYS_UN
  16 #include <sys/un.h>
  17 #endif
  18 # ifdef I_NETINET_IN
  19 #  include <netinet/in.h>
  20 # endif
  21 #include <netdb.h>
  22 #ifdef I_ARPA_INET
  23 # include <arpa/inet.h>
  24 #endif
  25 #else
  26 #include "sockadapt.h"
  27 #endif
  28
  29 #ifndef AF_NBS
  30 #undef PF_NBS
  31 #endif
  32
  33 #ifndef AF_X25
  34 #undef PF_X25
  35 #endif
  36
  37 #ifndef INADDR_NONE
  38 #define INADDR_NONE     0xffffffff
  39 #endif /* INADDR_NONE */
  40 #ifndef INADDR_BROADCAST
  41 #define INADDR_BROADCAST        0xffffffff
  42 #endif /* INADDR_BROADCAST */
  43 #ifndef INADDR_LOOPBACK
  44 #define INADDR_LOOPBACK         0x7F000001
  45 #endif /* INADDR_LOOPBACK */
  46
  47 #ifndef HAS_INET_ATON
  48
  49 /*
  50  * Check whether "cp" is a valid ascii representation
  51  * of an Internet address and convert to a binary address.
  52  * Returns 1 if the address is valid, 0 if not.
  53  * This replaces inet_addr, the return value from which
  54  * cannot distinguish between failure and a local broadcast address.
  55  */
  56 static int
  57 my_inet_aton(register const char *cp, struct in_addr *addr)
  58 {
  59         register U32 val;
  60         register int base;
  61         register char c;
  62         int nparts;
  63         const char *s;
  64         unsigned int parts[4];
  65         register unsigned int *pp = parts;
  66
  67         if (!cp)
  68                 return 0;
  69         for (;;) {
  70                 /*
  71                  * Collect number up to ``.''.
  72                  * Values are specified as for C:
  73                  * 0x=hex, 0=octal, other=decimal.
  74                  */
  75                 val = 0; base = 10;
  76                 if (*cp == '0') {
  77                         if (*++cp == 'x' || *cp == 'X')
  78                                 base = 16, cp++;
  79                         else
  80                                 base = 8;
  81                 }
  82                 while ((c = *cp) != '\0') {
  83                         if (isDIGIT(c)) {
  84                                 val = (val * base) + (c - '0');
  85                                 cp++;
  86                                 continue;
  87                         }
  88                         if (base == 16 && (s=strchr(PL_hexdigit,c))) {
  89                                 val = (val << 4) +
  90                                         ((s - PL_hexdigit) & 15);
  91                                 cp++;
  92                                 continue;
  93                         }
  94                         break;
  95                 }
  96                 if (*cp == '.') {
  97                         /*
  98                          * Internet format:
  99                          *      a.b.c.d
 100                          *      a.b.c   (with c treated as 16-bits)
 101                          *      a.b     (with b treated as 24 bits)
 102                          */
 103                         if (pp >= parts + 3 || val > 0xff)
 104                                 return 0;
 105                         *pp++ = val, cp++;
 106                 } else
 107                         break;
 108         }
 109         /*
 110          * Check for trailing characters.
 111          */
 112         if (*cp && !isSPACE(*cp))
 113                 return 0;
 114         /*
 115          * Concoct the address according to
 116          * the number of parts specified.
 117          */
 118         nparts = pp - parts + 1;        /* force to an int for switch() */
 119         switch (nparts) {
 120
 121         case 1:                         /* a -- 32 bits */
 122                 break;
 123
 124         case 2:                         /* a.b -- 8.24 bits */
 125                 if (val > 0xffffff)
 126                         return 0;
 127                 val |= parts[0] << 24;
 128                 break;
 129
 130         case 3:                         /* a.b.c -- 8.8.16 bits */
 131                 if (val > 0xffff)
 132                         return 0;
 133                 val |= (parts[0] << 24) | (parts[1] << 16);
 134                 break;
 135
 136         case 4:                         /* a.b.c.d -- 8.8.8.8 bits */
 137                 if (val > 0xff)
 138                         return 0;
 139                 val |= (parts[0] << 24) | (parts[1] << 16) | (parts[2] << 8);
 140                 break;
 141         }
 142         addr->s_addr = htonl(val);
 143         return 1;
 144 }
 145
 146 #undef inet_aton
 147 #define inet_aton my_inet_aton
 148
 149 #endif /* ! HAS_INET_ATON */
 150
 151
 152 static int
 153 not_here(char *s)
 154 {
 155     croak("Socket::%s not implemented on this architecture", s);
 156     return -1;
 157 }
 158
 159 static double
 160 constant(char *name, int arg)
 161 {
 162     errno = 0;
 163     switch (*name) {
 164     case 'A':
 165         if (strEQ(name, "AF_802"))
 166 #ifdef AF_802
 167             return AF_802;
 168 #else
 169             goto not_there;
 170 #endif
 171         if (strEQ(name, "AF_APPLETALK"))
 172 #ifdef AF_APPLETALK
 173             return AF_APPLETALK;
 174 #else
 175             goto not_there;
 176 #endif
 177         if (strEQ(name, "AF_CCITT"))
 178 #ifdef AF_CCITT
 179             return AF_CCITT;
 180 #else
 181             goto not_there;
 182 #endif
 183         if (strEQ(name, "AF_CHAOS"))
 184 #ifdef AF_CHAOS
 185             return AF_CHAOS;
 186 #else
 187             goto not_there;
 188 #endif
 189         if (strEQ(name, "AF_DATAKIT"))
 190 #ifdef AF_DATAKIT
 191             return AF_DATAKIT;
 192 #else
 193             goto not_there;
 194 #endif
 195         if (strEQ(name, "AF_DECnet"))
 196 #ifdef AF_DECnet
 197             return AF_DECnet;
 198 #else
 199             goto not_there;
 200 #endif
 201         if (strEQ(name, "AF_DLI"))
 202 #ifdef AF_DLI
 203             return AF_DLI;
 204 #else
 205             goto not_there;
 206 #endif
 207         if (strEQ(name, "AF_ECMA"))
 208 #ifdef AF_ECMA
 209             return AF_ECMA;
 210 #else
 211             goto not_there;
 212 #endif
 213         if (strEQ(name, "AF_GOSIP"))
 214 #ifdef AF_GOSIP
 215             return AF_GOSIP;
 216 #else
 217             goto not_there;
 218 #endif
 219         if (strEQ(name, "AF_HYLINK"))
 220 #ifdef AF_HYLINK
 221             return AF_HYLINK;
 222 #else
 223             goto not_there;
 224 #endif
 225         if (strEQ(name, "AF_IMPLINK"))
 226 #ifdef AF_IMPLINK
 227             return AF_IMPLINK;
 228 #else
 229             goto not_there;
 230 #endif
 231         if (strEQ(name, "AF_INET"))
 232 #ifdef AF_INET
 233             return AF_INET;
 234 #else
 235             goto not_there;
 236 #endif
 237         if (strEQ(name, "AF_LAT"))
 238 #ifdef AF_LAT
 239             return AF_LAT;
 240 #else
 241             goto not_there;
 242 #endif
 243         if (strEQ(name, "AF_MAX"))
 244 #ifdef AF_MAX
 245             return AF_MAX;
 246 #else
 247             goto not_there;
 248 #endif
 249         if (strEQ(name, "AF_NBS"))
 250 #ifdef AF_NBS
 251             return AF_NBS;
 252 #else
 253             goto not_there;
 254 #endif
 255         if (strEQ(name, "AF_NIT"))
 256 #ifdef AF_NIT
 257             return AF_NIT;
 258 #else
 259             goto not_there;
 260 #endif
 261         if (strEQ(name, "AF_NS"))
 262 #ifdef AF_NS
 263             return AF_NS;
 264 #else
 265             goto not_there;
 266 #endif
 267         if (strEQ(name, "AF_OSI"))
 268 #ifdef AF_OSI
 269             return AF_OSI;
 270 #else
 271             goto not_there;
 272 #endif
 273         if (strEQ(name, "AF_OSINET"))
 274 #ifdef AF_OSINET
 275             return AF_OSINET;
 276 #else
 277             goto not_there;
 278 #endif
 279         if (strEQ(name, "AF_PUP"))
 280 #ifdef AF_PUP
 281             return AF_PUP;
 282 #else
 283             goto not_there;
 284 #endif
 285         if (strEQ(name, "AF_SNA"))
 286 #ifdef AF_SNA
 287             return AF_SNA;
 288 #else
 289             goto not_there;
 290 #endif
 291         if (strEQ(name, "AF_UNIX"))
 292 #ifdef AF_UNIX
 293             return AF_UNIX;
 294 #else
 295             goto not_there;
 296 #endif
 297         if (strEQ(name, "AF_UNSPEC"))
 298 #ifdef AF_UNSPEC
 299             return AF_UNSPEC;
 300 #else
 301             goto not_there;
 302 #endif
 303         if (strEQ(name, "AF_X25"))
 304 #ifdef AF_X25
 305             return AF_X25;
 306 #else
 307             goto not_there;
 308 #endif
 309         break;
 310     case 'B':
 311         break;
 312     case 'C':
 313         break;
 314     case 'D':
 315         break;
 316     case 'E':
 317         break;
 318     case 'F':
 319         break;
 320     case 'G':
 321         break;
 322     case 'H':
 323         break;
 324     case 'I':
 325         break;
 326     case 'J':
 327         break;
 328     case 'K':
 329         break;
 330     case 'L':
 331         break;
 332     case 'M':
 333         if (strEQ(name, "MSG_CTLFLAGS"))
 334 #ifdef MSG_CTLFLAGS
 335             return MSG_CTLFLAGS;
 336 #else
 337             goto not_there;
 338 #endif
 339         if (strEQ(name, "MSG_CTLIGNORE"))
 340 #ifdef MSG_CTLIGNORE
 341             return MSG_CTLIGNORE;
 342 #else
 343             goto not_there;
 344 #endif
 345         if (strEQ(name, "MSG_CTRUNC"))
 346 #if defined(MSG_TRUNC) || defined(HAS_MSG_CTRUNC) /* might be an enum */
 347             return MSG_CTRUNC;
 348 #else
 349             goto not_there;
 350 #endif
 351         if (strEQ(name, "MSG_DONTROUTE"))
 352 #if defined(MSG_DONTROUTE) || defined(HAS_MSG_DONTROUTE) /* might be an enum */
 353             return MSG_DONTROUTE;
 354 #else
 355             goto not_there;
 356 #endif
 357         if (strEQ(name, "MSG_DONTWAIT"))
 358 #ifdef MSG_DONTWAIT
 359             return MSG_DONTWAIT;
 360 #else
 361             goto not_there;
 362 #endif
 363         if (strEQ(name, "MSG_EOF"))
 364 #ifdef MSG_EOF
 365             return MSG_EOF;
 366 #else
 367             goto not_there;
 368 #endif
 369         if (strEQ(name, "MSG_EOR"))
 370 #ifdef MSG_EOR
 371             return MSG_EOR;
 372 #else
 373             goto not_there;
 374 #endif
 375         if (strEQ(name, "MSG_ERRQUEUE"))
 376 #ifdef MSG_ERRQUEUE
 377             return MSG_ERRQUEUE;
 378 #else
 379             goto not_there;
 380 #endif
 381         if (strEQ(name, "MSG_FIN"))
 382 #ifdef MSG_FIN
 383             return MSG_FIN;
 384 #else
 385             goto not_there;
 386 #endif
 387         if (strEQ(name, "MSG_MAXIOVLEN"))
 388 #ifdef MSG_MAXIOVLEN
 389             return MSG_MAXIOVLEN;
 390 #else
 391             goto not_there;
 392 #endif
 393         if (strEQ(name, "MSG_NOSIGNAL"))
 394 #ifdef MSG_NOSIGNAL
 395             return MSG_NOSIGNAL;
 396 #else
 397             goto not_there;
 398 #endif
 399         if (strEQ(name, "MSG_OOB"))
 400 #if defined(MSG_OOB) || defined(HAS_MSG_OOB) /* might be an enum */
 401             return MSG_OOB;
 402 #else
 403             goto not_there;
 404 #endif
 405         if (strEQ(name, "MSG_PEEK"))
 406 #if defined(MSG_PEEK) || defined(HAS_MSG_PEEK) /* might be an enum */
 407             return MSG_PEEK;
 408 #else
 409             goto not_there;
 410 #endif
 411         if (strEQ(name, "MSG_PROXY"))
 412 #if defined(MSG_PROXY) || defined(HAS_MSG_PROXY) /* might be an enum */
 413             return MSG_PROXY;
 414 #else
 415             goto not_there;
 416 #endif
 417         if (strEQ(name, "MSG_RST"))
 418 #ifdef MSG_RST
 419             return MSG_RST;
 420 #else
 421             goto not_there;
 422 #endif
 423         if (strEQ(name, "MSG_SYN"))
 424 #ifdef MSG_SYN
 425             return MSG_SYN;
 426 #else
 427             goto not_there;
 428 #endif
 429         if (strEQ(name, "MSG_TRUNC"))
 430 #ifdef MSG_TRUNC
 431             return MSG_TRUNC;
 432 #else
 433             goto not_there;
 434 #endif
 435         if (strEQ(name, "MSG_WAITALL"))
 436 #ifdef MSG_WAITALL
 437             return MSG_WAITALL;
 438 #else
 439             goto not_there;
 440 #endif
 441         break;
 442     case 'N':
 443         break;
 444     case 'O':
 445         break;
 446     case 'P':
 447         if (strEQ(name, "PF_802"))
 448 #ifdef PF_802
 449             return PF_802;
 450 #else
 451             goto not_there;
 452 #endif
 453         if (strEQ(name, "PF_APPLETALK"))
 454 #ifdef PF_APPLETALK
 455             return PF_APPLETALK;
 456 #else
 457             goto not_there;
 458 #endif
 459         if (strEQ(name, "PF_CCITT"))
 460 #ifdef PF_CCITT
 461             return PF_CCITT;
 462 #else
 463             goto not_there;
 464 #endif
 465         if (strEQ(name, "PF_CHAOS"))
 466 #ifdef PF_CHAOS
 467             return PF_CHAOS;
 468 #else
 469             goto not_there;
 470 #endif
 471         if (strEQ(name, "PF_DATAKIT"))
 472 #ifdef PF_DATAKIT
 473             return PF_DATAKIT;
 474 #else
 475             goto not_there;
 476 #endif
 477         if (strEQ(name, "PF_DECnet"))
 478 #ifdef PF_DECnet
 479             return PF_DECnet;
 480 #else
 481             goto not_there;
 482 #endif
 483         if (strEQ(name, "PF_DLI"))
 484 #ifdef PF_DLI
 485             return PF_DLI;
 486 #else
 487             goto not_there;
 488 #endif
 489         if (strEQ(name, "PF_ECMA"))
 490 #ifdef PF_ECMA
 491             return PF_ECMA;
 492 #else
 493             goto not_there;
 494 #endif
 495         if (strEQ(name, "PF_GOSIP"))
 496 #ifdef PF_GOSIP
 497             return PF_GOSIP;
 498 #else
 499             goto not_there;
 500 #endif
 501         if (strEQ(name, "PF_HYLINK"))
 502 #ifdef PF_HYLINK
 503             return PF_HYLINK;
 504 #else
 505             goto not_there;
 506 #endif
 507         if (strEQ(name, "PF_IMPLINK"))
 508 #ifdef PF_IMPLINK
 509             return PF_IMPLINK;
 510 #else
 511             goto not_there;
 512 #endif
 513         if (strEQ(name, "PF_INET"))
 514 #ifdef PF_INET
 515             return PF_INET;
 516 #else
 517             goto not_there;
 518 #endif
 519         if (strEQ(name, "PF_LAT"))
 520 #ifdef PF_LAT
 521             return PF_LAT;
 522 #else
 523             goto not_there;
 524 #endif
 525         if (strEQ(name, "PF_MAX"))
 526 #ifdef PF_MAX
 527             return PF_MAX;
 528 #else
 529             goto not_there;
 530 #endif
 531         if (strEQ(name, "PF_NBS"))
 532 #ifdef PF_NBS
 533             return PF_NBS;
 534 #else
 535             goto not_there;
 536 #endif
 537         if (strEQ(name, "PF_NIT"))
 538 #ifdef PF_NIT
 539             return PF_NIT;
 540 #else
 541             goto not_there;
 542 #endif
 543         if (strEQ(name, "PF_NS"))
 544 #ifdef PF_NS
 545             return PF_NS;
 546 #else
 547             goto not_there;
 548 #endif
 549         if (strEQ(name, "PF_OSI"))
 550 #ifdef PF_OSI
 551             return PF_OSI;
 552 #else
 553             goto not_there;
 554 #endif
 555         if (strEQ(name, "PF_OSINET"))
 556 #ifdef PF_OSINET
 557             return PF_OSINET;
 558 #else
 559             goto not_there;
 560 #endif
 561         if (strEQ(name, "PF_PUP"))
 562 #ifdef PF_PUP
 563             return PF_PUP;
 564 #else
 565             goto not_there;
 566 #endif
 567         if (strEQ(name, "PF_SNA"))
 568 #ifdef PF_SNA
 569             return PF_SNA;
 570 #else
 571             goto not_there;
 572 #endif
 573         if (strEQ(name, "PF_UNIX"))
 574 #ifdef PF_UNIX
 575             return PF_UNIX;
 576 #else
 577             goto not_there;
 578 #endif
 579         if (strEQ(name, "PF_UNSPEC"))
 580 #ifdef PF_UNSPEC
 581             return PF_UNSPEC;
 582 #else
 583             goto not_there;
 584 #endif
 585         if (strEQ(name, "PF_X25"))
 586 #ifdef PF_X25
 587             return PF_X25;
 588 #else
 589             goto not_there;
 590 #endif
 591         break;
 592     case 'Q':
 593         break;
 594     case 'R':
 595         break;
 596     case 'S':
 597         if (strEQ(name, "SCM_CONNECT"))
 598 #ifdef SCM_CONNECT
 599             return SCM_CONNECT;
 600 #else
 601             goto not_there;
 602 #endif
 603         if (strEQ(name, "SCM_CREDENTIALS"))
 604 #ifdef SCM_CREDENTIALS
 605             return SCM_CREDENTIALS;
 606 #else
 607             goto not_there;
 608 #endif
 609         if (strEQ(name, "SCM_CREDS"))
 610 #ifdef SCM_CREDS
 611             return SCM_CREDS;
 612 #else
 613             goto not_there;
 614 #endif
 615         if (strEQ(name, "SCM_RIGHTS"))
 616 #if defined(SCM_RIGHTS) || defined(HAS_SCM_RIGHTS) /* might be an enum */
 617             return SCM_RIGHTS;
 618 #else
 619             goto not_there;
 620 #endif
 621         if (strEQ(name, "SCM_TIMESTAMP"))
 622 #ifdef SCM_TIMESTAMP
 623             return SCM_TIMESTAMP;
 624 #else
 625             goto not_there;
 626 #endif
 627         if (strEQ(name, "SOCK_DGRAM"))
 628 #ifdef SOCK_DGRAM
 629             return SOCK_DGRAM;
 630 #else
 631             goto not_there;
 632 #endif
 633         if (strEQ(name, "SOCK_RAW"))
 634 #ifdef SOCK_RAW
 635             return SOCK_RAW;
 636 #else
 637             goto not_there;
 638 #endif
 639         if (strEQ(name, "SOCK_RDM"))
 640 #ifdef SOCK_RDM
 641             return SOCK_RDM;
 642 #else
 643             goto not_there;
 644 #endif
 645         if (strEQ(name, "SOCK_SEQPACKET"))
 646 #ifdef SOCK_SEQPACKET
 647             return SOCK_SEQPACKET;
 648 #else
 649             goto not_there;
 650 #endif
 651         if (strEQ(name, "SOCK_STREAM"))
 652 #ifdef SOCK_STREAM
 653             return SOCK_STREAM;
 654 #else
 655             goto not_there;
 656 #endif
 657         if (strEQ(name, "SOL_SOCKET"))
 658 #ifdef SOL_SOCKET
 659             return SOL_SOCKET;
 660 #else
 661             goto not_there;
 662 #endif
 663         if (strEQ(name, "SOMAXCONN"))
 664 #ifdef SOMAXCONN
 665             return SOMAXCONN;
 666 #else
 667             goto not_there;
 668 #endif
 669         if (strEQ(name, "SO_ACCEPTCONN"))
 670 #ifdef SO_ACCEPTCONN
 671             return SO_ACCEPTCONN;
 672 #else
 673             goto not_there;
 674 #endif
 675         if (strEQ(name, "SO_BROADCAST"))
 676 #ifdef SO_BROADCAST
 677             return SO_BROADCAST;
 678 #else
 679             goto not_there;
 680 #endif
 681         if (strEQ(name, "SO_DEBUG"))
 682 #ifdef SO_DEBUG
 683             return SO_DEBUG;
 684 #else
 685             goto not_there;
 686 #endif
 687         if (strEQ(name, "SO_DONTLINGER"))
 688 #ifdef SO_DONTLINGER
 689             return SO_DONTLINGER;
 690 #else
 691             goto not_there;
 692 #endif
 693         if (strEQ(name, "SO_DONTROUTE"))
 694 #ifdef SO_DONTROUTE
 695             return SO_DONTROUTE;
 696 #else
 697             goto not_there;
 698 #endif
 699         if (strEQ(name, "SO_ERROR"))
 700 #ifdef SO_ERROR
 701             return SO_ERROR;
 702 #else
 703             goto not_there;
 704 #endif
 705         if (strEQ(name, "SO_KEEPALIVE"))
 706 #ifdef SO_KEEPALIVE
 707             return SO_KEEPALIVE;
 708 #else
 709             goto not_there;
 710 #endif
 711         if (strEQ(name, "SO_LINGER"))
 712 #ifdef SO_LINGER
 713             return SO_LINGER;
 714 #else
 715             goto not_there;
 716 #endif
 717         if (strEQ(name, "SO_OOBINLINE"))
 718 #ifdef SO_OOBINLINE
 719             return SO_OOBINLINE;
 720 #else
 721             goto not_there;
 722 #endif
 723         if (strEQ(name, "SO_RCVBUF"))
 724 #ifdef SO_RCVBUF
 725             return SO_RCVBUF;
 726 #else
 727             goto not_there;
 728 #endif
 729         if (strEQ(name, "SO_RCVLOWAT"))
 730 #ifdef SO_RCVLOWAT
 731             return SO_RCVLOWAT;
 732 #else
 733             goto not_there;
 734 #endif
 735         if (strEQ(name, "SO_RCVTIMEO"))
 736 #ifdef SO_RCVTIMEO
 737             return SO_RCVTIMEO;
 738 #else
 739             goto not_there;
 740 #endif
 741         if (strEQ(name, "SO_REUSEADDR"))
 742 #ifdef SO_REUSEADDR
 743             return SO_REUSEADDR;
 744 #else
 745             goto not_there;
 746 #endif
 747         if (strEQ(name, "SO_REUSEPORT"))
 748 #ifdef SO_REUSEPORT
 749             return SO_REUSEPORT;
 750 #else
 751             goto not_there;
 752 #endif
 753         if (strEQ(name, "SO_SNDBUF"))
 754 #ifdef SO_SNDBUF
 755             return SO_SNDBUF;
 756 #else
 757             goto not_there;
 758 #endif
 759         if (strEQ(name, "SO_SNDLOWAT"))
 760 #ifdef SO_SNDLOWAT
 761             return SO_SNDLOWAT;
 762 #else
 763             goto not_there;
 764 #endif
 765         if (strEQ(name, "SO_SNDTIMEO"))
 766 #ifdef SO_SNDTIMEO
 767             return SO_SNDTIMEO;
 768 #else
 769             goto not_there;
 770 #endif
 771         if (strEQ(name, "SO_TYPE"))
 772 #ifdef SO_TYPE
 773             return SO_TYPE;
 774 #else
 775             goto not_there;
 776 #endif
 777         if (strEQ(name, "SO_USELOOPBACK"))
 778 #ifdef SO_USELOOPBACK
 779             return SO_USELOOPBACK;
 780 #else
 781             goto not_there;
 782 #endif
 783         break;
 784     case 'T':
 785         break;
 786     case 'U':
 787         break;
 788     case 'V':
 789         break;
 790     case 'W':
 791         break;
 792     case 'X':
 793         break;
 794     case 'Y':
 795         break;
 796     case 'Z':
 797         break;
 798     }
 799     errno = EINVAL;
 800     return 0;
 801
 802 not_there:
 803     errno = ENOENT;
 804     return 0;
 805 }
 806
 807
 808 MODULE = Socket         PACKAGE = Socket
 809
 810 double
 811 constant(name,arg)
 812         char *          name
 813         int             arg
 814
 815
 816 void
 817 inet_aton(host)
 818         char *  host
 819         CODE:
 820         {
 821         struct in_addr ip_address;
 822         struct hostent * phe;
 823         int ok = inet_aton(host, &ip_address);
 824
 825         if (!ok && (phe = gethostbyname(host))) {
 826                 Copy( phe->h_addr, &ip_address, phe->h_length, char );
 827                 ok = 1;
 828         }
 829
 830         ST(0) = sv_newmortal();
 831         if (ok) {
 832                 sv_setpvn( ST(0), (char *)&ip_address, sizeof ip_address );
 833         }
 834         }
 835
 836 void
 837 inet_ntoa(ip_address_sv)
 838         SV *    ip_address_sv
 839         CODE:
 840         {
 841         STRLEN addrlen;
 842         struct in_addr addr;
 843         char * addr_str;
 844         char * ip_address = SvPV(ip_address_sv,addrlen);
 845         if (addrlen != sizeof(addr)) {
 846             croak("Bad arg length for %s, length is %d, should be %d",
 847                         "Socket::inet_ntoa",
 848                         addrlen, sizeof(addr));
 849         }
 850
 851         Copy( ip_address, &addr, sizeof addr, char );
 852         addr_str = inet_ntoa(addr);
 853
 854         ST(0) = sv_2mortal(newSVpv(addr_str, strlen(addr_str)));
 855         }
 856
 857 void
 858 pack_sockaddr_un(pathname)
 859         char *  pathname
 860         CODE:
 861         {
 862 #ifdef I_SYS_UN
 863         struct sockaddr_un sun_ad; /* fear using sun */
 864         STRLEN len;
 865         Zero( &sun_ad, sizeof sun_ad, char );
 866         sun_ad.sun_family = AF_UNIX;
 867         len = strlen(pathname);
 868         if (len > sizeof(sun_ad.sun_path))
 869             len = sizeof(sun_ad.sun_path);
 870         Copy( pathname, sun_ad.sun_path, len, char );
 871         ST(0) = sv_2mortal(newSVpv((char *)&sun_ad, sizeof sun_ad));
 872 #else
 873         ST(0) = (SV *) not_here("pack_sockaddr_un");
 874 #endif
 875
 876         }
 877
 878 void
 879 unpack_sockaddr_un(sun_sv)
 880         SV *    sun_sv
 881         CODE:
 882         {
 883 #ifdef I_SYS_UN
 884         struct sockaddr_un addr;
 885         STRLEN sockaddrlen;
 886         char * sun_ad = SvPV(sun_sv,sockaddrlen);
 887         char * e;
 888
 889         if (sockaddrlen != sizeof(addr)) {
 890             croak("Bad arg length for %s, length is %d, should be %d",
 891                         "Socket::unpack_sockaddr_un",
 892                         sockaddrlen, sizeof(addr));
 893         }
 894
 895         Copy( sun_ad, &addr, sizeof addr, char );
 896
 897         if ( addr.sun_family != AF_UNIX ) {
 898             croak("Bad address family for %s, got %d, should be %d",
 899                         "Socket::unpack_sockaddr_un",
 900                         addr.sun_family,
 901                         AF_UNIX);
 902         }
 903         e = addr.sun_path;
 904         while (*e && e < addr.sun_path + sizeof addr.sun_path)
 905             ++e;
 906         ST(0) = sv_2mortal(newSVpv(addr.sun_path, e - addr.sun_path));
 907 #else
 908         ST(0) = (SV *) not_here("unpack_sockaddr_un");
 909 #endif
 910         }
 911
 912 void
 913 pack_sockaddr_in(port,ip_address)
 914         unsigned short  port
 915         char *  ip_address
 916         CODE:
 917         {
 918         struct sockaddr_in sin;
 919
 920         Zero( &sin, sizeof sin, char );
 921         sin.sin_family = AF_INET;
 922         sin.sin_port = htons(port);
 923         Copy( ip_address, &sin.sin_addr, sizeof sin.sin_addr, char );
 924
 925         ST(0) = sv_2mortal(newSVpv((char *)&sin, sizeof sin));
 926         }
 927
 928 void
 929 unpack_sockaddr_in(sin_sv)
 930         SV *    sin_sv
 931         PPCODE:
 932         {
 933         STRLEN sockaddrlen;
 934         struct sockaddr_in addr;
 935         unsigned short  port;
 936         struct in_addr  ip_address;
 937         char *  sin = SvPV(sin_sv,sockaddrlen);
 938         if (sockaddrlen != sizeof(addr)) {
 939             croak("Bad arg length for %s, length is %d, should be %d",
 940                         "Socket::unpack_sockaddr_in",
 941                         sockaddrlen, sizeof(addr));
 942         }
 943         Copy( sin, &addr,sizeof addr, char );
 944         if ( addr.sin_family != AF_INET ) {
 945             croak("Bad address family for %s, got %d, should be %d",
 946                         "Socket::unpack_sockaddr_in",
 947                         addr.sin_family,
 948                         AF_INET);
 949         }
 950         port = ntohs(addr.sin_port);
 951         ip_address = addr.sin_addr;
 952
 953         EXTEND(SP, 2);
 954         PUSHs(sv_2mortal(newSViv((IV) port)));
 955         PUSHs(sv_2mortal(newSVpv((char *)&ip_address,sizeof ip_address)));
 956         }
 957
 958 void
 959 INADDR_ANY()
 960         CODE:
 961         {
 962         struct in_addr  ip_address;
 963         ip_address.s_addr = htonl(INADDR_ANY);
 964         ST(0) = sv_2mortal(newSVpv((char *)&ip_address,sizeof ip_address ));
 965         }
 966
 967 void
 968 INADDR_LOOPBACK()
 969         CODE:
 970         {
 971         struct in_addr  ip_address;
 972         ip_address.s_addr = htonl(INADDR_LOOPBACK);
 973         ST(0) = sv_2mortal(newSVpv((char *)&ip_address,sizeof ip_address));
 974         }
 975
 976 void
 977 INADDR_NONE()
 978         CODE:
 979         {
 980         struct in_addr  ip_address;
 981         ip_address.s_addr = htonl(INADDR_NONE);
 982         ST(0) = sv_2mortal(newSVpv((char *)&ip_address,sizeof ip_address));
 983         }
 984
 985 void
 986 INADDR_BROADCAST()
 987         CODE:
 988         {
 989         struct in_addr  ip_address;
 990         ip_address.s_addr = htonl(INADDR_BROADCAST);
 991         ST(0) = sv_2mortal(newSVpv((char *)&ip_address,sizeof ip_address));
 992         }