Re: missing E<> POD directive in perlpod.pod
[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 */
33#ifndef INADDR_LOOPBACK
34#define INADDR_LOOPBACK 0x7F000001
35#endif /* INADDR_LOOPBACK */
36
37
a0d0e21e 38static int
39not_here(s)
40char *s;
41{
42 croak("Socket::%s not implemented on this architecture", s);
43 return -1;
44}
45
46static double
47constant(name, arg)
48char *name;
49int arg;
50{
51 errno = 0;
52 switch (*name) {
53 case 'A':
54 if (strEQ(name, "AF_802"))
55#ifdef AF_802
56 return AF_802;
57#else
58 goto not_there;
59#endif
60 if (strEQ(name, "AF_APPLETALK"))
61#ifdef AF_APPLETALK
62 return AF_APPLETALK;
63#else
64 goto not_there;
65#endif
66 if (strEQ(name, "AF_CCITT"))
67#ifdef AF_CCITT
68 return AF_CCITT;
69#else
70 goto not_there;
71#endif
72 if (strEQ(name, "AF_CHAOS"))
73#ifdef AF_CHAOS
74 return AF_CHAOS;
75#else
76 goto not_there;
77#endif
78 if (strEQ(name, "AF_DATAKIT"))
79#ifdef AF_DATAKIT
80 return AF_DATAKIT;
81#else
82 goto not_there;
83#endif
84 if (strEQ(name, "AF_DECnet"))
85#ifdef AF_DECnet
86 return AF_DECnet;
87#else
88 goto not_there;
89#endif
90 if (strEQ(name, "AF_DLI"))
91#ifdef AF_DLI
92 return AF_DLI;
93#else
94 goto not_there;
95#endif
96 if (strEQ(name, "AF_ECMA"))
97#ifdef AF_ECMA
98 return AF_ECMA;
99#else
100 goto not_there;
101#endif
102 if (strEQ(name, "AF_GOSIP"))
103#ifdef AF_GOSIP
104 return AF_GOSIP;
105#else
106 goto not_there;
107#endif
108 if (strEQ(name, "AF_HYLINK"))
109#ifdef AF_HYLINK
110 return AF_HYLINK;
111#else
112 goto not_there;
113#endif
114 if (strEQ(name, "AF_IMPLINK"))
115#ifdef AF_IMPLINK
116 return AF_IMPLINK;
117#else
118 goto not_there;
119#endif
120 if (strEQ(name, "AF_INET"))
121#ifdef AF_INET
122 return AF_INET;
123#else
124 goto not_there;
125#endif
126 if (strEQ(name, "AF_LAT"))
127#ifdef AF_LAT
128 return AF_LAT;
129#else
130 goto not_there;
131#endif
132 if (strEQ(name, "AF_MAX"))
133#ifdef AF_MAX
134 return AF_MAX;
135#else
136 goto not_there;
137#endif
138 if (strEQ(name, "AF_NBS"))
139#ifdef AF_NBS
140 return AF_NBS;
141#else
142 goto not_there;
143#endif
144 if (strEQ(name, "AF_NIT"))
145#ifdef AF_NIT
146 return AF_NIT;
147#else
148 goto not_there;
149#endif
150 if (strEQ(name, "AF_NS"))
151#ifdef AF_NS
152 return AF_NS;
153#else
154 goto not_there;
155#endif
156 if (strEQ(name, "AF_OSI"))
157#ifdef AF_OSI
158 return AF_OSI;
159#else
160 goto not_there;
161#endif
162 if (strEQ(name, "AF_OSINET"))
163#ifdef AF_OSINET
164 return AF_OSINET;
165#else
166 goto not_there;
167#endif
168 if (strEQ(name, "AF_PUP"))
169#ifdef AF_PUP
170 return AF_PUP;
171#else
172 goto not_there;
173#endif
174 if (strEQ(name, "AF_SNA"))
175#ifdef AF_SNA
176 return AF_SNA;
177#else
178 goto not_there;
179#endif
180 if (strEQ(name, "AF_UNIX"))
181#ifdef AF_UNIX
182 return AF_UNIX;
183#else
184 goto not_there;
185#endif
186 if (strEQ(name, "AF_UNSPEC"))
187#ifdef AF_UNSPEC
188 return AF_UNSPEC;
189#else
190 goto not_there;
191#endif
192 if (strEQ(name, "AF_X25"))
193#ifdef AF_X25
194 return AF_X25;
195#else
196 goto not_there;
197#endif
198 break;
199 case 'B':
200 break;
201 case 'C':
202 break;
203 case 'D':
204 break;
205 case 'E':
206 break;
207 case 'F':
208 break;
209 case 'G':
210 break;
211 case 'H':
212 break;
213 case 'I':
214 break;
215 case 'J':
216 break;
217 case 'K':
218 break;
219 case 'L':
220 break;
221 case 'M':
222 if (strEQ(name, "MSG_DONTROUTE"))
223#ifdef MSG_DONTROUTE
224 return MSG_DONTROUTE;
225#else
226 goto not_there;
227#endif
228 if (strEQ(name, "MSG_MAXIOVLEN"))
229#ifdef MSG_MAXIOVLEN
230 return MSG_MAXIOVLEN;
231#else
232 goto not_there;
233#endif
234 if (strEQ(name, "MSG_OOB"))
235#ifdef MSG_OOB
236 return MSG_OOB;
237#else
238 goto not_there;
239#endif
240 if (strEQ(name, "MSG_PEEK"))
241#ifdef MSG_PEEK
242 return MSG_PEEK;
243#else
244 goto not_there;
245#endif
246 break;
247 case 'N':
248 break;
249 case 'O':
250 break;
251 case 'P':
252 if (strEQ(name, "PF_802"))
253#ifdef PF_802
254 return PF_802;
255#else
256 goto not_there;
257#endif
258 if (strEQ(name, "PF_APPLETALK"))
259#ifdef PF_APPLETALK
260 return PF_APPLETALK;
261#else
262 goto not_there;
263#endif
264 if (strEQ(name, "PF_CCITT"))
265#ifdef PF_CCITT
266 return PF_CCITT;
267#else
268 goto not_there;
269#endif
270 if (strEQ(name, "PF_CHAOS"))
271#ifdef PF_CHAOS
272 return PF_CHAOS;
273#else
274 goto not_there;
275#endif
276 if (strEQ(name, "PF_DATAKIT"))
277#ifdef PF_DATAKIT
278 return PF_DATAKIT;
279#else
280 goto not_there;
281#endif
282 if (strEQ(name, "PF_DECnet"))
283#ifdef PF_DECnet
284 return PF_DECnet;
285#else
286 goto not_there;
287#endif
288 if (strEQ(name, "PF_DLI"))
289#ifdef PF_DLI
290 return PF_DLI;
291#else
292 goto not_there;
293#endif
294 if (strEQ(name, "PF_ECMA"))
295#ifdef PF_ECMA
296 return PF_ECMA;
297#else
298 goto not_there;
299#endif
300 if (strEQ(name, "PF_GOSIP"))
301#ifdef PF_GOSIP
302 return PF_GOSIP;
303#else
304 goto not_there;
305#endif
306 if (strEQ(name, "PF_HYLINK"))
307#ifdef PF_HYLINK
308 return PF_HYLINK;
309#else
310 goto not_there;
311#endif
312 if (strEQ(name, "PF_IMPLINK"))
313#ifdef PF_IMPLINK
314 return PF_IMPLINK;
315#else
316 goto not_there;
317#endif
318 if (strEQ(name, "PF_INET"))
319#ifdef PF_INET
320 return PF_INET;
321#else
322 goto not_there;
323#endif
324 if (strEQ(name, "PF_LAT"))
325#ifdef PF_LAT
326 return PF_LAT;
327#else
328 goto not_there;
329#endif
330 if (strEQ(name, "PF_MAX"))
331#ifdef PF_MAX
332 return PF_MAX;
333#else
334 goto not_there;
335#endif
336 if (strEQ(name, "PF_NBS"))
337#ifdef PF_NBS
338 return PF_NBS;
339#else
340 goto not_there;
341#endif
342 if (strEQ(name, "PF_NIT"))
343#ifdef PF_NIT
344 return PF_NIT;
345#else
346 goto not_there;
347#endif
348 if (strEQ(name, "PF_NS"))
349#ifdef PF_NS
350 return PF_NS;
351#else
352 goto not_there;
353#endif
354 if (strEQ(name, "PF_OSI"))
355#ifdef PF_OSI
356 return PF_OSI;
357#else
358 goto not_there;
359#endif
360 if (strEQ(name, "PF_OSINET"))
361#ifdef PF_OSINET
362 return PF_OSINET;
363#else
364 goto not_there;
365#endif
366 if (strEQ(name, "PF_PUP"))
367#ifdef PF_PUP
368 return PF_PUP;
369#else
370 goto not_there;
371#endif
372 if (strEQ(name, "PF_SNA"))
373#ifdef PF_SNA
374 return PF_SNA;
375#else
376 goto not_there;
377#endif
378 if (strEQ(name, "PF_UNIX"))
379#ifdef PF_UNIX
380 return PF_UNIX;
381#else
382 goto not_there;
383#endif
384 if (strEQ(name, "PF_UNSPEC"))
385#ifdef PF_UNSPEC
386 return PF_UNSPEC;
387#else
388 goto not_there;
389#endif
390 if (strEQ(name, "PF_X25"))
391#ifdef PF_X25
392 return PF_X25;
393#else
394 goto not_there;
395#endif
396 break;
397 case 'Q':
398 break;
399 case 'R':
400 break;
401 case 'S':
402 if (strEQ(name, "SOCK_DGRAM"))
403#ifdef SOCK_DGRAM
404 return SOCK_DGRAM;
405#else
406 goto not_there;
407#endif
408 if (strEQ(name, "SOCK_RAW"))
409#ifdef SOCK_RAW
410 return SOCK_RAW;
411#else
412 goto not_there;
413#endif
414 if (strEQ(name, "SOCK_RDM"))
415#ifdef SOCK_RDM
416 return SOCK_RDM;
417#else
418 goto not_there;
419#endif
420 if (strEQ(name, "SOCK_SEQPACKET"))
421#ifdef SOCK_SEQPACKET
422 return SOCK_SEQPACKET;
423#else
424 goto not_there;
425#endif
426 if (strEQ(name, "SOCK_STREAM"))
427#ifdef SOCK_STREAM
428 return SOCK_STREAM;
429#else
430 goto not_there;
431#endif
432 if (strEQ(name, "SOL_SOCKET"))
433#ifdef SOL_SOCKET
434 return SOL_SOCKET;
435#else
436 goto not_there;
437#endif
438 if (strEQ(name, "SOMAXCONN"))
439#ifdef SOMAXCONN
440 return SOMAXCONN;
441#else
442 goto not_there;
443#endif
444 if (strEQ(name, "SO_ACCEPTCONN"))
445#ifdef SO_ACCEPTCONN
446 return SO_ACCEPTCONN;
447#else
448 goto not_there;
449#endif
450 if (strEQ(name, "SO_BROADCAST"))
451#ifdef SO_BROADCAST
452 return SO_BROADCAST;
453#else
454 goto not_there;
455#endif
456 if (strEQ(name, "SO_DEBUG"))
457#ifdef SO_DEBUG
458 return SO_DEBUG;
459#else
460 goto not_there;
461#endif
462 if (strEQ(name, "SO_DONTLINGER"))
463#ifdef SO_DONTLINGER
464 return SO_DONTLINGER;
465#else
466 goto not_there;
467#endif
468 if (strEQ(name, "SO_DONTROUTE"))
469#ifdef SO_DONTROUTE
470 return SO_DONTROUTE;
471#else
472 goto not_there;
473#endif
474 if (strEQ(name, "SO_ERROR"))
475#ifdef SO_ERROR
476 return SO_ERROR;
477#else
478 goto not_there;
479#endif
480 if (strEQ(name, "SO_KEEPALIVE"))
481#ifdef SO_KEEPALIVE
482 return SO_KEEPALIVE;
483#else
484 goto not_there;
485#endif
486 if (strEQ(name, "SO_LINGER"))
487#ifdef SO_LINGER
488 return SO_LINGER;
489#else
490 goto not_there;
491#endif
492 if (strEQ(name, "SO_OOBINLINE"))
493#ifdef SO_OOBINLINE
494 return SO_OOBINLINE;
495#else
496 goto not_there;
497#endif
498 if (strEQ(name, "SO_RCVBUF"))
499#ifdef SO_RCVBUF
500 return SO_RCVBUF;
501#else
502 goto not_there;
503#endif
504 if (strEQ(name, "SO_RCVLOWAT"))
505#ifdef SO_RCVLOWAT
506 return SO_RCVLOWAT;
507#else
508 goto not_there;
509#endif
510 if (strEQ(name, "SO_RCVTIMEO"))
511#ifdef SO_RCVTIMEO
512 return SO_RCVTIMEO;
513#else
514 goto not_there;
515#endif
516 if (strEQ(name, "SO_REUSEADDR"))
517#ifdef SO_REUSEADDR
518 return SO_REUSEADDR;
519#else
520 goto not_there;
521#endif
522 if (strEQ(name, "SO_REUSEPORT"))
523#ifdef SO_REUSEPORT
524 return SO_REUSEPORT;
525#else
526 goto not_there;
527#endif
528 if (strEQ(name, "SO_SNDBUF"))
529#ifdef SO_SNDBUF
530 return SO_SNDBUF;
531#else
532 goto not_there;
533#endif
534 if (strEQ(name, "SO_SNDLOWAT"))
535#ifdef SO_SNDLOWAT
536 return SO_SNDLOWAT;
537#else
538 goto not_there;
539#endif
540 if (strEQ(name, "SO_SNDTIMEO"))
541#ifdef SO_SNDTIMEO
542 return SO_SNDTIMEO;
543#else
544 goto not_there;
545#endif
546 if (strEQ(name, "SO_TYPE"))
547#ifdef SO_TYPE
548 return SO_TYPE;
549#else
550 goto not_there;
551#endif
552 if (strEQ(name, "SO_USELOOPBACK"))
553#ifdef SO_USELOOPBACK
554 return SO_USELOOPBACK;
555#else
556 goto not_there;
557#endif
558 break;
559 case 'T':
560 break;
561 case 'U':
562 break;
563 case 'V':
564 break;
565 case 'W':
566 break;
567 case 'X':
568 break;
569 case 'Y':
570 break;
571 case 'Z':
572 break;
573 }
574 errno = EINVAL;
575 return 0;
576
577not_there:
578 errno = ENOENT;
579 return 0;
580}
581
8e07c86e 582
a0d0e21e 583MODULE = Socket PACKAGE = Socket
584
585double
586constant(name,arg)
587 char * name
588 int arg
589
8e07c86e 590
591void
592inet_aton(host)
593 char * host
594 CODE:
595 {
596 struct in_addr ip_address;
597 struct hostent * phe;
598
599 if (phe = gethostbyname(host)) {
600 Copy( phe->h_addr, &ip_address, phe->h_length, char );
601 } else {
602 ip_address.s_addr = inet_addr(host);
603 }
604
605 ST(0) = sv_newmortal();
606 if(ip_address.s_addr != INADDR_NONE) {
607 sv_setpvn( ST(0), (char *)&ip_address, sizeof ip_address );
608 }
609 }
610
611void
612inet_ntoa(ip_address_sv)
613 SV * ip_address_sv
614 CODE:
615 {
616 STRLEN addrlen;
617 struct in_addr addr;
618 char * addr_str;
619 char * ip_address = SvPV(ip_address_sv,addrlen);
620 if (addrlen != sizeof(addr)) {
621 croak("Bad arg length for %s, length is %d, should be %d",
622 "Socket::inet_ntoa",
623 addrlen, sizeof(addr));
624 }
625
626 Copy( ip_address, &addr, sizeof addr, char );
627 addr_str = inet_ntoa(addr);
628
629 ST(0) = sv_2mortal(newSVpv(addr_str, strlen(addr_str)));
630 }
631
632void
4633a7c4 633pack_sockaddr_un(pathname)
634 char * pathname
635 CODE:
636 {
25f94b33 637#ifdef I_SYS_UN
4633a7c4 638 struct sockaddr_un sun_ad; /* fear using sun */
639 Zero( &sun_ad, sizeof sun_ad, char );
640 sun_ad.sun_family = AF_UNIX;
641 Copy( pathname, sun_ad.sun_path, sizeof sun_ad.sun_path, char );
642 ST(0) = sv_2mortal(newSVpv((char *)&sun_ad, sizeof sun_ad));
25f94b33 643#else
644 ST(0) = (SV *) not_here("pack_sockaddr_un");
645#endif
646
4633a7c4 647 }
648
649void
650unpack_sockaddr_un(sun_sv)
651 SV * sun_sv
f13e1b2f 652 CODE:
4633a7c4 653 {
25f94b33 654#ifdef I_SYS_UN
4633a7c4 655 STRLEN sockaddrlen;
656 struct sockaddr_un addr;
657 char * sun_ad = SvPV(sun_sv,sockaddrlen);
658
659 if (sockaddrlen != sizeof(addr)) {
660 croak("Bad arg length for %s, length is %d, should be %d",
661 "Socket::unpack_sockaddr_un",
662 sockaddrlen, sizeof(addr));
663 }
664
665 Copy( sun_ad, &addr, sizeof addr, char );
666
667 if ( addr.sun_family != AF_UNIX ) {
668 croak("Bad address family for %s, got %d, should be %d",
669 "Socket::unpack_sockaddr_un",
670 addr.sun_family,
671 AF_UNIX);
672 }
673 ST(0) = sv_2mortal(newSVpv(addr.sun_path, strlen(addr.sun_path)));
25f94b33 674#else
675 ST(0) = (SV *) not_here("unpack_sockaddr_un");
676#endif
4633a7c4 677 }
678
679void
680pack_sockaddr_in(port,ip_address)
2c129a17 681 unsigned short port
8e07c86e 682 char * ip_address
683 CODE:
684 {
685 struct sockaddr_in sin;
686
687 Zero( &sin, sizeof sin, char );
4633a7c4 688 sin.sin_family = AF_INET;
8e07c86e 689 sin.sin_port = htons(port);
690 Copy( ip_address, &sin.sin_addr, sizeof sin.sin_addr, char );
691
692 ST(0) = sv_2mortal(newSVpv((char *)&sin, sizeof sin));
693 }
694
695void
696unpack_sockaddr_in(sin_sv)
697 SV * sin_sv
698 PPCODE:
699 {
700 STRLEN sockaddrlen;
701 struct sockaddr_in addr;
2c129a17 702 unsigned short port;
8e07c86e 703 struct in_addr ip_address;
704 char * sin = SvPV(sin_sv,sockaddrlen);
705 if (sockaddrlen != sizeof(addr)) {
706 croak("Bad arg length for %s, length is %d, should be %d",
707 "Socket::unpack_sockaddr_in",
708 sockaddrlen, sizeof(addr));
709 }
8e07c86e 710 Copy( sin, &addr,sizeof addr, char );
4633a7c4 711 if ( addr.sin_family != AF_INET ) {
712 croak("Bad address family for %s, got %d, should be %d",
713 "Socket::unpack_sockaddr_in",
714 addr.sin_family,
715 AF_INET);
716 }
8e07c86e 717 port = ntohs(addr.sin_port);
718 ip_address = addr.sin_addr;
719
4633a7c4 720 EXTEND(sp, 2);
2c129a17 721 PUSHs(sv_2mortal(newSViv((IV) port)));
8e07c86e 722 PUSHs(sv_2mortal(newSVpv((char *)&ip_address,sizeof ip_address)));
723 }
724
725void
726INADDR_ANY()
727 CODE:
728 {
729 struct in_addr ip_address;
730 ip_address.s_addr = htonl(INADDR_ANY);
731 ST(0) = sv_2mortal(newSVpv((char *)&ip_address,sizeof ip_address ));
732 }
733
734void
735INADDR_LOOPBACK()
736 CODE:
737 {
738 struct in_addr ip_address;
739 ip_address.s_addr = htonl(INADDR_LOOPBACK);
740 ST(0) = sv_2mortal(newSVpv((char *)&ip_address,sizeof ip_address));
741 }
742
743void
744INADDR_NONE()
745 CODE:
746 {
747 struct in_addr ip_address;
748 ip_address.s_addr = htonl(INADDR_NONE);
749 ST(0) = sv_2mortal(newSVpv((char *)&ip_address,sizeof ip_address));
750 }