Always NUL-terminate opsets
[p5sagit/p5-mst-13.2.git] / ext / Socket / Socket.xs
CommitLineData
a0d0e21e 1#include "EXTERN.h"
2#include "perl.h"
3#include "XSUB.h"
4
8e07c86e 5#ifndef VMS
6# ifdef I_SYS_TYPES
7# include <sys/types.h>
8# endif
a0d0e21e 9#include <sys/socket.h>
25f94b33 10#ifdef I_SYS_UN
4633a7c4 11#include <sys/un.h>
25f94b33 12#endif
8e07c86e 13# ifdef I_NETINET_IN
14# include <netinet/in.h>
15# endif
16#include <netdb.h>
17#include <arpa/inet.h>
18#else
19#include "sockadapt.h"
20#endif
a0d0e21e 21
22#ifndef AF_NBS
23#undef PF_NBS
24#endif
25
26#ifndef AF_X25
27#undef PF_X25
28#endif
29
8e07c86e 30#ifndef INADDR_NONE
31#define INADDR_NONE 0xffffffff
32#endif /* INADDR_NONE */
7e1af8bc 33#ifndef INADDR_BROADCAST
34#define INADDR_BROADCAST 0xffffffff
35#endif /* INADDR_BROADCAST */
8e07c86e 36#ifndef INADDR_LOOPBACK
37#define INADDR_LOOPBACK 0x7F000001
38#endif /* INADDR_LOOPBACK */
39
7e1af8bc 40#ifndef HAS_INET_ATON
41
42/*
43 * Check whether "cp" is a valid ascii representation
44 * of an Internet address and convert to a binary address.
45 * Returns 1 if the address is valid, 0 if not.
46 * This replaces inet_addr, the return value from which
47 * cannot distinguish between failure and a local broadcast address.
48 */
49static int
50my_inet_aton(cp, addr)
51register const char *cp;
52struct in_addr *addr;
53{
54 register unsigned long val;
55 register int base;
56 register char c;
57 int nparts;
58 const char *s;
59 unsigned int parts[4];
60 register unsigned int *pp = parts;
61
62 for (;;) {
63 /*
64 * Collect number up to ``.''.
65 * Values are specified as for C:
66 * 0x=hex, 0=octal, other=decimal.
67 */
68 val = 0; base = 10;
69 if (*cp == '0') {
70 if (*++cp == 'x' || *cp == 'X')
71 base = 16, cp++;
72 else
73 base = 8;
74 }
75 while ((c = *cp) != '\0') {
76 if (isDIGIT(c)) {
77 val = (val * base) + (c - '0');
78 cp++;
79 continue;
80 }
81 if (base == 16 && (s=strchr(hexdigit,c))) {
82 val = (val << 4) +
83 ((s - hexdigit) & 15);
84 cp++;
85 continue;
86 }
87 break;
88 }
89 if (*cp == '.') {
90 /*
91 * Internet format:
92 * a.b.c.d
93 * a.b.c (with c treated as 16-bits)
94 * a.b (with b treated as 24 bits)
95 */
96 if (pp >= parts + 3 || val > 0xff)
97 return 0;
98 *pp++ = val, cp++;
99 } else
100 break;
101 }
102 /*
103 * Check for trailing characters.
104 */
105 if (*cp && !isSPACE(*cp))
106 return 0;
107 /*
108 * Concoct the address according to
109 * the number of parts specified.
110 */
111 nparts = pp - parts + 1; /* force to an int for switch() */
112 switch (nparts) {
113
114 case 1: /* a -- 32 bits */
115 break;
116
117 case 2: /* a.b -- 8.24 bits */
118 if (val > 0xffffff)
119 return 0;
120 val |= parts[0] << 24;
121 break;
122
123 case 3: /* a.b.c -- 8.8.16 bits */
124 if (val > 0xffff)
125 return 0;
126 val |= (parts[0] << 24) | (parts[1] << 16);
127 break;
128
129 case 4: /* a.b.c.d -- 8.8.8.8 bits */
130 if (val > 0xff)
131 return 0;
132 val |= (parts[0] << 24) | (parts[1] << 16) | (parts[2] << 8);
133 break;
134 }
135 addr->s_addr = htonl(val);
136 return 1;
137}
138
139#undef inet_aton
140#define inet_aton my_inet_aton
141
142#endif /* ! HAS_INET_ATON */
143
8e07c86e 144
a0d0e21e 145static int
146not_here(s)
147char *s;
148{
149 croak("Socket::%s not implemented on this architecture", s);
150 return -1;
151}
152
153static double
154constant(name, arg)
155char *name;
156int arg;
157{
158 errno = 0;
159 switch (*name) {
160 case 'A':
161 if (strEQ(name, "AF_802"))
162#ifdef AF_802
163 return AF_802;
164#else
165 goto not_there;
166#endif
167 if (strEQ(name, "AF_APPLETALK"))
168#ifdef AF_APPLETALK
169 return AF_APPLETALK;
170#else
171 goto not_there;
172#endif
173 if (strEQ(name, "AF_CCITT"))
174#ifdef AF_CCITT
175 return AF_CCITT;
176#else
177 goto not_there;
178#endif
179 if (strEQ(name, "AF_CHAOS"))
180#ifdef AF_CHAOS
181 return AF_CHAOS;
182#else
183 goto not_there;
184#endif
185 if (strEQ(name, "AF_DATAKIT"))
186#ifdef AF_DATAKIT
187 return AF_DATAKIT;
188#else
189 goto not_there;
190#endif
191 if (strEQ(name, "AF_DECnet"))
192#ifdef AF_DECnet
193 return AF_DECnet;
194#else
195 goto not_there;
196#endif
197 if (strEQ(name, "AF_DLI"))
198#ifdef AF_DLI
199 return AF_DLI;
200#else
201 goto not_there;
202#endif
203 if (strEQ(name, "AF_ECMA"))
204#ifdef AF_ECMA
205 return AF_ECMA;
206#else
207 goto not_there;
208#endif
209 if (strEQ(name, "AF_GOSIP"))
210#ifdef AF_GOSIP
211 return AF_GOSIP;
212#else
213 goto not_there;
214#endif
215 if (strEQ(name, "AF_HYLINK"))
216#ifdef AF_HYLINK
217 return AF_HYLINK;
218#else
219 goto not_there;
220#endif
221 if (strEQ(name, "AF_IMPLINK"))
222#ifdef AF_IMPLINK
223 return AF_IMPLINK;
224#else
225 goto not_there;
226#endif
227 if (strEQ(name, "AF_INET"))
228#ifdef AF_INET
229 return AF_INET;
230#else
231 goto not_there;
232#endif
233 if (strEQ(name, "AF_LAT"))
234#ifdef AF_LAT
235 return AF_LAT;
236#else
237 goto not_there;
238#endif
239 if (strEQ(name, "AF_MAX"))
240#ifdef AF_MAX
241 return AF_MAX;
242#else
243 goto not_there;
244#endif
245 if (strEQ(name, "AF_NBS"))
246#ifdef AF_NBS
247 return AF_NBS;
248#else
249 goto not_there;
250#endif
251 if (strEQ(name, "AF_NIT"))
252#ifdef AF_NIT
253 return AF_NIT;
254#else
255 goto not_there;
256#endif
257 if (strEQ(name, "AF_NS"))
258#ifdef AF_NS
259 return AF_NS;
260#else
261 goto not_there;
262#endif
263 if (strEQ(name, "AF_OSI"))
264#ifdef AF_OSI
265 return AF_OSI;
266#else
267 goto not_there;
268#endif
269 if (strEQ(name, "AF_OSINET"))
270#ifdef AF_OSINET
271 return AF_OSINET;
272#else
273 goto not_there;
274#endif
275 if (strEQ(name, "AF_PUP"))
276#ifdef AF_PUP
277 return AF_PUP;
278#else
279 goto not_there;
280#endif
281 if (strEQ(name, "AF_SNA"))
282#ifdef AF_SNA
283 return AF_SNA;
284#else
285 goto not_there;
286#endif
287 if (strEQ(name, "AF_UNIX"))
288#ifdef AF_UNIX
289 return AF_UNIX;
290#else
291 goto not_there;
292#endif
293 if (strEQ(name, "AF_UNSPEC"))
294#ifdef AF_UNSPEC
295 return AF_UNSPEC;
296#else
297 goto not_there;
298#endif
299 if (strEQ(name, "AF_X25"))
300#ifdef AF_X25
301 return AF_X25;
302#else
303 goto not_there;
304#endif
305 break;
306 case 'B':
307 break;
308 case 'C':
309 break;
310 case 'D':
311 break;
312 case 'E':
313 break;
314 case 'F':
315 break;
316 case 'G':
317 break;
318 case 'H':
319 break;
320 case 'I':
321 break;
322 case 'J':
323 break;
324 case 'K':
325 break;
326 case 'L':
327 break;
328 case 'M':
329 if (strEQ(name, "MSG_DONTROUTE"))
330#ifdef MSG_DONTROUTE
331 return MSG_DONTROUTE;
332#else
333 goto not_there;
334#endif
335 if (strEQ(name, "MSG_MAXIOVLEN"))
336#ifdef MSG_MAXIOVLEN
337 return MSG_MAXIOVLEN;
338#else
339 goto not_there;
340#endif
341 if (strEQ(name, "MSG_OOB"))
342#ifdef MSG_OOB
343 return MSG_OOB;
344#else
345 goto not_there;
346#endif
347 if (strEQ(name, "MSG_PEEK"))
348#ifdef MSG_PEEK
349 return MSG_PEEK;
350#else
351 goto not_there;
352#endif
353 break;
354 case 'N':
355 break;
356 case 'O':
357 break;
358 case 'P':
359 if (strEQ(name, "PF_802"))
360#ifdef PF_802
361 return PF_802;
362#else
363 goto not_there;
364#endif
365 if (strEQ(name, "PF_APPLETALK"))
366#ifdef PF_APPLETALK
367 return PF_APPLETALK;
368#else
369 goto not_there;
370#endif
371 if (strEQ(name, "PF_CCITT"))
372#ifdef PF_CCITT
373 return PF_CCITT;
374#else
375 goto not_there;
376#endif
377 if (strEQ(name, "PF_CHAOS"))
378#ifdef PF_CHAOS
379 return PF_CHAOS;
380#else
381 goto not_there;
382#endif
383 if (strEQ(name, "PF_DATAKIT"))
384#ifdef PF_DATAKIT
385 return PF_DATAKIT;
386#else
387 goto not_there;
388#endif
389 if (strEQ(name, "PF_DECnet"))
390#ifdef PF_DECnet
391 return PF_DECnet;
392#else
393 goto not_there;
394#endif
395 if (strEQ(name, "PF_DLI"))
396#ifdef PF_DLI
397 return PF_DLI;
398#else
399 goto not_there;
400#endif
401 if (strEQ(name, "PF_ECMA"))
402#ifdef PF_ECMA
403 return PF_ECMA;
404#else
405 goto not_there;
406#endif
407 if (strEQ(name, "PF_GOSIP"))
408#ifdef PF_GOSIP
409 return PF_GOSIP;
410#else
411 goto not_there;
412#endif
413 if (strEQ(name, "PF_HYLINK"))
414#ifdef PF_HYLINK
415 return PF_HYLINK;
416#else
417 goto not_there;
418#endif
419 if (strEQ(name, "PF_IMPLINK"))
420#ifdef PF_IMPLINK
421 return PF_IMPLINK;
422#else
423 goto not_there;
424#endif
425 if (strEQ(name, "PF_INET"))
426#ifdef PF_INET
427 return PF_INET;
428#else
429 goto not_there;
430#endif
431 if (strEQ(name, "PF_LAT"))
432#ifdef PF_LAT
433 return PF_LAT;
434#else
435 goto not_there;
436#endif
437 if (strEQ(name, "PF_MAX"))
438#ifdef PF_MAX
439 return PF_MAX;
440#else
441 goto not_there;
442#endif
443 if (strEQ(name, "PF_NBS"))
444#ifdef PF_NBS
445 return PF_NBS;
446#else
447 goto not_there;
448#endif
449 if (strEQ(name, "PF_NIT"))
450#ifdef PF_NIT
451 return PF_NIT;
452#else
453 goto not_there;
454#endif
455 if (strEQ(name, "PF_NS"))
456#ifdef PF_NS
457 return PF_NS;
458#else
459 goto not_there;
460#endif
461 if (strEQ(name, "PF_OSI"))
462#ifdef PF_OSI
463 return PF_OSI;
464#else
465 goto not_there;
466#endif
467 if (strEQ(name, "PF_OSINET"))
468#ifdef PF_OSINET
469 return PF_OSINET;
470#else
471 goto not_there;
472#endif
473 if (strEQ(name, "PF_PUP"))
474#ifdef PF_PUP
475 return PF_PUP;
476#else
477 goto not_there;
478#endif
479 if (strEQ(name, "PF_SNA"))
480#ifdef PF_SNA
481 return PF_SNA;
482#else
483 goto not_there;
484#endif
485 if (strEQ(name, "PF_UNIX"))
486#ifdef PF_UNIX
487 return PF_UNIX;
488#else
489 goto not_there;
490#endif
491 if (strEQ(name, "PF_UNSPEC"))
492#ifdef PF_UNSPEC
493 return PF_UNSPEC;
494#else
495 goto not_there;
496#endif
497 if (strEQ(name, "PF_X25"))
498#ifdef PF_X25
499 return PF_X25;
500#else
501 goto not_there;
502#endif
503 break;
504 case 'Q':
505 break;
506 case 'R':
507 break;
508 case 'S':
509 if (strEQ(name, "SOCK_DGRAM"))
510#ifdef SOCK_DGRAM
511 return SOCK_DGRAM;
512#else
513 goto not_there;
514#endif
515 if (strEQ(name, "SOCK_RAW"))
516#ifdef SOCK_RAW
517 return SOCK_RAW;
518#else
519 goto not_there;
520#endif
521 if (strEQ(name, "SOCK_RDM"))
522#ifdef SOCK_RDM
523 return SOCK_RDM;
524#else
525 goto not_there;
526#endif
527 if (strEQ(name, "SOCK_SEQPACKET"))
528#ifdef SOCK_SEQPACKET
529 return SOCK_SEQPACKET;
530#else
531 goto not_there;
532#endif
533 if (strEQ(name, "SOCK_STREAM"))
534#ifdef SOCK_STREAM
535 return SOCK_STREAM;
536#else
537 goto not_there;
538#endif
539 if (strEQ(name, "SOL_SOCKET"))
540#ifdef SOL_SOCKET
541 return SOL_SOCKET;
542#else
543 goto not_there;
544#endif
545 if (strEQ(name, "SOMAXCONN"))
546#ifdef SOMAXCONN
547 return SOMAXCONN;
548#else
549 goto not_there;
550#endif
551 if (strEQ(name, "SO_ACCEPTCONN"))
552#ifdef SO_ACCEPTCONN
553 return SO_ACCEPTCONN;
554#else
555 goto not_there;
556#endif
557 if (strEQ(name, "SO_BROADCAST"))
558#ifdef SO_BROADCAST
559 return SO_BROADCAST;
560#else
561 goto not_there;
562#endif
563 if (strEQ(name, "SO_DEBUG"))
564#ifdef SO_DEBUG
565 return SO_DEBUG;
566#else
567 goto not_there;
568#endif
569 if (strEQ(name, "SO_DONTLINGER"))
570#ifdef SO_DONTLINGER
571 return SO_DONTLINGER;
572#else
573 goto not_there;
574#endif
575 if (strEQ(name, "SO_DONTROUTE"))
576#ifdef SO_DONTROUTE
577 return SO_DONTROUTE;
578#else
579 goto not_there;
580#endif
581 if (strEQ(name, "SO_ERROR"))
582#ifdef SO_ERROR
583 return SO_ERROR;
584#else
585 goto not_there;
586#endif
587 if (strEQ(name, "SO_KEEPALIVE"))
588#ifdef SO_KEEPALIVE
589 return SO_KEEPALIVE;
590#else
591 goto not_there;
592#endif
593 if (strEQ(name, "SO_LINGER"))
594#ifdef SO_LINGER
595 return SO_LINGER;
596#else
597 goto not_there;
598#endif
599 if (strEQ(name, "SO_OOBINLINE"))
600#ifdef SO_OOBINLINE
601 return SO_OOBINLINE;
602#else
603 goto not_there;
604#endif
605 if (strEQ(name, "SO_RCVBUF"))
606#ifdef SO_RCVBUF
607 return SO_RCVBUF;
608#else
609 goto not_there;
610#endif
611 if (strEQ(name, "SO_RCVLOWAT"))
612#ifdef SO_RCVLOWAT
613 return SO_RCVLOWAT;
614#else
615 goto not_there;
616#endif
617 if (strEQ(name, "SO_RCVTIMEO"))
618#ifdef SO_RCVTIMEO
619 return SO_RCVTIMEO;
620#else
621 goto not_there;
622#endif
623 if (strEQ(name, "SO_REUSEADDR"))
624#ifdef SO_REUSEADDR
625 return SO_REUSEADDR;
626#else
627 goto not_there;
628#endif
629 if (strEQ(name, "SO_REUSEPORT"))
630#ifdef SO_REUSEPORT
631 return SO_REUSEPORT;
632#else
633 goto not_there;
634#endif
635 if (strEQ(name, "SO_SNDBUF"))
636#ifdef SO_SNDBUF
637 return SO_SNDBUF;
638#else
639 goto not_there;
640#endif
641 if (strEQ(name, "SO_SNDLOWAT"))
642#ifdef SO_SNDLOWAT
643 return SO_SNDLOWAT;
644#else
645 goto not_there;
646#endif
647 if (strEQ(name, "SO_SNDTIMEO"))
648#ifdef SO_SNDTIMEO
649 return SO_SNDTIMEO;
650#else
651 goto not_there;
652#endif
653 if (strEQ(name, "SO_TYPE"))
654#ifdef SO_TYPE
655 return SO_TYPE;
656#else
657 goto not_there;
658#endif
659 if (strEQ(name, "SO_USELOOPBACK"))
660#ifdef SO_USELOOPBACK
661 return SO_USELOOPBACK;
662#else
663 goto not_there;
664#endif
665 break;
666 case 'T':
667 break;
668 case 'U':
669 break;
670 case 'V':
671 break;
672 case 'W':
673 break;
674 case 'X':
675 break;
676 case 'Y':
677 break;
678 case 'Z':
679 break;
680 }
681 errno = EINVAL;
682 return 0;
683
684not_there:
685 errno = ENOENT;
686 return 0;
687}
688
8e07c86e 689
a0d0e21e 690MODULE = Socket PACKAGE = Socket
691
692double
693constant(name,arg)
694 char * name
695 int arg
696
8e07c86e 697
698void
699inet_aton(host)
700 char * host
701 CODE:
702 {
703 struct in_addr ip_address;
704 struct hostent * phe;
7e1af8bc 705 int ok;
8e07c86e 706
707 if (phe = gethostbyname(host)) {
708 Copy( phe->h_addr, &ip_address, phe->h_length, char );
7e1af8bc 709 ok = 1;
8e07c86e 710 } else {
7e1af8bc 711 ok = inet_aton(host, &ip_address);
8e07c86e 712 }
713
714 ST(0) = sv_newmortal();
7e1af8bc 715 if (ok) {
8e07c86e 716 sv_setpvn( ST(0), (char *)&ip_address, sizeof ip_address );
717 }
718 }
719
720void
721inet_ntoa(ip_address_sv)
722 SV * ip_address_sv
723 CODE:
724 {
725 STRLEN addrlen;
726 struct in_addr addr;
727 char * addr_str;
728 char * ip_address = SvPV(ip_address_sv,addrlen);
729 if (addrlen != sizeof(addr)) {
730 croak("Bad arg length for %s, length is %d, should be %d",
731 "Socket::inet_ntoa",
732 addrlen, sizeof(addr));
733 }
734
735 Copy( ip_address, &addr, sizeof addr, char );
736 addr_str = inet_ntoa(addr);
737
738 ST(0) = sv_2mortal(newSVpv(addr_str, strlen(addr_str)));
739 }
740
741void
4633a7c4 742pack_sockaddr_un(pathname)
743 char * pathname
744 CODE:
745 {
25f94b33 746#ifdef I_SYS_UN
4633a7c4 747 struct sockaddr_un sun_ad; /* fear using sun */
748 Zero( &sun_ad, sizeof sun_ad, char );
749 sun_ad.sun_family = AF_UNIX;
750 Copy( pathname, sun_ad.sun_path, sizeof sun_ad.sun_path, char );
751 ST(0) = sv_2mortal(newSVpv((char *)&sun_ad, sizeof sun_ad));
25f94b33 752#else
753 ST(0) = (SV *) not_here("pack_sockaddr_un");
754#endif
755
4633a7c4 756 }
757
758void
759unpack_sockaddr_un(sun_sv)
760 SV * sun_sv
f13e1b2f 761 CODE:
4633a7c4 762 {
25f94b33 763#ifdef I_SYS_UN
4633a7c4 764 STRLEN sockaddrlen;
765 struct sockaddr_un addr;
766 char * sun_ad = SvPV(sun_sv,sockaddrlen);
767
768 if (sockaddrlen != sizeof(addr)) {
769 croak("Bad arg length for %s, length is %d, should be %d",
770 "Socket::unpack_sockaddr_un",
771 sockaddrlen, sizeof(addr));
772 }
773
774 Copy( sun_ad, &addr, sizeof addr, char );
775
776 if ( addr.sun_family != AF_UNIX ) {
777 croak("Bad address family for %s, got %d, should be %d",
778 "Socket::unpack_sockaddr_un",
779 addr.sun_family,
780 AF_UNIX);
781 }
782 ST(0) = sv_2mortal(newSVpv(addr.sun_path, strlen(addr.sun_path)));
25f94b33 783#else
784 ST(0) = (SV *) not_here("unpack_sockaddr_un");
785#endif
4633a7c4 786 }
787
788void
789pack_sockaddr_in(port,ip_address)
2c129a17 790 unsigned short port
8e07c86e 791 char * ip_address
792 CODE:
793 {
794 struct sockaddr_in sin;
795
796 Zero( &sin, sizeof sin, char );
4633a7c4 797 sin.sin_family = AF_INET;
8e07c86e 798 sin.sin_port = htons(port);
799 Copy( ip_address, &sin.sin_addr, sizeof sin.sin_addr, char );
800
801 ST(0) = sv_2mortal(newSVpv((char *)&sin, sizeof sin));
802 }
803
804void
805unpack_sockaddr_in(sin_sv)
806 SV * sin_sv
807 PPCODE:
808 {
809 STRLEN sockaddrlen;
810 struct sockaddr_in addr;
2c129a17 811 unsigned short port;
8e07c86e 812 struct in_addr ip_address;
813 char * sin = SvPV(sin_sv,sockaddrlen);
814 if (sockaddrlen != sizeof(addr)) {
815 croak("Bad arg length for %s, length is %d, should be %d",
816 "Socket::unpack_sockaddr_in",
817 sockaddrlen, sizeof(addr));
818 }
8e07c86e 819 Copy( sin, &addr,sizeof addr, char );
4633a7c4 820 if ( addr.sin_family != AF_INET ) {
821 croak("Bad address family for %s, got %d, should be %d",
822 "Socket::unpack_sockaddr_in",
823 addr.sin_family,
824 AF_INET);
825 }
8e07c86e 826 port = ntohs(addr.sin_port);
827 ip_address = addr.sin_addr;
828
4633a7c4 829 EXTEND(sp, 2);
2c129a17 830 PUSHs(sv_2mortal(newSViv((IV) port)));
8e07c86e 831 PUSHs(sv_2mortal(newSVpv((char *)&ip_address,sizeof ip_address)));
832 }
833
834void
835INADDR_ANY()
836 CODE:
837 {
838 struct in_addr ip_address;
839 ip_address.s_addr = htonl(INADDR_ANY);
840 ST(0) = sv_2mortal(newSVpv((char *)&ip_address,sizeof ip_address ));
841 }
842
843void
844INADDR_LOOPBACK()
845 CODE:
846 {
847 struct in_addr ip_address;
848 ip_address.s_addr = htonl(INADDR_LOOPBACK);
849 ST(0) = sv_2mortal(newSVpv((char *)&ip_address,sizeof ip_address));
850 }
851
852void
853INADDR_NONE()
854 CODE:
855 {
856 struct in_addr ip_address;
857 ip_address.s_addr = htonl(INADDR_NONE);
858 ST(0) = sv_2mortal(newSVpv((char *)&ip_address,sizeof ip_address));
859 }
7e1af8bc 860
861void
862INADDR_BROADCAST()
863 CODE:
864 {
865 struct in_addr ip_address;
866 ip_address.s_addr = htonl(INADDR_BROADCAST);
867 ST(0) = sv_2mortal(newSVpv((char *)&ip_address,sizeof ip_address));
868 }