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)
  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 # ifdef I_NETINET_IN
  34 #  include <netinet/in.h>
  35 # endif
  36 # ifdef I_NETDB
  37 #  include <netdb.h>
  38 # endif
  39 # ifdef I_ARPA_INET
  40 #  include <arpa/inet.h>
  41 # endif
  42 # ifdef I_NETINET_TCP
  43 #  include <netinet/tcp.h>
  44 # endif
  45 #else
  46 # include "sockadapt.h"
  47 #endif
  48
  49 #ifdef NETWARE
  50 NETDB_DEFINE_CONTEXT
  51 NETINET_DEFINE_CONTEXT
  52 #endif
  53
  54 #ifdef I_SYSUIO
  55 # include <sys/uio.h>
  56 #endif
  57
  58 #ifndef AF_NBS
  59 # undef PF_NBS
  60 #endif
  61
  62 #ifndef AF_X25
  63 # undef PF_X25
  64 #endif
  65
  66 #ifndef INADDR_NONE
  67 # define INADDR_NONE    0xffffffff
  68 #endif /* INADDR_NONE */
  69 #ifndef INADDR_BROADCAST
  70 # define INADDR_BROADCAST       0xffffffff
  71 #endif /* INADDR_BROADCAST */
  72 #ifndef INADDR_LOOPBACK
  73 # define INADDR_LOOPBACK         0x7F000001
  74 #endif /* INADDR_LOOPBACK */
  75
  76 #ifndef HAS_INET_ATON
  77
  78 /*
  79  * Check whether "cp" is a valid ascii representation
  80  * of an Internet address and convert to a binary address.
  81  * Returns 1 if the address is valid, 0 if not.
  82  * This replaces inet_addr, the return value from which
  83  * cannot distinguish between failure and a local broadcast address.
  84  */
  85 static int
  86 my_inet_aton(register const char *cp, struct in_addr *addr)
  87 {
  88         dTHX;
  89         register U32 val;
  90         register int base;
  91         register char c;
  92         int nparts;
  93         const char *s;
  94         unsigned int parts[4];
  95         register unsigned int *pp = parts;
  96
  97        if (!cp || !*cp)
  98                 return 0;
  99         for (;;) {
 100                 /*
 101                  * Collect number up to ``.''.
 102                  * Values are specified as for C:
 103                  * 0x=hex, 0=octal, other=decimal.
 104                  */
 105                 val = 0; base = 10;
 106                 if (*cp == '0') {
 107                         if (*++cp == 'x' || *cp == 'X')
 108                                 base = 16, cp++;
 109                         else
 110                                 base = 8;
 111                 }
 112                 while ((c = *cp) != '\0') {
 113                         if (isDIGIT(c)) {
 114                                 val = (val * base) + (c - '0');
 115                                 cp++;
 116                                 continue;
 117                         }
 118                         if (base == 16 && (s=strchr(PL_hexdigit,c))) {
 119                                 val = (val << 4) +
 120                                         ((s - PL_hexdigit) & 15);
 121                                 cp++;
 122                                 continue;
 123                         }
 124                         break;
 125                 }
 126                 if (*cp == '.') {
 127                         /*
 128                          * Internet format:
 129                          *      a.b.c.d
 130                          *      a.b.c   (with c treated as 16-bits)
 131                          *      a.b     (with b treated as 24 bits)
 132                          */
 133                         if (pp >= parts + 3 || val > 0xff)
 134                                 return 0;
 135                         *pp++ = val, cp++;
 136                 } else
 137                         break;
 138         }
 139         /*
 140          * Check for trailing characters.
 141          */
 142         if (*cp && !isSPACE(*cp))
 143                 return 0;
 144         /*
 145          * Concoct the address according to
 146          * the number of parts specified.
 147          */
 148         nparts = pp - parts + 1;        /* force to an int for switch() */
 149         switch (nparts) {
 150
 151         case 1:                         /* a -- 32 bits */
 152                 break;
 153
 154         case 2:                         /* a.b -- 8.24 bits */
 155                 if (val > 0xffffff)
 156                         return 0;
 157                 val |= parts[0] << 24;
 158                 break;
 159
 160         case 3:                         /* a.b.c -- 8.8.16 bits */
 161                 if (val > 0xffff)
 162                         return 0;
 163                 val |= (parts[0] << 24) | (parts[1] << 16);
 164                 break;
 165
 166         case 4:                         /* a.b.c.d -- 8.8.8.8 bits */
 167                 if (val > 0xff)
 168                         return 0;
 169                 val |= (parts[0] << 24) | (parts[1] << 16) | (parts[2] << 8);
 170                 break;
 171         }
 172         addr->s_addr = htonl(val);
 173         return 1;
 174 }
 175
 176 #undef inet_aton
 177 #define inet_aton my_inet_aton
 178
 179 #endif /* ! HAS_INET_ATON */
 180
 181
 182 static int
 183 not_here(char *s)
 184 {
 185     croak("Socket::%s not implemented on this architecture", s);
 186     return -1;
 187 }
 188
 189 #define PERL_IN_ADDR_S_ADDR_SIZE 4
 190
 191 /*
 192 * Bad assumptions possible here.
 193 *
 194 * Bad Assumption 1: struct in_addr has no other fields
 195 * than the s_addr (which is the field we care about
 196 * in here, really). However, we can be fed either 4-byte
 197 * addresses (from pack("N", ...), or va.b.c.d, or ...),
 198 * or full struct in_addrs (from e.g. pack_sockaddr_in()),
 199 * which may or may not be 4 bytes in size.
 200 *
 201 * Bad Assumption 2: the s_addr field is a simple type
 202 * (such as an int, u_int32_t).  It can be a bit field,
 203 * in which case using & (address-of) on it or taking sizeof()
 204 * wouldn't go over too well.  (Those are not attempted
 205 * now but in case someone thinks to change the below code
 206 * to use addr.s_addr instead of addr, you have been warned.)
 207 *
 208 * Bad Assumption 3: the s_addr is the first field in
 209 * an in_addr, or that its bytes are the first bytes in
 210 * an in_addr.
 211 *
 212 * These bad assumptions are wrong in UNICOS which has
 213 * struct in_addr { struct { u_long  st_addr:32; } s_da };
 214 * #define s_addr s_da.st_addr
 215 * and u_long is 64 bits.
 216 *
 217 * --jhi */
 218
 219 #include "const-c.inc"
 220
 221 MODULE = Socket         PACKAGE = Socket
 222
 223 INCLUDE: const-xs.inc
 224
 225 void
 226 inet_aton(host)
 227         char *  host
 228         CODE:
 229         {
 230         struct in_addr ip_address;
 231         struct hostent * phe;
 232         int ok =
 233                 (host != NULL) &&
 234                 (*host != '\0') &&
 235                 inet_aton(host, &ip_address);
 236
 237         if (!ok && (phe = gethostbyname(host))) {
 238                 Copy( phe->h_addr, &ip_address, phe->h_length, char );
 239                 ok = 1;
 240         }
 241
 242         ST(0) = sv_newmortal();
 243         if (ok)
 244                 sv_setpvn( ST(0), (char *)&ip_address, sizeof ip_address );
 245         }
 246
 247 void
 248 inet_ntoa(ip_address_sv)
 249         SV *    ip_address_sv
 250         CODE:
 251         {
 252         STRLEN addrlen;
 253         struct in_addr addr;
 254         char * addr_str;
 255         char * ip_address;
 256         if (DO_UTF8(ip_address_sv) && !sv_utf8_downgrade(ip_address_sv, 1))
 257              croak("Wide character in Socket::inet_ntoa");
 258         ip_address = SvPVbyte(ip_address_sv, addrlen);
 259         if (addrlen == sizeof(addr) || addrlen == 4)
 260                 addr.s_addr =
 261                     (ip_address[0] & 0xFF) << 24 |
 262                     (ip_address[1] & 0xFF) << 16 |
 263                     (ip_address[2] & 0xFF) <<  8 |
 264                     (ip_address[3] & 0xFF);
 265         else
 266                 croak("Bad arg length for %s, length is %d, should be %d",
 267                       "Socket::inet_ntoa",
 268                       addrlen, sizeof(addr));
 269         /* We could use inet_ntoa() but that is broken
 270          * in HP-UX + GCC + 64bitint (returns "0.0.0.0"),
 271          * so let's use this sprintf() workaround everywhere.
 272          * This is also more threadsafe than using inet_ntoa(). */
 273         New(1138, addr_str, 4 * 3 + 3 + 1, char); /* IPv6? */
 274         sprintf(addr_str, "%d.%d.%d.%d",
 275                 ((addr.s_addr >> 24) & 0xFF),
 276                 ((addr.s_addr >> 16) & 0xFF),
 277                 ((addr.s_addr >>  8) & 0xFF),
 278                 ( addr.s_addr        & 0xFF));
 279         ST(0) = sv_2mortal(newSVpvn(addr_str, strlen(addr_str)));
 280         Safefree(addr_str);
 281         }
 282
 283 void
 284 sockaddr_family(sockaddr)
 285         SV *    sockaddr
 286         PREINIT:
 287         STRLEN sockaddr_len;
 288         char *sockaddr_pv = SvPVbyte(sockaddr, sockaddr_len);
 289         CODE:
 290         if (sockaddr_len < offsetof(struct sockaddr, sa_data)) {
 291             croak("Bad arg length for %s, length is %d, should be at least %d",
 292                   "Socket::sockaddr_family", sockaddr_len,
 293                   offsetof(struct sockaddr, sa_data));
 294         }
 295         ST(0) = sv_2mortal(newSViv(((struct sockaddr*)sockaddr_pv)->sa_family));
 296
 297 void
 298 pack_sockaddr_un(pathname)
 299         char *  pathname
 300         CODE:
 301         {
 302 #ifdef I_SYS_UN
 303         struct sockaddr_un sun_ad; /* fear using sun */
 304         STRLEN len;
 305
 306         Zero( &sun_ad, sizeof sun_ad, char );
 307         sun_ad.sun_family = AF_UNIX;
 308         len = strlen(pathname);
 309         if (len > sizeof(sun_ad.sun_path))
 310             len = sizeof(sun_ad.sun_path);
 311 #  ifdef OS2    /* Name should start with \socket\ and contain backslashes! */
 312         {
 313             int off;
 314             char *s, *e;
 315
 316             if (pathname[0] != '/' && pathname[0] != '\\')
 317                 croak("Relative UNIX domain socket name '%s' unsupported", pathname);
 318             else if (len < 8
 319                      || pathname[7] != '/' && pathname[7] != '\\'
 320                      || !strnicmp(pathname + 1, "socket", 6))
 321                 off = 7;
 322             else
 323                 off = 0;                /* Preserve names starting with \socket\ */
 324             Copy( "\\socket", sun_ad.sun_path, off, char);
 325             Copy( pathname, sun_ad.sun_path + off, len, char );
 326
 327             s = sun_ad.sun_path + off - 1;
 328             e = s + len + 1;
 329             while (++s < e)
 330                 if (*s = '/')
 331                     *s = '\\';
 332         }
 333 #  else /* !( defined OS2 ) */
 334         Copy( pathname, sun_ad.sun_path, len, char );
 335 #  endif
 336         if (0) not_here("dummy");
 337         ST(0) = sv_2mortal(newSVpvn((char *)&sun_ad, sizeof sun_ad));
 338 #else
 339         ST(0) = (SV *) not_here("pack_sockaddr_un");
 340 #endif
 341
 342         }
 343
 344 void
 345 unpack_sockaddr_un(sun_sv)
 346         SV *    sun_sv
 347         CODE:
 348         {
 349 #ifdef I_SYS_UN
 350         struct sockaddr_un addr;
 351         STRLEN sockaddrlen;
 352         char * sun_ad = SvPVbyte(sun_sv,sockaddrlen);
 353         char * e;
 354 #   ifndef __linux__
 355         /* On Linux sockaddrlen on sockets returned by accept, recvfrom,
 356            getpeername and getsockname is not equal to sizeof(addr). */
 357         if (sockaddrlen != sizeof(addr)) {
 358             croak("Bad arg length for %s, length is %d, should be %d",
 359                         "Socket::unpack_sockaddr_un",
 360                         sockaddrlen, sizeof(addr));
 361         }
 362 #   endif
 363
 364         Copy( sun_ad, &addr, sizeof addr, char );
 365
 366         if ( addr.sun_family != AF_UNIX ) {
 367             croak("Bad address family for %s, got %d, should be %d",
 368                         "Socket::unpack_sockaddr_un",
 369                         addr.sun_family,
 370                         AF_UNIX);
 371         }
 372         e = addr.sun_path;
 373         while (*e && e < addr.sun_path + sizeof addr.sun_path)
 374             ++e;
 375         ST(0) = sv_2mortal(newSVpvn(addr.sun_path, e - addr.sun_path));
 376 #else
 377         ST(0) = (SV *) not_here("unpack_sockaddr_un");
 378 #endif
 379         }
 380
 381 void
 382 pack_sockaddr_in(port, ip_address_sv)
 383         unsigned short  port
 384         SV *    ip_address_sv
 385         CODE:
 386         {
 387         struct sockaddr_in sin;
 388         struct in_addr addr;
 389         STRLEN addrlen;
 390         char * ip_address;
 391         if (DO_UTF8(ip_address_sv) && !sv_utf8_downgrade(ip_address_sv, 1))
 392              croak("Wide character in Socket::pack_sockaddr_in");
 393         ip_address = SvPVbyte(ip_address_sv, addrlen);
 394         if (addrlen == sizeof(addr) || addrlen == 4)
 395                 addr.s_addr =
 396                     (ip_address[0] & 0xFF) << 24 |
 397                     (ip_address[1] & 0xFF) << 16 |
 398                     (ip_address[2] & 0xFF) <<  8 |
 399                     (ip_address[3] & 0xFF);
 400         else
 401                 croak("Bad arg length for %s, length is %d, should be %d",
 402                       "Socket::pack_sockaddr_in",
 403                       addrlen, sizeof(addr));
 404         Zero( &sin, sizeof sin, char );
 405         sin.sin_family = AF_INET;
 406         sin.sin_port = htons(port);
 407         sin.sin_addr.s_addr = htonl(addr.s_addr);
 408         ST(0) = sv_2mortal(newSVpvn((char *)&sin, sizeof sin));
 409         }
 410
 411 void
 412 unpack_sockaddr_in(sin_sv)
 413         SV *    sin_sv
 414         PPCODE:
 415         {
 416         STRLEN sockaddrlen;
 417         struct sockaddr_in addr;
 418         unsigned short  port;
 419         struct in_addr  ip_address;
 420         char *  sin = SvPVbyte(sin_sv,sockaddrlen);
 421         if (sockaddrlen != sizeof(addr)) {
 422             croak("Bad arg length for %s, length is %d, should be %d",
 423                         "Socket::unpack_sockaddr_in",
 424                         sockaddrlen, sizeof(addr));
 425         }
 426         Copy( sin, &addr,sizeof addr, char );
 427         if ( addr.sin_family != AF_INET ) {
 428             croak("Bad address family for %s, got %d, should be %d",
 429                         "Socket::unpack_sockaddr_in",
 430                         addr.sin_family,
 431                         AF_INET);
 432         }
 433         port = ntohs(addr.sin_port);
 434         ip_address = addr.sin_addr;
 435
 436         EXTEND(SP, 2);
 437         PUSHs(sv_2mortal(newSViv((IV) port)));
 438         PUSHs(sv_2mortal(newSVpvn((char *)&ip_address, sizeof ip_address)));
 439         }