This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
update Changes; integrate cfgperl contents into mainline
[perl5.git] / ext / Socket / Socket.xs
1 #define PERL_NO_GET_CONTEXT
2 #include "EXTERN.h"
3 #include "perl.h"
4 #include "XSUB.h"
5
6 #ifndef VMS
7 # ifdef I_SYS_TYPES
8 #  include <sys/types.h>
9 # endif
10 # include <sys/socket.h>
11 # if defined(USE_SOCKS) && defined(I_SOCKS)
12 #   include <socks.h>
13 # endif 
14 # ifdef MPE
15 #  define PF_INET AF_INET
16 #  define PF_UNIX AF_UNIX
17 #  define SOCK_RAW 3
18 # endif
19 # ifdef I_SYS_UN
20 #  include <sys/un.h>
21 # endif
22 /* XXX Configure test for <netinet/in_systm.h needed XXX */
23 # if defined(NeXT) || defined(__NeXT__)
24 #  include <netinet/in_systm.h>
25 # endif
26 # ifdef I_NETINET_IN
27 #  include <netinet/in.h>
28 # endif
29 # ifdef I_NETDB
30 #  include <netdb.h>
31 # endif
32 # ifdef I_ARPA_INET
33 #  include <arpa/inet.h>
34 # endif
35 # ifdef I_NETINET_TCP
36 #  include <netinet/tcp.h>
37 # endif
38 #else
39 # include "sockadapt.h"
40 #endif
41
42 #ifdef I_SYSUIO
43 # include <sys/uio.h>
44 #endif
45
46 #ifndef AF_NBS
47 # undef PF_NBS
48 #endif
49
50 #ifndef AF_X25
51 # undef PF_X25
52 #endif
53
54 #ifndef INADDR_NONE
55 # define INADDR_NONE    0xffffffff
56 #endif /* INADDR_NONE */
57 #ifndef INADDR_BROADCAST
58 # define INADDR_BROADCAST       0xffffffff
59 #endif /* INADDR_BROADCAST */
60 #ifndef INADDR_LOOPBACK
61 # define INADDR_LOOPBACK         0x7F000001
62 #endif /* INADDR_LOOPBACK */
63
64 #ifndef HAS_INET_ATON
65
66 /* 
67  * Check whether "cp" is a valid ascii representation
68  * of an Internet address and convert to a binary address.
69  * Returns 1 if the address is valid, 0 if not.
70  * This replaces inet_addr, the return value from which
71  * cannot distinguish between failure and a local broadcast address.
72  */
73 static int
74 my_inet_aton(register const char *cp, struct in_addr *addr)
75 {
76         dTHX;
77         register U32 val;
78         register int base;
79         register char c;
80         int nparts;
81         const char *s;
82         unsigned int parts[4];
83         register unsigned int *pp = parts;
84
85         if (!cp)
86                 return 0;
87         for (;;) {
88                 /*
89                  * Collect number up to ``.''.
90                  * Values are specified as for C:
91                  * 0x=hex, 0=octal, other=decimal.
92                  */
93                 val = 0; base = 10;
94                 if (*cp == '0') {
95                         if (*++cp == 'x' || *cp == 'X')
96                                 base = 16, cp++;
97                         else
98                                 base = 8;
99                 }
100                 while ((c = *cp) != '\0') {
101                         if (isDIGIT(c)) {
102                                 val = (val * base) + (c - '0');
103                                 cp++;
104                                 continue;
105                         }
106                         if (base == 16 && (s=strchr(PL_hexdigit,c))) {
107                                 val = (val << 4) + 
108                                         ((s - PL_hexdigit) & 15);
109                                 cp++;
110                                 continue;
111                         }
112                         break;
113                 }
114                 if (*cp == '.') {
115                         /*
116                          * Internet format:
117                          *      a.b.c.d
118                          *      a.b.c   (with c treated as 16-bits)
119                          *      a.b     (with b treated as 24 bits)
120                          */
121                         if (pp >= parts + 3 || val > 0xff)
122                                 return 0;
123                         *pp++ = val, cp++;
124                 } else
125                         break;
126         }
127         /*
128          * Check for trailing characters.
129          */
130         if (*cp && !isSPACE(*cp))
131                 return 0;
132         /*
133          * Concoct the address according to
134          * the number of parts specified.
135          */
136         nparts = pp - parts + 1;        /* force to an int for switch() */
137         switch (nparts) {
138
139         case 1:                         /* a -- 32 bits */
140                 break;
141
142         case 2:                         /* a.b -- 8.24 bits */
143                 if (val > 0xffffff)
144                         return 0;
145                 val |= parts[0] << 24;
146                 break;
147
148         case 3:                         /* a.b.c -- 8.8.16 bits */
149                 if (val > 0xffff)
150                         return 0;
151                 val |= (parts[0] << 24) | (parts[1] << 16);
152                 break;
153
154         case 4:                         /* a.b.c.d -- 8.8.8.8 bits */
155                 if (val > 0xff)
156                         return 0;
157                 val |= (parts[0] << 24) | (parts[1] << 16) | (parts[2] << 8);
158                 break;
159         }
160         addr->s_addr = htonl(val);
161         return 1;
162 }
163
164 #undef inet_aton
165 #define inet_aton my_inet_aton
166
167 #endif /* ! HAS_INET_ATON */
168
169
170 static int
171 not_here(char *s)
172 {
173     croak("Socket::%s not implemented on this architecture", s);
174     return -1;
175 }
176
177 static double
178 constant(char *name, int arg)
179 {
180     errno = 0;
181     switch (*name) {
182     case 'A':
183         if (strEQ(name, "AF_802"))
184 #ifdef AF_802
185             return AF_802;
186 #else
187             goto not_there;
188 #endif
189         if (strEQ(name, "AF_APPLETALK"))
190 #ifdef AF_APPLETALK
191             return AF_APPLETALK;
192 #else
193             goto not_there;
194 #endif
195         if (strEQ(name, "AF_CCITT"))
196 #ifdef AF_CCITT
197             return AF_CCITT;
198 #else
199             goto not_there;
200 #endif
201         if (strEQ(name, "AF_CHAOS"))
202 #ifdef AF_CHAOS
203             return AF_CHAOS;
204 #else
205             goto not_there;
206 #endif
207         if (strEQ(name, "AF_DATAKIT"))
208 #ifdef AF_DATAKIT
209             return AF_DATAKIT;
210 #else
211             goto not_there;
212 #endif
213         if (strEQ(name, "AF_DECnet"))
214 #ifdef AF_DECnet
215             return AF_DECnet;
216 #else
217             goto not_there;
218 #endif
219         if (strEQ(name, "AF_DLI"))
220 #ifdef AF_DLI
221             return AF_DLI;
222 #else
223             goto not_there;
224 #endif
225         if (strEQ(name, "AF_ECMA"))
226 #ifdef AF_ECMA
227             return AF_ECMA;
228 #else
229             goto not_there;
230 #endif
231         if (strEQ(name, "AF_GOSIP"))
232 #ifdef AF_GOSIP
233             return AF_GOSIP;
234 #else
235             goto not_there;
236 #endif
237         if (strEQ(name, "AF_HYLINK"))
238 #ifdef AF_HYLINK
239             return AF_HYLINK;
240 #else
241             goto not_there;
242 #endif
243         if (strEQ(name, "AF_IMPLINK"))
244 #ifdef AF_IMPLINK
245             return AF_IMPLINK;
246 #else
247             goto not_there;
248 #endif
249         if (strEQ(name, "AF_INET"))
250 #ifdef AF_INET
251             return AF_INET;
252 #else
253             goto not_there;
254 #endif
255         if (strEQ(name, "AF_LAT"))
256 #ifdef AF_LAT
257             return AF_LAT;
258 #else
259             goto not_there;
260 #endif
261         if (strEQ(name, "AF_MAX"))
262 #ifdef AF_MAX
263             return AF_MAX;
264 #else
265             goto not_there;
266 #endif
267         if (strEQ(name, "AF_NBS"))
268 #ifdef AF_NBS
269             return AF_NBS;
270 #else
271             goto not_there;
272 #endif
273         if (strEQ(name, "AF_NIT"))
274 #ifdef AF_NIT
275             return AF_NIT;
276 #else
277             goto not_there;
278 #endif
279         if (strEQ(name, "AF_NS"))
280 #ifdef AF_NS
281             return AF_NS;
282 #else
283             goto not_there;
284 #endif
285         if (strEQ(name, "AF_OSI"))
286 #ifdef AF_OSI
287             return AF_OSI;
288 #else
289             goto not_there;
290 #endif
291         if (strEQ(name, "AF_OSINET"))
292 #ifdef AF_OSINET
293             return AF_OSINET;
294 #else
295             goto not_there;
296 #endif
297         if (strEQ(name, "AF_PUP"))
298 #ifdef AF_PUP
299             return AF_PUP;
300 #else
301             goto not_there;
302 #endif
303         if (strEQ(name, "AF_SNA"))
304 #ifdef AF_SNA
305             return AF_SNA;
306 #else
307             goto not_there;
308 #endif
309         if (strEQ(name, "AF_UNIX"))
310 #ifdef AF_UNIX
311             return AF_UNIX;
312 #else
313             goto not_there;
314 #endif
315         if (strEQ(name, "AF_UNSPEC"))
316 #ifdef AF_UNSPEC
317             return AF_UNSPEC;
318 #else
319             goto not_there;
320 #endif
321         if (strEQ(name, "AF_X25"))
322 #ifdef AF_X25
323             return AF_X25;
324 #else
325             goto not_there;
326 #endif
327         break;
328     case 'B':
329         break;
330     case 'C':
331         break;
332     case 'D':
333         break;
334     case 'E':
335         break;
336     case 'F':
337         break;
338     case 'G':
339         break;
340     case 'H':
341         break;
342     case 'I':
343         if (strEQ(name, "IOV_MAX"))
344 #ifdef IOV_MAX
345             return IOV_MAX;
346 #else
347             goto not_there;
348 #endif
349         if (strEQ(name, "IPPROTO_TCP"))
350 #ifdef IPPROTO_TCP
351             return IPPROTO_TCP;
352 #else
353             goto not_there;
354 #endif
355         break;
356     case 'J':
357         break;
358     case 'K':
359         break;
360     case 'L':
361         break;
362     case 'M':
363         if (strEQ(name, "MSG_BCAST"))
364 #ifdef MSG_BCAST
365             return MSG_BCAST;
366 #else
367             goto not_there;
368 #endif
369         if (strEQ(name, "MSG_CTLFLAGS"))
370 #ifdef MSG_CTLFLAGS
371             return MSG_CTLFLAGS;
372 #else
373             goto not_there;
374 #endif
375         if (strEQ(name, "MSG_CTLIGNORE"))
376 #ifdef MSG_CTLIGNORE
377             return MSG_CTLIGNORE;
378 #else
379             goto not_there;
380 #endif
381         if (strEQ(name, "MSG_CTRUNC"))
382 #if defined(MSG_TRUNC) || defined(HAS_MSG_CTRUNC) /* might be an enum */
383             return MSG_CTRUNC;
384 #else
385             goto not_there;
386 #endif
387         if (strEQ(name, "MSG_DONTROUTE"))
388 #if defined(MSG_DONTROUTE) || defined(HAS_MSG_DONTROUTE) /* might be an enum */
389             return MSG_DONTROUTE;
390 #else
391             goto not_there;
392 #endif
393         if (strEQ(name, "MSG_DONTWAIT"))
394 #ifdef MSG_DONTWAIT
395             return MSG_DONTWAIT;
396 #else
397             goto not_there;
398 #endif
399         if (strEQ(name, "MSG_EOF"))
400 #ifdef MSG_EOF
401             return MSG_EOF;
402 #else
403             goto not_there;
404 #endif
405         if (strEQ(name, "MSG_EOR"))
406 #ifdef MSG_EOR
407             return MSG_EOR;
408 #else
409             goto not_there;
410 #endif
411         if (strEQ(name, "MSG_ERRQUEUE"))
412 #ifdef MSG_ERRQUEUE
413             return MSG_ERRQUEUE;
414 #else
415             goto not_there;
416 #endif
417         if (strEQ(name, "MSG_FIN"))
418 #ifdef MSG_FIN
419             return MSG_FIN;
420 #else
421             goto not_there;
422 #endif
423         if (strEQ(name, "MSG_MAXIOVLEN"))
424 #ifdef MSG_MAXIOVLEN
425             return MSG_MAXIOVLEN;
426 #else
427             goto not_there;
428 #endif
429         if (strEQ(name, "MSG_MCAST"))
430 #ifdef MSG_MCAST
431             return MSG_MCAST;
432 #else
433             goto not_there;
434 #endif
435         if (strEQ(name, "MSG_NOSIGNAL"))
436 #ifdef MSG_NOSIGNAL
437             return MSG_NOSIGNAL;
438 #else
439             goto not_there;
440 #endif
441         if (strEQ(name, "MSG_OOB"))
442 #if defined(MSG_OOB) || defined(HAS_MSG_OOB) /* might be an enum */
443             return MSG_OOB;
444 #else
445             goto not_there;
446 #endif
447         if (strEQ(name, "MSG_PEEK"))
448 #if defined(MSG_PEEK) || defined(HAS_MSG_PEEK) /* might be an enum */
449             return MSG_PEEK;
450 #else
451             goto not_there;
452 #endif
453         if (strEQ(name, "MSG_PROXY"))
454 #if defined(MSG_PROXY) || defined(HAS_MSG_PROXY) /* might be an enum */
455             return MSG_PROXY;
456 #else
457             goto not_there;
458 #endif
459         if (strEQ(name, "MSG_RST"))
460 #ifdef MSG_RST
461             return MSG_RST;
462 #else
463             goto not_there;
464 #endif
465         if (strEQ(name, "MSG_SYN"))
466 #ifdef MSG_SYN
467             return MSG_SYN;
468 #else
469             goto not_there;
470 #endif
471         if (strEQ(name, "MSG_TRUNC"))
472 #ifdef MSG_TRUNC
473             return MSG_TRUNC;
474 #else
475             goto not_there;
476 #endif
477         if (strEQ(name, "MSG_WAITALL"))
478 #ifdef MSG_WAITALL
479             return MSG_WAITALL;
480 #else
481             goto not_there;
482 #endif
483         break;
484     case 'N':
485         break;
486     case 'O':
487         break;
488     case 'P':
489         if (strEQ(name, "PF_802"))
490 #ifdef PF_802
491             return PF_802;
492 #else
493             goto not_there;
494 #endif
495         if (strEQ(name, "PF_APPLETALK"))
496 #ifdef PF_APPLETALK
497             return PF_APPLETALK;
498 #else
499             goto not_there;
500 #endif
501         if (strEQ(name, "PF_CCITT"))
502 #ifdef PF_CCITT
503             return PF_CCITT;
504 #else
505             goto not_there;
506 #endif
507         if (strEQ(name, "PF_CHAOS"))
508 #ifdef PF_CHAOS
509             return PF_CHAOS;
510 #else
511             goto not_there;
512 #endif
513         if (strEQ(name, "PF_DATAKIT"))
514 #ifdef PF_DATAKIT
515             return PF_DATAKIT;
516 #else
517             goto not_there;
518 #endif
519         if (strEQ(name, "PF_DECnet"))
520 #ifdef PF_DECnet
521             return PF_DECnet;
522 #else
523             goto not_there;
524 #endif
525         if (strEQ(name, "PF_DLI"))
526 #ifdef PF_DLI
527             return PF_DLI;
528 #else
529             goto not_there;
530 #endif
531         if (strEQ(name, "PF_ECMA"))
532 #ifdef PF_ECMA
533             return PF_ECMA;
534 #else
535             goto not_there;
536 #endif
537         if (strEQ(name, "PF_GOSIP"))
538 #ifdef PF_GOSIP
539             return PF_GOSIP;
540 #else
541             goto not_there;
542 #endif
543         if (strEQ(name, "PF_HYLINK"))
544 #ifdef PF_HYLINK
545             return PF_HYLINK;
546 #else
547             goto not_there;
548 #endif
549         if (strEQ(name, "PF_IMPLINK"))
550 #ifdef PF_IMPLINK
551             return PF_IMPLINK;
552 #else
553             goto not_there;
554 #endif
555         if (strEQ(name, "PF_INET"))
556 #ifdef PF_INET
557             return PF_INET;
558 #else
559             goto not_there;
560 #endif
561         if (strEQ(name, "PF_LAT"))
562 #ifdef PF_LAT
563             return PF_LAT;
564 #else
565             goto not_there;
566 #endif
567         if (strEQ(name, "PF_MAX"))
568 #ifdef PF_MAX
569             return PF_MAX;
570 #else
571             goto not_there;
572 #endif
573         if (strEQ(name, "PF_NBS"))
574 #ifdef PF_NBS
575             return PF_NBS;
576 #else
577             goto not_there;
578 #endif
579         if (strEQ(name, "PF_NIT"))
580 #ifdef PF_NIT
581             return PF_NIT;
582 #else
583             goto not_there;
584 #endif
585         if (strEQ(name, "PF_NS"))
586 #ifdef PF_NS
587             return PF_NS;
588 #else
589             goto not_there;
590 #endif
591         if (strEQ(name, "PF_OSI"))
592 #ifdef PF_OSI
593             return PF_OSI;
594 #else
595             goto not_there;
596 #endif
597         if (strEQ(name, "PF_OSINET"))
598 #ifdef PF_OSINET
599             return PF_OSINET;
600 #else
601             goto not_there;
602 #endif
603         if (strEQ(name, "PF_PUP"))
604 #ifdef PF_PUP
605             return PF_PUP;
606 #else
607             goto not_there;
608 #endif
609         if (strEQ(name, "PF_SNA"))
610 #ifdef PF_SNA
611             return PF_SNA;
612 #else
613             goto not_there;
614 #endif
615         if (strEQ(name, "PF_UNIX"))
616 #ifdef PF_UNIX
617             return PF_UNIX;
618 #else
619             goto not_there;
620 #endif
621         if (strEQ(name, "PF_UNSPEC"))
622 #ifdef PF_UNSPEC
623             return PF_UNSPEC;
624 #else
625             goto not_there;
626 #endif
627         if (strEQ(name, "PF_X25"))
628 #ifdef PF_X25
629             return PF_X25;
630 #else
631             goto not_there;
632 #endif
633         break;
634     case 'Q':
635         break;
636     case 'R':
637         break;
638     case 'S':
639         if (strEQ(name, "SCM_CONNECT"))
640 #ifdef SCM_CONNECT
641             return SCM_CONNECT;
642 #else
643             goto not_there;
644 #endif
645         if (strEQ(name, "SCM_CREDENTIALS"))
646 #ifdef SCM_CREDENTIALS
647             return SCM_CREDENTIALS;
648 #else
649             goto not_there;
650 #endif
651         if (strEQ(name, "SCM_CREDS"))
652 #ifdef SCM_CREDS
653             return SCM_CREDS;
654 #else
655             goto not_there;
656 #endif
657         if (strEQ(name, "SCM_RIGHTS"))
658 #if defined(SCM_RIGHTS) || defined(HAS_SCM_RIGHTS) /* might be an enum */
659             return SCM_RIGHTS;
660 #else
661             goto not_there;
662 #endif
663         if (strEQ(name, "SCM_TIMESTAMP"))
664 #ifdef SCM_TIMESTAMP
665             return SCM_TIMESTAMP;
666 #else
667             goto not_there;
668 #endif
669         if (strEQ(name, "SHUT_RD"))
670 #ifdef SHUT_RD
671             return SHUT_RD;
672 #else
673             return 0;
674 #endif
675         if (strEQ(name, "SHUT_RDWR"))
676 #ifdef SHUT_RDWR
677             return SHUT_RDWR;
678 #else
679             return 2;
680 #endif
681         if (strEQ(name, "SHUT_WR"))
682 #ifdef SHUT_WR
683             return SHUT_WR;
684 #else
685             return 1;
686 #endif
687         if (strEQ(name, "SOCK_DGRAM"))
688 #ifdef SOCK_DGRAM
689             return SOCK_DGRAM;
690 #else
691             goto not_there;
692 #endif
693         if (strEQ(name, "SOCK_RAW"))
694 #ifdef SOCK_RAW
695             return SOCK_RAW;
696 #else
697             goto not_there;
698 #endif
699         if (strEQ(name, "SOCK_RDM"))
700 #ifdef SOCK_RDM
701             return SOCK_RDM;
702 #else
703             goto not_there;
704 #endif
705         if (strEQ(name, "SOCK_SEQPACKET"))
706 #ifdef SOCK_SEQPACKET
707             return SOCK_SEQPACKET;
708 #else
709             goto not_there;
710 #endif
711         if (strEQ(name, "SOCK_STREAM"))
712 #ifdef SOCK_STREAM
713             return SOCK_STREAM;
714 #else
715             goto not_there;
716 #endif
717         if (strEQ(name, "SOL_SOCKET"))
718 #ifdef SOL_SOCKET
719             return SOL_SOCKET;
720 #else
721             goto not_there;
722 #endif
723         if (strEQ(name, "SOMAXCONN"))
724 #ifdef SOMAXCONN
725             return SOMAXCONN;
726 #else
727             goto not_there;
728 #endif
729         if (strEQ(name, "SO_ACCEPTCONN"))
730 #ifdef SO_ACCEPTCONN
731             return SO_ACCEPTCONN;
732 #else
733             goto not_there;
734 #endif
735         if (strEQ(name, "SO_BROADCAST"))
736 #ifdef SO_BROADCAST
737             return SO_BROADCAST;
738 #else
739             goto not_there;
740 #endif
741         if (strEQ(name, "SO_DEBUG"))
742 #ifdef SO_DEBUG
743             return SO_DEBUG;
744 #else
745             goto not_there;
746 #endif
747         if (strEQ(name, "SO_DONTLINGER"))
748 #ifdef SO_DONTLINGER
749             return SO_DONTLINGER;
750 #else
751             goto not_there;
752 #endif
753         if (strEQ(name, "SO_DONTROUTE"))
754 #ifdef SO_DONTROUTE
755             return SO_DONTROUTE;
756 #else
757             goto not_there;
758 #endif
759         if (strEQ(name, "SO_ERROR"))
760 #ifdef SO_ERROR
761             return SO_ERROR;
762 #else
763             goto not_there;
764 #endif
765         if (strEQ(name, "SO_KEEPALIVE"))
766 #ifdef SO_KEEPALIVE
767             return SO_KEEPALIVE;
768 #else
769             goto not_there;
770 #endif
771         if (strEQ(name, "SO_LINGER"))
772 #ifdef SO_LINGER
773             return SO_LINGER;
774 #else
775             goto not_there;
776 #endif
777         if (strEQ(name, "SO_OOBINLINE"))
778 #ifdef SO_OOBINLINE
779             return SO_OOBINLINE;
780 #else
781             goto not_there;
782 #endif
783         if (strEQ(name, "SO_RCVBUF"))
784 #ifdef SO_RCVBUF
785             return SO_RCVBUF;
786 #else
787             goto not_there;
788 #endif
789         if (strEQ(name, "SO_RCVLOWAT"))
790 #ifdef SO_RCVLOWAT
791             return SO_RCVLOWAT;
792 #else
793             goto not_there;
794 #endif
795         if (strEQ(name, "SO_RCVTIMEO"))
796 #ifdef SO_RCVTIMEO
797             return SO_RCVTIMEO;
798 #else
799             goto not_there;
800 #endif
801         if (strEQ(name, "SO_REUSEADDR"))
802 #ifdef SO_REUSEADDR
803             return SO_REUSEADDR;
804 #else
805             goto not_there;
806 #endif
807         if (strEQ(name, "SO_REUSEPORT"))
808 #ifdef SO_REUSEPORT
809             return SO_REUSEPORT;
810 #else
811             goto not_there;
812 #endif
813         if (strEQ(name, "SO_SNDBUF"))
814 #ifdef SO_SNDBUF
815             return SO_SNDBUF;
816 #else
817             goto not_there;
818 #endif
819         if (strEQ(name, "SO_SNDLOWAT"))
820 #ifdef SO_SNDLOWAT
821             return SO_SNDLOWAT;
822 #else
823             goto not_there;
824 #endif
825         if (strEQ(name, "SO_SNDTIMEO"))
826 #ifdef SO_SNDTIMEO
827             return SO_SNDTIMEO;
828 #else
829             goto not_there;
830 #endif
831         if (strEQ(name, "SO_TYPE"))
832 #ifdef SO_TYPE
833             return SO_TYPE;
834 #else
835             goto not_there;
836 #endif
837         if (strEQ(name, "SO_USELOOPBACK"))
838 #ifdef SO_USELOOPBACK
839             return SO_USELOOPBACK;
840 #else
841             goto not_there;
842 #endif
843         break;
844     case 'T':
845         if (strEQ(name, "TCP_KEEPALIVE"))
846 #ifdef TCP_KEEPALIVE
847             return TCP_KEEPALIVE;
848 #else
849             goto not_there;
850 #endif
851         if (strEQ(name, "TCP_MAXRT"))
852 #ifdef TCP_MAXRT
853             return TCP_MAXRT;
854 #else
855             goto not_there;
856 #endif
857         if (strEQ(name, "TCP_MAXSEG"))
858 #ifdef TCP_MAXSEG
859             return TCP_MAXSEG;
860 #else
861             goto not_there;
862 #endif
863         if (strEQ(name, "TCP_NODELAY"))
864 #ifdef TCP_NODELAY
865             return TCP_NODELAY;
866 #else
867             goto not_there;
868 #endif
869         if (strEQ(name, "TCP_STDURG"))
870 #ifdef TCP_STDURG
871             return TCP_STDURG;
872 #else
873             goto not_there;
874 #endif
875         break;
876     case 'U':
877         if (strEQ(name, "UIO_MAXIOV"))
878 #ifdef UIO_MAXIOV
879             return UIO_MAXIOV;
880 #else
881             goto not_there;
882 #endif
883         break;
884     case 'V':
885         break;
886     case 'W':
887         break;
888     case 'X':
889         break;
890     case 'Y':
891         break;
892     case 'Z':
893         break;
894     }
895     errno = EINVAL;
896     return 0;
897
898 not_there:
899     errno = ENOENT;
900     return 0;
901 }
902
903
904 MODULE = Socket         PACKAGE = Socket
905
906 double
907 constant(name,arg)
908         char *          name
909         int             arg
910
911
912 void
913 inet_aton(host)
914         char *  host
915         CODE:
916         {
917         struct in_addr ip_address;
918         struct hostent * phe;
919         int ok = inet_aton(host, &ip_address);
920
921         if (!ok && (phe = gethostbyname(host))) {
922                 Copy( phe->h_addr, &ip_address, phe->h_length, char );
923                 ok = 1;
924         }
925
926         ST(0) = sv_newmortal();
927         if (ok) {
928                 sv_setpvn( ST(0), (char *)&ip_address, sizeof ip_address );
929         }
930         }
931
932 void
933 inet_ntoa(ip_address_sv)
934         SV *    ip_address_sv
935         CODE:
936         {
937         STRLEN addrlen;
938         struct in_addr addr;
939         char * addr_str;
940         char * ip_address = SvPV(ip_address_sv,addrlen);
941         if (addrlen != sizeof(addr)) {
942             croak("Bad arg length for %s, length is %d, should be %d",
943                         "Socket::inet_ntoa",
944                         addrlen, sizeof(addr));
945         }
946
947         Copy( ip_address, &addr, sizeof addr, char );
948         addr_str = inet_ntoa(addr);
949
950         ST(0) = sv_2mortal(newSVpvn(addr_str, strlen(addr_str)));
951         }
952
953 void
954 pack_sockaddr_un(pathname)
955         char *  pathname
956         CODE:
957         {
958 #ifdef I_SYS_UN
959         struct sockaddr_un sun_ad; /* fear using sun */
960         STRLEN len;
961
962         Zero( &sun_ad, sizeof sun_ad, char );
963         sun_ad.sun_family = AF_UNIX;
964         len = strlen(pathname);
965         if (len > sizeof(sun_ad.sun_path))
966             len = sizeof(sun_ad.sun_path);
967 #  ifdef OS2    /* Name should start with \socket\ and contain backslashes! */
968         {
969             int off;
970             char *s, *e;
971
972             if (pathname[0] != '/' && pathname[0] != '\\')
973                 croak("Relative UNIX domain socket name '%s' unsupported", pathname);
974             else if (len < 8 
975                      || pathname[7] != '/' && pathname[7] != '\\'
976                      || !strnicmp(pathname + 1, "socket", 6))
977                 off = 7;
978             else
979                 off = 0;                /* Preserve names starting with \socket\ */
980             Copy( "\\socket", sun_ad.sun_path, off, char);
981             Copy( pathname, sun_ad.sun_path + off, len, char );
982
983             s = sun_ad.sun_path + off - 1;
984             e = s + len + 1;
985             while (++s < e)
986                 if (*s = '/')
987                     *s = '\\';
988         }
989 #  else /* !( defined OS2 ) */ 
990         Copy( pathname, sun_ad.sun_path, len, char );
991 #  endif
992         ST(0) = sv_2mortal(newSVpvn((char *)&sun_ad, sizeof sun_ad));
993 #else
994         ST(0) = (SV *) not_here("pack_sockaddr_un");
995 #endif
996         
997         }
998
999 void
1000 unpack_sockaddr_un(sun_sv)
1001         SV *    sun_sv
1002         CODE:
1003         {
1004 #ifdef I_SYS_UN
1005         struct sockaddr_un addr;
1006         STRLEN sockaddrlen;
1007         char * sun_ad = SvPV(sun_sv,sockaddrlen);
1008         char * e;
1009
1010         if (sockaddrlen != sizeof(addr)) {
1011             croak("Bad arg length for %s, length is %d, should be %d",
1012                         "Socket::unpack_sockaddr_un",
1013                         sockaddrlen, sizeof(addr));
1014         }
1015
1016         Copy( sun_ad, &addr, sizeof addr, char );
1017
1018         if ( addr.sun_family != AF_UNIX ) {
1019             croak("Bad address family for %s, got %d, should be %d",
1020                         "Socket::unpack_sockaddr_un",
1021                         addr.sun_family,
1022                         AF_UNIX);
1023         }
1024         e = addr.sun_path;
1025         while (*e && e < addr.sun_path + sizeof addr.sun_path)
1026             ++e;
1027         ST(0) = sv_2mortal(newSVpvn(addr.sun_path, e - addr.sun_path));
1028 #else
1029         ST(0) = (SV *) not_here("unpack_sockaddr_un");
1030 #endif
1031         }
1032
1033 void
1034 pack_sockaddr_in(port,ip_address)
1035         unsigned short  port
1036         char *  ip_address
1037         CODE:
1038         {
1039         struct sockaddr_in sin;
1040
1041         Zero( &sin, sizeof sin, char );
1042         sin.sin_family = AF_INET;
1043         sin.sin_port = htons(port);
1044         Copy( ip_address, &sin.sin_addr, sizeof sin.sin_addr, char );
1045
1046         ST(0) = sv_2mortal(newSVpvn((char *)&sin, sizeof sin));
1047         }
1048
1049 void
1050 unpack_sockaddr_in(sin_sv)
1051         SV *    sin_sv
1052         PPCODE:
1053         {
1054         STRLEN sockaddrlen;
1055         struct sockaddr_in addr;
1056         unsigned short  port;
1057         struct in_addr  ip_address;
1058         char *  sin = SvPV(sin_sv,sockaddrlen);
1059         if (sockaddrlen != sizeof(addr)) {
1060             croak("Bad arg length for %s, length is %d, should be %d",
1061                         "Socket::unpack_sockaddr_in",
1062                         sockaddrlen, sizeof(addr));
1063         }
1064         Copy( sin, &addr,sizeof addr, char );
1065         if ( addr.sin_family != AF_INET ) {
1066             croak("Bad address family for %s, got %d, should be %d",
1067                         "Socket::unpack_sockaddr_in",
1068                         addr.sin_family,
1069                         AF_INET);
1070         } 
1071         port = ntohs(addr.sin_port);
1072         ip_address = addr.sin_addr;
1073
1074         EXTEND(SP, 2);
1075         PUSHs(sv_2mortal(newSViv((IV) port)));
1076         PUSHs(sv_2mortal(newSVpvn((char *)&ip_address,sizeof ip_address)));
1077         }
1078
1079 void
1080 INADDR_ANY()
1081         CODE:
1082         {
1083         struct in_addr  ip_address;
1084         ip_address.s_addr = htonl(INADDR_ANY);
1085         ST(0) = sv_2mortal(newSVpvn((char *)&ip_address,sizeof ip_address ));
1086         }
1087
1088 void
1089 INADDR_LOOPBACK()
1090         CODE:
1091         {
1092         struct in_addr  ip_address;
1093         ip_address.s_addr = htonl(INADDR_LOOPBACK);
1094         ST(0) = sv_2mortal(newSVpvn((char *)&ip_address,sizeof ip_address));
1095         }
1096
1097 void
1098 INADDR_NONE()
1099         CODE:
1100         {
1101         struct in_addr  ip_address;
1102         ip_address.s_addr = htonl(INADDR_NONE);
1103         ST(0) = sv_2mortal(newSVpvn((char *)&ip_address,sizeof ip_address));
1104         }
1105
1106 void
1107 INADDR_BROADCAST()
1108         CODE:
1109         {
1110         struct in_addr  ip_address;
1111         ip_address.s_addr = htonl(INADDR_BROADCAST);
1112         ST(0) = sv_2mortal(newSVpvn((char *)&ip_address,sizeof ip_address));
1113         }