1 #define PERL_NO_GET_CONTEXT
9 # include <sys/types.h>
11 #if !defined(ultrix) /* Avoid double definition. */
12 # include <sys/socket.h>
14 #if defined(USE_SOCKS) && defined(I_SOCKS)
18 # define PF_INET AF_INET
19 # define PF_UNIX AF_UNIX
25 /* XXX Configure test for <netinet/in_systm.h needed XXX */
26 #if defined(NeXT) || defined(__NeXT__)
27 # include <netinet/in_systm.h>
29 #if defined(__sgi) && !defined(AF_LINK) && defined(PF_LINK) && PF_LINK == AF_LNK
32 #if defined(I_NETINET_IN) || defined(__ultrix__)
33 # include <netinet/in.h>
35 #if defined(I_NETINET_IP)
36 # include <netinet/ip.h>
39 # if !defined(ultrix) /* Avoid double definition. */
44 # include <arpa/inet.h>
47 # include <netinet/tcp.h>
50 #if defined(WIN32) && !defined(UNDER_CE)
51 # include <ws2tcpip.h>
55 int inet_pton(int af, const char *src, void *dst)
57 struct sockaddr_storage ss;
58 int size = sizeof(ss);
59 char src_copy[INET6_ADDRSTRLEN+1];
61 ZeroMemory(&ss, sizeof(ss));
62 /* stupid non-const API */
63 strncpy(src_copy, src, INET6_ADDRSTRLEN+1);
64 src_copy[INET6_ADDRSTRLEN] = 0;
66 if (WSAStringToAddress(src_copy, af, NULL, (struct sockaddr *)&ss, &size) != 0)
71 *(struct in_addr *)dst = ((struct sockaddr_in *)&ss)->sin_addr;
74 *(struct in6_addr *)dst = ((struct sockaddr_in6 *)&ss)->sin6_addr;
79 const char *inet_ntop(int af, const void *src, char *dst, socklen_t size)
81 struct sockaddr_storage ss;
82 unsigned long s = size;
84 ZeroMemory(&ss, sizeof(ss));
89 ((struct sockaddr_in *)&ss)->sin_addr = *(struct in_addr *)src;
92 ((struct sockaddr_in6 *)&ss)->sin6_addr = *(struct in6_addr *)src;
98 /* cannot directly use &size because of strict aliasing rules */
99 if (WSAAddressToString((struct sockaddr *)&ss, sizeof(ss), NULL, dst, &s) != 0)
111 NETINET_DEFINE_CONTEXT
115 # include <sys/uio.h>
127 # define INADDR_NONE 0xffffffff
128 #endif /* INADDR_NONE */
129 #ifndef INADDR_BROADCAST
130 # define INADDR_BROADCAST 0xffffffff
131 #endif /* INADDR_BROADCAST */
132 #ifndef INADDR_LOOPBACK
133 # define INADDR_LOOPBACK 0x7F000001
134 #endif /* INADDR_LOOPBACK */
136 #ifndef C_ARRAY_LENGTH
137 #define C_ARRAY_LENGTH(arr) (sizeof(arr) / sizeof(*(arr)))
138 #endif /* !C_ARRAY_LENGTH */
140 #ifndef PERL_UNUSED_VAR
141 # define PERL_UNUSED_VAR(x) ((void)x)
142 #endif /* !PERL_UNUSED_VAR */
144 #ifndef PERL_UNUSED_ARG
145 # define PERL_UNUSED_ARG(x) PERL_UNUSED_VAR(x)
146 #endif /* !PERL_UNUSED_ARG */
149 # define Newx(v,n,t) New(0,v,n,t)
153 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
154 # define SvPVx_nolen(sv) ({SV *_sv = (sv); SvPV_nolen(_sv); })
156 # define SvPVx_nolen(sv) ((PL_Sv = (sv)), SvPV_nolen(PL_Sv))
158 #endif /* !SvPVx_nolen */
161 # define croak_sv(sv) croak(SvPVx_nolen(sv))
165 # define hv_stores(hv, keystr, val) \
166 hv_store(hv, ""keystr"", sizeof(keystr)-1, val, 0)
167 #endif /* !hv_stores */
169 #ifndef newSVpvn_flags
170 # define newSVpvn_flags(s,len,flags) my_newSVpvn_flags(aTHX_ s,len,flags)
171 static SV *my_newSVpvn_flags(pTHX_ const char *s, STRLEN len, U32 flags)
173 SV *sv = newSVpvn(s, len);
174 SvFLAGS(sv) |= (flags & SVf_UTF8);
175 return (flags & SVs_TEMP) ? sv_2mortal(sv) : sv;
177 #endif /* !newSVpvn_flags */
180 # define SvRV_set(sv, val) (SvRV(sv) = (val))
181 #endif /* !SvRV_set */
184 # define SvPV_nomg SvPV
185 #endif /* !SvPV_nomg */
188 # define HEK_FLAGS(hek) 0
189 # define HVhek_UTF8 1
190 #endif /* !HEK_FLAGS */
193 /* These magic numbers are arbitrarily chosen (copied from perl core in fact)
194 * and only have to match between this definition and the code that uses them
196 # define HV_FETCH_ISSTORE 0x04
197 # define HV_FETCH_LVALUE 0x10
198 # define hv_common(hv, keysv, key, klen, flags, act, val, hash) \
199 my_hv_common(aTHX_ hv, keysv, key, klen, flags, act, val, hash)
200 static void *my_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
201 int flags, int act, SV *val, U32 hash)
204 * This only handles the usage actually made by the code
205 * generated by ExtUtils::Constant. EU:C really ought to arrange
206 * portability of its generated code itself.
209 keysv = sv_2mortal(newSVpvn(key, klen));
210 if (flags & HVhek_UTF8)
213 if (act == HV_FETCH_LVALUE) {
214 return (void*)hv_fetch_ent(hv, keysv, 1, hash);
215 } else if (act == HV_FETCH_ISSTORE) {
216 return (void*)hv_store_ent(hv, keysv, val, hash);
218 croak("panic: my_hv_common: act=0x%x", act);
221 #endif /* !hv_common */
223 #ifndef hv_common_key_len
224 # define hv_common_key_len(hv, key, kl, act, val, hash) \
225 my_hv_common_key_len(aTHX_ hv, key, kl, act, val, hash)
226 static void *my_hv_common_key_len(pTHX_ HV *hv, const char *key, I32 kl,
227 int act, SV *val, U32 hash)
238 return hv_common(hv, NULL, key, klen, flags, act, val, hash);
240 #endif /* !hv_common_key_len */
243 # define mPUSHi(i) sv_setiv_mg(PUSHs(sv_newmortal()), (IV)(i))
246 # define mPUSHp(p,l) sv_setpvn_mg(PUSHs(sv_newmortal()), (p), (l))
249 # define mPUSHs(s) PUSHs(sv_2mortal(s))
254 # define newCONSTSUB(stash, name, val) my_newCONSTSUB(aTHX_ stash, name, val)
255 static CV *my_newCONSTSUB(pTHX_ HV *stash, char *name, SV *val)
258 * This has to satisfy code generated by ExtUtils::Constant.
259 * It depends on the 5.8+ layout of constant subs. It has
260 * two calls to newCONSTSUB(): one for real constants, and one
261 * for undefined constants. In the latter case, it turns the
262 * initially-generated constant subs into something else, and
263 * it needs the return value from newCONSTSUB() which Perl 5.6
268 Perl_newCONSTSUB(aTHX_ stash, name, val);
270 SAVESPTR(PL_curstash);
272 gv = gv_fetchpv(name, 0, SVt_PVCV);
275 CvXSUBANY(cv).any_ptr = &PL_sv_undef;
278 # define CvCONST_off(cv) my_CvCONST_off(aTHX_ cv)
279 static void my_CvCONST_off(pTHX_ CV *cv)
285 #endif /* !CvCONST_on */
287 #ifndef HAS_INET_ATON
290 * Check whether "cp" is a valid ascii representation
291 * of an Internet address and convert to a binary address.
292 * Returns 1 if the address is valid, 0 if not.
293 * This replaces inet_addr, the return value from which
294 * cannot distinguish between failure and a local broadcast address.
297 my_inet_aton(register const char *cp, struct in_addr *addr)
305 unsigned int parts[4];
306 register unsigned int *pp = parts;
312 * Collect number up to ".".
313 * Values are specified as for C:
314 * 0x=hex, 0=octal, other=decimal.
318 if (*++cp == 'x' || *cp == 'X')
323 while ((c = *cp) != '\0') {
325 val = (val * base) + (c - '0');
329 if (base == 16 && (s=strchr(PL_hexdigit,c))) {
331 ((s - PL_hexdigit) & 15);
341 * a.b.c (with c treated as 16-bits)
342 * a.b (with b treated as 24 bits)
344 if (pp >= parts + 3 || val > 0xff)
351 * Check for trailing characters.
353 if (*cp && !isSPACE(*cp))
356 * Concoct the address according to
357 * the number of parts specified.
359 nparts = pp - parts + 1; /* force to an int for switch() */
362 case 1: /* a -- 32 bits */
365 case 2: /* a.b -- 8.24 bits */
368 val |= parts[0] << 24;
371 case 3: /* a.b.c -- 8.8.16 bits */
374 val |= (parts[0] << 24) | (parts[1] << 16);
377 case 4: /* a.b.c.d -- 8.8.8.8 bits */
380 val |= (parts[0] << 24) | (parts[1] << 16) | (parts[2] << 8);
383 addr->s_addr = htonl(val);
388 #define inet_aton my_inet_aton
390 #endif /* ! HAS_INET_ATON */
392 /* These are not gni() constants; they're extensions for the perl API */
393 /* The definitions in Socket.pm and Socket.xs must match */
394 #define NIx_NOHOST (1 << 0)
395 #define NIx_NOSERV (1 << 1)
397 /* On Windows, ole2.h defines a macro called "interface". We don't need that,
398 * and it will complicate the variables in pack_ip_mreq() etc. (RT87389)
402 /* STRUCT_OFFSET should have come from from perl.h, but if not,
403 * roll our own (not using offsetof() since that is C99). */
404 #ifndef STRUCT_OFFSET
405 # define STRUCT_OFFSET(s,m) (Size_t)(&(((s *)0)->m))
409 not_here(const char *s)
411 croak("Socket::%s not implemented on this architecture", s);
415 #define PERL_IN_ADDR_S_ADDR_SIZE 4
418 * Bad assumptions possible here.
420 * Bad Assumption 1: struct in_addr has no other fields
421 * than the s_addr (which is the field we care about
422 * in here, really). However, we can be fed either 4-byte
423 * addresses (from pack("N", ...), or va.b.c.d, or ...),
424 * or full struct in_addrs (from e.g. pack_sockaddr_in()),
425 * which may or may not be 4 bytes in size.
427 * Bad Assumption 2: the s_addr field is a simple type
428 * (such as an int, u_int32_t). It can be a bit field,
429 * in which case using & (address-of) on it or taking sizeof()
430 * wouldn't go over too well. (Those are not attempted
431 * now but in case someone thinks to change the below code
432 * to use addr.s_addr instead of addr, you have been warned.)
434 * Bad Assumption 3: the s_addr is the first field in
435 * an in_addr, or that its bytes are the first bytes in
438 * These bad assumptions are wrong in UNICOS which has
439 * struct in_addr { struct { u_long st_addr:32; } s_da };
440 * #define s_addr s_da.st_addr
441 * and u_long is 64 bits.
445 #include "const-c.inc"
447 #ifdef HAS_GETADDRINFO
448 static SV *err_to_SV(pTHX_ int err)
450 SV *ret = sv_newmortal();
451 (void) SvUPGRADE(ret, SVt_PVNV);
454 const char *error = gai_strerror(err);
455 sv_setpv(ret, error);
461 SvIV_set(ret, err); SvIOK_on(ret);
466 static void xs_getaddrinfo(pTHX_ CV *cv)
474 char *hostname = NULL;
475 char *servicename = NULL;
477 struct addrinfo hints_s;
478 struct addrinfo *res;
479 struct addrinfo *res_iter;
485 croak("Usage: Socket::getaddrinfo(host, service, hints)");
495 service = &PL_sv_undef;
506 hostname = SvPV_nomg(host, len);
513 servicename = SvPV_nomg(service, len);
518 Zero(&hints_s, sizeof(hints_s), char);
519 hints_s.ai_family = PF_UNSPEC;
521 if(hints && SvOK(hints)) {
525 if(!SvROK(hints) || SvTYPE(SvRV(hints)) != SVt_PVHV)
526 croak("hints is not a HASH reference");
528 hintshash = (HV*)SvRV(hints);
530 if((valp = hv_fetch(hintshash, "flags", 5, 0)) != NULL && SvOK(*valp))
531 hints_s.ai_flags = SvIV(*valp);
532 if((valp = hv_fetch(hintshash, "family", 6, 0)) != NULL && SvOK(*valp))
533 hints_s.ai_family = SvIV(*valp);
534 if((valp = hv_fetch(hintshash, "socktype", 8, 0)) != NULL && SvOK(*valp))
535 hints_s.ai_socktype = SvIV(*valp);
536 if((valp = hv_fetch(hintshash, "protocol", 8, 0)) != NULL && SvOK(*valp))
537 hints_s.ai_protocol = SvIV(*valp);
540 err = getaddrinfo(hostname, servicename, &hints_s, &res);
542 XPUSHs(err_to_SV(aTHX_ err));
548 for(res_iter = res; res_iter; res_iter = res_iter->ai_next) {
549 HV *res_hv = newHV();
551 (void)hv_stores(res_hv, "family", newSViv(res_iter->ai_family));
552 (void)hv_stores(res_hv, "socktype", newSViv(res_iter->ai_socktype));
553 (void)hv_stores(res_hv, "protocol", newSViv(res_iter->ai_protocol));
555 (void)hv_stores(res_hv, "addr", newSVpvn((char*)res_iter->ai_addr, res_iter->ai_addrlen));
557 if(res_iter->ai_canonname)
558 (void)hv_stores(res_hv, "canonname", newSVpv(res_iter->ai_canonname, 0));
560 (void)hv_stores(res_hv, "canonname", newSV(0));
562 XPUSHs(sv_2mortal(newRV_noinc((SV*)res_hv)));
572 #ifdef HAS_GETNAMEINFO
573 static void xs_getnameinfo(pTHX_ CV *cv)
583 char *sa; /* we'll cast to struct sockaddr * when necessary */
587 int want_host, want_serv;
590 if(items < 1 || items > 3)
591 croak("Usage: Socket::getnameinfo(addr, flags=0, xflags=0)");
606 xflags = SvIV(ST(2));
608 want_host = !(xflags & NIx_NOHOST);
609 want_serv = !(xflags & NIx_NOSERV);
612 croak("addr is not a string");
614 addr_len = SvCUR(addr);
616 /* We need to ensure the sockaddr is aligned, because a random SvPV might
617 * not be due to SvOOK */
618 Newx(sa, addr_len, char);
619 Copy(SvPV_nolen(addr), sa, addr_len, char);
620 #ifdef HAS_SOCKADDR_SA_LEN
621 ((struct sockaddr *)sa)->sa_len = addr_len;
624 err = getnameinfo((struct sockaddr *)sa, addr_len,
625 want_host ? host : NULL, want_host ? sizeof(host) : 0,
626 want_serv ? serv : NULL, want_serv ? sizeof(serv) : 0,
631 XPUSHs(err_to_SV(aTHX_ err));
636 XPUSHs(want_host ? sv_2mortal(newSVpv(host, 0)) : &PL_sv_undef);
637 XPUSHs(want_serv ? sv_2mortal(newSVpv(serv, 0)) : &PL_sv_undef);
643 MODULE = Socket PACKAGE = Socket
645 INCLUDE: const-xs.inc
648 #ifdef HAS_GETADDRINFO
649 newXS("Socket::getaddrinfo", xs_getaddrinfo, __FILE__);
651 #ifdef HAS_GETNAMEINFO
652 newXS("Socket::getnameinfo", xs_getnameinfo, __FILE__);
660 struct in_addr ip_address;
661 struct hostent * phe;
663 if ((*host != '\0') && inet_aton(host, &ip_address)) {
664 ST(0) = sv_2mortal(newSVpvn((char *)&ip_address, sizeof(ip_address)));
668 phe = gethostbyname(host);
669 if (phe && phe->h_addrtype == AF_INET && phe->h_length == 4) {
670 ST(0) = sv_2mortal(newSVpvn((char *)phe->h_addr, phe->h_length));
678 inet_ntoa(ip_address_sv)
685 if (DO_UTF8(ip_address_sv) && !sv_utf8_downgrade(ip_address_sv, 1))
686 croak("Wide character in %s", "Socket::inet_ntoa");
687 ip_address = SvPVbyte(ip_address_sv, addrlen);
688 if (addrlen == sizeof(addr) || addrlen == 4)
690 (ip_address[0] & 0xFF) << 24 |
691 (ip_address[1] & 0xFF) << 16 |
692 (ip_address[2] & 0xFF) << 8 |
693 (ip_address[3] & 0xFF);
695 croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf,
696 "Socket::inet_ntoa", (UV)addrlen, (UV)sizeof(addr));
697 /* We could use inet_ntoa() but that is broken
698 * in HP-UX + GCC + 64bitint (returns "0.0.0.0"),
699 * so let's use this sprintf() workaround everywhere.
700 * This is also more threadsafe than using inet_ntoa(). */
701 ST(0) = sv_2mortal(Perl_newSVpvf(aTHX_ "%d.%d.%d.%d", /* IPv6? */
702 (int)((addr.s_addr >> 24) & 0xFF),
703 (int)((addr.s_addr >> 16) & 0xFF),
704 (int)((addr.s_addr >> 8) & 0xFF),
705 (int)( addr.s_addr & 0xFF)));
709 sockaddr_family(sockaddr)
713 char *sockaddr_pv = SvPVbyte(sockaddr, sockaddr_len);
715 if (sockaddr_len < STRUCT_OFFSET(struct sockaddr, sa_data))
716 croak("Bad arg length for %s, length is %"UVuf", should be at least %"UVuf,
717 "Socket::sockaddr_family", (UV)sockaddr_len,
718 (UV)STRUCT_OFFSET(struct sockaddr, sa_data));
719 ST(0) = sv_2mortal(newSViv(((struct sockaddr*)sockaddr_pv)->sa_family));
722 pack_sockaddr_un(pathname)
727 struct sockaddr_un sun_ad; /* fear using sun */
732 Zero(&sun_ad, sizeof(sun_ad), char);
733 sun_ad.sun_family = AF_UNIX;
734 pathname_pv = SvPV(pathname,len);
735 if (len > sizeof(sun_ad.sun_path))
736 len = sizeof(sun_ad.sun_path);
737 # ifdef OS2 /* Name should start with \socket\ and contain backslashes! */
742 if (pathname_pv[0] != '/' && pathname_pv[0] != '\\')
743 croak("Relative UNIX domain socket name '%s' unsupported",
746 || pathname_pv[7] != '/' && pathname_pv[7] != '\\'
747 || !strnicmp(pathname_pv + 1, "socket", 6))
750 off = 0; /* Preserve names starting with \socket\ */
751 Copy("\\socket", sun_ad.sun_path, off, char);
752 Copy(pathname_pv, sun_ad.sun_path + off, len, char);
754 s = sun_ad.sun_path + off - 1;
760 # else /* !( defined OS2 ) */
761 Copy(pathname_pv, sun_ad.sun_path, len, char);
763 if (0) not_here("dummy");
764 if (len > 1 && sun_ad.sun_path[0] == '\0') {
765 /* Linux-style abstract-namespace socket.
766 * The name is not a file name, but an array of arbitrary
767 * character, starting with \0 and possibly including \0s,
768 * therefore the length of the structure must denote the
769 * end of that character array */
770 addr_len = (char *)&(sun_ad.sun_path) - (char *)&sun_ad + len;
772 addr_len = sizeof(sun_ad);
774 # ifdef HAS_SOCKADDR_SA_LEN
775 sun_ad.sun_len = addr_len;
777 ST(0) = sv_2mortal(newSVpvn((char *)&sun_ad, addr_len));
779 ST(0) = (SV*)not_here("pack_sockaddr_un");
785 unpack_sockaddr_un(sun_sv)
790 struct sockaddr_un addr;
792 char * sun_ad = SvPVbyte(sun_sv,sockaddrlen);
794 # if defined(__linux__) || defined(HAS_SOCKADDR_SA_LEN)
795 /* On Linux or *BSD sockaddrlen on sockets returned by accept, recvfrom,
796 getpeername and getsockname is not equal to sizeof(addr). */
797 if (sockaddrlen < sizeof(addr)) {
798 Copy(sun_ad, &addr, sockaddrlen, char);
799 Zero(((char*)&addr) + sockaddrlen, sizeof(addr) - sockaddrlen, char);
801 Copy(sun_ad, &addr, sizeof(addr), char);
803 # ifdef HAS_SOCKADDR_SA_LEN
804 /* In this case, sun_len must be checked */
805 if (sockaddrlen != addr.sun_len)
806 croak("Invalid arg sun_len field for %s, length is %"UVuf", but sun_len is %"UVuf,
807 "Socket::unpack_sockaddr_un", (UV)sockaddrlen, (UV)addr.sun_len);
810 if (sockaddrlen != sizeof(addr))
811 croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf,
812 "Socket::unpack_sockaddr_un", (UV)sockaddrlen, (UV)sizeof(addr));
813 Copy(sun_ad, &addr, sizeof(addr), char);
816 if (addr.sun_family != AF_UNIX)
817 croak("Bad address family for %s, got %d, should be %d",
818 "Socket::unpack_sockaddr_un", addr.sun_family, AF_UNIX);
820 if (addr.sun_path[0] == '\0') {
821 /* Linux-style abstract socket address begins with a nul
822 * and can contain nuls. */
823 addr_len = (char *)&addr - (char *)&(addr.sun_path) + sockaddrlen;
827 # if defined(HAS_SOCKADDR_SA_LEN)
828 /* On *BSD sun_path not always ends with a '\0' */
829 int maxlen = addr.sun_len - 2; /* should use STRUCT_OFFSET(struct sockaddr_un, sun_path) instead of 2 */
830 if (maxlen > (int)sizeof(addr.sun_path))
831 maxlen = (int)sizeof(addr.sun_path);
833 const int maxlen = (int)sizeof(addr.sun_path);
835 for (addr_len = 0; addr.sun_path[addr_len]
836 && addr_len < maxlen; addr_len++);
839 ST(0) = sv_2mortal(newSVpvn(addr.sun_path, addr_len));
841 ST(0) = (SV*)not_here("unpack_sockaddr_un");
846 pack_sockaddr_in(port, ip_address_sv)
851 struct sockaddr_in sin;
855 if (DO_UTF8(ip_address_sv) && !sv_utf8_downgrade(ip_address_sv, 1))
856 croak("Wide character in %s", "Socket::pack_sockaddr_in");
857 ip_address = SvPVbyte(ip_address_sv, addrlen);
858 if (addrlen == sizeof(addr) || addrlen == 4)
860 (unsigned int)(ip_address[0] & 0xFF) << 24 |
861 (unsigned int)(ip_address[1] & 0xFF) << 16 |
862 (unsigned int)(ip_address[2] & 0xFF) << 8 |
863 (unsigned int)(ip_address[3] & 0xFF);
865 croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf,
866 "Socket::pack_sockaddr_in",
867 (UV)addrlen, (UV)sizeof(addr));
868 Zero(&sin, sizeof(sin), char);
869 sin.sin_family = AF_INET;
870 sin.sin_port = htons(port);
871 sin.sin_addr.s_addr = htonl(addr.s_addr);
872 # ifdef HAS_SOCKADDR_SA_LEN
873 sin.sin_len = sizeof(sin);
875 ST(0) = sv_2mortal(newSVpvn((char *)&sin, sizeof(sin)));
879 unpack_sockaddr_in(sin_sv)
884 struct sockaddr_in addr;
886 char * sin = SvPVbyte(sin_sv,sockaddrlen);
887 if (sockaddrlen != sizeof(addr)) {
888 croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf,
889 "Socket::unpack_sockaddr_in", (UV)sockaddrlen, (UV)sizeof(addr));
891 Copy(sin, &addr, sizeof(addr), char);
892 if (addr.sin_family != AF_INET) {
893 croak("Bad address family for %s, got %d, should be %d",
894 "Socket::unpack_sockaddr_in", addr.sin_family, AF_INET);
896 ip_address_sv = newSVpvn((char *)&addr.sin_addr, sizeof(addr.sin_addr));
898 if(GIMME_V == G_ARRAY) {
900 mPUSHi(ntohs(addr.sin_port));
901 mPUSHs(ip_address_sv);
904 mPUSHs(ip_address_sv);
909 pack_sockaddr_in6(port, sin6_addr, scope_id=0, flowinfo=0)
912 unsigned long scope_id
913 unsigned long flowinfo
916 #ifdef HAS_SOCKADDR_IN6
917 struct sockaddr_in6 sin6;
920 if (DO_UTF8(sin6_addr) && !sv_utf8_downgrade(sin6_addr, 1))
921 croak("Wide character in %s", "Socket::pack_sockaddr_in6");
922 addrbytes = SvPVbyte(sin6_addr, addrlen);
923 if (addrlen != sizeof(sin6.sin6_addr))
924 croak("Bad arg length %s, length is %"UVuf", should be %"UVuf,
925 "Socket::pack_sockaddr_in6", (UV)addrlen, (UV)sizeof(sin6.sin6_addr));
926 Zero(&sin6, sizeof(sin6), char);
927 sin6.sin6_family = AF_INET6;
928 sin6.sin6_port = htons(port);
929 sin6.sin6_flowinfo = htonl(flowinfo);
930 Copy(addrbytes, &sin6.sin6_addr, sizeof(sin6.sin6_addr), char);
931 # ifdef HAS_SIN6_SCOPE_ID
932 sin6.sin6_scope_id = scope_id;
935 warn("%s cannot represent non-zero scope_id %d",
936 "Socket::pack_sockaddr_in6", scope_id);
938 # ifdef HAS_SOCKADDR_SA_LEN
939 sin6.sin6_len = sizeof(sin6);
941 ST(0) = sv_2mortal(newSVpvn((char *)&sin6, sizeof(sin6)));
943 PERL_UNUSED_VAR(port);
944 PERL_UNUSED_VAR(sin6_addr);
945 ST(0) = (SV*)not_here("pack_sockaddr_in6");
950 unpack_sockaddr_in6(sin6_sv)
954 #ifdef HAS_SOCKADDR_IN6
956 struct sockaddr_in6 sin6;
957 char * addrbytes = SvPVbyte(sin6_sv, addrlen);
959 if (addrlen != sizeof(sin6))
960 croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf,
961 "Socket::unpack_sockaddr_in6", (UV)addrlen, (UV)sizeof(sin6));
962 Copy(addrbytes, &sin6, sizeof(sin6), char);
963 if (sin6.sin6_family != AF_INET6)
964 croak("Bad address family for %s, got %d, should be %d",
965 "Socket::unpack_sockaddr_in6", sin6.sin6_family, AF_INET6);
966 ip_address_sv = newSVpvn((char *)&sin6.sin6_addr, sizeof(sin6.sin6_addr));
968 if(GIMME_V == G_ARRAY) {
970 mPUSHi(ntohs(sin6.sin6_port));
971 mPUSHs(ip_address_sv);
972 # ifdef HAS_SIN6_SCOPE_ID
973 mPUSHi(sin6.sin6_scope_id);
977 mPUSHi(ntohl(sin6.sin6_flowinfo));
980 mPUSHs(ip_address_sv);
983 PERL_UNUSED_VAR(sin6_sv);
984 ST(0) = (SV*)not_here("pack_sockaddr_in6");
989 inet_ntop(af, ip_address_sv)
996 struct in6_addr addr;
997 char str[INET6_ADDRSTRLEN];
1000 char str[INET_ADDRSTRLEN];
1004 if (DO_UTF8(ip_address_sv) && !sv_utf8_downgrade(ip_address_sv, 1))
1005 croak("Wide character in %s", "Socket::inet_ntop");
1007 ip_address = SvPV(ip_address_sv, addrlen);
1012 croak("Bad address length for Socket::inet_ntop on AF_INET;"
1013 " got %"UVuf", should be 4", (UV)addrlen);
1018 croak("Bad address length for Socket::inet_ntop on AF_INET6;"
1019 " got %"UVuf", should be 16", (UV)addrlen);
1023 croak("Bad address family for %s, got %d, should be"
1025 " either AF_INET or AF_INET6",
1029 "Socket::inet_ntop", af);
1032 if(addrlen < sizeof(addr)) {
1033 Copy(ip_address, &addr, addrlen, char);
1034 Zero(((char*)&addr) + addrlen, sizeof(addr) - addrlen, char);
1037 Copy(ip_address, &addr, sizeof addr, char);
1039 inet_ntop(af, &addr, str, sizeof str);
1041 ST(0) = sv_2mortal(newSVpvn(str, strlen(str)));
1043 PERL_UNUSED_VAR(af);
1044 PERL_UNUSED_VAR(ip_address_sv);
1045 ST(0) = (SV*)not_here("inet_ntop");
1057 struct in6_addr ip_address;
1059 struct in_addr ip_address;
1072 croak("Bad address family for %s, got %d, should be"
1074 " either AF_INET or AF_INET6",
1078 "Socket::inet_pton", af);
1080 ok = (*host != '\0') && inet_pton(af, host, &ip_address);
1082 ST(0) = sv_newmortal();
1084 sv_setpvn( ST(0), (char *)&ip_address, addrlen);
1087 PERL_UNUSED_VAR(af);
1088 PERL_UNUSED_VAR(host);
1089 ST(0) = (SV*)not_here("inet_pton");
1093 pack_ip_mreq(multiaddr, interface=&PL_sv_undef)
1099 struct ip_mreq mreq;
1100 char * multiaddrbytes;
1101 char * interfacebytes;
1103 if (DO_UTF8(multiaddr) && !sv_utf8_downgrade(multiaddr, 1))
1104 croak("Wide character in %s", "Socket::pack_ip_mreq");
1105 multiaddrbytes = SvPVbyte(multiaddr, len);
1106 if (len != sizeof(mreq.imr_multiaddr))
1107 croak("Bad arg length %s, length is %"UVuf", should be %"UVuf,
1108 "Socket::pack_ip_mreq", (UV)len, (UV)sizeof(mreq.imr_multiaddr));
1109 Zero(&mreq, sizeof(mreq), char);
1110 Copy(multiaddrbytes, &mreq.imr_multiaddr, sizeof(mreq.imr_multiaddr), char);
1111 if(SvOK(interface)) {
1112 if (DO_UTF8(interface) && !sv_utf8_downgrade(interface, 1))
1113 croak("Wide character in %s", "Socket::pack_ip_mreq");
1114 interfacebytes = SvPVbyte(interface, len);
1115 if (len != sizeof(mreq.imr_interface))
1116 croak("Bad arg length %s, length is %"UVuf", should be %"UVuf,
1117 "Socket::pack_ip_mreq", (UV)len, (UV)sizeof(mreq.imr_interface));
1118 Copy(interfacebytes, &mreq.imr_interface, sizeof(mreq.imr_interface), char);
1121 mreq.imr_interface.s_addr = INADDR_ANY;
1122 ST(0) = sv_2mortal(newSVpvn((char *)&mreq, sizeof(mreq)));
1124 not_here("pack_ip_mreq");
1129 unpack_ip_mreq(mreq_sv)
1134 struct ip_mreq mreq;
1136 char * mreqbytes = SvPVbyte(mreq_sv, mreqlen);
1137 if (mreqlen != sizeof(mreq))
1138 croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf,
1139 "Socket::unpack_ip_mreq", (UV)mreqlen, (UV)sizeof(mreq));
1140 Copy(mreqbytes, &mreq, sizeof(mreq), char);
1142 mPUSHp((char *)&mreq.imr_multiaddr, sizeof(mreq.imr_multiaddr));
1143 mPUSHp((char *)&mreq.imr_interface, sizeof(mreq.imr_interface));
1145 not_here("unpack_ip_mreq");
1150 pack_ip_mreq_source(multiaddr, source, interface=&PL_sv_undef)
1156 #if defined(HAS_IP_MREQ_SOURCE) && defined (IP_ADD_SOURCE_MEMBERSHIP)
1157 struct ip_mreq_source mreq;
1158 char * multiaddrbytes;
1160 char * interfacebytes;
1162 if (DO_UTF8(multiaddr) && !sv_utf8_downgrade(multiaddr, 1))
1163 croak("Wide character in %s", "Socket::pack_ip_mreq_source");
1164 multiaddrbytes = SvPVbyte(multiaddr, len);
1165 if (len != sizeof(mreq.imr_multiaddr))
1166 croak("Bad arg length %s, length is %"UVuf", should be %"UVuf,
1167 "Socket::pack_ip_mreq", (UV)len, (UV)sizeof(mreq.imr_multiaddr));
1168 if (DO_UTF8(source) && !sv_utf8_downgrade(source, 1))
1169 croak("Wide character in %s", "Socket::pack_ip_mreq_source");
1170 if (len != sizeof(mreq.imr_sourceaddr))
1171 croak("Bad arg length %s, length is %"UVuf", should be %"UVuf,
1172 "Socket::pack_ip_mreq", (UV)len, (UV)sizeof(mreq.imr_sourceaddr));
1173 sourcebytes = SvPVbyte(source, len);
1174 Zero(&mreq, sizeof(mreq), char);
1175 Copy(multiaddrbytes, &mreq.imr_multiaddr, sizeof(mreq.imr_multiaddr), char);
1176 Copy(sourcebytes, &mreq.imr_sourceaddr, sizeof(mreq.imr_sourceaddr), char);
1177 if(SvOK(interface)) {
1178 if (DO_UTF8(interface) && !sv_utf8_downgrade(interface, 1))
1179 croak("Wide character in %s", "Socket::pack_ip_mreq");
1180 interfacebytes = SvPVbyte(interface, len);
1181 if (len != sizeof(mreq.imr_interface))
1182 croak("Bad arg length %s, length is %"UVuf", should be %"UVuf,
1183 "Socket::pack_ip_mreq", (UV)len, (UV)sizeof(mreq.imr_interface));
1184 Copy(interfacebytes, &mreq.imr_interface, sizeof(mreq.imr_interface), char);
1187 mreq.imr_interface.s_addr = INADDR_ANY;
1188 ST(0) = sv_2mortal(newSVpvn((char *)&mreq, sizeof(mreq)));
1190 PERL_UNUSED_VAR(multiaddr);
1191 PERL_UNUSED_VAR(source);
1192 not_here("pack_ip_mreq_source");
1197 unpack_ip_mreq_source(mreq_sv)
1201 #if defined(HAS_IP_MREQ_SOURCE) && defined (IP_ADD_SOURCE_MEMBERSHIP)
1202 struct ip_mreq_source mreq;
1204 char * mreqbytes = SvPVbyte(mreq_sv, mreqlen);
1205 if (mreqlen != sizeof(mreq))
1206 croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf,
1207 "Socket::unpack_ip_mreq_source", (UV)mreqlen, (UV)sizeof(mreq));
1208 Copy(mreqbytes, &mreq, sizeof(mreq), char);
1210 mPUSHp((char *)&mreq.imr_multiaddr, sizeof(mreq.imr_multiaddr));
1211 mPUSHp((char *)&mreq.imr_sourceaddr, sizeof(mreq.imr_sourceaddr));
1212 mPUSHp((char *)&mreq.imr_interface, sizeof(mreq.imr_interface));
1214 PERL_UNUSED_VAR(mreq_sv);
1215 not_here("unpack_ip_mreq_source");
1220 pack_ipv6_mreq(multiaddr, ifindex)
1222 unsigned int ifindex
1225 #ifdef HAS_IPV6_MREQ
1226 struct ipv6_mreq mreq;
1227 char * multiaddrbytes;
1229 if (DO_UTF8(multiaddr) && !sv_utf8_downgrade(multiaddr, 1))
1230 croak("Wide character in %s", "Socket::pack_ipv6_mreq");
1231 multiaddrbytes = SvPVbyte(multiaddr, len);
1232 if (len != sizeof(mreq.ipv6mr_multiaddr))
1233 croak("Bad arg length %s, length is %"UVuf", should be %"UVuf,
1234 "Socket::pack_ipv6_mreq", (UV)len, (UV)sizeof(mreq.ipv6mr_multiaddr));
1235 Zero(&mreq, sizeof(mreq), char);
1236 Copy(multiaddrbytes, &mreq.ipv6mr_multiaddr, sizeof(mreq.ipv6mr_multiaddr), char);
1237 mreq.ipv6mr_interface = ifindex;
1238 ST(0) = sv_2mortal(newSVpvn((char *)&mreq, sizeof(mreq)));
1240 PERL_UNUSED_VAR(multiaddr);
1241 PERL_UNUSED_VAR(ifindex);
1242 not_here("pack_ipv6_mreq");
1247 unpack_ipv6_mreq(mreq_sv)
1251 #ifdef HAS_IPV6_MREQ
1252 struct ipv6_mreq mreq;
1254 char * mreqbytes = SvPVbyte(mreq_sv, mreqlen);
1255 if (mreqlen != sizeof(mreq))
1256 croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf,
1257 "Socket::unpack_ipv6_mreq", (UV)mreqlen, (UV)sizeof(mreq));
1258 Copy(mreqbytes, &mreq, sizeof(mreq), char);
1260 mPUSHp((char *)&mreq.ipv6mr_multiaddr, sizeof(mreq.ipv6mr_multiaddr));
1261 mPUSHi(mreq.ipv6mr_interface);
1263 PERL_UNUSED_VAR(mreq_sv);
1264 not_here("unpack_ipv6_mreq");