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