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