vms/sockadapt.c

   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 */