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
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
|
/* sockadapt.c
*
* Author: Charles Bailey bailey@newman.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
/* We have these on VMS 7.0 and above, or on Dec C 5.6 if it's providing */
/* the 7.0 DECC RTL */
#if ((((__VMS_VER >= 70000000) && (__DECC_VER >= 50200000)) || (__CRTL_VER >= 70000000)) && defined(DECCRTL_SOCKETS))
#else
void setnetent(int stayopen) {
dTHX;
Perl_croak(aTHX_ "Function \"setnetent\" not implemented in this version of perl");
}
void endnetent() {
dTHX;
Perl_croak(aTHX_ "Function \"endnetent\" not implemented in this version of perl");
}
#endif
#if defined(DECCRTL_SOCKETS)
/* Use builtin socket interface in DECCRTL and
* UCX emulation in whatever TCP/IP stack is present.
*/
#if ((__VMS_VER >= 70000000) && (__DECC_VER >= 50200000)) || (__CRTL_VER >= 70000000)
#else
void sethostent(int stayopen) {
dTHX;
Perl_croak(aTHX_ "Function \"sethostent\" not implemented in this version of perl");
}
void endhostent() {
dTHX;
Perl_croak(aTHX_ "Function \"endhostent\" not implemented in this version of perl");
}
void setprotoent(int stayopen) {
dTHX;
Perl_croak(aTHX_ "Function \"setprotoent\" not implemented in this version of perl");
}
void endprotoent() {
dTHX;
Perl_croak(aTHX_ "Function \"endprotoent\" not implemented in this version of perl");
}
void setservent(int stayopen) {
dTHX;
Perl_croak(aTHX_ "Function \"setservent\" not implemented in this version of perl");
}
void endservent() {
dTHX;
Perl_croak(aTHX_ "Function \"endservent\" not implemented in this version of perl");
}
__sockadapt_my_hostent_t gethostent() {
dTHX;
Perl_croak(aTHX_ "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() {
dTHX;
Perl_croak(aTHX_ "Function \"getservent\" not implemented in this version of perl");
return (__sockadapt_my_servent_t )NULL; /* Avoid MISSINGRETURN warning, not reached */
}
#endif
#else
/* Work around things missing/broken in SOCKETSHR. */
__sockadapt_my_netent_t getnetbyaddr( __sockadapt_my_addr_t net, int type) {
dTHX;
Perl_croak(aTHX_ "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) {
dTHX;
Perl_croak(aTHX_ "Function \"getnetbyname\" not implemented in this version of perl");
return (struct netent *)NULL; /* Avoid MISSINGRETURN warning, not reached */
}
__sockadapt_my_netent_t getnetent() {
dTHX;
Perl_croak(aTHX_ "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 */
|
