Commit | Line | Data |
---|---|---|
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 | 34 | #endif |
a5c69419 AP |
35 | #if defined(I_NETINET_IP) |
36 | # include <netinet/ip.h> | |
37 | #endif | |
046cc26c | 38 | #ifdef I_NETDB |
c2654555 | 39 | # if !defined(ultrix) /* Avoid double definition. */ |
87edd446 JH |
40 | # include <netdb.h> |
41 | # endif | |
046cc26c CB |
42 | #endif |
43 | #ifdef I_ARPA_INET | |
9cc6feab | 44 | # include <arpa/inet.h> |
046cc26c CB |
45 | #endif |
46 | #ifdef I_NETINET_TCP | |
9cc6feab | 47 | # include <netinet/tcp.h> |
8e07c86e | 48 | #endif |
a0d0e21e | 49 | |
406cccc2 | 50 | #if defined(WIN32) && !defined(UNDER_CE) |
3be135d8 TC |
51 | # include <ws2tcpip.h> |
52 | #endif | |
53 | ||
0d06df21 | 54 | #ifdef WIN32 |
e45189ae DD |
55 | |
56 | /* VC 6 with its original headers doesn't know about sockaddr_storage, VC 2003 does*/ | |
57 | #ifndef _SS_MAXSIZE | |
58 | ||
59 | # define _SS_MAXSIZE 128 | |
60 | # define _SS_ALIGNSIZE (sizeof(__int64)) | |
61 | ||
62 | # define _SS_PAD1SIZE (_SS_ALIGNSIZE - sizeof (short)) | |
63 | # define _SS_PAD2SIZE (_SS_MAXSIZE - (sizeof (short) + _SS_PAD1SIZE \ | |
64 | + _SS_ALIGNSIZE)) | |
65 | ||
66 | struct sockaddr_storage { | |
67 | short ss_family; | |
68 | char __ss_pad1[_SS_PAD1SIZE]; | |
69 | __int64 __ss_align; | |
70 | char __ss_pad2[_SS_PAD2SIZE]; | |
71 | }; | |
72 | ||
73 | typedef int socklen_t; | |
74 | ||
75 | #define in6_addr in_addr6 | |
76 | ||
77 | #define INET_ADDRSTRLEN 22 | |
78 | #define INET6_ADDRSTRLEN 65 | |
79 | ||
80 | #endif | |
81 | ||
82 | static int inet_pton(int af, const char *src, void *dst) | |
0d06df21 CBW |
83 | { |
84 | struct sockaddr_storage ss; | |
85 | int size = sizeof(ss); | |
e45189ae | 86 | ss.ss_family = af; /* per MSDN */ |
0d06df21 | 87 | |
e45189ae | 88 | if (WSAStringToAddress((char*)src, af, NULL, (struct sockaddr *)&ss, &size) != 0) |
0d06df21 CBW |
89 | return 0; |
90 | ||
91 | switch(af) { | |
92 | case AF_INET: | |
93 | *(struct in_addr *)dst = ((struct sockaddr_in *)&ss)->sin_addr; | |
94 | return 1; | |
95 | case AF_INET6: | |
96 | *(struct in6_addr *)dst = ((struct sockaddr_in6 *)&ss)->sin6_addr; | |
97 | return 1; | |
e45189ae DD |
98 | default: |
99 | WSASetLastError(WSAEAFNOSUPPORT); | |
100 | return -1; | |
0d06df21 CBW |
101 | } |
102 | } | |
103 | ||
e45189ae | 104 | static const char *inet_ntop(int af, const void *src, char *dst, socklen_t size) |
0d06df21 CBW |
105 | { |
106 | struct sockaddr_storage ss; | |
107 | unsigned long s = size; | |
108 | ||
109 | ZeroMemory(&ss, sizeof(ss)); | |
110 | ss.ss_family = af; | |
111 | ||
112 | switch(af) { | |
113 | case AF_INET: | |
114 | ((struct sockaddr_in *)&ss)->sin_addr = *(struct in_addr *)src; | |
115 | break; | |
116 | case AF_INET6: | |
117 | ((struct sockaddr_in6 *)&ss)->sin6_addr = *(struct in6_addr *)src; | |
118 | break; | |
119 | default: | |
120 | return NULL; | |
121 | } | |
122 | ||
123 | /* cannot directly use &size because of strict aliasing rules */ | |
124 | if (WSAAddressToString((struct sockaddr *)&ss, sizeof(ss), NULL, dst, &s) != 0) | |
125 | return NULL; | |
126 | else | |
127 | return dst; | |
128 | } | |
129 | ||
130 | #define HAS_INETPTON | |
131 | #define HAS_INETNTOP | |
132 | #endif | |
133 | ||
2986a63f JH |
134 | #ifdef NETWARE |
135 | NETDB_DEFINE_CONTEXT | |
136 | NETINET_DEFINE_CONTEXT | |
137 | #endif | |
138 | ||
6b1016b5 JH |
139 | #ifdef I_SYSUIO |
140 | # include <sys/uio.h> | |
141 | #endif | |
142 | ||
a0d0e21e | 143 | #ifndef AF_NBS |
9cc6feab | 144 | # undef PF_NBS |
a0d0e21e LW |
145 | #endif |
146 | ||
147 | #ifndef AF_X25 | |
9cc6feab | 148 | # undef PF_X25 |
a0d0e21e LW |
149 | #endif |
150 | ||
8e07c86e | 151 | #ifndef INADDR_NONE |
9cc6feab | 152 | # define INADDR_NONE 0xffffffff |
8e07c86e | 153 | #endif /* INADDR_NONE */ |
7e1af8bc | 154 | #ifndef INADDR_BROADCAST |
9cc6feab | 155 | # define INADDR_BROADCAST 0xffffffff |
7e1af8bc | 156 | #endif /* INADDR_BROADCAST */ |
8e07c86e | 157 | #ifndef INADDR_LOOPBACK |
c2654555 | 158 | # define INADDR_LOOPBACK 0x7F000001 |
8e07c86e AD |
159 | #endif /* INADDR_LOOPBACK */ |
160 | ||
b8311542 AB |
161 | #ifndef INET_ADDRSTRLEN |
162 | #define INET_ADDRSTRLEN 16 | |
163 | #endif | |
164 | ||
9dea6244 CBW |
165 | #ifndef C_ARRAY_LENGTH |
166 | #define C_ARRAY_LENGTH(arr) (sizeof(arr) / sizeof(*(arr))) | |
167 | #endif /* !C_ARRAY_LENGTH */ | |
168 | ||
169 | #ifndef PERL_UNUSED_VAR | |
170 | # define PERL_UNUSED_VAR(x) ((void)x) | |
171 | #endif /* !PERL_UNUSED_VAR */ | |
172 | ||
173 | #ifndef PERL_UNUSED_ARG | |
174 | # define PERL_UNUSED_ARG(x) PERL_UNUSED_VAR(x) | |
175 | #endif /* !PERL_UNUSED_ARG */ | |
176 | ||
177 | #ifndef Newx | |
178 | # define Newx(v,n,t) New(0,v,n,t) | |
179 | #endif /* !Newx */ | |
180 | ||
50e79584 SH |
181 | #ifndef SvPVx_nolen |
182 | #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) | |
183 | # define SvPVx_nolen(sv) ({SV *_sv = (sv); SvPV_nolen(_sv); }) | |
184 | #else /* __GNUC__ */ | |
185 | # define SvPVx_nolen(sv) ((PL_Sv = (sv)), SvPV_nolen(PL_Sv)) | |
186 | #endif /* __GNU__ */ | |
187 | #endif /* !SvPVx_nolen */ | |
188 | ||
4c3d8e12 | 189 | #ifndef croak_sv |
17673bf5 | 190 | # define croak_sv(sv) croak(SvPVx_nolen(sv)) |
4c3d8e12 PE |
191 | #endif |
192 | ||
9dea6244 CBW |
193 | #ifndef hv_stores |
194 | # define hv_stores(hv, keystr, val) \ | |
195 | hv_store(hv, ""keystr"", sizeof(keystr)-1, val, 0) | |
196 | #endif /* !hv_stores */ | |
c2654555 | 197 | |
9dea6244 CBW |
198 | #ifndef newSVpvn_flags |
199 | # define newSVpvn_flags(s,len,flags) my_newSVpvn_flags(aTHX_ s,len,flags) | |
37b1de1b | 200 | static SV *my_newSVpvn_flags(pTHX_ const char *s, STRLEN len, U32 flags) |
c2654555 CBW |
201 | { |
202 | SV *sv = newSVpvn(s, len); | |
203 | SvFLAGS(sv) |= (flags & SVf_UTF8); | |
204 | return (flags & SVs_TEMP) ? sv_2mortal(sv) : sv; | |
205 | } | |
9dea6244 | 206 | #endif /* !newSVpvn_flags */ |
37b1de1b | 207 | |
9dea6244 CBW |
208 | #ifndef SvRV_set |
209 | # define SvRV_set(sv, val) (SvRV(sv) = (val)) | |
210 | #endif /* !SvRV_set */ | |
211 | ||
212 | #ifndef SvPV_nomg | |
213 | # define SvPV_nomg SvPV | |
214 | #endif /* !SvPV_nomg */ | |
215 | ||
216 | #ifndef HEK_FLAGS | |
217 | # define HEK_FLAGS(hek) 0 | |
218 | # define HVhek_UTF8 1 | |
219 | #endif /* !HEK_FLAGS */ | |
220 | ||
221 | #ifndef hv_common | |
222 | /* These magic numbers are arbitrarily chosen (copied from perl core in fact) | |
223 | * and only have to match between this definition and the code that uses them | |
224 | */ | |
225 | # define HV_FETCH_ISSTORE 0x04 | |
226 | # define HV_FETCH_LVALUE 0x10 | |
227 | # define hv_common(hv, keysv, key, klen, flags, act, val, hash) \ | |
228 | my_hv_common(aTHX_ hv, keysv, key, klen, flags, act, val, hash) | |
229 | static void *my_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, | |
230 | int flags, int act, SV *val, U32 hash) | |
231 | { | |
232 | /* | |
233 | * This only handles the usage actually made by the code | |
234 | * generated by ExtUtils::Constant. EU:C really ought to arrange | |
235 | * portability of its generated code itself. | |
236 | */ | |
237 | if (!keysv) { | |
238 | keysv = sv_2mortal(newSVpvn(key, klen)); | |
239 | if (flags & HVhek_UTF8) | |
240 | SvUTF8_on(keysv); | |
241 | } | |
242 | if (act == HV_FETCH_LVALUE) { | |
243 | return (void*)hv_fetch_ent(hv, keysv, 1, hash); | |
244 | } else if (act == HV_FETCH_ISSTORE) { | |
245 | return (void*)hv_store_ent(hv, keysv, val, hash); | |
246 | } else { | |
247 | croak("panic: my_hv_common: act=0x%x", act); | |
248 | } | |
249 | } | |
250 | #endif /* !hv_common */ | |
251 | ||
252 | #ifndef hv_common_key_len | |
253 | # define hv_common_key_len(hv, key, kl, act, val, hash) \ | |
254 | my_hv_common_key_len(aTHX_ hv, key, kl, act, val, hash) | |
255 | static void *my_hv_common_key_len(pTHX_ HV *hv, const char *key, I32 kl, | |
256 | int act, SV *val, U32 hash) | |
257 | { | |
258 | STRLEN klen; | |
259 | int flags; | |
260 | if (kl < 0) { | |
261 | klen = -kl; | |
262 | flags = HVhek_UTF8; | |
263 | } else { | |
264 | klen = kl; | |
265 | flags = 0; | |
266 | } | |
267 | return hv_common(hv, NULL, key, klen, flags, act, val, hash); | |
268 | } | |
269 | #endif /* !hv_common_key_len */ | |
270 | ||
271 | #ifndef mPUSHi | |
272 | # define mPUSHi(i) sv_setiv_mg(PUSHs(sv_newmortal()), (IV)(i)) | |
273 | #endif /* !mPUSHi */ | |
274 | #ifndef mPUSHp | |
275 | # define mPUSHp(p,l) sv_setpvn_mg(PUSHs(sv_newmortal()), (p), (l)) | |
276 | #endif /* !mPUSHp */ | |
aff163d9 SH |
277 | #ifndef mPUSHs |
278 | # define mPUSHs(s) PUSHs(sv_2mortal(s)) | |
279 | #endif /* !mPUSHs */ | |
9dea6244 CBW |
280 | |
281 | #ifndef CvCONST_on | |
282 | # undef newCONSTSUB | |
283 | # define newCONSTSUB(stash, name, val) my_newCONSTSUB(aTHX_ stash, name, val) | |
284 | static CV *my_newCONSTSUB(pTHX_ HV *stash, char *name, SV *val) | |
285 | { | |
286 | /* | |
287 | * This has to satisfy code generated by ExtUtils::Constant. | |
288 | * It depends on the 5.8+ layout of constant subs. It has | |
289 | * two calls to newCONSTSUB(): one for real constants, and one | |
290 | * for undefined constants. In the latter case, it turns the | |
291 | * initially-generated constant subs into something else, and | |
292 | * it needs the return value from newCONSTSUB() which Perl 5.6 | |
293 | * doesn't provide. | |
294 | */ | |
295 | GV *gv; | |
296 | CV *cv; | |
297 | Perl_newCONSTSUB(aTHX_ stash, name, val); | |
298 | ENTER; | |
299 | SAVESPTR(PL_curstash); | |
300 | PL_curstash = stash; | |
301 | gv = gv_fetchpv(name, 0, SVt_PVCV); | |
302 | cv = GvCV(gv); | |
303 | LEAVE; | |
304 | CvXSUBANY(cv).any_ptr = &PL_sv_undef; | |
305 | return cv; | |
306 | } | |
307 | # define CvCONST_off(cv) my_CvCONST_off(aTHX_ cv) | |
308 | static void my_CvCONST_off(pTHX_ CV *cv) | |
309 | { | |
310 | op_free(CvROOT(cv)); | |
311 | CvROOT(cv) = NULL; | |
312 | CvSTART(cv) = NULL; | |
313 | } | |
314 | #endif /* !CvCONST_on */ | |
c2654555 | 315 | |
7e1af8bc | 316 | #ifndef HAS_INET_ATON |
317 | ||
a062834f | 318 | /* |
7e1af8bc | 319 | * Check whether "cp" is a valid ascii representation |
320 | * of an Internet address and convert to a binary address. | |
321 | * Returns 1 if the address is valid, 0 if not. | |
322 | * This replaces inet_addr, the return value from which | |
323 | * cannot distinguish between failure and a local broadcast address. | |
324 | */ | |
325 | static int | |
f0f333f4 | 326 | my_inet_aton(register const char *cp, struct in_addr *addr) |
7e1af8bc | 327 | { |
c5be433b | 328 | dTHX; |
0caed002 | 329 | register U32 val; |
7e1af8bc | 330 | register int base; |
331 | register char c; | |
332 | int nparts; | |
333 | const char *s; | |
334 | unsigned int parts[4]; | |
335 | register unsigned int *pp = parts; | |
336 | ||
c2654555 | 337 | if (!cp || !*cp) |
0caed002 | 338 | return 0; |
7e1af8bc | 339 | for (;;) { |
340 | /* | |
882ce583 | 341 | * Collect number up to ".". |
7e1af8bc | 342 | * Values are specified as for C: |
343 | * 0x=hex, 0=octal, other=decimal. | |
344 | */ | |
345 | val = 0; base = 10; | |
346 | if (*cp == '0') { | |
347 | if (*++cp == 'x' || *cp == 'X') | |
348 | base = 16, cp++; | |
349 | else | |
350 | base = 8; | |
351 | } | |
352 | while ((c = *cp) != '\0') { | |
353 | if (isDIGIT(c)) { | |
354 | val = (val * base) + (c - '0'); | |
355 | cp++; | |
356 | continue; | |
357 | } | |
3280af22 | 358 | if (base == 16 && (s=strchr(PL_hexdigit,c))) { |
a062834f | 359 | val = (val << 4) + |
3280af22 | 360 | ((s - PL_hexdigit) & 15); |
7e1af8bc | 361 | cp++; |
362 | continue; | |
363 | } | |
364 | break; | |
365 | } | |
366 | if (*cp == '.') { | |
367 | /* | |
368 | * Internet format: | |
369 | * a.b.c.d | |
370 | * a.b.c (with c treated as 16-bits) | |
371 | * a.b (with b treated as 24 bits) | |
372 | */ | |
373 | if (pp >= parts + 3 || val > 0xff) | |
374 | return 0; | |
375 | *pp++ = val, cp++; | |
376 | } else | |
377 | break; | |
378 | } | |
379 | /* | |
380 | * Check for trailing characters. | |
381 | */ | |
382 | if (*cp && !isSPACE(*cp)) | |
383 | return 0; | |
384 | /* | |
385 | * Concoct the address according to | |
386 | * the number of parts specified. | |
387 | */ | |
388 | nparts = pp - parts + 1; /* force to an int for switch() */ | |
389 | switch (nparts) { | |
390 | ||
391 | case 1: /* a -- 32 bits */ | |
392 | break; | |
393 | ||
394 | case 2: /* a.b -- 8.24 bits */ | |
395 | if (val > 0xffffff) | |
396 | return 0; | |
397 | val |= parts[0] << 24; | |
398 | break; | |
399 | ||
400 | case 3: /* a.b.c -- 8.8.16 bits */ | |
401 | if (val > 0xffff) | |
402 | return 0; | |
403 | val |= (parts[0] << 24) | (parts[1] << 16); | |
404 | break; | |
405 | ||
406 | case 4: /* a.b.c.d -- 8.8.8.8 bits */ | |
407 | if (val > 0xff) | |
408 | return 0; | |
409 | val |= (parts[0] << 24) | (parts[1] << 16) | (parts[2] << 8); | |
410 | break; | |
411 | } | |
412 | addr->s_addr = htonl(val); | |
413 | return 1; | |
414 | } | |
415 | ||
416 | #undef inet_aton | |
417 | #define inet_aton my_inet_aton | |
418 | ||
419 | #endif /* ! HAS_INET_ATON */ | |
420 | ||
c2654555 CBW |
421 | /* These are not gni() constants; they're extensions for the perl API */ |
422 | /* The definitions in Socket.pm and Socket.xs must match */ | |
423 | #define NIx_NOHOST (1 << 0) | |
424 | #define NIx_NOSERV (1 << 1) | |
425 | ||
406cccc2 SH |
426 | /* On Windows, ole2.h defines a macro called "interface". We don't need that, |
427 | * and it will complicate the variables in pack_ip_mreq() etc. (RT87389) | |
428 | */ | |
429 | #undef interface | |
430 | ||
c6d5e127 CBW |
431 | /* STRUCT_OFFSET should have come from from perl.h, but if not, |
432 | * roll our own (not using offsetof() since that is C99). */ | |
433 | #ifndef STRUCT_OFFSET | |
434 | # define STRUCT_OFFSET(s,m) (Size_t)(&(((s *)0)->m)) | |
435 | #endif | |
8e07c86e | 436 | |
a0d0e21e | 437 | static int |
d3f5e399 | 438 | not_here(const char *s) |
a0d0e21e LW |
439 | { |
440 | croak("Socket::%s not implemented on this architecture", s); | |
441 | return -1; | |
442 | } | |
443 | ||
2528d3bc JH |
444 | #define PERL_IN_ADDR_S_ADDR_SIZE 4 |
445 | ||
446 | /* | |
447 | * Bad assumptions possible here. | |
448 | * | |
449 | * Bad Assumption 1: struct in_addr has no other fields | |
450 | * than the s_addr (which is the field we care about | |
451 | * in here, really). However, we can be fed either 4-byte | |
452 | * addresses (from pack("N", ...), or va.b.c.d, or ...), | |
453 | * or full struct in_addrs (from e.g. pack_sockaddr_in()), | |
454 | * which may or may not be 4 bytes in size. | |
455 | * | |
456 | * Bad Assumption 2: the s_addr field is a simple type | |
c2654555 | 457 | * (such as an int, u_int32_t). It can be a bit field, |
2528d3bc JH |
458 | * in which case using & (address-of) on it or taking sizeof() |
459 | * wouldn't go over too well. (Those are not attempted | |
460 | * now but in case someone thinks to change the below code | |
461 | * to use addr.s_addr instead of addr, you have been warned.) | |
462 | * | |
463 | * Bad Assumption 3: the s_addr is the first field in | |
464 | * an in_addr, or that its bytes are the first bytes in | |
465 | * an in_addr. | |
466 | * | |
467 | * These bad assumptions are wrong in UNICOS which has | |
468 | * struct in_addr { struct { u_long st_addr:32; } s_da }; | |
469 | * #define s_addr s_da.st_addr | |
470 | * and u_long is 64 bits. | |
471 | * | |
472 | * --jhi */ | |
473 | ||
1cb0fb50 | 474 | #include "const-c.inc" |
8e07c86e | 475 | |
eccda089 PE |
476 | #ifdef HAS_GETADDRINFO |
477 | static SV *err_to_SV(pTHX_ int err) | |
478 | { | |
0f41f5e2 | 479 | SV *ret = sv_newmortal(); |
9dea6244 | 480 | (void) SvUPGRADE(ret, SVt_PVNV); |
eccda089 | 481 | |
0f41f5e2 PE |
482 | if(err) { |
483 | const char *error = gai_strerror(err); | |
484 | sv_setpv(ret, error); | |
485 | } | |
486 | else { | |
487 | sv_setpv(ret, ""); | |
488 | } | |
eccda089 | 489 | |
0f41f5e2 | 490 | SvIV_set(ret, err); SvIOK_on(ret); |
eccda089 | 491 | |
0f41f5e2 | 492 | return ret; |
eccda089 PE |
493 | } |
494 | ||
495 | static void xs_getaddrinfo(pTHX_ CV *cv) | |
496 | { | |
0f41f5e2 PE |
497 | dXSARGS; |
498 | ||
499 | SV *host; | |
500 | SV *service; | |
501 | SV *hints; | |
502 | ||
503 | char *hostname = NULL; | |
504 | char *servicename = NULL; | |
505 | STRLEN len; | |
506 | struct addrinfo hints_s; | |
507 | struct addrinfo *res; | |
508 | struct addrinfo *res_iter; | |
509 | int err; | |
510 | int n_res; | |
511 | ||
9dea6244 | 512 | PERL_UNUSED_ARG(cv); |
0f41f5e2 | 513 | if(items > 3) |
1584259f | 514 | croak("Usage: Socket::getaddrinfo(host, service, hints)"); |
0f41f5e2 PE |
515 | |
516 | SP -= items; | |
517 | ||
518 | if(items < 1) | |
519 | host = &PL_sv_undef; | |
520 | else | |
521 | host = ST(0); | |
522 | ||
523 | if(items < 2) | |
524 | service = &PL_sv_undef; | |
525 | else | |
526 | service = ST(1); | |
527 | ||
528 | if(items < 3) | |
529 | hints = NULL; | |
530 | else | |
531 | hints = ST(2); | |
532 | ||
533 | SvGETMAGIC(host); | |
534 | if(SvOK(host)) { | |
535 | hostname = SvPV_nomg(host, len); | |
536 | if (!len) | |
537 | hostname = NULL; | |
538 | } | |
539 | ||
540 | SvGETMAGIC(service); | |
541 | if(SvOK(service)) { | |
542 | servicename = SvPV_nomg(service, len); | |
543 | if (!len) | |
544 | servicename = NULL; | |
545 | } | |
546 | ||
c2654555 | 547 | Zero(&hints_s, sizeof(hints_s), char); |
0cd14f2e | 548 | hints_s.ai_family = PF_UNSPEC; |
0f41f5e2 PE |
549 | |
550 | if(hints && SvOK(hints)) { | |
551 | HV *hintshash; | |
552 | SV **valp; | |
553 | ||
554 | if(!SvROK(hints) || SvTYPE(SvRV(hints)) != SVt_PVHV) | |
555 | croak("hints is not a HASH reference"); | |
556 | ||
557 | hintshash = (HV*)SvRV(hints); | |
558 | ||
23296748 | 559 | if((valp = hv_fetch(hintshash, "flags", 5, 0)) != NULL && SvOK(*valp)) |
0f41f5e2 | 560 | hints_s.ai_flags = SvIV(*valp); |
23296748 | 561 | if((valp = hv_fetch(hintshash, "family", 6, 0)) != NULL && SvOK(*valp)) |
0f41f5e2 | 562 | hints_s.ai_family = SvIV(*valp); |
23296748 | 563 | if((valp = hv_fetch(hintshash, "socktype", 8, 0)) != NULL && SvOK(*valp)) |
0f41f5e2 | 564 | hints_s.ai_socktype = SvIV(*valp); |
23296748 | 565 | if((valp = hv_fetch(hintshash, "protocol", 8, 0)) != NULL && SvOK(*valp)) |
0f41f5e2 PE |
566 | hints_s.ai_protocol = SvIV(*valp); |
567 | } | |
568 | ||
569 | err = getaddrinfo(hostname, servicename, &hints_s, &res); | |
570 | ||
571 | XPUSHs(err_to_SV(aTHX_ err)); | |
572 | ||
573 | if(err) | |
574 | XSRETURN(1); | |
575 | ||
576 | n_res = 0; | |
577 | for(res_iter = res; res_iter; res_iter = res_iter->ai_next) { | |
578 | HV *res_hv = newHV(); | |
579 | ||
580 | (void)hv_stores(res_hv, "family", newSViv(res_iter->ai_family)); | |
581 | (void)hv_stores(res_hv, "socktype", newSViv(res_iter->ai_socktype)); | |
582 | (void)hv_stores(res_hv, "protocol", newSViv(res_iter->ai_protocol)); | |
583 | ||
584 | (void)hv_stores(res_hv, "addr", newSVpvn((char*)res_iter->ai_addr, res_iter->ai_addrlen)); | |
585 | ||
586 | if(res_iter->ai_canonname) | |
587 | (void)hv_stores(res_hv, "canonname", newSVpv(res_iter->ai_canonname, 0)); | |
588 | else | |
589 | (void)hv_stores(res_hv, "canonname", newSV(0)); | |
590 | ||
591 | XPUSHs(sv_2mortal(newRV_noinc((SV*)res_hv))); | |
592 | n_res++; | |
593 | } | |
594 | ||
595 | freeaddrinfo(res); | |
596 | ||
597 | XSRETURN(1 + n_res); | |
eccda089 PE |
598 | } |
599 | #endif | |
600 | ||
601 | #ifdef HAS_GETNAMEINFO | |
602 | static void xs_getnameinfo(pTHX_ CV *cv) | |
603 | { | |
0f41f5e2 | 604 | dXSARGS; |
eccda089 | 605 | |
0f41f5e2 PE |
606 | SV *addr; |
607 | int flags; | |
c2654555 | 608 | int xflags; |
eccda089 | 609 | |
0f41f5e2 PE |
610 | char host[1024]; |
611 | char serv[256]; | |
612 | char *sa; /* we'll cast to struct sockaddr * when necessary */ | |
613 | STRLEN addr_len; | |
614 | int err; | |
eccda089 | 615 | |
c2654555 CBW |
616 | int want_host, want_serv; |
617 | ||
9dea6244 | 618 | PERL_UNUSED_ARG(cv); |
c2654555 CBW |
619 | if(items < 1 || items > 3) |
620 | croak("Usage: Socket::getnameinfo(addr, flags=0, xflags=0)"); | |
eccda089 | 621 | |
0f41f5e2 | 622 | SP -= items; |
eccda089 | 623 | |
0f41f5e2 | 624 | addr = ST(0); |
17673bf5 | 625 | SvGETMAGIC(addr); |
eccda089 | 626 | |
0f41f5e2 PE |
627 | if(items < 2) |
628 | flags = 0; | |
629 | else | |
630 | flags = SvIV(ST(1)); | |
eccda089 | 631 | |
c2654555 CBW |
632 | if(items < 3) |
633 | xflags = 0; | |
634 | else | |
635 | xflags = SvIV(ST(2)); | |
636 | ||
637 | want_host = !(xflags & NIx_NOHOST); | |
638 | want_serv = !(xflags & NIx_NOSERV); | |
639 | ||
7ec80894 | 640 | if(!SvPOKp(addr)) |
0f41f5e2 | 641 | croak("addr is not a string"); |
eccda089 | 642 | |
0f41f5e2 | 643 | addr_len = SvCUR(addr); |
eccda089 | 644 | |
0f41f5e2 PE |
645 | /* We need to ensure the sockaddr is aligned, because a random SvPV might |
646 | * not be due to SvOOK */ | |
647 | Newx(sa, addr_len, char); | |
648 | Copy(SvPV_nolen(addr), sa, addr_len, char); | |
eccda089 | 649 | #ifdef HAS_SOCKADDR_SA_LEN |
0f41f5e2 | 650 | ((struct sockaddr *)sa)->sa_len = addr_len; |
eccda089 PE |
651 | #endif |
652 | ||
0f41f5e2 | 653 | err = getnameinfo((struct sockaddr *)sa, addr_len, |
c2654555 CBW |
654 | want_host ? host : NULL, want_host ? sizeof(host) : 0, |
655 | want_serv ? serv : NULL, want_serv ? sizeof(serv) : 0, | |
0f41f5e2 | 656 | flags); |
eccda089 | 657 | |
0f41f5e2 | 658 | Safefree(sa); |
eccda089 | 659 | |
0f41f5e2 | 660 | XPUSHs(err_to_SV(aTHX_ err)); |
eccda089 | 661 | |
0f41f5e2 PE |
662 | if(err) |
663 | XSRETURN(1); | |
eccda089 | 664 | |
c2654555 CBW |
665 | XPUSHs(want_host ? sv_2mortal(newSVpv(host, 0)) : &PL_sv_undef); |
666 | XPUSHs(want_serv ? sv_2mortal(newSVpv(serv, 0)) : &PL_sv_undef); | |
eccda089 | 667 | |
0f41f5e2 | 668 | XSRETURN(3); |
eccda089 PE |
669 | } |
670 | #endif | |
671 | ||
a0d0e21e LW |
672 | MODULE = Socket PACKAGE = Socket |
673 | ||
1cb0fb50 | 674 | INCLUDE: const-xs.inc |
8e07c86e | 675 | |
eccda089 PE |
676 | BOOT: |
677 | #ifdef HAS_GETADDRINFO | |
c2654555 | 678 | newXS("Socket::getaddrinfo", xs_getaddrinfo, __FILE__); |
eccda089 PE |
679 | #endif |
680 | #ifdef HAS_GETNAMEINFO | |
c2654555 | 681 | newXS("Socket::getnameinfo", xs_getnameinfo, __FILE__); |
eccda089 PE |
682 | #endif |
683 | ||
8e07c86e AD |
684 | void |
685 | inet_aton(host) | |
686 | char * host | |
687 | CODE: | |
688 | { | |
fbf77aee | 689 | struct in_addr ip_address; |
8e07c86e AD |
690 | struct hostent * phe; |
691 | ||
4596752b | 692 | if ((*host != '\0') && inet_aton(host, &ip_address)) { |
c2654555 | 693 | ST(0) = sv_2mortal(newSVpvn((char *)&ip_address, sizeof(ip_address))); |
4596752b NC |
694 | XSRETURN(1); |
695 | } | |
06a9195c | 696 | |
4596752b NC |
697 | phe = gethostbyname(host); |
698 | if (phe && phe->h_addrtype == AF_INET && phe->h_length == 4) { | |
c2654555 | 699 | ST(0) = sv_2mortal(newSVpvn((char *)phe->h_addr, phe->h_length)); |
4596752b | 700 | XSRETURN(1); |
8e07c86e | 701 | } |
06a9195c | 702 | |
4596752b | 703 | XSRETURN_UNDEF; |
8e07c86e | 704 | } |
8e07c86e AD |
705 | |
706 | void | |
707 | inet_ntoa(ip_address_sv) | |
708 | SV * ip_address_sv | |
709 | CODE: | |
710 | { | |
711 | STRLEN addrlen; | |
712 | struct in_addr addr; | |
1d68b939 JH |
713 | char * ip_address; |
714 | if (DO_UTF8(ip_address_sv) && !sv_utf8_downgrade(ip_address_sv, 1)) | |
c2654555 | 715 | croak("Wide character in %s", "Socket::inet_ntoa"); |
f780604f | 716 | ip_address = SvPVbyte(ip_address_sv, addrlen); |
2528d3bc | 717 | if (addrlen == sizeof(addr) || addrlen == 4) |
c2654555 | 718 | addr.s_addr = |
2528d3bc JH |
719 | (ip_address[0] & 0xFF) << 24 | |
720 | (ip_address[1] & 0xFF) << 16 | | |
721 | (ip_address[2] & 0xFF) << 8 | | |
722 | (ip_address[3] & 0xFF); | |
723 | else | |
9dea6244 CBW |
724 | croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf, |
725 | "Socket::inet_ntoa", (UV)addrlen, (UV)sizeof(addr)); | |
2528d3bc JH |
726 | /* We could use inet_ntoa() but that is broken |
727 | * in HP-UX + GCC + 64bitint (returns "0.0.0.0"), | |
1d88b533 JH |
728 | * so let's use this sprintf() workaround everywhere. |
729 | * This is also more threadsafe than using inet_ntoa(). */ | |
8063d419 | 730 | ST(0) = sv_2mortal(Perl_newSVpvf(aTHX_ "%d.%d.%d.%d", /* IPv6? */ |
17673bf5 CBW |
731 | (int)((addr.s_addr >> 24) & 0xFF), |
732 | (int)((addr.s_addr >> 16) & 0xFF), | |
733 | (int)((addr.s_addr >> 8) & 0xFF), | |
734 | (int)( addr.s_addr & 0xFF))); | |
8e07c86e AD |
735 | } |
736 | ||
737 | void | |
2a84dff3 GA |
738 | sockaddr_family(sockaddr) |
739 | SV * sockaddr | |
740 | PREINIT: | |
741 | STRLEN sockaddr_len; | |
f780604f | 742 | char *sockaddr_pv = SvPVbyte(sockaddr, sockaddr_len); |
2a84dff3 | 743 | CODE: |
c6d5e127 | 744 | if (sockaddr_len < STRUCT_OFFSET(struct sockaddr, sa_data)) |
9dea6244 CBW |
745 | croak("Bad arg length for %s, length is %"UVuf", should be at least %"UVuf, |
746 | "Socket::sockaddr_family", (UV)sockaddr_len, | |
c6d5e127 | 747 | (UV)STRUCT_OFFSET(struct sockaddr, sa_data)); |
2a84dff3 GA |
748 | ST(0) = sv_2mortal(newSViv(((struct sockaddr*)sockaddr_pv)->sa_family)); |
749 | ||
750 | void | |
4633a7c4 | 751 | pack_sockaddr_un(pathname) |
7513c55b | 752 | SV * pathname |
4633a7c4 LW |
753 | CODE: |
754 | { | |
25f94b33 | 755 | #ifdef I_SYS_UN |
4633a7c4 | 756 | struct sockaddr_un sun_ad; /* fear using sun */ |
fcdb74fc | 757 | STRLEN len; |
7513c55b | 758 | char * pathname_pv; |
99f13d4c | 759 | int addr_len; |
202975e6 | 760 | |
c2654555 | 761 | Zero(&sun_ad, sizeof(sun_ad), char); |
4633a7c4 | 762 | sun_ad.sun_family = AF_UNIX; |
7513c55b | 763 | pathname_pv = SvPV(pathname,len); |
20408e3c GS |
764 | if (len > sizeof(sun_ad.sun_path)) |
765 | len = sizeof(sun_ad.sun_path); | |
202975e6 IZ |
766 | # ifdef OS2 /* Name should start with \socket\ and contain backslashes! */ |
767 | { | |
c2654555 CBW |
768 | int off; |
769 | char *s, *e; | |
770 | ||
771 | if (pathname_pv[0] != '/' && pathname_pv[0] != '\\') | |
772 | croak("Relative UNIX domain socket name '%s' unsupported", | |
773 | pathname_pv); | |
774 | else if (len < 8 | |
775 | || pathname_pv[7] != '/' && pathname_pv[7] != '\\' | |
776 | || !strnicmp(pathname_pv + 1, "socket", 6)) | |
777 | off = 7; | |
778 | else | |
779 | off = 0; /* Preserve names starting with \socket\ */ | |
780 | Copy("\\socket", sun_ad.sun_path, off, char); | |
781 | Copy(pathname_pv, sun_ad.sun_path + off, len, char); | |
782 | ||
783 | s = sun_ad.sun_path + off - 1; | |
784 | e = s + len + 1; | |
785 | while (++s < e) | |
786 | if (*s = '/') | |
787 | *s = '\\'; | |
202975e6 | 788 | } |
a062834f | 789 | # else /* !( defined OS2 ) */ |
c2654555 | 790 | Copy(pathname_pv, sun_ad.sun_path, len, char); |
202975e6 | 791 | # endif |
a062834f | 792 | if (0) not_here("dummy"); |
99f13d4c LR |
793 | if (len > 1 && sun_ad.sun_path[0] == '\0') { |
794 | /* Linux-style abstract-namespace socket. | |
795 | * The name is not a file name, but an array of arbitrary | |
796 | * character, starting with \0 and possibly including \0s, | |
797 | * therefore the length of the structure must denote the | |
798 | * end of that character array */ | |
178e6016 | 799 | addr_len = (char *)&(sun_ad.sun_path) - (char *)&sun_ad + len; |
99f13d4c | 800 | } else { |
c2654555 | 801 | addr_len = sizeof(sun_ad); |
99f13d4c | 802 | } |
5897b17c PE |
803 | # ifdef HAS_SOCKADDR_SA_LEN |
804 | sun_ad.sun_len = addr_len; | |
805 | # endif | |
c2654555 | 806 | ST(0) = sv_2mortal(newSVpvn((char *)&sun_ad, addr_len)); |
25f94b33 | 807 | #else |
c2654555 | 808 | ST(0) = (SV*)not_here("pack_sockaddr_un"); |
25f94b33 | 809 | #endif |
c2654555 | 810 | |
4633a7c4 LW |
811 | } |
812 | ||
813 | void | |
814 | unpack_sockaddr_un(sun_sv) | |
815 | SV * sun_sv | |
f13e1b2f | 816 | CODE: |
4633a7c4 | 817 | { |
25f94b33 | 818 | #ifdef I_SYS_UN |
4633a7c4 | 819 | struct sockaddr_un addr; |
fcdb74fc | 820 | STRLEN sockaddrlen; |
f780604f | 821 | char * sun_ad = SvPVbyte(sun_sv,sockaddrlen); |
89904c08 | 822 | int addr_len; |
669d990b SH |
823 | # if defined(__linux__) || defined(HAS_SOCKADDR_SA_LEN) |
824 | /* On Linux or *BSD sockaddrlen on sockets returned by accept, recvfrom, | |
36902e12 | 825 | getpeername and getsockname is not equal to sizeof(addr). */ |
eabcd9c8 A |
826 | if (sockaddrlen < sizeof(addr)) { |
827 | Copy(sun_ad, &addr, sockaddrlen, char); | |
23296748 | 828 | Zero(((char*)&addr) + sockaddrlen, sizeof(addr) - sockaddrlen, char); |
eabcd9c8 A |
829 | } else { |
830 | Copy(sun_ad, &addr, sizeof(addr), char); | |
831 | } | |
669d990b SH |
832 | # ifdef HAS_SOCKADDR_SA_LEN |
833 | /* In this case, sun_len must be checked */ | |
834 | if (sockaddrlen != addr.sun_len) | |
835 | croak("Invalid arg sun_len field for %s, length is %"UVuf", but sun_len is %"UVuf, | |
836 | "Socket::unpack_sockaddr_un", (UV)sockaddrlen, (UV)addr.sun_len); | |
837 | # endif | |
eabcd9c8 | 838 | # else |
c2654555 | 839 | if (sockaddrlen != sizeof(addr)) |
9dea6244 CBW |
840 | croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf, |
841 | "Socket::unpack_sockaddr_un", (UV)sockaddrlen, (UV)sizeof(addr)); | |
c2654555 | 842 | Copy(sun_ad, &addr, sizeof(addr), char); |
eabcd9c8 | 843 | # endif |
4633a7c4 | 844 | |
c2654555 CBW |
845 | if (addr.sun_family != AF_UNIX) |
846 | croak("Bad address family for %s, got %d, should be %d", | |
847 | "Socket::unpack_sockaddr_un", addr.sun_family, AF_UNIX); | |
669d990b | 848 | # ifdef __linux__ |
89904c08 LR |
849 | if (addr.sun_path[0] == '\0') { |
850 | /* Linux-style abstract socket address begins with a nul | |
851 | * and can contain nuls. */ | |
178e6016 | 852 | addr_len = (char *)&addr - (char *)&(addr.sun_path) + sockaddrlen; |
669d990b SH |
853 | } else |
854 | # endif | |
855 | { | |
856 | # if defined(HAS_SOCKADDR_SA_LEN) | |
857 | /* On *BSD sun_path not always ends with a '\0' */ | |
c6d5e127 | 858 | int maxlen = addr.sun_len - 2; /* should use STRUCT_OFFSET(struct sockaddr_un, sun_path) instead of 2 */ |
669d990b SH |
859 | if (maxlen > (int)sizeof(addr.sun_path)) |
860 | maxlen = (int)sizeof(addr.sun_path); | |
861 | # else | |
862 | const int maxlen = (int)sizeof(addr.sun_path); | |
863 | # endif | |
2d703bea JH |
864 | for (addr_len = 0; addr_len < maxlen |
865 | && addr.sun_path[addr_len]; addr_len++); | |
89904c08 LR |
866 | } |
867 | ||
c2654555 | 868 | ST(0) = sv_2mortal(newSVpvn(addr.sun_path, addr_len)); |
25f94b33 | 869 | #else |
c2654555 | 870 | ST(0) = (SV*)not_here("unpack_sockaddr_un"); |
25f94b33 | 871 | #endif |
4633a7c4 LW |
872 | } |
873 | ||
874 | void | |
2528d3bc | 875 | pack_sockaddr_in(port, ip_address_sv) |
2c129a17 | 876 | unsigned short port |
2528d3bc | 877 | SV * ip_address_sv |
8e07c86e AD |
878 | CODE: |
879 | { | |
880 | struct sockaddr_in sin; | |
2528d3bc JH |
881 | struct in_addr addr; |
882 | STRLEN addrlen; | |
883 | char * ip_address; | |
884 | if (DO_UTF8(ip_address_sv) && !sv_utf8_downgrade(ip_address_sv, 1)) | |
c2654555 | 885 | croak("Wide character in %s", "Socket::pack_sockaddr_in"); |
f780604f | 886 | ip_address = SvPVbyte(ip_address_sv, addrlen); |
2528d3bc | 887 | if (addrlen == sizeof(addr) || addrlen == 4) |
c2654555 | 888 | addr.s_addr = |
17673bf5 CBW |
889 | (unsigned int)(ip_address[0] & 0xFF) << 24 | |
890 | (unsigned int)(ip_address[1] & 0xFF) << 16 | | |
891 | (unsigned int)(ip_address[2] & 0xFF) << 8 | | |
892 | (unsigned int)(ip_address[3] & 0xFF); | |
2528d3bc | 893 | else |
9dea6244 | 894 | croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf, |
2528d3bc | 895 | "Socket::pack_sockaddr_in", |
9dea6244 | 896 | (UV)addrlen, (UV)sizeof(addr)); |
c2654555 | 897 | Zero(&sin, sizeof(sin), char); |
4633a7c4 | 898 | sin.sin_family = AF_INET; |
8e07c86e | 899 | sin.sin_port = htons(port); |
2528d3bc | 900 | sin.sin_addr.s_addr = htonl(addr.s_addr); |
5897b17c | 901 | # ifdef HAS_SOCKADDR_SA_LEN |
c2654555 | 902 | sin.sin_len = sizeof(sin); |
5897b17c | 903 | # endif |
c2654555 | 904 | ST(0) = sv_2mortal(newSVpvn((char *)&sin, sizeof(sin))); |
8e07c86e AD |
905 | } |
906 | ||
907 | void | |
908 | unpack_sockaddr_in(sin_sv) | |
909 | SV * sin_sv | |
910 | PPCODE: | |
911 | { | |
912 | STRLEN sockaddrlen; | |
913 | struct sockaddr_in addr; | |
aff163d9 | 914 | SV *ip_address_sv; |
f780604f | 915 | char * sin = SvPVbyte(sin_sv,sockaddrlen); |
8e07c86e | 916 | if (sockaddrlen != sizeof(addr)) { |
9dea6244 | 917 | croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf, |
c6d5e127 | 918 | "Socket::unpack_sockaddr_in", (UV)sockaddrlen, (UV)sizeof(addr)); |
8e07c86e | 919 | } |
c2654555 CBW |
920 | Copy(sin, &addr, sizeof(addr), char); |
921 | if (addr.sin_family != AF_INET) { | |
4633a7c4 | 922 | croak("Bad address family for %s, got %d, should be %d", |
c2654555 | 923 | "Socket::unpack_sockaddr_in", addr.sin_family, AF_INET); |
a062834f | 924 | } |
aff163d9 | 925 | ip_address_sv = newSVpvn((char *)&addr.sin_addr, sizeof(addr.sin_addr)); |
8e07c86e | 926 | |
aff163d9 SH |
927 | if(GIMME_V == G_ARRAY) { |
928 | EXTEND(SP, 2); | |
929 | mPUSHi(ntohs(addr.sin_port)); | |
930 | mPUSHs(ip_address_sv); | |
931 | } | |
932 | else { | |
933 | mPUSHs(ip_address_sv); | |
934 | } | |
8e07c86e | 935 | } |
036d8bd4 SP |
936 | |
937 | void | |
9987e04d PE |
938 | pack_sockaddr_in6(port, sin6_addr, scope_id=0, flowinfo=0) |
939 | unsigned short port | |
940 | SV * sin6_addr | |
941 | unsigned long scope_id | |
942 | unsigned long flowinfo | |
943 | CODE: | |
944 | { | |
9dea6244 | 945 | #ifdef HAS_SOCKADDR_IN6 |
9987e04d PE |
946 | struct sockaddr_in6 sin6; |
947 | char * addrbytes; | |
948 | STRLEN addrlen; | |
949 | if (DO_UTF8(sin6_addr) && !sv_utf8_downgrade(sin6_addr, 1)) | |
c2654555 | 950 | croak("Wide character in %s", "Socket::pack_sockaddr_in6"); |
9987e04d | 951 | addrbytes = SvPVbyte(sin6_addr, addrlen); |
c2654555 | 952 | if (addrlen != sizeof(sin6.sin6_addr)) |
9dea6244 CBW |
953 | croak("Bad arg length %s, length is %"UVuf", should be %"UVuf, |
954 | "Socket::pack_sockaddr_in6", (UV)addrlen, (UV)sizeof(sin6.sin6_addr)); | |
9987e04d PE |
955 | Zero(&sin6, sizeof(sin6), char); |
956 | sin6.sin6_family = AF_INET6; | |
957 | sin6.sin6_port = htons(port); | |
958 | sin6.sin6_flowinfo = htonl(flowinfo); | |
959 | Copy(addrbytes, &sin6.sin6_addr, sizeof(sin6.sin6_addr), char); | |
24b8ee2e | 960 | # ifdef HAS_SIN6_SCOPE_ID |
9987e04d | 961 | sin6.sin6_scope_id = scope_id; |
79c932f0 | 962 | # else |
c2654555 | 963 | if (scope_id != 0) |
79c932f0 | 964 | warn("%s cannot represent non-zero scope_id %d", |
c2654555 | 965 | "Socket::pack_sockaddr_in6", scope_id); |
24b8ee2e | 966 | # endif |
5897b17c PE |
967 | # ifdef HAS_SOCKADDR_SA_LEN |
968 | sin6.sin6_len = sizeof(sin6); | |
969 | # endif | |
c2654555 | 970 | ST(0) = sv_2mortal(newSVpvn((char *)&sin6, sizeof(sin6))); |
9987e04d | 971 | #else |
17673bf5 CBW |
972 | PERL_UNUSED_VAR(port); |
973 | PERL_UNUSED_VAR(sin6_addr); | |
9987e04d PE |
974 | ST(0) = (SV*)not_here("pack_sockaddr_in6"); |
975 | #endif | |
976 | } | |
977 | ||
978 | void | |
979 | unpack_sockaddr_in6(sin6_sv) | |
980 | SV * sin6_sv | |
981 | PPCODE: | |
982 | { | |
9dea6244 | 983 | #ifdef HAS_SOCKADDR_IN6 |
9987e04d PE |
984 | STRLEN addrlen; |
985 | struct sockaddr_in6 sin6; | |
986 | char * addrbytes = SvPVbyte(sin6_sv, addrlen); | |
aff163d9 | 987 | SV *ip_address_sv; |
9987e04d | 988 | if (addrlen != sizeof(sin6)) |
9dea6244 CBW |
989 | croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf, |
990 | "Socket::unpack_sockaddr_in6", (UV)addrlen, (UV)sizeof(sin6)); | |
9987e04d | 991 | Copy(addrbytes, &sin6, sizeof(sin6), char); |
c2654555 CBW |
992 | if (sin6.sin6_family != AF_INET6) |
993 | croak("Bad address family for %s, got %d, should be %d", | |
994 | "Socket::unpack_sockaddr_in6", sin6.sin6_family, AF_INET6); | |
aff163d9 SH |
995 | ip_address_sv = newSVpvn((char *)&sin6.sin6_addr, sizeof(sin6.sin6_addr)); |
996 | ||
997 | if(GIMME_V == G_ARRAY) { | |
998 | EXTEND(SP, 4); | |
999 | mPUSHi(ntohs(sin6.sin6_port)); | |
1000 | mPUSHs(ip_address_sv); | |
24b8ee2e | 1001 | # ifdef HAS_SIN6_SCOPE_ID |
aff163d9 | 1002 | mPUSHi(sin6.sin6_scope_id); |
24b8ee2e | 1003 | # else |
aff163d9 | 1004 | mPUSHi(0); |
24b8ee2e | 1005 | # endif |
aff163d9 SH |
1006 | mPUSHi(ntohl(sin6.sin6_flowinfo)); |
1007 | } | |
1008 | else { | |
1009 | mPUSHs(ip_address_sv); | |
1010 | } | |
9987e04d | 1011 | #else |
17673bf5 | 1012 | PERL_UNUSED_VAR(sin6_sv); |
9987e04d PE |
1013 | ST(0) = (SV*)not_here("pack_sockaddr_in6"); |
1014 | #endif | |
1015 | } | |
1016 | ||
1017 | void | |
036d8bd4 | 1018 | inet_ntop(af, ip_address_sv) |
c2654555 CBW |
1019 | int af |
1020 | SV * ip_address_sv | |
1021 | CODE: | |
036d8bd4 | 1022 | #ifdef HAS_INETNTOP |
5b05192f | 1023 | STRLEN addrlen; |
a5addb16 | 1024 | #ifdef AF_INET6 |
036d8bd4 SP |
1025 | struct in6_addr addr; |
1026 | char str[INET6_ADDRSTRLEN]; | |
a5addb16 PG |
1027 | #else |
1028 | struct in_addr addr; | |
1029 | char str[INET_ADDRSTRLEN]; | |
1030 | #endif | |
eabcd9c8 A |
1031 | char *ip_address; |
1032 | ||
1033 | if (DO_UTF8(ip_address_sv) && !sv_utf8_downgrade(ip_address_sv, 1)) | |
1034 | croak("Wide character in %s", "Socket::inet_ntop"); | |
1035 | ||
1036 | ip_address = SvPV(ip_address_sv, addrlen); | |
036d8bd4 | 1037 | |
aff163d9 SH |
1038 | switch(af) { |
1039 | case AF_INET: | |
1040 | if(addrlen != 4) | |
1041 | croak("Bad address length for Socket::inet_ntop on AF_INET;" | |
5b05192f | 1042 | " got %"UVuf", should be 4", (UV)addrlen); |
aff163d9 | 1043 | break; |
a5addb16 | 1044 | #ifdef AF_INET6 |
aff163d9 SH |
1045 | case AF_INET6: |
1046 | if(addrlen != 16) | |
1047 | croak("Bad address length for Socket::inet_ntop on AF_INET6;" | |
5b05192f | 1048 | " got %"UVuf", should be 16", (UV)addrlen); |
aff163d9 | 1049 | break; |
a5addb16 | 1050 | #endif |
aff163d9 | 1051 | default: |
c2654555 | 1052 | croak("Bad address family for %s, got %d, should be" |
a5addb16 | 1053 | #ifdef AF_INET6 |
c2654555 | 1054 | " either AF_INET or AF_INET6", |
a5addb16 | 1055 | #else |
c2654555 | 1056 | " AF_INET", |
a5addb16 | 1057 | #endif |
c2654555 CBW |
1058 | "Socket::inet_ntop", af); |
1059 | } | |
036d8bd4 | 1060 | |
5b05192f CBW |
1061 | if(addrlen < sizeof(addr)) { |
1062 | Copy(ip_address, &addr, addrlen, char); | |
1063 | Zero(((char*)&addr) + addrlen, sizeof(addr) - addrlen, char); | |
1064 | } | |
1065 | else { | |
1066 | Copy(ip_address, &addr, sizeof addr, char); | |
1067 | } | |
a5addb16 | 1068 | inet_ntop(af, &addr, str, sizeof str); |
036d8bd4 | 1069 | |
c2654555 | 1070 | ST(0) = sv_2mortal(newSVpvn(str, strlen(str))); |
036d8bd4 | 1071 | #else |
17673bf5 CBW |
1072 | PERL_UNUSED_VAR(af); |
1073 | PERL_UNUSED_VAR(ip_address_sv); | |
c2654555 | 1074 | ST(0) = (SV*)not_here("inet_ntop"); |
036d8bd4 SP |
1075 | #endif |
1076 | ||
1077 | void | |
1078 | inet_pton(af, host) | |
c2654555 CBW |
1079 | int af |
1080 | const char * host | |
1081 | CODE: | |
036d8bd4 | 1082 | #ifdef HAS_INETPTON |
c2654555 | 1083 | int ok; |
eabcd9c8 | 1084 | int addrlen = 0; |
a5addb16 PG |
1085 | #ifdef AF_INET6 |
1086 | struct in6_addr ip_address; | |
1087 | #else | |
1088 | struct in_addr ip_address; | |
1089 | #endif | |
1090 | ||
eabcd9c8 A |
1091 | switch(af) { |
1092 | case AF_INET: | |
1093 | addrlen = 4; | |
1094 | break; | |
a5addb16 | 1095 | #ifdef AF_INET6 |
eabcd9c8 A |
1096 | case AF_INET6: |
1097 | addrlen = 16; | |
1098 | break; | |
a5addb16 | 1099 | #endif |
eabcd9c8 | 1100 | default: |
a5addb16 PG |
1101 | croak("Bad address family for %s, got %d, should be" |
1102 | #ifdef AF_INET6 | |
c2654555 | 1103 | " either AF_INET or AF_INET6", |
a5addb16 | 1104 | #else |
c2654555 | 1105 | " AF_INET", |
a5addb16 | 1106 | #endif |
c2654555 CBW |
1107 | "Socket::inet_pton", af); |
1108 | } | |
1109 | ok = (*host != '\0') && inet_pton(af, host, &ip_address); | |
036d8bd4 | 1110 | |
c2654555 CBW |
1111 | ST(0) = sv_newmortal(); |
1112 | if (ok) { | |
eabcd9c8 | 1113 | sv_setpvn( ST(0), (char *)&ip_address, addrlen); |
c2654555 | 1114 | } |
036d8bd4 | 1115 | #else |
17673bf5 CBW |
1116 | PERL_UNUSED_VAR(af); |
1117 | PERL_UNUSED_VAR(host); | |
c2654555 | 1118 | ST(0) = (SV*)not_here("inet_pton"); |
036d8bd4 | 1119 | #endif |
4f5bb87f PE |
1120 | |
1121 | void | |
3be135d8 TC |
1122 | pack_ip_mreq(multiaddr, interface=&PL_sv_undef) |
1123 | SV * multiaddr | |
1124 | SV * interface | |
1125 | CODE: | |
1126 | { | |
1127 | #ifdef HAS_IP_MREQ | |
1128 | struct ip_mreq mreq; | |
1129 | char * multiaddrbytes; | |
1130 | char * interfacebytes; | |
1131 | STRLEN len; | |
1132 | if (DO_UTF8(multiaddr) && !sv_utf8_downgrade(multiaddr, 1)) | |
1133 | croak("Wide character in %s", "Socket::pack_ip_mreq"); | |
1134 | multiaddrbytes = SvPVbyte(multiaddr, len); | |
1135 | if (len != sizeof(mreq.imr_multiaddr)) | |
1136 | croak("Bad arg length %s, length is %"UVuf", should be %"UVuf, | |
1137 | "Socket::pack_ip_mreq", (UV)len, (UV)sizeof(mreq.imr_multiaddr)); | |
1138 | Zero(&mreq, sizeof(mreq), char); | |
1139 | Copy(multiaddrbytes, &mreq.imr_multiaddr, sizeof(mreq.imr_multiaddr), char); | |
1140 | if(SvOK(interface)) { | |
1141 | if (DO_UTF8(interface) && !sv_utf8_downgrade(interface, 1)) | |
1142 | croak("Wide character in %s", "Socket::pack_ip_mreq"); | |
1143 | interfacebytes = SvPVbyte(interface, len); | |
1144 | if (len != sizeof(mreq.imr_interface)) | |
1145 | croak("Bad arg length %s, length is %"UVuf", should be %"UVuf, | |
1146 | "Socket::pack_ip_mreq", (UV)len, (UV)sizeof(mreq.imr_interface)); | |
1147 | Copy(interfacebytes, &mreq.imr_interface, sizeof(mreq.imr_interface), char); | |
1148 | } | |
1149 | else | |
1150 | mreq.imr_interface.s_addr = INADDR_ANY; | |
1151 | ST(0) = sv_2mortal(newSVpvn((char *)&mreq, sizeof(mreq))); | |
1152 | #else | |
1153 | not_here("pack_ip_mreq"); | |
1154 | #endif | |
1155 | } | |
1156 | ||
1157 | void | |
1158 | unpack_ip_mreq(mreq_sv) | |
1159 | SV * mreq_sv | |
1160 | PPCODE: | |
1161 | { | |
1162 | #ifdef HAS_IP_MREQ | |
1163 | struct ip_mreq mreq; | |
1164 | STRLEN mreqlen; | |
1165 | char * mreqbytes = SvPVbyte(mreq_sv, mreqlen); | |
1166 | if (mreqlen != sizeof(mreq)) | |
1167 | croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf, | |
1168 | "Socket::unpack_ip_mreq", (UV)mreqlen, (UV)sizeof(mreq)); | |
1169 | Copy(mreqbytes, &mreq, sizeof(mreq), char); | |
1170 | EXTEND(SP, 2); | |
1171 | mPUSHp((char *)&mreq.imr_multiaddr, sizeof(mreq.imr_multiaddr)); | |
1172 | mPUSHp((char *)&mreq.imr_interface, sizeof(mreq.imr_interface)); | |
1173 | #else | |
1174 | not_here("unpack_ip_mreq"); | |
1175 | #endif | |
1176 | } | |
1177 | ||
1178 | void | |
d4ada64a SH |
1179 | pack_ip_mreq_source(multiaddr, source, interface=&PL_sv_undef) |
1180 | SV * multiaddr | |
1181 | SV * source | |
1182 | SV * interface | |
1183 | CODE: | |
1184 | { | |
aff163d9 | 1185 | #if defined(HAS_IP_MREQ_SOURCE) && defined (IP_ADD_SOURCE_MEMBERSHIP) |
d4ada64a SH |
1186 | struct ip_mreq_source mreq; |
1187 | char * multiaddrbytes; | |
1188 | char * sourcebytes; | |
1189 | char * interfacebytes; | |
1190 | STRLEN len; | |
1191 | if (DO_UTF8(multiaddr) && !sv_utf8_downgrade(multiaddr, 1)) | |
1192 | croak("Wide character in %s", "Socket::pack_ip_mreq_source"); | |
1193 | multiaddrbytes = SvPVbyte(multiaddr, len); | |
1194 | if (len != sizeof(mreq.imr_multiaddr)) | |
1195 | croak("Bad arg length %s, length is %"UVuf", should be %"UVuf, | |
1196 | "Socket::pack_ip_mreq", (UV)len, (UV)sizeof(mreq.imr_multiaddr)); | |
1197 | if (DO_UTF8(source) && !sv_utf8_downgrade(source, 1)) | |
1198 | croak("Wide character in %s", "Socket::pack_ip_mreq_source"); | |
1199 | if (len != sizeof(mreq.imr_sourceaddr)) | |
1200 | croak("Bad arg length %s, length is %"UVuf", should be %"UVuf, | |
1201 | "Socket::pack_ip_mreq", (UV)len, (UV)sizeof(mreq.imr_sourceaddr)); | |
1202 | sourcebytes = SvPVbyte(source, len); | |
1203 | Zero(&mreq, sizeof(mreq), char); | |
1204 | Copy(multiaddrbytes, &mreq.imr_multiaddr, sizeof(mreq.imr_multiaddr), char); | |
1205 | Copy(sourcebytes, &mreq.imr_sourceaddr, sizeof(mreq.imr_sourceaddr), char); | |
1206 | if(SvOK(interface)) { | |
1207 | if (DO_UTF8(interface) && !sv_utf8_downgrade(interface, 1)) | |
1208 | croak("Wide character in %s", "Socket::pack_ip_mreq"); | |
1209 | interfacebytes = SvPVbyte(interface, len); | |
1210 | if (len != sizeof(mreq.imr_interface)) | |
1211 | croak("Bad arg length %s, length is %"UVuf", should be %"UVuf, | |
1212 | "Socket::pack_ip_mreq", (UV)len, (UV)sizeof(mreq.imr_interface)); | |
1213 | Copy(interfacebytes, &mreq.imr_interface, sizeof(mreq.imr_interface), char); | |
1214 | } | |
1215 | else | |
1216 | mreq.imr_interface.s_addr = INADDR_ANY; | |
1217 | ST(0) = sv_2mortal(newSVpvn((char *)&mreq, sizeof(mreq))); | |
1218 | #else | |
17673bf5 CBW |
1219 | PERL_UNUSED_VAR(multiaddr); |
1220 | PERL_UNUSED_VAR(source); | |
d4ada64a SH |
1221 | not_here("pack_ip_mreq_source"); |
1222 | #endif | |
1223 | } | |
1224 | ||
1225 | void | |
1226 | unpack_ip_mreq_source(mreq_sv) | |
1227 | SV * mreq_sv | |
1228 | PPCODE: | |
1229 | { | |
aff163d9 | 1230 | #if defined(HAS_IP_MREQ_SOURCE) && defined (IP_ADD_SOURCE_MEMBERSHIP) |
d4ada64a SH |
1231 | struct ip_mreq_source mreq; |
1232 | STRLEN mreqlen; | |
1233 | char * mreqbytes = SvPVbyte(mreq_sv, mreqlen); | |
1234 | if (mreqlen != sizeof(mreq)) | |
1235 | croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf, | |
1236 | "Socket::unpack_ip_mreq_source", (UV)mreqlen, (UV)sizeof(mreq)); | |
1237 | Copy(mreqbytes, &mreq, sizeof(mreq), char); | |
1238 | EXTEND(SP, 3); | |
1239 | mPUSHp((char *)&mreq.imr_multiaddr, sizeof(mreq.imr_multiaddr)); | |
1240 | mPUSHp((char *)&mreq.imr_sourceaddr, sizeof(mreq.imr_sourceaddr)); | |
1241 | mPUSHp((char *)&mreq.imr_interface, sizeof(mreq.imr_interface)); | |
1242 | #else | |
17673bf5 | 1243 | PERL_UNUSED_VAR(mreq_sv); |
d4ada64a SH |
1244 | not_here("unpack_ip_mreq_source"); |
1245 | #endif | |
1246 | } | |
1247 | ||
1248 | void | |
406cccc2 | 1249 | pack_ipv6_mreq(multiaddr, ifindex) |
3be135d8 | 1250 | SV * multiaddr |
406cccc2 | 1251 | unsigned int ifindex |
4f5bb87f PE |
1252 | CODE: |
1253 | { | |
9dea6244 | 1254 | #ifdef HAS_IPV6_MREQ |
4f5bb87f | 1255 | struct ipv6_mreq mreq; |
3be135d8 TC |
1256 | char * multiaddrbytes; |
1257 | STRLEN len; | |
1258 | if (DO_UTF8(multiaddr) && !sv_utf8_downgrade(multiaddr, 1)) | |
c2654555 | 1259 | croak("Wide character in %s", "Socket::pack_ipv6_mreq"); |
3be135d8 TC |
1260 | multiaddrbytes = SvPVbyte(multiaddr, len); |
1261 | if (len != sizeof(mreq.ipv6mr_multiaddr)) | |
9dea6244 | 1262 | croak("Bad arg length %s, length is %"UVuf", should be %"UVuf, |
3be135d8 | 1263 | "Socket::pack_ipv6_mreq", (UV)len, (UV)sizeof(mreq.ipv6mr_multiaddr)); |
4f5bb87f | 1264 | Zero(&mreq, sizeof(mreq), char); |
3be135d8 | 1265 | Copy(multiaddrbytes, &mreq.ipv6mr_multiaddr, sizeof(mreq.ipv6mr_multiaddr), char); |
406cccc2 | 1266 | mreq.ipv6mr_interface = ifindex; |
c2654555 | 1267 | ST(0) = sv_2mortal(newSVpvn((char *)&mreq, sizeof(mreq))); |
4f5bb87f | 1268 | #else |
17673bf5 CBW |
1269 | PERL_UNUSED_VAR(multiaddr); |
1270 | PERL_UNUSED_VAR(ifindex); | |
3be135d8 | 1271 | not_here("pack_ipv6_mreq"); |
4f5bb87f PE |
1272 | #endif |
1273 | } | |
1274 | ||
1275 | void | |
1276 | unpack_ipv6_mreq(mreq_sv) | |
1277 | SV * mreq_sv | |
1278 | PPCODE: | |
1279 | { | |
9dea6244 | 1280 | #ifdef HAS_IPV6_MREQ |
4f5bb87f PE |
1281 | struct ipv6_mreq mreq; |
1282 | STRLEN mreqlen; | |
1283 | char * mreqbytes = SvPVbyte(mreq_sv, mreqlen); | |
1284 | if (mreqlen != sizeof(mreq)) | |
9dea6244 CBW |
1285 | croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf, |
1286 | "Socket::unpack_ipv6_mreq", (UV)mreqlen, (UV)sizeof(mreq)); | |
4f5bb87f PE |
1287 | Copy(mreqbytes, &mreq, sizeof(mreq), char); |
1288 | EXTEND(SP, 2); | |
1289 | mPUSHp((char *)&mreq.ipv6mr_multiaddr, sizeof(mreq.ipv6mr_multiaddr)); | |
1290 | mPUSHi(mreq.ipv6mr_interface); | |
1291 | #else | |
17673bf5 | 1292 | PERL_UNUSED_VAR(mreq_sv); |
4f5bb87f PE |
1293 | not_here("unpack_ipv6_mreq"); |
1294 | #endif | |
1295 | } |