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 int
467 0           not_here(const char *s)
468             {
469 0           croak("Socket::%s not implemented on this architecture", s);
470             return -1;
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
831             ", should be %" UVuf,
832             "Socket::inet_ntoa", (UV)addrlen, (UV)sizeof(addr));
833             /* We could use inet_ntoa() but that is broken
834             * in HP-UX + GCC + 64bitint (returns "0.0.0.0"),
835             * so let's use this sprintf() workaround everywhere.
836             * This is also more threadsafe than using inet_ntoa(). */
837 4           ST(0) = sv_2mortal(Perl_newSVpvf(aTHX_ "%d.%d.%d.%d", /* IPv6? */
838             (int)((addr.s_addr >> 24) & 0xFF),
839             (int)((addr.s_addr >> 16) & 0xFF),
840             (int)((addr.s_addr >> 8) & 0xFF),
841             (int)( addr.s_addr & 0xFF)));
842             }
843              
844             void
845             sockaddr_family(sockaddr)
846             SV * sockaddr
847             PREINIT:
848             STRLEN sockaddr_len;
849 5 50         char *sockaddr_pv = SvPVbyte(sockaddr, sockaddr_len);
850             CODE:
851 5 100         if (sockaddr_len < STRUCT_OFFSET(struct sockaddr, sa_data))
852 1           croak("Bad arg length for %s, length is %" UVuf
853             ", should be at least %" UVuf,
854             "Socket::sockaddr_family", (UV)sockaddr_len,
855             (UV)STRUCT_OFFSET(struct sockaddr, sa_data));
856 4           ST(0) = sv_2mortal(newSViv(((struct sockaddr*)sockaddr_pv)->sa_family));
857              
858             void
859             pack_sockaddr_un(pathname)
860             SV * pathname
861             CODE:
862             {
863             #if defined(I_SYS_UN) || defined(WIN32)
864             struct sockaddr_un sun_ad; /* fear using sun */
865             STRLEN len;
866             char * pathname_pv;
867             int addr_len;
868              
869 3 100         if (!SvOK(pathname))
    50          
    50          
870 1           croak("Undefined path for %s", "Socket::pack_sockaddr_un");
871              
872 2           Zero(&sun_ad, sizeof(sun_ad), char);
873 2           sun_ad.sun_family = AF_UNIX;
874 2 50         pathname_pv = SvPVbyte(pathname,len);
875 2 100         if (len > sizeof(sun_ad.sun_path)) {
876 1           warn("Path length (%" UVuf ") is longer than maximum supported length"
877             " (%" UVuf ") and will be truncated",
878             (UV)len, (UV)sizeof(sun_ad.sun_path));
879 1           len = sizeof(sun_ad.sun_path);
880             }
881             # ifdef OS2 /* Name should start with \socket\ and contain backslashes! */
882             {
883             int off;
884             char *s, *e;
885              
886             if (pathname_pv[0] != '/' && pathname_pv[0] != '\\')
887             croak("Relative UNIX domain socket name '%s' unsupported",
888             pathname_pv);
889             else if (len < 8
890             || pathname_pv[7] != '/' && pathname_pv[7] != '\\'
891             || !strnicmp(pathname_pv + 1, "socket", 6))
892             off = 7;
893             else
894             off = 0; /* Preserve names starting with \socket\ */
895             Copy("\\socket", sun_ad.sun_path, off, char);
896             Copy(pathname_pv, sun_ad.sun_path + off, len, char);
897              
898             s = sun_ad.sun_path + off - 1;
899             e = s + len + 1;
900             while (++s < e)
901             if (*s = '/')
902             *s = '\\';
903             }
904             # else /* !( defined OS2 ) */
905 2           Copy(pathname_pv, sun_ad.sun_path, len, char);
906             # endif
907             if (0) not_here("dummy");
908 2 50         if (len > 1 && sun_ad.sun_path[0] == '\0') {
    100          
909             /* Linux-style abstract-namespace socket.
910             * The name is not a file name, but an array of arbitrary
911             * character, starting with \0 and possibly including \0s,
912             * therefore the length of the structure must denote the
913             * end of that character array */
914 1           addr_len = (char *)&(sun_ad.sun_path) - (char *)&sun_ad + len;
915             } else {
916 1           addr_len = sizeof(sun_ad);
917             }
918             # ifdef HAS_SOCKADDR_SA_LEN
919             sun_ad.sun_len = addr_len;
920             # endif
921 2           ST(0) = sv_2mortal(newSVpvn((char *)&sun_ad, addr_len));
922             #else
923             ST(0) = (SV*)not_here("pack_sockaddr_un");
924             #endif
925            
926             }
927              
928             void
929             unpack_sockaddr_un(sun_sv)
930             SV * sun_sv
931             CODE:
932             {
933             #if defined(I_SYS_UN) || defined(WIN32)
934             struct sockaddr_un addr;
935             STRLEN sockaddrlen;
936             char * sun_ad;
937 2           int addr_len = 0;
938 2 100         if (!SvOK(sun_sv))
    50          
    50          
939 1           croak("Undefined address for %s", "Socket::unpack_sockaddr_un");
940 1 50         sun_ad = SvPVbyte(sun_sv,sockaddrlen);
941             # if defined(__linux__) || defined(__CYGWIN__) || defined(HAS_SOCKADDR_SA_LEN)
942             /* On Linux, Cygwin or *BSD sockaddrlen on sockets returned by accept,
943             * recvfrom, getpeername and getsockname is not equal to sizeof(addr). */
944 1 50         if (sockaddrlen < sizeof(addr)) {
945 1           Copy(sun_ad, &addr, sockaddrlen, char);
946 1           Zero(((char*)&addr) + sockaddrlen, sizeof(addr) - sockaddrlen, char);
947             } else {
948 0           Copy(sun_ad, &addr, sizeof(addr), char);
949             }
950             # ifdef HAS_SOCKADDR_SA_LEN
951             /* In this case, sun_len must be checked */
952             if (sockaddrlen != addr.sun_len)
953             croak("Invalid arg sun_len field for %s, length is %" UVuf
954             ", but sun_len is %" UVuf,
955             "Socket::unpack_sockaddr_un", (UV)sockaddrlen, (UV)addr.sun_len);
956             # endif
957             # else
958             if (sockaddrlen != sizeof(addr))
959             croak("Bad arg length for %s, length is %" UVuf
960             ", should be %" UVuf,
961             "Socket::unpack_sockaddr_un", (UV)sockaddrlen, (UV)sizeof(addr));
962             Copy(sun_ad, &addr, sizeof(addr), char);
963             # endif
964              
965 1 50         if (addr.sun_family != AF_UNIX)
966 0           croak("Bad address family for %s, got %d, should be %d",
967 0           "Socket::unpack_sockaddr_un", addr.sun_family, AF_UNIX);
968             # ifdef __linux__
969 1 50         if (addr.sun_path[0] == '\0') {
970             /* Linux-style abstract socket address begins with a nul
971             * and can contain nuls. */
972 1           addr_len = (char *)&addr - (char *)&(addr.sun_path) + sockaddrlen;
973             } else
974             # endif
975             {
976             # if defined(HAS_SOCKADDR_SA_LEN)
977             /* On *BSD sun_path not always ends with a '\0' */
978             int maxlen = addr.sun_len - 2; /* should use STRUCT_OFFSET(struct sockaddr_un, sun_path) instead of 2 */
979             if (maxlen > (int)sizeof(addr.sun_path))
980             maxlen = (int)sizeof(addr.sun_path);
981             # else
982 0           const int maxlen = (int)sizeof(addr.sun_path);
983             # endif
984 0 0         while (addr_len < maxlen && addr.sun_path[addr_len])
    0          
985 0           addr_len++;
986             }
987              
988 1           ST(0) = sv_2mortal(newSVpvn(addr.sun_path, addr_len));
989             #else
990             ST(0) = (SV*)not_here("unpack_sockaddr_un");
991             #endif
992             }
993              
994             void
995             pack_sockaddr_in(port_sv, ip_address_sv)
996             SV * port_sv
997             SV * ip_address_sv
998             CODE:
999             {
1000             struct sockaddr_in sin;
1001             struct in_addr addr;
1002             STRLEN addrlen;
1003 15           unsigned short port = 0;
1004             char * ip_address;
1005 15 100         if (SvOK(port_sv)) {
    50          
    50          
1006 14 50         port = SvUV(port_sv);
1007 14 50         if (SvUV(port_sv) > 0xFFFF)
    100          
1008 1           warn("Port number above 0xFFFF, will be truncated to %d for %s",
1009             port, "Socket::pack_sockaddr_in");
1010             }
1011 15 100         if (!SvOK(ip_address_sv))
    50          
    50          
1012 1           croak("Undefined address for %s", "Socket::pack_sockaddr_in");
1013 14 50         if (DO_UTF8(ip_address_sv) && !sv_utf8_downgrade(ip_address_sv, 1))
    0          
    0          
1014 0           croak("Wide character in %s", "Socket::pack_sockaddr_in");
1015 14 50         ip_address = SvPVbyte(ip_address_sv, addrlen);
1016 14 50         if (addrlen == sizeof(addr) || addrlen == 4)
    0          
1017 14           addr.s_addr =
1018 28           (unsigned int)(ip_address[0] & 0xFF) << 24 |
1019 28           (unsigned int)(ip_address[1] & 0xFF) << 16 |
1020 28           (unsigned int)(ip_address[2] & 0xFF) << 8 |
1021 14           (unsigned int)(ip_address[3] & 0xFF);
1022             else
1023 0           croak("Bad arg length for %s, length is %" UVuf
1024             ", should be %" UVuf,
1025             "Socket::pack_sockaddr_in",
1026             (UV)addrlen, (UV)sizeof(addr));
1027 14           Zero(&sin, sizeof(sin), char);
1028 14           sin.sin_family = AF_INET;
1029 14           sin.sin_port = htons(port);
1030 14           sin.sin_addr.s_addr = htonl(addr.s_addr);
1031             # ifdef HAS_SOCKADDR_SA_LEN
1032             sin.sin_len = sizeof(sin);
1033             # endif
1034 14           ST(0) = sv_2mortal(newSVpvn((char *)&sin, sizeof(sin)));
1035             }
1036              
1037             void
1038             unpack_sockaddr_in(sin_sv)
1039             SV * sin_sv
1040             PPCODE:
1041             {
1042             STRLEN sockaddrlen;
1043             struct sockaddr_in addr;
1044             SV *ip_address_sv;
1045             char * sin;
1046 9 100         if (!SvOK(sin_sv))
    50          
    50          
1047 1           croak("Undefined address for %s", "Socket::unpack_sockaddr_in");
1048 8 50         sin = SvPVbyte(sin_sv,sockaddrlen);
1049 8 50         if (sockaddrlen != sizeof(addr)) {
1050 0           croak("Bad arg length for %s, length is %" UVuf
1051             ", should be %" UVuf,
1052             "Socket::unpack_sockaddr_in", (UV)sockaddrlen, (UV)sizeof(addr));
1053             }
1054 8           Copy(sin, &addr, sizeof(addr), char);
1055 8 50         if (addr.sin_family != AF_INET) {
1056 0           croak("Bad address family for %s, got %d, should be %d",
1057 0           "Socket::unpack_sockaddr_in", addr.sin_family, AF_INET);
1058             }
1059 8           ip_address_sv = newSVpvn((char *)&addr.sin_addr, sizeof(addr.sin_addr));
1060              
1061 8 100         if(GIMME_V == G_LIST) {
    100          
1062 7 50         EXTEND(SP, 2);
1063 7           mPUSHi(ntohs(addr.sin_port));
1064 7           mPUSHs(ip_address_sv);
1065             }
1066             else {
1067 1           mPUSHs(ip_address_sv);
1068             }
1069             }
1070              
1071             void
1072             pack_sockaddr_in6(port_sv, sin6_addr, scope_id=0, flowinfo=0)
1073             SV * port_sv
1074             SV * sin6_addr
1075             unsigned long scope_id
1076             unsigned long flowinfo
1077             CODE:
1078             {
1079             #ifdef HAS_SOCKADDR_IN6
1080 5           unsigned short port = 0;
1081             struct sockaddr_in6 sin6;
1082             char * addrbytes;
1083             STRLEN addrlen;
1084 5 100         if (SvOK(port_sv)) {
    50          
    50          
1085 4 50         port = SvUV(port_sv);
1086 4 50         if (SvUV(port_sv) > 0xFFFF)
    100          
1087 1           warn("Port number above 0xFFFF, will be truncated to %d for %s",
1088             port, "Socket::pack_sockaddr_in6");
1089             }
1090 5 100         if (!SvOK(sin6_addr))
    50          
    50          
1091 1           croak("Undefined address for %s", "Socket::pack_sockaddr_in6");
1092 4 50         if (DO_UTF8(sin6_addr) && !sv_utf8_downgrade(sin6_addr, 1))
    0          
    0          
1093 0           croak("Wide character in %s", "Socket::pack_sockaddr_in6");
1094 4 50         addrbytes = SvPVbyte(sin6_addr, addrlen);
1095 4 50         if (addrlen != sizeof(sin6.sin6_addr))
1096 0           croak("Bad arg length %s, length is %" UVuf
1097             ", should be %" UVuf,
1098             "Socket::pack_sockaddr_in6", (UV)addrlen, (UV)sizeof(sin6.sin6_addr));
1099 4           Zero(&sin6, sizeof(sin6), char);
1100 4           sin6.sin6_family = AF_INET6;
1101 4           sin6.sin6_port = htons(port);
1102 4           sin6.sin6_flowinfo = htonl(flowinfo);
1103 4           Copy(addrbytes, &sin6.sin6_addr, sizeof(sin6.sin6_addr), char);
1104             # ifdef HAS_SIN6_SCOPE_ID
1105 4           sin6.sin6_scope_id = scope_id;
1106             # else
1107             if (scope_id != 0)
1108             warn("%s cannot represent non-zero scope_id %d",
1109             "Socket::pack_sockaddr_in6", scope_id);
1110             # endif
1111             # ifdef HAS_SOCKADDR_SA_LEN
1112             sin6.sin6_len = sizeof(sin6);
1113             # endif
1114 4           ST(0) = sv_2mortal(newSVpvn((char *)&sin6, sizeof(sin6)));
1115             #else
1116             PERL_UNUSED_VAR(port_sv);
1117             PERL_UNUSED_VAR(sin6_addr);
1118             ST(0) = (SV*)not_here("pack_sockaddr_in6");
1119             #endif
1120             }
1121              
1122             void
1123             unpack_sockaddr_in6(sin6_sv)
1124             SV * sin6_sv
1125             PPCODE:
1126             {
1127             #ifdef HAS_SOCKADDR_IN6
1128             STRLEN addrlen;
1129             struct sockaddr_in6 sin6;
1130             char * addrbytes;
1131             SV *ip_address_sv;
1132 8 100         if (!SvOK(sin6_sv))
    50          
    50          
1133 1           croak("Undefined address for %s", "Socket::unpack_sockaddr_in6");
1134 7 50         addrbytes = SvPVbyte(sin6_sv, addrlen);
1135 7 50         if (addrlen != sizeof(sin6))
1136 0           croak("Bad arg length for %s, length is %" UVuf
1137             ", should be %" UVuf,
1138             "Socket::unpack_sockaddr_in6", (UV)addrlen, (UV)sizeof(sin6));
1139 7           Copy(addrbytes, &sin6, sizeof(sin6), char);
1140 7 50         if (sin6.sin6_family != AF_INET6)
1141 0           croak("Bad address family for %s, got %d, should be %d",
1142 0           "Socket::unpack_sockaddr_in6", sin6.sin6_family, AF_INET6);
1143 7           ip_address_sv = newSVpvn((char *)&sin6.sin6_addr, sizeof(sin6.sin6_addr));
1144              
1145 7 100         if(GIMME_V == G_LIST) {
    100          
1146 6 50         EXTEND(SP, 4);
1147 6           mPUSHi(ntohs(sin6.sin6_port));
1148 6           mPUSHs(ip_address_sv);
1149             # ifdef HAS_SIN6_SCOPE_ID
1150 6           mPUSHi(sin6.sin6_scope_id);
1151             # else
1152             mPUSHi(0);
1153             # endif
1154 6           mPUSHi(ntohl(sin6.sin6_flowinfo));
1155             }
1156             else {
1157 1           mPUSHs(ip_address_sv);
1158             }
1159             #else
1160             PERL_UNUSED_VAR(sin6_sv);
1161             ST(0) = (SV*)not_here("pack_sockaddr_in6");
1162             #endif
1163             }
1164              
1165             void
1166             inet_ntop(af, ip_address_sv)
1167             int af
1168             SV * ip_address_sv
1169             CODE:
1170             #ifdef HAS_INETNTOP
1171             STRLEN addrlen;
1172             #ifdef AF_INET6
1173             struct in6_addr addr;
1174             char str[INET6_ADDRSTRLEN];
1175             #else
1176             struct in_addr addr;
1177             char str[INET_ADDRSTRLEN];
1178             #endif
1179             char *ip_address;
1180              
1181 6 100         if (DO_UTF8(ip_address_sv) && !sv_utf8_downgrade(ip_address_sv, 1))
    50          
    50          
1182 1           croak("Wide character in %s", "Socket::inet_ntop");
1183              
1184 5 50         ip_address = SvPVbyte(ip_address_sv, addrlen);
1185              
1186 5           switch(af) {
1187             case AF_INET:
1188 3 50         if(addrlen != 4)
1189 0           croak("Bad address length for Socket::inet_ntop on AF_INET;"
1190             " got %" UVuf ", should be 4", (UV)addrlen);
1191 3           break;
1192             #ifdef AF_INET6
1193             case AF_INET6:
1194 2 50         if(addrlen != 16)
1195 0           croak("Bad address length for Socket::inet_ntop on AF_INET6;"
1196             " got %" UVuf ", should be 16", (UV)addrlen);
1197 2           break;
1198             #endif
1199             default:
1200             #ifdef AF_INET6
1201             # define WANT_FAMILY "either AF_INET or AF_INET6"
1202             #else
1203             # define WANT_FAMILY "AF_INET"
1204             #endif
1205 0           croak("Bad address family for %s, got %d, should be " WANT_FAMILY,
1206             "Socket::inet_ntop", af);
1207             #undef WANT_FAMILY
1208             }
1209              
1210 5 100         if(addrlen < sizeof(addr)) {
1211 3           Copy(ip_address, &addr, addrlen, char);
1212 3           Zero(((char*)&addr) + addrlen, sizeof(addr) - addrlen, char);
1213             }
1214             else {
1215 2           Copy(ip_address, &addr, sizeof addr, char);
1216             }
1217 5           inet_ntop(af, &addr, str, sizeof str);
1218              
1219 5           ST(0) = sv_2mortal(newSVpvn(str, strlen(str)));
1220             #else
1221             PERL_UNUSED_VAR(af);
1222             PERL_UNUSED_VAR(ip_address_sv);
1223             ST(0) = (SV*)not_here("inet_ntop");
1224             #endif
1225              
1226             void
1227             inet_pton(af, host)
1228             int af
1229             const char * host
1230             CODE:
1231             #ifdef HAS_INETPTON
1232             int ok;
1233 6           int addrlen = 0;
1234             #ifdef AF_INET6
1235             struct in6_addr ip_address;
1236             #else
1237             struct in_addr ip_address;
1238             #endif
1239              
1240 6           switch(af) {
1241             case AF_INET:
1242 3           addrlen = 4;
1243 3           break;
1244             #ifdef AF_INET6
1245             case AF_INET6:
1246 3           addrlen = 16;
1247 3           break;
1248             #endif
1249             default:
1250             #ifdef AF_INET6
1251             # define WANT_FAMILY "either AF_INET or AF_INET6"
1252             #else
1253             # define WANT_FAMILY "AF_INET"
1254             #endif
1255 0           croak("Bad address family for %s, got %d, should be " WANT_FAMILY, "Socket::inet_pton", af);
1256             #undef WANT_FAMILY
1257             }
1258 6 50         ok = (*host != '\0') && inet_pton(af, host, &ip_address);
    50          
1259              
1260 6           ST(0) = sv_newmortal();
1261 6 50         if (ok) {
1262 6           sv_setpvn( ST(0), (char *)&ip_address, addrlen);
1263             }
1264             #else
1265             PERL_UNUSED_VAR(af);
1266             PERL_UNUSED_VAR(host);
1267             ST(0) = (SV*)not_here("inet_pton");
1268             #endif
1269              
1270             void
1271             pack_ip_mreq(multiaddr, interface=&PL_sv_undef)
1272             SV * multiaddr
1273             SV * interface
1274             CODE:
1275             {
1276             #ifdef HAS_IP_MREQ
1277             struct ip_mreq mreq;
1278             char * multiaddrbytes;
1279             char * interfacebytes;
1280             STRLEN len;
1281 2 50         if (DO_UTF8(multiaddr) && !sv_utf8_downgrade(multiaddr, 1))
    0          
    0          
1282 0           croak("Wide character in %s", "Socket::pack_ip_mreq");
1283 2 50         multiaddrbytes = SvPVbyte(multiaddr, len);
1284 2 50         if (len != sizeof(mreq.imr_multiaddr))
1285 0           croak("Bad arg length %s, length is %" UVuf
1286             ", should be %" UVuf,
1287             "Socket::pack_ip_mreq", (UV)len, (UV)sizeof(mreq.imr_multiaddr));
1288 2           Zero(&mreq, sizeof(mreq), char);
1289 2           Copy(multiaddrbytes, &mreq.imr_multiaddr, sizeof(mreq.imr_multiaddr), char);
1290 2 100         if(SvOK(interface)) {
    50          
    50          
1291 1 50         if (DO_UTF8(interface) && !sv_utf8_downgrade(interface, 1))
    0          
    0          
1292 0           croak("Wide character in %s", "Socket::pack_ip_mreq");
1293 1 50         interfacebytes = SvPVbyte(interface, len);
1294 1 50         if (len != sizeof(mreq.imr_interface))
1295 0           croak("Bad arg length %s, length is %" UVuf
1296             ", should be %" UVuf,
1297             "Socket::pack_ip_mreq", (UV)len, (UV)sizeof(mreq.imr_interface));
1298 1           Copy(interfacebytes, &mreq.imr_interface, sizeof(mreq.imr_interface), char);
1299             }
1300             else
1301 1           mreq.imr_interface.s_addr = INADDR_ANY;
1302 2           ST(0) = sv_2mortal(newSVpvn((char *)&mreq, sizeof(mreq)));
1303             #else
1304             not_here("pack_ip_mreq");
1305             #endif
1306             }
1307              
1308             void
1309             unpack_ip_mreq(mreq_sv)
1310             SV * mreq_sv
1311             PPCODE:
1312             {
1313             #ifdef HAS_IP_MREQ
1314             struct ip_mreq mreq;
1315             STRLEN mreqlen;
1316 2 50         char * mreqbytes = SvPVbyte(mreq_sv, mreqlen);
1317 2 50         if (mreqlen != sizeof(mreq))
1318 0           croak("Bad arg length for %s, length is %" UVuf
1319             ", should be %" UVuf,
1320             "Socket::unpack_ip_mreq", (UV)mreqlen, (UV)sizeof(mreq));
1321 2           Copy(mreqbytes, &mreq, sizeof(mreq), char);
1322 2 50         EXTEND(SP, 2);
1323 2           mPUSHp((char *)&mreq.imr_multiaddr, sizeof(mreq.imr_multiaddr));
1324 2           mPUSHp((char *)&mreq.imr_interface, sizeof(mreq.imr_interface));
1325             #else
1326             not_here("unpack_ip_mreq");
1327             #endif
1328             }
1329              
1330             void
1331             pack_ip_mreq_source(multiaddr, source, interface=&PL_sv_undef)
1332             SV * multiaddr
1333             SV * source
1334             SV * interface
1335             CODE:
1336             {
1337             #if defined(HAS_IP_MREQ_SOURCE) && defined (IP_ADD_SOURCE_MEMBERSHIP)
1338             struct ip_mreq_source mreq;
1339             char * multiaddrbytes;
1340             char * sourcebytes;
1341             char * interfacebytes;
1342             STRLEN len;
1343 1 50         if (DO_UTF8(multiaddr) && !sv_utf8_downgrade(multiaddr, 1))
    0          
    0          
1344 0           croak("Wide character in %s", "Socket::pack_ip_mreq_source");
1345 1 50         multiaddrbytes = SvPVbyte(multiaddr, len);
1346 1 50         if (len != sizeof(mreq.imr_multiaddr))
1347 0           croak("Bad arg length %s, length is %" UVuf
1348             ", should be %" UVuf,
1349             "Socket::pack_ip_mreq", (UV)len, (UV)sizeof(mreq.imr_multiaddr));
1350 1 50         if (DO_UTF8(source) && !sv_utf8_downgrade(source, 1))
    0          
    0          
1351 0           croak("Wide character in %s", "Socket::pack_ip_mreq_source");
1352 1 50         if (len != sizeof(mreq.imr_sourceaddr))
1353 0           croak("Bad arg length %s, length is %" UVuf
1354             ", should be %" UVuf,
1355             "Socket::pack_ip_mreq", (UV)len, (UV)sizeof(mreq.imr_sourceaddr));
1356 1 50         sourcebytes = SvPVbyte(source, len);
1357 1           Zero(&mreq, sizeof(mreq), char);
1358 1           Copy(multiaddrbytes, &mreq.imr_multiaddr, sizeof(mreq.imr_multiaddr), char);
1359 1           Copy(sourcebytes, &mreq.imr_sourceaddr, sizeof(mreq.imr_sourceaddr), char);
1360 1 50         if(SvOK(interface)) {
    0          
    0          
1361 1 50         if (DO_UTF8(interface) && !sv_utf8_downgrade(interface, 1))
    0          
    0          
1362 0           croak("Wide character in %s", "Socket::pack_ip_mreq");
1363 1 50         interfacebytes = SvPVbyte(interface, len);
1364 1 50         if (len != sizeof(mreq.imr_interface))
1365 0           croak("Bad arg length %s, length is %" UVuf
1366             ", should be %" UVuf,
1367             "Socket::pack_ip_mreq", (UV)len, (UV)sizeof(mreq.imr_interface));
1368 1           Copy(interfacebytes, &mreq.imr_interface, sizeof(mreq.imr_interface), char);
1369             }
1370             else
1371 0           mreq.imr_interface.s_addr = INADDR_ANY;
1372 1           ST(0) = sv_2mortal(newSVpvn((char *)&mreq, sizeof(mreq)));
1373             #else
1374             PERL_UNUSED_VAR(multiaddr);
1375             PERL_UNUSED_VAR(source);
1376             not_here("pack_ip_mreq_source");
1377             #endif
1378             }
1379              
1380             void
1381             unpack_ip_mreq_source(mreq_sv)
1382             SV * mreq_sv
1383             PPCODE:
1384             {
1385             #if defined(HAS_IP_MREQ_SOURCE) && defined (IP_ADD_SOURCE_MEMBERSHIP)
1386             struct ip_mreq_source mreq;
1387             STRLEN mreqlen;
1388 1 50         char * mreqbytes = SvPVbyte(mreq_sv, mreqlen);
1389 1 50         if (mreqlen != sizeof(mreq))
1390 0           croak("Bad arg length for %s, length is %" UVuf
1391             ", should be %" UVuf,
1392             "Socket::unpack_ip_mreq_source", (UV)mreqlen, (UV)sizeof(mreq));
1393 1           Copy(mreqbytes, &mreq, sizeof(mreq), char);
1394 1 50         EXTEND(SP, 3);
1395 1           mPUSHp((char *)&mreq.imr_multiaddr, sizeof(mreq.imr_multiaddr));
1396 1           mPUSHp((char *)&mreq.imr_sourceaddr, sizeof(mreq.imr_sourceaddr));
1397 1           mPUSHp((char *)&mreq.imr_interface, sizeof(mreq.imr_interface));
1398             #else
1399             PERL_UNUSED_VAR(mreq_sv);
1400             not_here("unpack_ip_mreq_source");
1401             #endif
1402             }
1403              
1404             void
1405             pack_ipv6_mreq(multiaddr, ifindex)
1406             SV * multiaddr
1407             unsigned int ifindex
1408             CODE:
1409             {
1410             #ifdef HAS_IPV6_MREQ
1411             struct ipv6_mreq mreq;
1412             char * multiaddrbytes;
1413             STRLEN len;
1414 1 50         if (DO_UTF8(multiaddr) && !sv_utf8_downgrade(multiaddr, 1))
    0          
    0          
1415 0           croak("Wide character in %s", "Socket::pack_ipv6_mreq");
1416 1 50         multiaddrbytes = SvPVbyte(multiaddr, len);
1417 1 50         if (len != sizeof(mreq.ipv6mr_multiaddr))
1418 0           croak("Bad arg length %s, length is %" UVuf
1419             ", should be %" UVuf,
1420             "Socket::pack_ipv6_mreq", (UV)len, (UV)sizeof(mreq.ipv6mr_multiaddr));
1421 1           Zero(&mreq, sizeof(mreq), char);
1422 1           Copy(multiaddrbytes, &mreq.ipv6mr_multiaddr, sizeof(mreq.ipv6mr_multiaddr), char);
1423 1           mreq.ipv6mr_interface = ifindex;
1424 1           ST(0) = sv_2mortal(newSVpvn((char *)&mreq, sizeof(mreq)));
1425             #else
1426             PERL_UNUSED_VAR(multiaddr);
1427             PERL_UNUSED_VAR(ifindex);
1428             not_here("pack_ipv6_mreq");
1429             #endif
1430             }
1431              
1432             void
1433             unpack_ipv6_mreq(mreq_sv)
1434             SV * mreq_sv
1435             PPCODE:
1436             {
1437             #ifdef HAS_IPV6_MREQ
1438             struct ipv6_mreq mreq;
1439             STRLEN mreqlen;
1440 1 50         char * mreqbytes = SvPVbyte(mreq_sv, mreqlen);
1441 1 50         if (mreqlen != sizeof(mreq))
1442 0           croak("Bad arg length for %s, length is %" UVuf
1443             ", should be %" UVuf,
1444             "Socket::unpack_ipv6_mreq", (UV)mreqlen, (UV)sizeof(mreq));
1445 1           Copy(mreqbytes, &mreq, sizeof(mreq), char);
1446 1 50         EXTEND(SP, 2);
1447 1           mPUSHp((char *)&mreq.ipv6mr_multiaddr, sizeof(mreq.ipv6mr_multiaddr));
1448 1           mPUSHi(mreq.ipv6mr_interface);
1449             #else
1450             PERL_UNUSED_VAR(mreq_sv);
1451             not_here("unpack_ipv6_mreq");
1452             #endif
1453             }