File Coverage

cpan/Socket/Socket.xs
Criterion Covered Total %
statement 231 275 84.0
branch n/a
condition n/a
subroutine n/a
total 231 275 84.0


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