1 | /* sockadapt.c |
---|
2 | * |
---|
3 | * Author: Charles Bailey bailey@newman.upenn.edu |
---|
4 | * Last Revised: 4-Mar-1997 |
---|
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 | * |
---|
11 | * This version is set up for perl5 with UCX (or emulation) via |
---|
12 | * the DECCRTL or SOCKETSHR 0.9D. |
---|
13 | */ |
---|
14 | |
---|
15 | #include "EXTERN.h" |
---|
16 | #include "perl.h" |
---|
17 | |
---|
18 | #if defined(__DECC) && defined(__DECC_VER) && (__DECC_VER >= 50200000) |
---|
19 | # define __sockadapt_my_hostent_t __struct_hostent_ptr32 |
---|
20 | # define __sockadapt_my_netent_t __struct_netent_ptr32 |
---|
21 | # define __sockadapt_my_servent_t __struct_servent_ptr32 |
---|
22 | # define __sockadapt_my_addr_t __in_addr_t |
---|
23 | # define __sockadapt_my_name_t const char * |
---|
24 | #else |
---|
25 | # define __sockadapt_my_hostent_t struct hostent * |
---|
26 | # define __sockadapt_my_netent_t struct netent * |
---|
27 | # define __sockadapt_my_servent_t struct servent * |
---|
28 | # define __sockadapt_my_addr_t long |
---|
29 | # define __sockadapt_my_name_t char * |
---|
30 | #endif |
---|
31 | |
---|
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 |
---|
36 | void setnetent(int stayopen) { |
---|
37 | croak("Function \"setnetent\" not implemented in this version of perl"); |
---|
38 | } |
---|
39 | void endnetent() { |
---|
40 | croak("Function \"endnetent\" not implemented in this version of perl"); |
---|
41 | } |
---|
42 | #endif |
---|
43 | |
---|
44 | #if defined(DECCRTL_SOCKETS) |
---|
45 | /* Use builtin socket interface in DECCRTL and |
---|
46 | * UCX emulation in whatever TCP/IP stack is present. |
---|
47 | */ |
---|
48 | |
---|
49 | #if ((__VMS_VER >= 70000000) && (__DECC_VER >= 50200000)) || (__CRTL_VER >= 70000000) |
---|
50 | #else |
---|
51 | void sethostent(int stayopen) { |
---|
52 | croak("Function \"sethostent\" not implemented in this version of perl"); |
---|
53 | } |
---|
54 | void endhostent() { |
---|
55 | croak("Function \"endhostent\" not implemented in this version of perl"); |
---|
56 | } |
---|
57 | void setprotoent(int stayopen) { |
---|
58 | croak("Function \"setprotoent\" not implemented in this version of perl"); |
---|
59 | } |
---|
60 | void endprotoent() { |
---|
61 | croak("Function \"endprotoent\" not implemented in this version of perl"); |
---|
62 | } |
---|
63 | void setservent(int stayopen) { |
---|
64 | croak("Function \"setservent\" not implemented in this version of perl"); |
---|
65 | } |
---|
66 | void endservent() { |
---|
67 | croak("Function \"endservent\" not implemented in this version of perl"); |
---|
68 | } |
---|
69 | __sockadapt_my_hostent_t gethostent() { |
---|
70 | croak("Function \"gethostent\" not implemented in this version of perl"); |
---|
71 | return (__sockadapt_my_hostent_t )NULL; /* Avoid MISSINGRETURN warning, not reached */ |
---|
72 | } |
---|
73 | __sockadapt_my_servent_t getservent() { |
---|
74 | croak("Function \"getservent\" not implemented in this version of perl"); |
---|
75 | return (__sockadapt_my_servent_t )NULL; /* Avoid MISSINGRETURN warning, not reached */ |
---|
76 | } |
---|
77 | #endif |
---|
78 | |
---|
79 | #else |
---|
80 | /* Work around things missing/broken in SOCKETSHR. */ |
---|
81 | |
---|
82 | __sockadapt_my_netent_t getnetbyaddr( __sockadapt_my_addr_t net, int type) { |
---|
83 | croak("Function \"getnetbyaddr\" not implemented in this version of perl"); |
---|
84 | return (struct netent *)NULL; /* Avoid MISSINGRETURN warning, not reached */ |
---|
85 | } |
---|
86 | __sockadapt_my_netent_t getnetbyname( __sockadapt_my_name_t name) { |
---|
87 | croak("Function \"getnetbyname\" not implemented in this version of perl"); |
---|
88 | return (struct netent *)NULL; /* Avoid MISSINGRETURN warning, not reached */ |
---|
89 | } |
---|
90 | __sockadapt_my_netent_t getnetent() { |
---|
91 | croak("Function \"getnetent\" not implemented in this version of perl"); |
---|
92 | return (__sockadapt_my_netent_t )NULL; /* Avoid MISSINGRETURN warning, not reached */ |
---|
93 | } |
---|
94 | |
---|
95 | /* Some TCP/IP implementations seem to return success, when getpeername() |
---|
96 | * is called on a UDP socket, but the port and in_addr are all zeroes. |
---|
97 | */ |
---|
98 | |
---|
99 | int my_getpeername(int sock, struct sockaddr *addr, int *addrlen) { |
---|
100 | 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"; |
---|
101 | int rslt; |
---|
102 | |
---|
103 | rslt = si_getpeername(sock, addr, addrlen); |
---|
104 | |
---|
105 | /* Just pass an error back up the line */ |
---|
106 | if (rslt) return rslt; |
---|
107 | |
---|
108 | /* If the call succeeded, make sure we don't have a zeroed port/addr */ |
---|
109 | if (addr->sa_family == AF_INET && |
---|
110 | !memcmp((char *)addr + sizeof(u_short), nowhere, |
---|
111 | sizeof(u_short) + sizeof(struct in_addr))) { |
---|
112 | rslt = -1; |
---|
113 | SETERRNO(ENOTCONN,SS$_CLEARED); |
---|
114 | } |
---|
115 | return rslt; |
---|
116 | } |
---|
117 | #endif /* SOCKETSHR stuff */ |
---|