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