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