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