ext/Socket/Socket.xs

   1 #define PERL_NO_GET_CONTEXT
   2 #include "EXTERN.h"
   3 #include "perl.h"
   4 #include "XSUB.h"
   5
   6 #ifndef VMS
   7 # ifdef I_SYS_TYPES
   8 #  include <sys/types.h>
   9 # endif
  10 # include <sys/socket.h>
  11 # if defined(USE_SOCKS) && defined(I_SOCKS)
  12 #   include <socks.h>
  13 # endif
  14 # ifdef MPE
  15 #  define PF_INET AF_INET
  16 #  define PF_UNIX AF_UNIX
  17 #  define SOCK_RAW 3
  18 # endif
  19 # ifdef I_SYS_UN
  20 #  include <sys/un.h>
  21 # endif
  22 /* XXX Configure test for <netinet/in_systm.h needed XXX */
  23 # if defined(NeXT) || defined(__NeXT__)
  24 #  include <netinet/in_systm.h>
  25 # endif
  26 # ifdef I_NETINET_IN
  27 #  include <netinet/in.h>
  28 # endif
  29 # ifdef I_NETDB
  30 #  include <netdb.h>
  31 # endif
  32 # ifdef I_ARPA_INET
  33 #  include <arpa/inet.h>
  34 # endif
  35 # ifdef I_NETINET_TCP
  36 #  include <netinet/tcp.h>
  37 # endif
  38 #else
  39 # include "sockadapt.h"
  40 #endif
  41
  42 #ifdef I_SYSUIO
  43 # include <sys/uio.h>
  44 #endif
  45
  46 #ifndef AF_NBS
  47 # undef PF_NBS
  48 #endif
  49
  50 #ifndef AF_X25
  51 # undef PF_X25
  52 #endif
  53
  54 #ifndef INADDR_NONE
  55 # define INADDR_NONE    0xffffffff
  56 #endif /* INADDR_NONE */
  57 #ifndef INADDR_BROADCAST
  58 # define INADDR_BROADCAST       0xffffffff
  59 #endif /* INADDR_BROADCAST */
  60 #ifndef INADDR_LOOPBACK
  61 # define INADDR_LOOPBACK         0x7F000001
  62 #endif /* INADDR_LOOPBACK */
  63
  64 #ifndef HAS_INET_ATON
  65
  66 /*
  67  * Check whether "cp" is a valid ascii representation
  68  * of an Internet address and convert to a binary address.
  69  * Returns 1 if the address is valid, 0 if not.
  70  * This replaces inet_addr, the return value from which
  71  * cannot distinguish between failure and a local broadcast address.
  72  */
  73 static int
  74 my_inet_aton(register const char *cp, struct in_addr *addr)
  75 {
  76         dTHX;
  77         register U32 val;
  78         register int base;
  79         register char c;
  80         int nparts;
  81         const char *s;
  82         unsigned int parts[4];
  83         register unsigned int *pp = parts;
  84
  85         if (!cp)
  86                 return 0;
  87         for (;;) {
  88                 /*
  89                  * Collect number up to ``.''.
  90                  * Values are specified as for C:
  91                  * 0x=hex, 0=octal, other=decimal.
  92                  */
  93                 val = 0; base = 10;
  94                 if (*cp == '0') {
  95                         if (*++cp == 'x' || *cp == 'X')
  96                                 base = 16, cp++;
  97                         else
  98                                 base = 8;
  99                 }
 100                 while ((c = *cp) != '\0') {
 101                         if (isDIGIT(c)) {
 102                                 val = (val * base) + (c - '0');
 103                                 cp++;
 104                                 continue;
 105                         }
 106                         if (base == 16 && (s=strchr(PL_hexdigit,c))) {
 107                                 val = (val << 4) +
 108                                         ((s - PL_hexdigit) & 15);
 109                                 cp++;
 110                                 continue;
 111                         }
 112                         break;
 113                 }
 114                 if (*cp == '.') {
 115                         /*
 116                          * Internet format:
 117                          *      a.b.c.d
 118                          *      a.b.c   (with c treated as 16-bits)
 119                          *      a.b     (with b treated as 24 bits)
 120                          */
 121                         if (pp >= parts + 3 || val > 0xff)
 122                                 return 0;
 123                         *pp++ = val, cp++;
 124                 } else
 125                         break;
 126         }
 127         /*
 128          * Check for trailing characters.
 129          */
 130         if (*cp && !isSPACE(*cp))
 131                 return 0;
 132         /*
 133          * Concoct the address according to
 134          * the number of parts specified.
 135          */
 136         nparts = pp - parts + 1;        /* force to an int for switch() */
 137         switch (nparts) {
 138
 139         case 1:                         /* a -- 32 bits */
 140                 break;
 141
 142         case 2:                         /* a.b -- 8.24 bits */
 143                 if (val > 0xffffff)
 144                         return 0;
 145                 val |= parts[0] << 24;
 146                 break;
 147
 148         case 3:                         /* a.b.c -- 8.8.16 bits */
 149                 if (val > 0xffff)
 150                         return 0;
 151                 val |= (parts[0] << 24) | (parts[1] << 16);
 152                 break;
 153
 154         case 4:                         /* a.b.c.d -- 8.8.8.8 bits */
 155                 if (val > 0xff)
 156                         return 0;
 157                 val |= (parts[0] << 24) | (parts[1] << 16) | (parts[2] << 8);
 158                 break;
 159         }
 160         addr->s_addr = htonl(val);
 161         return 1;
 162 }
 163
 164 #undef inet_aton
 165 #define inet_aton my_inet_aton
 166
 167 #endif /* ! HAS_INET_ATON */
 168
 169
 170 static int
 171 not_here(char *s)
 172 {
 173     croak("Socket::%s not implemented on this architecture", s);
 174     return -1;
 175 }
 176
 177 #include "constants.c"
 178
 179 MODULE = Socket         PACKAGE = Socket
 180
 181 INCLUDE: constants.xs
 182
 183 void
 184 inet_aton(host)
 185         char *  host
 186         CODE:
 187         {
 188         struct in_addr ip_address;
 189         struct hostent * phe;
 190         int ok = inet_aton(host, &ip_address);
 191
 192         if (!ok && (phe = gethostbyname(host))) {
 193                 Copy( phe->h_addr, &ip_address, phe->h_length, char );
 194                 ok = 1;
 195         }
 196
 197         ST(0) = sv_newmortal();
 198         if (ok) {
 199                 sv_setpvn( ST(0), (char *)&ip_address, sizeof ip_address );
 200         }
 201         }
 202
 203 void
 204 inet_ntoa(ip_address_sv)
 205         SV *    ip_address_sv
 206         CODE:
 207         {
 208         STRLEN addrlen;
 209         struct in_addr addr;
 210         char * addr_str;
 211         char * ip_address = SvPV(ip_address_sv,addrlen);
 212         if (addrlen != sizeof(addr)) {
 213             croak("Bad arg length for %s, length is %d, should be %d",
 214                         "Socket::inet_ntoa",
 215                         addrlen, sizeof(addr));
 216         }
 217
 218         Copy( ip_address, &addr, sizeof addr, char );
 219         addr_str = inet_ntoa(addr);
 220
 221         ST(0) = sv_2mortal(newSVpvn(addr_str, strlen(addr_str)));
 222         }
 223
 224 void
 225 pack_sockaddr_un(pathname)
 226         char *  pathname
 227         CODE:
 228         {
 229 #ifdef I_SYS_UN
 230         struct sockaddr_un sun_ad; /* fear using sun */
 231         STRLEN len;
 232
 233         Zero( &sun_ad, sizeof sun_ad, char );
 234         sun_ad.sun_family = AF_UNIX;
 235         len = strlen(pathname);
 236         if (len > sizeof(sun_ad.sun_path))
 237             len = sizeof(sun_ad.sun_path);
 238 #  ifdef OS2    /* Name should start with \socket\ and contain backslashes! */
 239         {
 240             int off;
 241             char *s, *e;
 242
 243             if (pathname[0] != '/' && pathname[0] != '\\')
 244                 croak("Relative UNIX domain socket name '%s' unsupported", pathname);
 245             else if (len < 8
 246                      || pathname[7] != '/' && pathname[7] != '\\'
 247                      || !strnicmp(pathname + 1, "socket", 6))
 248                 off = 7;
 249             else
 250                 off = 0;                /* Preserve names starting with \socket\ */
 251             Copy( "\\socket", sun_ad.sun_path, off, char);
 252             Copy( pathname, sun_ad.sun_path + off, len, char );
 253
 254             s = sun_ad.sun_path + off - 1;
 255             e = s + len + 1;
 256             while (++s < e)
 257                 if (*s = '/')
 258                     *s = '\\';
 259         }
 260 #  else /* !( defined OS2 ) */
 261         Copy( pathname, sun_ad.sun_path, len, char );
 262 #  endif
 263         if (0) not_here("dummy");
 264         ST(0) = sv_2mortal(newSVpvn((char *)&sun_ad, sizeof sun_ad));
 265 #else
 266         ST(0) = (SV *) not_here("pack_sockaddr_un");
 267 #endif
 268
 269         }
 270
 271 void
 272 unpack_sockaddr_un(sun_sv)
 273         SV *    sun_sv
 274         CODE:
 275         {
 276 #ifdef I_SYS_UN
 277         struct sockaddr_un addr;
 278         STRLEN sockaddrlen;
 279         char * sun_ad = SvPV(sun_sv,sockaddrlen);
 280         char * e;
 281 #   ifndef __linux__
 282         /* On Linux sockaddrlen on sockets returned by accept, recvfrom,
 283            getpeername and getsockname is not equal to sizeof(addr). */
 284         if (sockaddrlen != sizeof(addr)) {
 285             croak("Bad arg length for %s, length is %d, should be %d",
 286                         "Socket::unpack_sockaddr_un",
 287                         sockaddrlen, sizeof(addr));
 288         }
 289 #   endif
 290
 291         Copy( sun_ad, &addr, sizeof addr, char );
 292
 293         if ( addr.sun_family != AF_UNIX ) {
 294             croak("Bad address family for %s, got %d, should be %d",
 295                         "Socket::unpack_sockaddr_un",
 296                         addr.sun_family,
 297                         AF_UNIX);
 298         }
 299         e = addr.sun_path;
 300         while (*e && e < addr.sun_path + sizeof addr.sun_path)
 301             ++e;
 302         ST(0) = sv_2mortal(newSVpvn(addr.sun_path, e - addr.sun_path));
 303 #else
 304         ST(0) = (SV *) not_here("unpack_sockaddr_un");
 305 #endif
 306         }
 307
 308 void
 309 pack_sockaddr_in(port,ip_address)
 310         unsigned short  port
 311         char *  ip_address
 312         CODE:
 313         {
 314         struct sockaddr_in sin;
 315
 316         Zero( &sin, sizeof sin, char );
 317         sin.sin_family = AF_INET;
 318         sin.sin_port = htons(port);
 319         Copy( ip_address, &sin.sin_addr, sizeof sin.sin_addr, char );
 320
 321         ST(0) = sv_2mortal(newSVpvn((char *)&sin, sizeof sin));
 322         }
 323
 324 void
 325 unpack_sockaddr_in(sin_sv)
 326         SV *    sin_sv
 327         PPCODE:
 328         {
 329         STRLEN sockaddrlen;
 330         struct sockaddr_in addr;
 331         unsigned short  port;
 332         struct in_addr  ip_address;
 333         char *  sin = SvPV(sin_sv,sockaddrlen);
 334         if (sockaddrlen != sizeof(addr)) {
 335             croak("Bad arg length for %s, length is %d, should be %d",
 336                         "Socket::unpack_sockaddr_in",
 337                         sockaddrlen, sizeof(addr));
 338         }
 339         Copy( sin, &addr,sizeof addr, char );
 340         if ( addr.sin_family != AF_INET ) {
 341             croak("Bad address family for %s, got %d, should be %d",
 342                         "Socket::unpack_sockaddr_in",
 343                         addr.sin_family,
 344                         AF_INET);
 345         }
 346         port = ntohs(addr.sin_port);
 347         ip_address = addr.sin_addr;
 348
 349         EXTEND(SP, 2);
 350         PUSHs(sv_2mortal(newSViv((IV) port)));
 351         PUSHs(sv_2mortal(newSVpvn((char *)&ip_address,sizeof ip_address)));
 352         }