Commit | Line | Data |
---|---|---|
a0d0e21e LW |
1 | /* sockadapt.c |
2 | * | |
bd3fa61c | 3 | * Author: Charles Bailey bailey@newman.upenn.edu |
9607fc9c | 4 | * Last Revised: 4-Mar-1997 |
a0d0e21e LW |
5 | * |
6 | * This file should contain stubs for any of the TCP/IP functions perl5 | |
7 | * requires which are not supported by your TCP/IP stack. These stubs | |
8 | * can attempt to emulate the routine in question, or can just return | |
9 | * an error status or cause perl to die. | |
10 | * | |
9607fc9c | 11 | * This version is set up for perl5 with UCX (or emulation) via |
12 | * the DECCRTL or SOCKETSHR 0.9D. | |
a0d0e21e LW |
13 | */ |
14 | ||
4633a7c4 LW |
15 | #include "EXTERN.h" |
16 | #include "perl.h" | |
9607fc9c | 17 | |
c07a80fd | 18 | #if defined(__DECC) && defined(__DECC_VER) && (__DECC_VER >= 50200000) |
9607fc9c | 19 | # define __sockadapt_my_hostent_t __struct_hostent_ptr32 |
c07a80fd | 20 | # define __sockadapt_my_netent_t __struct_netent_ptr32 |
9607fc9c | 21 | # define __sockadapt_my_servent_t __struct_servent_ptr32 |
c07a80fd | 22 | # define __sockadapt_my_addr_t __in_addr_t |
23 | # define __sockadapt_my_name_t const char * | |
24 | #else | |
9607fc9c | 25 | # define __sockadapt_my_hostent_t struct hostent * |
c07a80fd | 26 | # define __sockadapt_my_netent_t struct netent * |
9607fc9c | 27 | # define __sockadapt_my_servent_t struct servent * |
c07a80fd | 28 | # define __sockadapt_my_addr_t long |
29 | # define __sockadapt_my_name_t char * | |
30 | #endif | |
a0d0e21e | 31 | |
84902520 TB |
32 | /* We have these on VMS 7.0 and above, or on Dec C 5.6 if it's providing */ |
33 | /* the 7.0 DECC RTL */ | |
34 | #if ((((__VMS_VER >= 70000000) && (__DECC_VER >= 50200000)) || (__CRTL_VER >= 70000000)) && defined(DECCRTL_SOCKETS)) | |
35 | #else | |
9607fc9c | 36 | void setnetent(int stayopen) { |
32af7c23 CL |
37 | dTHX; |
38 | Perl_croak(aTHX_ "Function \"setnetent\" not implemented in this version of perl"); | |
9607fc9c | 39 | } |
40 | void endnetent() { | |
32af7c23 CL |
41 | dTHX; |
42 | Perl_croak(aTHX_ "Function \"endnetent\" not implemented in this version of perl"); | |
9607fc9c | 43 | } |
84902520 | 44 | #endif |
9607fc9c | 45 | |
46 | #if defined(DECCRTL_SOCKETS) | |
47 | /* Use builtin socket interface in DECCRTL and | |
48 | * UCX emulation in whatever TCP/IP stack is present. | |
49 | */ | |
50 | ||
84902520 TB |
51 | #if ((__VMS_VER >= 70000000) && (__DECC_VER >= 50200000)) || (__CRTL_VER >= 70000000) |
52 | #else | |
9607fc9c | 53 | void sethostent(int stayopen) { |
32af7c23 CL |
54 | dTHX; |
55 | Perl_croak(aTHX_ "Function \"sethostent\" not implemented in this version of perl"); | |
9607fc9c | 56 | } |
57 | void endhostent() { | |
32af7c23 CL |
58 | dTHX; |
59 | Perl_croak(aTHX_ "Function \"endhostent\" not implemented in this version of perl"); | |
9607fc9c | 60 | } |
61 | void setprotoent(int stayopen) { | |
32af7c23 CL |
62 | dTHX; |
63 | Perl_croak(aTHX_ "Function \"setprotoent\" not implemented in this version of perl"); | |
9607fc9c | 64 | } |
65 | void endprotoent() { | |
32af7c23 CL |
66 | dTHX; |
67 | Perl_croak(aTHX_ "Function \"endprotoent\" not implemented in this version of perl"); | |
9607fc9c | 68 | } |
69 | void setservent(int stayopen) { | |
32af7c23 CL |
70 | dTHX; |
71 | Perl_croak(aTHX_ "Function \"setservent\" not implemented in this version of perl"); | |
9607fc9c | 72 | } |
73 | void endservent() { | |
32af7c23 CL |
74 | dTHX; |
75 | Perl_croak(aTHX_ "Function \"endservent\" not implemented in this version of perl"); | |
9607fc9c | 76 | } |
77 | __sockadapt_my_hostent_t gethostent() { | |
32af7c23 CL |
78 | dTHX; |
79 | Perl_croak(aTHX_ "Function \"gethostent\" not implemented in this version of perl"); | |
9607fc9c | 80 | return (__sockadapt_my_hostent_t )NULL; /* Avoid MISSINGRETURN warning, not reached */ |
81 | } | |
82 | __sockadapt_my_servent_t getservent() { | |
32af7c23 CL |
83 | dTHX; |
84 | Perl_croak(aTHX_ "Function \"getservent\" not implemented in this version of perl"); | |
9607fc9c | 85 | return (__sockadapt_my_servent_t )NULL; /* Avoid MISSINGRETURN warning, not reached */ |
86 | } | |
84902520 | 87 | #endif |
9607fc9c | 88 | |
89 | #else | |
90 | /* Work around things missing/broken in SOCKETSHR. */ | |
91 | ||
c07a80fd | 92 | __sockadapt_my_netent_t getnetbyaddr( __sockadapt_my_addr_t net, int type) { |
32af7c23 CL |
93 | dTHX; |
94 | Perl_croak(aTHX_ "Function \"getnetbyaddr\" not implemented in this version of perl"); | |
4633a7c4 LW |
95 | return (struct netent *)NULL; /* Avoid MISSINGRETURN warning, not reached */ |
96 | } | |
c07a80fd | 97 | __sockadapt_my_netent_t getnetbyname( __sockadapt_my_name_t name) { |
32af7c23 CL |
98 | dTHX; |
99 | Perl_croak(aTHX_ "Function \"getnetbyname\" not implemented in this version of perl"); | |
4633a7c4 LW |
100 | return (struct netent *)NULL; /* Avoid MISSINGRETURN warning, not reached */ |
101 | } | |
c07a80fd | 102 | __sockadapt_my_netent_t getnetent() { |
32af7c23 CL |
103 | dTHX; |
104 | Perl_croak(aTHX_ "Function \"getnetent\" not implemented in this version of perl"); | |
9607fc9c | 105 | return (__sockadapt_my_netent_t )NULL; /* Avoid MISSINGRETURN warning, not reached */ |
c07a80fd | 106 | } |
42084d09 | 107 | |
108 | /* Some TCP/IP implementations seem to return success, when getpeername() | |
109 | * is called on a UDP socket, but the port and in_addr are all zeroes. | |
110 | */ | |
111 | ||
112 | int my_getpeername(int sock, struct sockaddr *addr, int *addrlen) { | |
113 | static char nowhere[] = "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0"; | |
114 | int rslt; | |
115 | ||
116 | rslt = si_getpeername(sock, addr, addrlen); | |
117 | ||
118 | /* Just pass an error back up the line */ | |
119 | if (rslt) return rslt; | |
120 | ||
121 | /* If the call succeeded, make sure we don't have a zeroed port/addr */ | |
122 | if (addr->sa_family == AF_INET && | |
123 | !memcmp((char *)addr + sizeof(u_short), nowhere, | |
124 | sizeof(u_short) + sizeof(struct in_addr))) { | |
125 | rslt = -1; | |
126 | SETERRNO(ENOTCONN,SS$_CLEARED); | |
127 | } | |
128 | return rslt; | |
129 | } | |
9607fc9c | 130 | #endif /* SOCKETSHR stuff */ |