| 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 | dTHX; |
| 38 | Perl_croak(aTHX_ "Function \"setnetent\" not implemented in this version of perl"); |
| 39 | } |
| 40 | void 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 | |
| 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 | } |
| 130 | #endif /* SOCKETSHR stuff */ |