This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Carp-1.25 released to CPAN
[perl5.git] / cpan / Socket / Socket.xs
CommitLineData
c5be433b 1#define PERL_NO_GET_CONTEXT
a0d0e21e
LW
2#include "EXTERN.h"
3#include "perl.h"
4#include "XSUB.h"
5
fc87b71c
NIS
6#include <stddef.h>
7
046cc26c 8#ifdef I_SYS_TYPES
8e07c86e 9# include <sys/types.h>
046cc26c
CB
10#endif
11#if !defined(ultrix) /* Avoid double definition. */
43db6828 12# include <sys/socket.h>
046cc26c
CB
13#endif
14#if defined(USE_SOCKS) && defined(I_SOCKS)
86959918 15# include <socks.h>
046cc26c
CB
16#endif
17#ifdef MPE
9cc6feab
JH
18# define PF_INET AF_INET
19# define PF_UNIX AF_UNIX
20# define SOCK_RAW 3
046cc26c
CB
21#endif
22#ifdef I_SYS_UN
9cc6feab 23# include <sys/un.h>
046cc26c 24#endif
bf9b2f8f 25/* XXX Configure test for <netinet/in_systm.h needed XXX */
046cc26c 26#if defined(NeXT) || defined(__NeXT__)
bf9b2f8f 27# include <netinet/in_systm.h>
046cc26c
CB
28#endif
29#if defined(__sgi) && !defined(AF_LINK) && defined(PF_LINK) && PF_LINK == AF_LNK
3b8fd1d5 30# undef PF_LINK
046cc26c
CB
31#endif
32#if defined(I_NETINET_IN) || defined(__ultrix__)
8e07c86e 33# include <netinet/in.h>
046cc26c
CB
34#endif
35#ifdef I_NETDB
c2654555 36# if !defined(ultrix) /* Avoid double definition. */
87edd446
JH
37# include <netdb.h>
38# endif
046cc26c
CB
39#endif
40#ifdef I_ARPA_INET
9cc6feab 41# include <arpa/inet.h>
046cc26c
CB
42#endif
43#ifdef I_NETINET_TCP
9cc6feab 44# include <netinet/tcp.h>
8e07c86e 45#endif
a0d0e21e 46
2986a63f
JH
47#ifdef NETWARE
48NETDB_DEFINE_CONTEXT
49NETINET_DEFINE_CONTEXT
50#endif
51
6b1016b5
JH
52#ifdef I_SYSUIO
53# include <sys/uio.h>
54#endif
55
a0d0e21e 56#ifndef AF_NBS
9cc6feab 57# undef PF_NBS
a0d0e21e
LW
58#endif
59
60#ifndef AF_X25
9cc6feab 61# undef PF_X25
a0d0e21e
LW
62#endif
63
8e07c86e 64#ifndef INADDR_NONE
9cc6feab 65# define INADDR_NONE 0xffffffff
8e07c86e 66#endif /* INADDR_NONE */
7e1af8bc 67#ifndef INADDR_BROADCAST
9cc6feab 68# define INADDR_BROADCAST 0xffffffff
7e1af8bc 69#endif /* INADDR_BROADCAST */
8e07c86e 70#ifndef INADDR_LOOPBACK
c2654555 71# define INADDR_LOOPBACK 0x7F000001
8e07c86e
AD
72#endif /* INADDR_LOOPBACK */
73
4c3d8e12
PLE
74#ifndef croak_sv
75# define croak_sv(sv) croak(SvPV_nolen(sv))
76#endif
77
c2654555
CBW
78/* perl < 5.8.9 or == 5.10.0 lacks newSVpvn_flags */
79#if PERL_VERSION < 8
80# define NEED_newSVpvn_flags
81#elif PERL_VERSION == 8 && PERL_SUBVERSION < 9
82# define NEED_newSVpvn_flags
83#elif PERL_VERSION == 10 && PERL_SUBVERSION == 0
84# define NEED_newSVpvn_flags
85#endif
86
87#ifdef NEED_newSVpvn_flags
37b1de1b 88static SV *my_newSVpvn_flags(pTHX_ const char *s, STRLEN len, U32 flags)
c2654555
CBW
89{
90 SV *sv = newSVpvn(s, len);
91 SvFLAGS(sv) |= (flags & SVf_UTF8);
92 return (flags & SVs_TEMP) ? sv_2mortal(sv) : sv;
93}
37b1de1b
CBW
94
95#define newSVpvn_flags(s,len,flags) my_newSVpvn_flags(aTHX_ s,len,flags)
c2654555
CBW
96#endif
97
7e1af8bc
PP
98#ifndef HAS_INET_ATON
99
a062834f 100/*
7e1af8bc
PP
101 * Check whether "cp" is a valid ascii representation
102 * of an Internet address and convert to a binary address.
103 * Returns 1 if the address is valid, 0 if not.
104 * This replaces inet_addr, the return value from which
105 * cannot distinguish between failure and a local broadcast address.
106 */
107static int
f0f333f4 108my_inet_aton(register const char *cp, struct in_addr *addr)
7e1af8bc 109{
c5be433b 110 dTHX;
0caed002 111 register U32 val;
7e1af8bc
PP
112 register int base;
113 register char c;
114 int nparts;
115 const char *s;
116 unsigned int parts[4];
117 register unsigned int *pp = parts;
118
c2654555 119 if (!cp || !*cp)
0caed002 120 return 0;
7e1af8bc
PP
121 for (;;) {
122 /*
882ce583 123 * Collect number up to ".".
7e1af8bc
PP
124 * Values are specified as for C:
125 * 0x=hex, 0=octal, other=decimal.
126 */
127 val = 0; base = 10;
128 if (*cp == '0') {
129 if (*++cp == 'x' || *cp == 'X')
130 base = 16, cp++;
131 else
132 base = 8;
133 }
134 while ((c = *cp) != '\0') {
135 if (isDIGIT(c)) {
136 val = (val * base) + (c - '0');
137 cp++;
138 continue;
139 }
3280af22 140 if (base == 16 && (s=strchr(PL_hexdigit,c))) {
a062834f 141 val = (val << 4) +
3280af22 142 ((s - PL_hexdigit) & 15);
7e1af8bc
PP
143 cp++;
144 continue;
145 }
146 break;
147 }
148 if (*cp == '.') {
149 /*
150 * Internet format:
151 * a.b.c.d
152 * a.b.c (with c treated as 16-bits)
153 * a.b (with b treated as 24 bits)
154 */
155 if (pp >= parts + 3 || val > 0xff)
156 return 0;
157 *pp++ = val, cp++;
158 } else
159 break;
160 }
161 /*
162 * Check for trailing characters.
163 */
164 if (*cp && !isSPACE(*cp))
165 return 0;
166 /*
167 * Concoct the address according to
168 * the number of parts specified.
169 */
170 nparts = pp - parts + 1; /* force to an int for switch() */
171 switch (nparts) {
172
173 case 1: /* a -- 32 bits */
174 break;
175
176 case 2: /* a.b -- 8.24 bits */
177 if (val > 0xffffff)
178 return 0;
179 val |= parts[0] << 24;
180 break;
181
182 case 3: /* a.b.c -- 8.8.16 bits */
183 if (val > 0xffff)
184 return 0;
185 val |= (parts[0] << 24) | (parts[1] << 16);
186 break;
187
188 case 4: /* a.b.c.d -- 8.8.8.8 bits */
189 if (val > 0xff)
190 return 0;
191 val |= (parts[0] << 24) | (parts[1] << 16) | (parts[2] << 8);
192 break;
193 }
194 addr->s_addr = htonl(val);
195 return 1;
196}
197
198#undef inet_aton
199#define inet_aton my_inet_aton
200
201#endif /* ! HAS_INET_ATON */
202
c2654555
CBW
203/* These are not gni() constants; they're extensions for the perl API */
204/* The definitions in Socket.pm and Socket.xs must match */
205#define NIx_NOHOST (1 << 0)
206#define NIx_NOSERV (1 << 1)
207
8e07c86e 208
a0d0e21e 209static int
d3f5e399 210not_here(const char *s)
a0d0e21e
LW
211{
212 croak("Socket::%s not implemented on this architecture", s);
213 return -1;
214}
215
2528d3bc
JH
216#define PERL_IN_ADDR_S_ADDR_SIZE 4
217
218/*
219* Bad assumptions possible here.
220*
221* Bad Assumption 1: struct in_addr has no other fields
222* than the s_addr (which is the field we care about
223* in here, really). However, we can be fed either 4-byte
224* addresses (from pack("N", ...), or va.b.c.d, or ...),
225* or full struct in_addrs (from e.g. pack_sockaddr_in()),
226* which may or may not be 4 bytes in size.
227*
228* Bad Assumption 2: the s_addr field is a simple type
c2654555 229* (such as an int, u_int32_t). It can be a bit field,
2528d3bc
JH
230* in which case using & (address-of) on it or taking sizeof()
231* wouldn't go over too well. (Those are not attempted
232* now but in case someone thinks to change the below code
233* to use addr.s_addr instead of addr, you have been warned.)
234*
235* Bad Assumption 3: the s_addr is the first field in
236* an in_addr, or that its bytes are the first bytes in
237* an in_addr.
238*
239* These bad assumptions are wrong in UNICOS which has
240* struct in_addr { struct { u_long st_addr:32; } s_da };
241* #define s_addr s_da.st_addr
242* and u_long is 64 bits.
243*
244* --jhi */
245
1cb0fb50 246#include "const-c.inc"
8e07c86e 247
eccda089
PLE
248#ifdef HAS_GETADDRINFO
249static SV *err_to_SV(pTHX_ int err)
250{
0f41f5e2
PLE
251 SV *ret = sv_newmortal();
252 SvUPGRADE(ret, SVt_PVNV);
eccda089 253
0f41f5e2
PLE
254 if(err) {
255 const char *error = gai_strerror(err);
256 sv_setpv(ret, error);
257 }
258 else {
259 sv_setpv(ret, "");
260 }
eccda089 261
0f41f5e2 262 SvIV_set(ret, err); SvIOK_on(ret);
eccda089 263
0f41f5e2 264 return ret;
eccda089
PLE
265}
266
267static void xs_getaddrinfo(pTHX_ CV *cv)
268{
0f41f5e2
PLE
269 dXSARGS;
270
271 SV *host;
272 SV *service;
273 SV *hints;
274
275 char *hostname = NULL;
276 char *servicename = NULL;
277 STRLEN len;
278 struct addrinfo hints_s;
279 struct addrinfo *res;
280 struct addrinfo *res_iter;
281 int err;
282 int n_res;
283
284 if(items > 3)
1584259f 285 croak("Usage: Socket::getaddrinfo(host, service, hints)");
0f41f5e2
PLE
286
287 SP -= items;
288
289 if(items < 1)
290 host = &PL_sv_undef;
291 else
292 host = ST(0);
293
294 if(items < 2)
295 service = &PL_sv_undef;
296 else
297 service = ST(1);
298
299 if(items < 3)
300 hints = NULL;
301 else
302 hints = ST(2);
303
304 SvGETMAGIC(host);
305 if(SvOK(host)) {
306 hostname = SvPV_nomg(host, len);
307 if (!len)
308 hostname = NULL;
309 }
310
311 SvGETMAGIC(service);
312 if(SvOK(service)) {
313 servicename = SvPV_nomg(service, len);
314 if (!len)
315 servicename = NULL;
316 }
317
c2654555 318 Zero(&hints_s, sizeof(hints_s), char);
0cd14f2e 319 hints_s.ai_family = PF_UNSPEC;
0f41f5e2
PLE
320
321 if(hints && SvOK(hints)) {
322 HV *hintshash;
323 SV **valp;
324
325 if(!SvROK(hints) || SvTYPE(SvRV(hints)) != SVt_PVHV)
326 croak("hints is not a HASH reference");
327
328 hintshash = (HV*)SvRV(hints);
329
330 if((valp = hv_fetch(hintshash, "flags", 5, 0)) != NULL)
331 hints_s.ai_flags = SvIV(*valp);
332 if((valp = hv_fetch(hintshash, "family", 6, 0)) != NULL)
333 hints_s.ai_family = SvIV(*valp);
334 if((valp = hv_fetch(hintshash, "socktype", 8, 0)) != NULL)
335 hints_s.ai_socktype = SvIV(*valp);
336 if((valp = hv_fetch(hintshash, "protocol", 8, 0)) != NULL)
337 hints_s.ai_protocol = SvIV(*valp);
338 }
339
340 err = getaddrinfo(hostname, servicename, &hints_s, &res);
341
342 XPUSHs(err_to_SV(aTHX_ err));
343
344 if(err)
345 XSRETURN(1);
346
347 n_res = 0;
348 for(res_iter = res; res_iter; res_iter = res_iter->ai_next) {
349 HV *res_hv = newHV();
350
351 (void)hv_stores(res_hv, "family", newSViv(res_iter->ai_family));
352 (void)hv_stores(res_hv, "socktype", newSViv(res_iter->ai_socktype));
353 (void)hv_stores(res_hv, "protocol", newSViv(res_iter->ai_protocol));
354
355 (void)hv_stores(res_hv, "addr", newSVpvn((char*)res_iter->ai_addr, res_iter->ai_addrlen));
356
357 if(res_iter->ai_canonname)
358 (void)hv_stores(res_hv, "canonname", newSVpv(res_iter->ai_canonname, 0));
359 else
360 (void)hv_stores(res_hv, "canonname", newSV(0));
361
362 XPUSHs(sv_2mortal(newRV_noinc((SV*)res_hv)));
363 n_res++;
364 }
365
366 freeaddrinfo(res);
367
368 XSRETURN(1 + n_res);
eccda089
PLE
369}
370#endif
371
372#ifdef HAS_GETNAMEINFO
373static void xs_getnameinfo(pTHX_ CV *cv)
374{
0f41f5e2 375 dXSARGS;
eccda089 376
0f41f5e2
PLE
377 SV *addr;
378 int flags;
c2654555 379 int xflags;
eccda089 380
0f41f5e2
PLE
381 char host[1024];
382 char serv[256];
383 char *sa; /* we'll cast to struct sockaddr * when necessary */
384 STRLEN addr_len;
385 int err;
eccda089 386
c2654555
CBW
387 int want_host, want_serv;
388
389 if(items < 1 || items > 3)
390 croak("Usage: Socket::getnameinfo(addr, flags=0, xflags=0)");
eccda089 391
0f41f5e2 392 SP -= items;
eccda089 393
0f41f5e2 394 addr = ST(0);
eccda089 395
0f41f5e2
PLE
396 if(items < 2)
397 flags = 0;
398 else
399 flags = SvIV(ST(1));
eccda089 400
c2654555
CBW
401 if(items < 3)
402 xflags = 0;
403 else
404 xflags = SvIV(ST(2));
405
406 want_host = !(xflags & NIx_NOHOST);
407 want_serv = !(xflags & NIx_NOSERV);
408
0f41f5e2
PLE
409 if(!SvPOK(addr))
410 croak("addr is not a string");
eccda089 411
0f41f5e2 412 addr_len = SvCUR(addr);
eccda089 413
0f41f5e2
PLE
414 /* We need to ensure the sockaddr is aligned, because a random SvPV might
415 * not be due to SvOOK */
416 Newx(sa, addr_len, char);
417 Copy(SvPV_nolen(addr), sa, addr_len, char);
eccda089 418#ifdef HAS_SOCKADDR_SA_LEN
0f41f5e2 419 ((struct sockaddr *)sa)->sa_len = addr_len;
eccda089
PLE
420#endif
421
0f41f5e2 422 err = getnameinfo((struct sockaddr *)sa, addr_len,
c2654555
CBW
423 want_host ? host : NULL, want_host ? sizeof(host) : 0,
424 want_serv ? serv : NULL, want_serv ? sizeof(serv) : 0,
0f41f5e2 425 flags);
eccda089 426
0f41f5e2 427 Safefree(sa);
eccda089 428
0f41f5e2 429 XPUSHs(err_to_SV(aTHX_ err));
eccda089 430
0f41f5e2
PLE
431 if(err)
432 XSRETURN(1);
eccda089 433
c2654555
CBW
434 XPUSHs(want_host ? sv_2mortal(newSVpv(host, 0)) : &PL_sv_undef);
435 XPUSHs(want_serv ? sv_2mortal(newSVpv(serv, 0)) : &PL_sv_undef);
eccda089 436
0f41f5e2 437 XSRETURN(3);
eccda089
PLE
438}
439#endif
440
a0d0e21e
LW
441MODULE = Socket PACKAGE = Socket
442
1cb0fb50 443INCLUDE: const-xs.inc
8e07c86e 444
eccda089
PLE
445BOOT:
446#ifdef HAS_GETADDRINFO
c2654555 447 newXS("Socket::getaddrinfo", xs_getaddrinfo, __FILE__);
eccda089
PLE
448#endif
449#ifdef HAS_GETNAMEINFO
c2654555 450 newXS("Socket::getnameinfo", xs_getnameinfo, __FILE__);
eccda089
PLE
451#endif
452
8e07c86e
AD
453void
454inet_aton(host)
455 char * host
456 CODE:
457 {
fbf77aee 458 struct in_addr ip_address;
8e07c86e
AD
459 struct hostent * phe;
460
4596752b 461 if ((*host != '\0') && inet_aton(host, &ip_address)) {
c2654555 462 ST(0) = sv_2mortal(newSVpvn((char *)&ip_address, sizeof(ip_address)));
4596752b
NC
463 XSRETURN(1);
464 }
465
466 phe = gethostbyname(host);
467 if (phe && phe->h_addrtype == AF_INET && phe->h_length == 4) {
c2654555 468 ST(0) = sv_2mortal(newSVpvn((char *)phe->h_addr, phe->h_length));
4596752b 469 XSRETURN(1);
8e07c86e
AD
470 }
471
4596752b 472 XSRETURN_UNDEF;
8e07c86e 473 }
8e07c86e
AD
474
475void
476inet_ntoa(ip_address_sv)
477 SV * ip_address_sv
478 CODE:
479 {
480 STRLEN addrlen;
481 struct in_addr addr;
1d68b939
JH
482 char * ip_address;
483 if (DO_UTF8(ip_address_sv) && !sv_utf8_downgrade(ip_address_sv, 1))
c2654555 484 croak("Wide character in %s", "Socket::inet_ntoa");
f780604f 485 ip_address = SvPVbyte(ip_address_sv, addrlen);
2528d3bc 486 if (addrlen == sizeof(addr) || addrlen == 4)
c2654555 487 addr.s_addr =
2528d3bc
JH
488 (ip_address[0] & 0xFF) << 24 |
489 (ip_address[1] & 0xFF) << 16 |
490 (ip_address[2] & 0xFF) << 8 |
491 (ip_address[3] & 0xFF);
492 else
c2654555
CBW
493 croak("Bad arg length for %s, length is %d, should be %d",
494 "Socket::inet_ntoa", addrlen, sizeof(addr));
2528d3bc
JH
495 /* We could use inet_ntoa() but that is broken
496 * in HP-UX + GCC + 64bitint (returns "0.0.0.0"),
1d88b533
JH
497 * so let's use this sprintf() workaround everywhere.
498 * This is also more threadsafe than using inet_ntoa(). */
8063d419
NC
499 ST(0) = sv_2mortal(Perl_newSVpvf(aTHX_ "%d.%d.%d.%d", /* IPv6? */
500 ((addr.s_addr >> 24) & 0xFF),
501 ((addr.s_addr >> 16) & 0xFF),
502 ((addr.s_addr >> 8) & 0xFF),
503 ( addr.s_addr & 0xFF)));
8e07c86e
AD
504 }
505
506void
2a84dff3
GA
507sockaddr_family(sockaddr)
508 SV * sockaddr
509 PREINIT:
510 STRLEN sockaddr_len;
f780604f 511 char *sockaddr_pv = SvPVbyte(sockaddr, sockaddr_len);
2a84dff3 512 CODE:
c2654555
CBW
513 if (sockaddr_len < offsetof(struct sockaddr, sa_data))
514 croak("Bad arg length for %s, length is %d, should be at least %d",
515 "Socket::sockaddr_family", sockaddr_len,
516 offsetof(struct sockaddr, sa_data));
2a84dff3
GA
517 ST(0) = sv_2mortal(newSViv(((struct sockaddr*)sockaddr_pv)->sa_family));
518
519void
4633a7c4 520pack_sockaddr_un(pathname)
7513c55b 521 SV * pathname
4633a7c4
LW
522 CODE:
523 {
25f94b33 524#ifdef I_SYS_UN
4633a7c4 525 struct sockaddr_un sun_ad; /* fear using sun */
fcdb74fc 526 STRLEN len;
7513c55b 527 char * pathname_pv;
99f13d4c 528 int addr_len;
202975e6 529
c2654555 530 Zero(&sun_ad, sizeof(sun_ad), char);
4633a7c4 531 sun_ad.sun_family = AF_UNIX;
7513c55b 532 pathname_pv = SvPV(pathname,len);
20408e3c
GS
533 if (len > sizeof(sun_ad.sun_path))
534 len = sizeof(sun_ad.sun_path);
202975e6
IZ
535# ifdef OS2 /* Name should start with \socket\ and contain backslashes! */
536 {
c2654555
CBW
537 int off;
538 char *s, *e;
539
540 if (pathname_pv[0] != '/' && pathname_pv[0] != '\\')
541 croak("Relative UNIX domain socket name '%s' unsupported",
542 pathname_pv);
543 else if (len < 8
544 || pathname_pv[7] != '/' && pathname_pv[7] != '\\'
545 || !strnicmp(pathname_pv + 1, "socket", 6))
546 off = 7;
547 else
548 off = 0; /* Preserve names starting with \socket\ */
549 Copy("\\socket", sun_ad.sun_path, off, char);
550 Copy(pathname_pv, sun_ad.sun_path + off, len, char);
551
552 s = sun_ad.sun_path + off - 1;
553 e = s + len + 1;
554 while (++s < e)
555 if (*s = '/')
556 *s = '\\';
202975e6 557 }
a062834f 558# else /* !( defined OS2 ) */
c2654555 559 Copy(pathname_pv, sun_ad.sun_path, len, char);
202975e6 560# endif
a062834f 561 if (0) not_here("dummy");
99f13d4c
LR
562 if (len > 1 && sun_ad.sun_path[0] == '\0') {
563 /* Linux-style abstract-namespace socket.
564 * The name is not a file name, but an array of arbitrary
565 * character, starting with \0 and possibly including \0s,
566 * therefore the length of the structure must denote the
567 * end of that character array */
178e6016 568 addr_len = (char *)&(sun_ad.sun_path) - (char *)&sun_ad + len;
99f13d4c 569 } else {
c2654555 570 addr_len = sizeof(sun_ad);
99f13d4c 571 }
5897b17c
PLE
572# ifdef HAS_SOCKADDR_SA_LEN
573 sun_ad.sun_len = addr_len;
574# endif
c2654555 575 ST(0) = sv_2mortal(newSVpvn((char *)&sun_ad, addr_len));
25f94b33 576#else
c2654555 577 ST(0) = (SV*)not_here("pack_sockaddr_un");
25f94b33 578#endif
c2654555 579
4633a7c4
LW
580 }
581
582void
583unpack_sockaddr_un(sun_sv)
584 SV * sun_sv
f13e1b2f 585 CODE:
4633a7c4 586 {
25f94b33 587#ifdef I_SYS_UN
4633a7c4 588 struct sockaddr_un addr;
fcdb74fc 589 STRLEN sockaddrlen;
f780604f 590 char * sun_ad = SvPVbyte(sun_sv,sockaddrlen);
89904c08 591 int addr_len;
36902e12
RG
592# ifndef __linux__
593 /* On Linux sockaddrlen on sockets returned by accept, recvfrom,
594 getpeername and getsockname is not equal to sizeof(addr). */
c2654555
CBW
595 if (sockaddrlen != sizeof(addr))
596 croak("Bad arg length for %s, length is %d, should be %d",
597 "Socket::unpack_sockaddr_un", sockaddrlen, sizeof(addr));
36902e12 598# endif
4633a7c4 599
c2654555 600 Copy(sun_ad, &addr, sizeof(addr), char);
4633a7c4 601
c2654555
CBW
602 if (addr.sun_family != AF_UNIX)
603 croak("Bad address family for %s, got %d, should be %d",
604 "Socket::unpack_sockaddr_un", addr.sun_family, AF_UNIX);
89904c08
LR
605
606 if (addr.sun_path[0] == '\0') {
607 /* Linux-style abstract socket address begins with a nul
608 * and can contain nuls. */
178e6016 609 addr_len = (char *)&addr - (char *)&(addr.sun_path) + sockaddrlen;
89904c08
LR
610 } else {
611 for (addr_len = 0; addr.sun_path[addr_len]
c33e8be1 612 && addr_len < (int)sizeof(addr.sun_path); addr_len++);
89904c08
LR
613 }
614
c2654555 615 ST(0) = sv_2mortal(newSVpvn(addr.sun_path, addr_len));
25f94b33 616#else
c2654555 617 ST(0) = (SV*)not_here("unpack_sockaddr_un");
25f94b33 618#endif
4633a7c4
LW
619 }
620
621void
2528d3bc 622pack_sockaddr_in(port, ip_address_sv)
2c129a17 623 unsigned short port
2528d3bc 624 SV * ip_address_sv
8e07c86e
AD
625 CODE:
626 {
627 struct sockaddr_in sin;
2528d3bc
JH
628 struct in_addr addr;
629 STRLEN addrlen;
630 char * ip_address;
631 if (DO_UTF8(ip_address_sv) && !sv_utf8_downgrade(ip_address_sv, 1))
c2654555 632 croak("Wide character in %s", "Socket::pack_sockaddr_in");
f780604f 633 ip_address = SvPVbyte(ip_address_sv, addrlen);
2528d3bc 634 if (addrlen == sizeof(addr) || addrlen == 4)
c2654555 635 addr.s_addr =
2528d3bc
JH
636 (ip_address[0] & 0xFF) << 24 |
637 (ip_address[1] & 0xFF) << 16 |
638 (ip_address[2] & 0xFF) << 8 |
639 (ip_address[3] & 0xFF);
640 else
c2654555 641 croak("Bad arg length for %s, length is %d, should be %d",
2528d3bc
JH
642 "Socket::pack_sockaddr_in",
643 addrlen, sizeof(addr));
c2654555 644 Zero(&sin, sizeof(sin), char);
4633a7c4 645 sin.sin_family = AF_INET;
8e07c86e 646 sin.sin_port = htons(port);
2528d3bc 647 sin.sin_addr.s_addr = htonl(addr.s_addr);
5897b17c 648# ifdef HAS_SOCKADDR_SA_LEN
c2654555 649 sin.sin_len = sizeof(sin);
5897b17c 650# endif
c2654555 651 ST(0) = sv_2mortal(newSVpvn((char *)&sin, sizeof(sin)));
8e07c86e
AD
652 }
653
654void
655unpack_sockaddr_in(sin_sv)
656 SV * sin_sv
657 PPCODE:
658 {
659 STRLEN sockaddrlen;
660 struct sockaddr_in addr;
2c129a17 661 unsigned short port;
c2654555 662 struct in_addr ip_address;
f780604f 663 char * sin = SvPVbyte(sin_sv,sockaddrlen);
8e07c86e
AD
664 if (sockaddrlen != sizeof(addr)) {
665 croak("Bad arg length for %s, length is %d, should be %d",
c2654555 666 "Socket::unpack_sockaddr_in", sockaddrlen, sizeof(addr));
8e07c86e 667 }
c2654555
CBW
668 Copy(sin, &addr, sizeof(addr), char);
669 if (addr.sin_family != AF_INET) {
4633a7c4 670 croak("Bad address family for %s, got %d, should be %d",
c2654555 671 "Socket::unpack_sockaddr_in", addr.sin_family, AF_INET);
a062834f 672 }
8e07c86e
AD
673 port = ntohs(addr.sin_port);
674 ip_address = addr.sin_addr;
675
924508f0 676 EXTEND(SP, 2);
2c129a17 677 PUSHs(sv_2mortal(newSViv((IV) port)));
c2654555 678 PUSHs(sv_2mortal(newSVpvn((char *)&ip_address, sizeof(ip_address))));
8e07c86e 679 }
036d8bd4
SP
680
681void
9987e04d
PLE
682pack_sockaddr_in6(port, sin6_addr, scope_id=0, flowinfo=0)
683 unsigned short port
684 SV * sin6_addr
685 unsigned long scope_id
686 unsigned long flowinfo
687 CODE:
688 {
689#ifdef AF_INET6
690 struct sockaddr_in6 sin6;
691 char * addrbytes;
692 STRLEN addrlen;
693 if (DO_UTF8(sin6_addr) && !sv_utf8_downgrade(sin6_addr, 1))
c2654555 694 croak("Wide character in %s", "Socket::pack_sockaddr_in6");
9987e04d 695 addrbytes = SvPVbyte(sin6_addr, addrlen);
c2654555
CBW
696 if (addrlen != sizeof(sin6.sin6_addr))
697 croak("Bad arg length %s, length is %d, should be %d",
698 "Socket::pack_sockaddr_in6", addrlen, sizeof(sin6.sin6_addr));
9987e04d
PLE
699 Zero(&sin6, sizeof(sin6), char);
700 sin6.sin6_family = AF_INET6;
701 sin6.sin6_port = htons(port);
702 sin6.sin6_flowinfo = htonl(flowinfo);
703 Copy(addrbytes, &sin6.sin6_addr, sizeof(sin6.sin6_addr), char);
24b8ee2e 704# ifdef HAS_SIN6_SCOPE_ID
9987e04d 705 sin6.sin6_scope_id = scope_id;
79c932f0 706# else
c2654555 707 if (scope_id != 0)
79c932f0 708 warn("%s cannot represent non-zero scope_id %d",
c2654555 709 "Socket::pack_sockaddr_in6", scope_id);
24b8ee2e 710# endif
5897b17c
PLE
711# ifdef HAS_SOCKADDR_SA_LEN
712 sin6.sin6_len = sizeof(sin6);
713# endif
c2654555 714 ST(0) = sv_2mortal(newSVpvn((char *)&sin6, sizeof(sin6)));
9987e04d
PLE
715#else
716 ST(0) = (SV*)not_here("pack_sockaddr_in6");
717#endif
718 }
719
720void
721unpack_sockaddr_in6(sin6_sv)
722 SV * sin6_sv
723 PPCODE:
724 {
725#ifdef AF_INET6
726 STRLEN addrlen;
727 struct sockaddr_in6 sin6;
728 char * addrbytes = SvPVbyte(sin6_sv, addrlen);
729 if (addrlen != sizeof(sin6))
c2654555
CBW
730 croak("Bad arg length for %s, length is %d, should be %d",
731 "Socket::unpack_sockaddr_in6", addrlen, sizeof(sin6));
9987e04d 732 Copy(addrbytes, &sin6, sizeof(sin6), char);
c2654555
CBW
733 if (sin6.sin6_family != AF_INET6)
734 croak("Bad address family for %s, got %d, should be %d",
735 "Socket::unpack_sockaddr_in6", sin6.sin6_family, AF_INET6);
9987e04d
PLE
736 EXTEND(SP, 4);
737 mPUSHi(ntohs(sin6.sin6_port));
738 mPUSHp((char *)&sin6.sin6_addr, sizeof(sin6.sin6_addr));
24b8ee2e 739# ifdef HAS_SIN6_SCOPE_ID
9987e04d 740 mPUSHi(sin6.sin6_scope_id);
24b8ee2e 741# else
8b079db6 742 mPUSHi(0);
24b8ee2e 743# endif
9987e04d
PLE
744 mPUSHi(ntohl(sin6.sin6_flowinfo));
745#else
746 ST(0) = (SV*)not_here("pack_sockaddr_in6");
747#endif
748 }
749
750void
036d8bd4 751inet_ntop(af, ip_address_sv)
c2654555
CBW
752 int af
753 SV * ip_address_sv
754 CODE:
036d8bd4
SP
755#ifdef HAS_INETNTOP
756 STRLEN addrlen, struct_size;
a5addb16 757#ifdef AF_INET6
036d8bd4
SP
758 struct in6_addr addr;
759 char str[INET6_ADDRSTRLEN];
a5addb16
PG
760#else
761 struct in_addr addr;
762 char str[INET_ADDRSTRLEN];
763#endif
036d8bd4
SP
764 char *ip_address = SvPV(ip_address_sv, addrlen);
765
a5addb16
PG
766 struct_size = sizeof(addr);
767
c2654555 768 if (af != AF_INET
a5addb16
PG
769#ifdef AF_INET6
770 && af != AF_INET6
771#endif
c2654555
CBW
772 ) {
773 croak("Bad address family for %s, got %d, should be"
a5addb16 774#ifdef AF_INET6
c2654555 775 " either AF_INET or AF_INET6",
a5addb16 776#else
c2654555 777 " AF_INET",
a5addb16 778#endif
c2654555
CBW
779 "Socket::inet_ntop", af);
780 }
036d8bd4 781
c2654555 782 Copy(ip_address, &addr, sizeof addr, char);
a5addb16 783 inet_ntop(af, &addr, str, sizeof str);
036d8bd4 784
c2654555 785 ST(0) = sv_2mortal(newSVpvn(str, strlen(str)));
036d8bd4 786#else
c2654555 787 ST(0) = (SV*)not_here("inet_ntop");
036d8bd4
SP
788#endif
789
790void
791inet_pton(af, host)
c2654555
CBW
792 int af
793 const char * host
794 CODE:
036d8bd4 795#ifdef HAS_INETPTON
c2654555 796 int ok;
a5addb16
PG
797#ifdef AF_INET6
798 struct in6_addr ip_address;
799#else
800 struct in_addr ip_address;
801#endif
802
c2654555 803 if (af != AF_INET
a5addb16 804#ifdef AF_INET6
c2654555 805 && af != AF_INET6
a5addb16 806#endif
c2654555 807 ) {
a5addb16
PG
808 croak("Bad address family for %s, got %d, should be"
809#ifdef AF_INET6
c2654555 810 " either AF_INET or AF_INET6",
a5addb16 811#else
c2654555 812 " AF_INET",
a5addb16 813#endif
c2654555
CBW
814 "Socket::inet_pton", af);
815 }
816 ok = (*host != '\0') && inet_pton(af, host, &ip_address);
036d8bd4 817
c2654555
CBW
818 ST(0) = sv_newmortal();
819 if (ok) {
820 sv_setpvn( ST(0), (char *)&ip_address, sizeof(ip_address) );
821 }
036d8bd4 822#else
c2654555 823 ST(0) = (SV*)not_here("inet_pton");
036d8bd4 824#endif
4f5bb87f
PLE
825
826void
827pack_ipv6_mreq(addr, interface)
828 SV * addr
829 unsigned int interface
830 CODE:
831 {
832#ifdef AF_INET6
833 struct ipv6_mreq mreq;
834 char * addrbytes;
835 STRLEN addrlen;
836 if (DO_UTF8(addr) && !sv_utf8_downgrade(addr, 1))
c2654555 837 croak("Wide character in %s", "Socket::pack_ipv6_mreq");
4f5bb87f 838 addrbytes = SvPVbyte(addr, addrlen);
c2654555
CBW
839 if (addrlen != sizeof(mreq.ipv6mr_multiaddr))
840 croak("Bad arg length %s, length is %d, should be %d",
841 "Socket::pack_ipv6_mreq", addrlen, sizeof(mreq.ipv6mr_multiaddr));
4f5bb87f
PLE
842 Zero(&mreq, sizeof(mreq), char);
843 Copy(addrbytes, &mreq.ipv6mr_multiaddr, sizeof(mreq.ipv6mr_multiaddr), char);
844 mreq.ipv6mr_interface = interface;
c2654555 845 ST(0) = sv_2mortal(newSVpvn((char *)&mreq, sizeof(mreq)));
4f5bb87f
PLE
846#else
847 ST(0) = (SV*)not_here("pack_ipv6_mreq");
848#endif
849 }
850
851void
852unpack_ipv6_mreq(mreq_sv)
853 SV * mreq_sv
854 PPCODE:
855 {
856#ifdef AF_INET6
857 struct ipv6_mreq mreq;
858 STRLEN mreqlen;
859 char * mreqbytes = SvPVbyte(mreq_sv, mreqlen);
860 if (mreqlen != sizeof(mreq))
c2654555
CBW
861 croak("Bad arg length for %s, length is %d, should be %d",
862 "Socket::unpack_ipv6_mreq", mreqlen, sizeof(mreq));
4f5bb87f
PLE
863 Copy(mreqbytes, &mreq, sizeof(mreq), char);
864 EXTEND(SP, 2);
865 mPUSHp((char *)&mreq.ipv6mr_multiaddr, sizeof(mreq.ipv6mr_multiaddr));
866 mPUSHi(mreq.ipv6mr_interface);
867#else
868 not_here("unpack_ipv6_mreq");
869#endif
870 }