File Coverage

Socket.xs
Criterion Covered Total %
statement 276 321 85.9
branch 217 396 54.8
condition n/a
subroutine n/a
pod n/a
total 493 717 68.7


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