This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
6c395571853b4abbe1cf80d597caf49e25b130c0
[perl5.git] / ext / Socket / Socket.xs
1 #include "EXTERN.h"
2 #include "perl.h"
3 #include "XSUB.h"
4
5 #ifndef VMS
6 # ifdef I_SYS_TYPES
7 #  include <sys/types.h>
8 # endif
9 #include <sys/socket.h>
10 #ifdef I_SYS_UN
11 #include <sys/un.h>
12 #endif
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
21
22 #ifndef AF_NBS
23 #undef PF_NBS
24 #endif
25
26 #ifndef AF_X25
27 #undef PF_X25
28 #endif
29
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
38 static int
39 not_here(s)
40 char *s;
41 {
42     croak("Socket::%s not implemented on this architecture", s);
43     return -1;
44 }
45
46 static double
47 constant(name, arg)
48 char *name;
49 int 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
577 not_there:
578     errno = ENOENT;
579     return 0;
580 }
581
582
583 MODULE = Socket         PACKAGE = Socket
584
585 double
586 constant(name,arg)
587         char *          name
588         int             arg
589
590
591 void
592 inet_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
611 void
612 inet_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
632 void
633 pack_sockaddr_un(pathname)
634         char *  pathname
635         CODE:
636         {
637 #ifdef I_SYS_UN
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));
643 #else
644         ST(0) = (SV *) not_here("pack_sockaddr_un");
645 #endif
646         
647         }
648
649 void
650 unpack_sockaddr_un(sun_sv)
651         SV *    sun_sv
652         CODE:
653         {
654 #ifdef I_SYS_UN
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)));
674 #else
675         ST(0) = (SV *) not_here("unpack_sockaddr_un");
676 #endif
677         }
678
679 void
680 pack_sockaddr_in(port,ip_address)
681         unsigned short  port
682         char *  ip_address
683         CODE:
684         {
685         struct sockaddr_in sin;
686
687         Zero( &sin, sizeof sin, char );
688         sin.sin_family = AF_INET;
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
695 void
696 unpack_sockaddr_in(sin_sv)
697         SV *    sin_sv
698         PPCODE:
699         {
700         STRLEN sockaddrlen;
701         struct sockaddr_in addr;
702         unsigned short  port;
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         }
710         Copy( sin, &addr,sizeof addr, char );
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         } 
717         port = ntohs(addr.sin_port);
718         ip_address = addr.sin_addr;
719
720         EXTEND(sp, 2);
721         PUSHs(sv_2mortal(newSViv((IV) port)));
722         PUSHs(sv_2mortal(newSVpv((char *)&ip_address,sizeof ip_address)));
723         }
724
725 void
726 INADDR_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
734 void
735 INADDR_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
743 void
744 INADDR_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         }