home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / vms / sockadapt.c < prev    next >
C/C++ Source or Header  |  1999-07-20  |  4KB  |  118 lines
  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.   croak("Function \"setnetent\" not implemented in this version of perl");
  38. }
  39. void endnetent() {
  40.   croak("Function \"endnetent\" not implemented in this version of perl");
  41. }
  42. #endif
  43.  
  44. #if defined(DECCRTL_SOCKETS)
  45.    /* Use builtin socket interface in DECCRTL and
  46.     * UCX emulation in whatever TCP/IP stack is present.
  47.     */
  48.  
  49. #if ((__VMS_VER >= 70000000) && (__DECC_VER >= 50200000)) || (__CRTL_VER >= 70000000)
  50. #else
  51.   void sethostent(int stayopen) {
  52.     croak("Function \"sethostent\" not implemented in this version of perl");
  53.   }
  54.   void endhostent() {
  55.     croak("Function \"endhostent\" not implemented in this version of perl");
  56.   }
  57.   void setprotoent(int stayopen) {
  58.     croak("Function \"setprotoent\" not implemented in this version of perl");
  59.   }
  60.   void endprotoent() {
  61.     croak("Function \"endprotoent\" not implemented in this version of perl");
  62.   }
  63.   void setservent(int stayopen) {
  64.     croak("Function \"setservent\" not implemented in this version of perl");
  65.   }
  66.   void endservent() {
  67.     croak("Function \"endservent\" not implemented in this version of perl");
  68.   }
  69.   __sockadapt_my_hostent_t gethostent() {
  70.     croak("Function \"gethostent\" not implemented in this version of perl");
  71.     return (__sockadapt_my_hostent_t )NULL; /* Avoid MISSINGRETURN warning, not reached */
  72.   }
  73.   __sockadapt_my_servent_t getservent() {
  74.     croak("Function \"getservent\" not implemented in this version of perl");
  75.     return (__sockadapt_my_servent_t )NULL; /* Avoid MISSINGRETURN warning, not reached */
  76.   }
  77. #endif
  78.  
  79. #else
  80.     /* Work around things missing/broken in SOCKETSHR. */
  81.  
  82. __sockadapt_my_netent_t getnetbyaddr( __sockadapt_my_addr_t net, int type) {
  83.   croak("Function \"getnetbyaddr\" not implemented in this version of perl");
  84.   return (struct netent *)NULL; /* Avoid MISSINGRETURN warning, not reached */
  85. }
  86. __sockadapt_my_netent_t getnetbyname( __sockadapt_my_name_t name) {
  87.   croak("Function \"getnetbyname\" not implemented in this version of perl");
  88.   return (struct netent *)NULL; /* Avoid MISSINGRETURN warning, not reached */
  89. }
  90. __sockadapt_my_netent_t getnetent() {
  91.   croak("Function \"getnetent\" not implemented in this version of perl");
  92.   return (__sockadapt_my_netent_t )NULL; /* Avoid MISSINGRETURN warning, not reached */
  93. }
  94.  
  95. /* Some TCP/IP implementations seem to return success, when getpeername()
  96.  * is called on a UDP socket, but the port and in_addr are all zeroes.
  97.  */
  98.  
  99. int my_getpeername(int sock, struct sockaddr *addr, int *addrlen) {
  100.   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";
  101.   int rslt;
  102.  
  103.   rslt = si_getpeername(sock, addr, addrlen);
  104.  
  105.   /* Just pass an error back up the line */
  106.   if (rslt) return rslt;
  107.  
  108.   /* If the call succeeded, make sure we don't have a zeroed port/addr */
  109.   if (addr->sa_family == AF_INET &&
  110.       !memcmp((char *)addr + sizeof(u_short), nowhere,
  111.               sizeof(u_short) + sizeof(struct in_addr))) {
  112.     rslt = -1;
  113.     SETERRNO(ENOTCONN,SS$_CLEARED);
  114.   }
  115.   return rslt;
  116. }
  117. #endif /* SOCKETSHR stuff */
  118.