source: trunk/essentials/dev-lang/perl/vms/sockadapt.c

Last change on this file was 3181, checked in by bird, 19 years ago

perl 5.8.8
File size: 4.5 KB
Line 
1/* sockadapt.c
2 *
3 * Author: Charles Bailey [email protected]
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
36void setnetent(int stayopen) {
37 dTHX;
38 Perl_croak(aTHX_ "Function \"setnetent\" not implemented in this version of perl");
39}
40void endnetent() {
41 dTHX;
42 Perl_croak(aTHX_ "Function \"endnetent\" not implemented in this version of perl");
43}
44#endif
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
51#if ((__VMS_VER >= 70000000) && (__DECC_VER >= 50200000)) || (__CRTL_VER >= 70000000)
52#else
53 void sethostent(int stayopen) {
54 dTHX;
55 Perl_croak(aTHX_ "Function \"sethostent\" not implemented in this version of perl");
56 }
57 void endhostent() {
58 dTHX;
59 Perl_croak(aTHX_ "Function \"endhostent\" not implemented in this version of perl");
60 }
61 void setprotoent(int stayopen) {
62 dTHX;
63 Perl_croak(aTHX_ "Function \"setprotoent\" not implemented in this version of perl");
64 }
65 void endprotoent() {
66 dTHX;
67 Perl_croak(aTHX_ "Function \"endprotoent\" not implemented in this version of perl");
68 }
69 void setservent(int stayopen) {
70 dTHX;
71 Perl_croak(aTHX_ "Function \"setservent\" not implemented in this version of perl");
72 }
73 void endservent() {
74 dTHX;
75 Perl_croak(aTHX_ "Function \"endservent\" not implemented in this version of perl");
76 }
77 __sockadapt_my_hostent_t gethostent() {
78 dTHX;
79 Perl_croak(aTHX_ "Function \"gethostent\" not implemented in this version of perl");
80 return (__sockadapt_my_hostent_t )NULL; /* Avoid MISSINGRETURN warning, not reached */
81 }
82 __sockadapt_my_servent_t getservent() {
83 dTHX;
84 Perl_croak(aTHX_ "Function \"getservent\" not implemented in this version of perl");
85 return (__sockadapt_my_servent_t )NULL; /* Avoid MISSINGRETURN warning, not reached */
86 }
87#endif
88
89#else
90 /* Work around things missing/broken in SOCKETSHR. */
91
92__sockadapt_my_netent_t getnetbyaddr( __sockadapt_my_addr_t net, int type) {
93 dTHX;
94 Perl_croak(aTHX_ "Function \"getnetbyaddr\" not implemented in this version of perl");
95 return (struct netent *)NULL; /* Avoid MISSINGRETURN warning, not reached */
96}
97__sockadapt_my_netent_t getnetbyname( __sockadapt_my_name_t name) {
98 dTHX;
99 Perl_croak(aTHX_ "Function \"getnetbyname\" not implemented in this version of perl");
100 return (struct netent *)NULL; /* Avoid MISSINGRETURN warning, not reached */
101}
102__sockadapt_my_netent_t getnetent() {
103 dTHX;
104 Perl_croak(aTHX_ "Function \"getnetent\" not implemented in this version of perl");
105 return (__sockadapt_my_netent_t )NULL; /* Avoid MISSINGRETURN warning, not reached */
106}
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
112int 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}
130#endif /* SOCKETSHR stuff */
Note: See TracBrowser for help on using the repository browser.