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 I_NETINET_IN
  11 #  include <netinet/in.h>
  12 # endif
  13 #include <netdb.h>
  14 #include <arpa/inet.h>
  15 #else
  16 #include "sockadapt.h"
  17 #endif
  18
  19 #ifndef AF_NBS
  20 #undef PF_NBS
  21 #endif
  22
  23 #ifndef AF_X25
  24 #undef PF_X25
  25 #endif
  26
  27 #ifndef INADDR_NONE
  28 #define INADDR_NONE     0xffffffff
  29 #endif /* INADDR_NONE */
  30 #ifndef INADDR_LOOPBACK
  31 #define INADDR_LOOPBACK         0x7F000001
  32 #endif /* INADDR_LOOPBACK */
  33
  34
  35 static int
  36 not_here(s)
  37 char *s;
  38 {
  39     croak("Socket::%s not implemented on this architecture", s);
  40     return -1;
  41 }
  42
  43 static double
  44 constant(name, arg)
  45 char *name;
  46 int arg;
  47 {
  48     errno = 0;
  49     switch (*name) {
  50     case 'A':
  51         if (strEQ(name, "AF_802"))
  52 #ifdef AF_802
  53             return AF_802;
  54 #else
  55             goto not_there;
  56 #endif
  57         if (strEQ(name, "AF_APPLETALK"))
  58 #ifdef AF_APPLETALK
  59             return AF_APPLETALK;
  60 #else
  61             goto not_there;
  62 #endif
  63         if (strEQ(name, "AF_CCITT"))
  64 #ifdef AF_CCITT
  65             return AF_CCITT;
  66 #else
  67             goto not_there;
  68 #endif
  69         if (strEQ(name, "AF_CHAOS"))
  70 #ifdef AF_CHAOS
  71             return AF_CHAOS;
  72 #else
  73             goto not_there;
  74 #endif
  75         if (strEQ(name, "AF_DATAKIT"))
  76 #ifdef AF_DATAKIT
  77             return AF_DATAKIT;
  78 #else
  79             goto not_there;
  80 #endif
  81         if (strEQ(name, "AF_DECnet"))
  82 #ifdef AF_DECnet
  83             return AF_DECnet;
  84 #else
  85             goto not_there;
  86 #endif
  87         if (strEQ(name, "AF_DLI"))
  88 #ifdef AF_DLI
  89             return AF_DLI;
  90 #else
  91             goto not_there;
  92 #endif
  93         if (strEQ(name, "AF_ECMA"))
  94 #ifdef AF_ECMA
  95             return AF_ECMA;
  96 #else
  97             goto not_there;
  98 #endif
  99         if (strEQ(name, "AF_GOSIP"))
 100 #ifdef AF_GOSIP
 101             return AF_GOSIP;
 102 #else
 103             goto not_there;
 104 #endif
 105         if (strEQ(name, "AF_HYLINK"))
 106 #ifdef AF_HYLINK
 107             return AF_HYLINK;
 108 #else
 109             goto not_there;
 110 #endif
 111         if (strEQ(name, "AF_IMPLINK"))
 112 #ifdef AF_IMPLINK
 113             return AF_IMPLINK;
 114 #else
 115             goto not_there;
 116 #endif
 117         if (strEQ(name, "AF_INET"))
 118 #ifdef AF_INET
 119             return AF_INET;
 120 #else
 121             goto not_there;
 122 #endif
 123         if (strEQ(name, "AF_LAT"))
 124 #ifdef AF_LAT
 125             return AF_LAT;
 126 #else
 127             goto not_there;
 128 #endif
 129         if (strEQ(name, "AF_MAX"))
 130 #ifdef AF_MAX
 131             return AF_MAX;
 132 #else
 133             goto not_there;
 134 #endif
 135         if (strEQ(name, "AF_NBS"))
 136 #ifdef AF_NBS
 137             return AF_NBS;
 138 #else
 139             goto not_there;
 140 #endif
 141         if (strEQ(name, "AF_NIT"))
 142 #ifdef AF_NIT
 143             return AF_NIT;
 144 #else
 145             goto not_there;
 146 #endif
 147         if (strEQ(name, "AF_NS"))
 148 #ifdef AF_NS
 149             return AF_NS;
 150 #else
 151             goto not_there;
 152 #endif
 153         if (strEQ(name, "AF_OSI"))
 154 #ifdef AF_OSI
 155             return AF_OSI;
 156 #else
 157             goto not_there;
 158 #endif
 159         if (strEQ(name, "AF_OSINET"))
 160 #ifdef AF_OSINET
 161             return AF_OSINET;
 162 #else
 163             goto not_there;
 164 #endif
 165         if (strEQ(name, "AF_PUP"))
 166 #ifdef AF_PUP
 167             return AF_PUP;
 168 #else
 169             goto not_there;
 170 #endif
 171         if (strEQ(name, "AF_SNA"))
 172 #ifdef AF_SNA
 173             return AF_SNA;
 174 #else
 175             goto not_there;
 176 #endif
 177         if (strEQ(name, "AF_UNIX"))
 178 #ifdef AF_UNIX
 179             return AF_UNIX;
 180 #else
 181             goto not_there;
 182 #endif
 183         if (strEQ(name, "AF_UNSPEC"))
 184 #ifdef AF_UNSPEC
 185             return AF_UNSPEC;
 186 #else
 187             goto not_there;
 188 #endif
 189         if (strEQ(name, "AF_X25"))
 190 #ifdef AF_X25
 191             return AF_X25;
 192 #else
 193             goto not_there;
 194 #endif
 195         break;
 196     case 'B':
 197         break;
 198     case 'C':
 199         break;
 200     case 'D':
 201         break;
 202     case 'E':
 203         break;
 204     case 'F':
 205         break;
 206     case 'G':
 207         break;
 208     case 'H':
 209         break;
 210     case 'I':
 211         break;
 212     case 'J':
 213         break;
 214     case 'K':
 215         break;
 216     case 'L':
 217         break;
 218     case 'M':
 219         if (strEQ(name, "MSG_DONTROUTE"))
 220 #ifdef MSG_DONTROUTE
 221             return MSG_DONTROUTE;
 222 #else
 223             goto not_there;
 224 #endif
 225         if (strEQ(name, "MSG_MAXIOVLEN"))
 226 #ifdef MSG_MAXIOVLEN
 227             return MSG_MAXIOVLEN;
 228 #else
 229             goto not_there;
 230 #endif
 231         if (strEQ(name, "MSG_OOB"))
 232 #ifdef MSG_OOB
 233             return MSG_OOB;
 234 #else
 235             goto not_there;
 236 #endif
 237         if (strEQ(name, "MSG_PEEK"))
 238 #ifdef MSG_PEEK
 239             return MSG_PEEK;
 240 #else
 241             goto not_there;
 242 #endif
 243         break;
 244     case 'N':
 245         break;
 246     case 'O':
 247         break;
 248     case 'P':
 249         if (strEQ(name, "PF_802"))
 250 #ifdef PF_802
 251             return PF_802;
 252 #else
 253             goto not_there;
 254 #endif
 255         if (strEQ(name, "PF_APPLETALK"))
 256 #ifdef PF_APPLETALK
 257             return PF_APPLETALK;
 258 #else
 259             goto not_there;
 260 #endif
 261         if (strEQ(name, "PF_CCITT"))
 262 #ifdef PF_CCITT
 263             return PF_CCITT;
 264 #else
 265             goto not_there;
 266 #endif
 267         if (strEQ(name, "PF_CHAOS"))
 268 #ifdef PF_CHAOS
 269             return PF_CHAOS;
 270 #else
 271             goto not_there;
 272 #endif
 273         if (strEQ(name, "PF_DATAKIT"))
 274 #ifdef PF_DATAKIT
 275             return PF_DATAKIT;
 276 #else
 277             goto not_there;
 278 #endif
 279         if (strEQ(name, "PF_DECnet"))
 280 #ifdef PF_DECnet
 281             return PF_DECnet;
 282 #else
 283             goto not_there;
 284 #endif
 285         if (strEQ(name, "PF_DLI"))
 286 #ifdef PF_DLI
 287             return PF_DLI;
 288 #else
 289             goto not_there;
 290 #endif
 291         if (strEQ(name, "PF_ECMA"))
 292 #ifdef PF_ECMA
 293             return PF_ECMA;
 294 #else
 295             goto not_there;
 296 #endif
 297         if (strEQ(name, "PF_GOSIP"))
 298 #ifdef PF_GOSIP
 299             return PF_GOSIP;
 300 #else
 301             goto not_there;
 302 #endif
 303         if (strEQ(name, "PF_HYLINK"))
 304 #ifdef PF_HYLINK
 305             return PF_HYLINK;
 306 #else
 307             goto not_there;
 308 #endif
 309         if (strEQ(name, "PF_IMPLINK"))
 310 #ifdef PF_IMPLINK
 311             return PF_IMPLINK;
 312 #else
 313             goto not_there;
 314 #endif
 315         if (strEQ(name, "PF_INET"))
 316 #ifdef PF_INET
 317             return PF_INET;
 318 #else
 319             goto not_there;
 320 #endif
 321         if (strEQ(name, "PF_LAT"))
 322 #ifdef PF_LAT
 323             return PF_LAT;
 324 #else
 325             goto not_there;
 326 #endif
 327         if (strEQ(name, "PF_MAX"))
 328 #ifdef PF_MAX
 329             return PF_MAX;
 330 #else
 331             goto not_there;
 332 #endif
 333         if (strEQ(name, "PF_NBS"))
 334 #ifdef PF_NBS
 335             return PF_NBS;
 336 #else
 337             goto not_there;
 338 #endif
 339         if (strEQ(name, "PF_NIT"))
 340 #ifdef PF_NIT
 341             return PF_NIT;
 342 #else
 343             goto not_there;
 344 #endif
 345         if (strEQ(name, "PF_NS"))
 346 #ifdef PF_NS
 347             return PF_NS;
 348 #else
 349             goto not_there;
 350 #endif
 351         if (strEQ(name, "PF_OSI"))
 352 #ifdef PF_OSI
 353             return PF_OSI;
 354 #else
 355             goto not_there;
 356 #endif
 357         if (strEQ(name, "PF_OSINET"))
 358 #ifdef PF_OSINET
 359             return PF_OSINET;
 360 #else
 361             goto not_there;
 362 #endif
 363         if (strEQ(name, "PF_PUP"))
 364 #ifdef PF_PUP
 365             return PF_PUP;
 366 #else
 367             goto not_there;
 368 #endif
 369         if (strEQ(name, "PF_SNA"))
 370 #ifdef PF_SNA
 371             return PF_SNA;
 372 #else
 373             goto not_there;
 374 #endif
 375         if (strEQ(name, "PF_UNIX"))
 376 #ifdef PF_UNIX
 377             return PF_UNIX;
 378 #else
 379             goto not_there;
 380 #endif
 381         if (strEQ(name, "PF_UNSPEC"))
 382 #ifdef PF_UNSPEC
 383             return PF_UNSPEC;
 384 #else
 385             goto not_there;
 386 #endif
 387         if (strEQ(name, "PF_X25"))
 388 #ifdef PF_X25
 389             return PF_X25;
 390 #else
 391             goto not_there;
 392 #endif
 393         break;
 394     case 'Q':
 395         break;
 396     case 'R':
 397         break;
 398     case 'S':
 399         if (strEQ(name, "SOCK_DGRAM"))
 400 #ifdef SOCK_DGRAM
 401             return SOCK_DGRAM;
 402 #else
 403             goto not_there;
 404 #endif
 405         if (strEQ(name, "SOCK_RAW"))
 406 #ifdef SOCK_RAW
 407             return SOCK_RAW;
 408 #else
 409             goto not_there;
 410 #endif
 411         if (strEQ(name, "SOCK_RDM"))
 412 #ifdef SOCK_RDM
 413             return SOCK_RDM;
 414 #else
 415             goto not_there;
 416 #endif
 417         if (strEQ(name, "SOCK_SEQPACKET"))
 418 #ifdef SOCK_SEQPACKET
 419             return SOCK_SEQPACKET;
 420 #else
 421             goto not_there;
 422 #endif
 423         if (strEQ(name, "SOCK_STREAM"))
 424 #ifdef SOCK_STREAM
 425             return SOCK_STREAM;
 426 #else
 427             goto not_there;
 428 #endif
 429         if (strEQ(name, "SOL_SOCKET"))
 430 #ifdef SOL_SOCKET
 431             return SOL_SOCKET;
 432 #else
 433             goto not_there;
 434 #endif
 435         if (strEQ(name, "SOMAXCONN"))
 436 #ifdef SOMAXCONN
 437             return SOMAXCONN;
 438 #else
 439             goto not_there;
 440 #endif
 441         if (strEQ(name, "SO_ACCEPTCONN"))
 442 #ifdef SO_ACCEPTCONN
 443             return SO_ACCEPTCONN;
 444 #else
 445             goto not_there;
 446 #endif
 447         if (strEQ(name, "SO_BROADCAST"))
 448 #ifdef SO_BROADCAST
 449             return SO_BROADCAST;
 450 #else
 451             goto not_there;
 452 #endif
 453         if (strEQ(name, "SO_DEBUG"))
 454 #ifdef SO_DEBUG
 455             return SO_DEBUG;
 456 #else
 457             goto not_there;
 458 #endif
 459         if (strEQ(name, "SO_DONTLINGER"))
 460 #ifdef SO_DONTLINGER
 461             return SO_DONTLINGER;
 462 #else
 463             goto not_there;
 464 #endif
 465         if (strEQ(name, "SO_DONTROUTE"))
 466 #ifdef SO_DONTROUTE
 467             return SO_DONTROUTE;
 468 #else
 469             goto not_there;
 470 #endif
 471         if (strEQ(name, "SO_ERROR"))
 472 #ifdef SO_ERROR
 473             return SO_ERROR;
 474 #else
 475             goto not_there;
 476 #endif
 477         if (strEQ(name, "SO_KEEPALIVE"))
 478 #ifdef SO_KEEPALIVE
 479             return SO_KEEPALIVE;
 480 #else
 481             goto not_there;
 482 #endif
 483         if (strEQ(name, "SO_LINGER"))
 484 #ifdef SO_LINGER
 485             return SO_LINGER;
 486 #else
 487             goto not_there;
 488 #endif
 489         if (strEQ(name, "SO_OOBINLINE"))
 490 #ifdef SO_OOBINLINE
 491             return SO_OOBINLINE;
 492 #else
 493             goto not_there;
 494 #endif
 495         if (strEQ(name, "SO_RCVBUF"))
 496 #ifdef SO_RCVBUF
 497             return SO_RCVBUF;
 498 #else
 499             goto not_there;
 500 #endif
 501         if (strEQ(name, "SO_RCVLOWAT"))
 502 #ifdef SO_RCVLOWAT
 503             return SO_RCVLOWAT;
 504 #else
 505             goto not_there;
 506 #endif
 507         if (strEQ(name, "SO_RCVTIMEO"))
 508 #ifdef SO_RCVTIMEO
 509             return SO_RCVTIMEO;
 510 #else
 511             goto not_there;
 512 #endif
 513         if (strEQ(name, "SO_REUSEADDR"))
 514 #ifdef SO_REUSEADDR
 515             return SO_REUSEADDR;
 516 #else
 517             goto not_there;
 518 #endif
 519         if (strEQ(name, "SO_REUSEPORT"))
 520 #ifdef SO_REUSEPORT
 521             return SO_REUSEPORT;
 522 #else
 523             goto not_there;
 524 #endif
 525         if (strEQ(name, "SO_SNDBUF"))
 526 #ifdef SO_SNDBUF
 527             return SO_SNDBUF;
 528 #else
 529             goto not_there;
 530 #endif
 531         if (strEQ(name, "SO_SNDLOWAT"))
 532 #ifdef SO_SNDLOWAT
 533             return SO_SNDLOWAT;
 534 #else
 535             goto not_there;
 536 #endif
 537         if (strEQ(name, "SO_SNDTIMEO"))
 538 #ifdef SO_SNDTIMEO
 539             return SO_SNDTIMEO;
 540 #else
 541             goto not_there;
 542 #endif
 543         if (strEQ(name, "SO_TYPE"))
 544 #ifdef SO_TYPE
 545             return SO_TYPE;
 546 #else
 547             goto not_there;
 548 #endif
 549         if (strEQ(name, "SO_USELOOPBACK"))
 550 #ifdef SO_USELOOPBACK
 551             return SO_USELOOPBACK;
 552 #else
 553             goto not_there;
 554 #endif
 555         break;
 556     case 'T':
 557         break;
 558     case 'U':
 559         break;
 560     case 'V':
 561         break;
 562     case 'W':
 563         break;
 564     case 'X':
 565         break;
 566     case 'Y':
 567         break;
 568     case 'Z':
 569         break;
 570     }
 571     errno = EINVAL;
 572     return 0;
 573
 574 not_there:
 575     errno = ENOENT;
 576     return 0;
 577 }
 578
 579
 580 MODULE = Socket         PACKAGE = Socket
 581
 582 double
 583 constant(name,arg)
 584         char *          name
 585         int             arg
 586
 587
 588 void
 589 inet_aton(host)
 590         char *  host
 591         CODE:
 592         {
 593         struct in_addr ip_address;
 594         struct hostent * phe;
 595
 596         if (phe = gethostbyname(host)) {
 597                 Copy( phe->h_addr, &ip_address, phe->h_length, char );
 598         } else {
 599                 ip_address.s_addr = inet_addr(host);
 600         }
 601
 602         ST(0) = sv_newmortal();
 603         if(ip_address.s_addr != INADDR_NONE) {
 604                 sv_setpvn( ST(0), (char *)&ip_address, sizeof ip_address );
 605         }
 606         }
 607
 608 void
 609 inet_ntoa(ip_address_sv)
 610         SV *    ip_address_sv
 611         CODE:
 612         {
 613         STRLEN addrlen;
 614         struct in_addr addr;
 615         char * addr_str;
 616         char * ip_address = SvPV(ip_address_sv,addrlen);
 617         if (addrlen != sizeof(addr)) {
 618             croak("Bad arg length for %s, length is %d, should be %d",
 619                         "Socket::inet_ntoa",
 620                         addrlen, sizeof(addr));
 621         }
 622
 623         Copy( ip_address, &addr, sizeof addr, char );
 624         addr_str = inet_ntoa(addr);
 625
 626         ST(0) = sv_2mortal(newSVpv(addr_str, strlen(addr_str)));
 627         }
 628
 629 void
 630 pack_sockaddr_in(family,port,ip_address)
 631         short   family
 632         short   port
 633         char *  ip_address
 634         CODE:
 635         {
 636         struct sockaddr_in sin;
 637
 638         Zero( &sin, sizeof sin, char );
 639         sin.sin_family = family;
 640         sin.sin_port = htons(port);
 641         Copy( ip_address, &sin.sin_addr, sizeof sin.sin_addr, char );
 642
 643         ST(0) = sv_2mortal(newSVpv((char *)&sin, sizeof sin));
 644         }
 645
 646 void
 647 unpack_sockaddr_in(sin_sv)
 648         SV *    sin_sv
 649         PPCODE:
 650         {
 651         STRLEN sockaddrlen;
 652         struct sockaddr_in addr;
 653         short   family;
 654         short   port;
 655         struct in_addr  ip_address;
 656         char *  sin = SvPV(sin_sv,sockaddrlen);
 657         if (sockaddrlen != sizeof(addr)) {
 658             croak("Bad arg length for %s, length is %d, should be %d",
 659                         "Socket::unpack_sockaddr_in",
 660                         sockaddrlen, sizeof(addr));
 661         }
 662
 663         Copy( sin, &addr,sizeof addr, char );
 664         family = addr.sin_family;
 665         port = ntohs(addr.sin_port);
 666         ip_address = addr.sin_addr;
 667
 668         EXTEND(sp, 3);
 669         PUSHs(sv_2mortal(newSViv(family)));
 670         PUSHs(sv_2mortal(newSViv(port)));
 671         PUSHs(sv_2mortal(newSVpv((char *)&ip_address,sizeof ip_address)));
 672         }
 673
 674 void
 675 INADDR_ANY()
 676         CODE:
 677         {
 678         struct in_addr  ip_address;
 679         ip_address.s_addr = htonl(INADDR_ANY);
 680         ST(0) = sv_2mortal(newSVpv((char *)&ip_address,sizeof ip_address ));
 681         }
 682
 683 void
 684 INADDR_LOOPBACK()
 685         CODE:
 686         {
 687         struct in_addr  ip_address;
 688         ip_address.s_addr = htonl(INADDR_LOOPBACK);
 689         ST(0) = sv_2mortal(newSVpv((char *)&ip_address,sizeof ip_address));
 690         }
 691
 692 void
 693 INADDR_NONE()
 694         CODE:
 695         {
 696         struct in_addr  ip_address;
 697         ip_address.s_addr = htonl(INADDR_NONE);
 698         ST(0) = sv_2mortal(newSVpv((char *)&ip_address,sizeof ip_address));
 699         }