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