home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / tkisrc04.zip / tcl / os2 / tclOS2HasSock.c < prev    next >
C/C++ Source or Header  |  1998-08-07  |  41KB  |  1,394 lines
  1. /* 
  2.  * tclOS2Sock.c --
  3.  *
  4.  *    This file contains OS/2-specific socket related code.
  5.  *
  6.  * Copyright (c) 1995-1996 Sun Microsystems, Inc.
  7.  * Copyright (c) 1996-1997 Illya Vaes
  8.  *
  9.  * See the file "license.terms" for information on usage and redistribution
  10.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  11.  *
  12.  */
  13.  
  14. #define FD_READ 0
  15. #define FD_WRITE 1
  16. #define FD_CLOSE 2
  17. #define FD_ACCEPT 3
  18. #define FD_CONNECT 4
  19.  
  20. #include "tclInt.h"
  21. #include "tclPort.h"
  22.  
  23. /* defines for how a socket is to be closed */
  24. #define HOW_RCV    0    /* further receives disabled */
  25. #define HOW_SND    1    /* further sends disabled */
  26. #define HOW_SNDRCV 2    /* further send and receives disabled */
  27. /* ERROR return value */
  28. #define SOCKET_ERROR -1
  29. /* INVALID SOCKET return value */
  30. #define INVALID_SOCKET -1
  31.  
  32. /*
  33.  * The following structure contains pointers to all of the WinSock API entry
  34.  * points used by Tcl.  It is initialized by InitSockets.  Since we
  35.  * dynamically load Winsock.dll on demand, we must use this function table
  36.  * to refer to functions in the socket API.
  37.  */
  38.  
  39. /* *MM* replaced all "APIENTRY  *" defs with the following #define */
  40. #ifdef EMX
  41. #define APIENTRYFPTR APIENTRY *
  42. #else
  43. #define APIENTRYPTR * APIENTRY
  44. typedef unsigned long u_long;
  45. typedef unsigned short u_short;
  46. #endif
  47.  
  48. static struct {
  49.     SOCKET (APIENTRYPTR accept)(SOCKET s, struct sockaddr  *addr,
  50.         int  *addrlen);
  51.     int (APIENTRYPTR bind)(SOCKET s, const struct sockaddr  *addr,
  52.         int namelen);
  53.     int (APIENTRYPTR soclose)(SOCKET s);
  54.     int (APIENTRYPTR connect)(SOCKET s, const struct sockaddr  *name,
  55.         int namelen);
  56.     int (APIENTRYPTR ioctlsocket)(SOCKET s, long cmd, u_long  *argp);
  57.     int (APIENTRYPTR getsockopt)(SOCKET s, int level, int optname,
  58.         void  * optval, int  *optlen);
  59.     u_short (APIENTRYPTR htons)(u_short hostshort);
  60.     unsigned long (APIENTRYPTR inet_addr)(const char  * cp);
  61.     char  * (APIENTRYPTR inet_ntoa)(struct in_addr in);
  62.     int (APIENTRYPTR listen)(SOCKET s, int backlog);
  63.     u_short (APIENTRYPTR ntohs)(u_short netshort);
  64.     int (APIENTRYPTR recv)(SOCKET s, void  * buf, int len, int flags);
  65.     int (APIENTRYPTR send)(SOCKET s, const void  * buf, int len, int flags);
  66.     int (APIENTRYPTR setsockopt)(SOCKET s, int level, int optname,
  67.         const void  * optval, int optlen);
  68.     int (APIENTRYPTR shutdown)(SOCKET s, int how);
  69.     SOCKET (APIENTRYPTR socket)(int af, int type, int protocol);
  70.     struct hostent  * (APIENTRYPTR gethostbyname)(const char  * name);
  71.     struct hostent  * (APIENTRYPTR gethostbyaddr)(const char  *addr,
  72.             int addrlen, int addrtype);
  73.     int (APIENTRYPTR gethostname)(char  * name, int namelen);
  74.     int (APIENTRYPTR getpeername)(SOCKET sock, struct sockaddr  *name,
  75.             int  *namelen);
  76.     struct servent  * (APIENTRYPTR getservbyname)(const char  * name,
  77.         const char  * proto);
  78.     int (APIENTRYPTR getsockname)(SOCKET sock, struct sockaddr  *name,
  79.             int  *namelen);
  80. } OS2Sock;
  81.  
  82. /*
  83.  * The following define declares a new user message for use on the
  84.  * socket window.
  85.  */
  86.  
  87. #define SOCKET_MESSAGE    WM_USER+1
  88.  
  89. /*
  90.  * The following structure is used to store the data associated with
  91.  * each socket.  A Tcl_File of type TCL_OS2_SOCKET will contain a
  92.  * pointer to one of these structures in the clientdata slot.
  93.  */
  94.  
  95. typedef struct SocketInfo {
  96.     SOCKET socket;           /* Windows SOCKET handle. */
  97.     int flags;               /* Bit field comprised of the flags
  98.                     * described below.  */
  99.     int checkMask;           /* OR'ed combination of TCL_READABLE and
  100.                     * TCL_WRITABLE as set by an asynchronous
  101.                     * event handler. */
  102.     int watchMask;           /* OR'ed combination of TCL_READABLE and
  103.                     * TCL_WRITABLE as set by Tcl_WatchFile. */
  104.     int eventMask;           /* OR'ed combination of FD_READ, FD_WRITE,
  105.                                     * FD_CLOSE, FD_ACCEPT and FD_CONNECT. */
  106.     Tcl_File file;           /* The file handle for the socket. */
  107.     Tcl_TcpAcceptProc *acceptProc; /* Proc to call on accept. */
  108.     ClientData acceptProcData;       /* The data for the accept proc. */
  109.     struct SocketInfo *nextPtr;       /* The next socket on the global socket
  110.                     * list. */
  111. } SocketInfo;
  112.  
  113. /*
  114.  * This defines the minimum buffersize maintained by the kernel.
  115.  */
  116.  
  117. #define TCP_BUFFER_SIZE 4096
  118.  
  119. /*
  120.  * The following macros may be used to set the flags field of
  121.  * a SocketInfo structure.
  122.  */
  123.  
  124. #define SOCKET_WATCH     (1<<1)
  125.                 /* TclOS2WatchSocket has been called since the
  126.                  * last time we entered Tcl_WaitForEvent. */
  127. #define SOCKET_REGISTERED (1<<2)
  128.                 /* A valid WSAAsyncSelect handler is
  129.                  * registered. */
  130. #define SOCKET_ASYNCH    (1<<3)
  131.                 /* The socket is in asynch mode. */
  132.  
  133. /*
  134.  * Every open socket has an entry on the following list.
  135.  */
  136.  
  137. static SocketInfo *socketList = NULL;
  138.  
  139. /*
  140.  * Static functions defined in this file.
  141.  */
  142.  
  143. static SocketInfo *    CreateSocket _ANSI_ARGS_((Tcl_Interp *interp,
  144.                 int port, char *host, int server, char *myaddr,
  145.                 int myport, int async));
  146. static int        CreateSocketAddress _ANSI_ARGS_(
  147.                 (struct sockaddr_in *sockaddrPtr,
  148.                 char *host, int port));
  149. static int        InitSockets _ANSI_ARGS_((void));
  150. static SocketInfo *    NewSocketInfo _ANSI_ARGS_((Tcl_File file));
  151. static void        TcpAccept _ANSI_ARGS_((ClientData data, int mask));
  152. static int        TcpCloseProc _ANSI_ARGS_((ClientData instanceData,
  153.                         Tcl_Interp *interp, Tcl_File inFile,
  154.                             Tcl_File outFile));
  155. static int        TcpGetOptionProc _ANSI_ARGS_((ClientData instanceData,
  156.                     char *optionName, Tcl_DString *optionValue));
  157. static int        TcpInputProc _ANSI_ARGS_((ClientData instanceData,
  158.                         Tcl_File inFile, char *buf, int toRead,
  159.                         int *errorCode));
  160. static int        TcpOutputProc _ANSI_ARGS_((ClientData instanceData,
  161.                         Tcl_File outFile, char *buf, int toWrite,
  162.                         int *errorCode));
  163.  
  164. /*
  165.  * This structure describes the channel type structure for TCP socket
  166.  * based IO.
  167.  */
  168.  
  169. static Tcl_ChannelType tcpChannelType = {
  170.     "tcp",        /* Type name. */
  171.     NULL,        /* Block: Not used. */
  172.     TcpCloseProc,    /* Close proc. */
  173.     TcpInputProc,    /* Input proc. */
  174.     TcpOutputProc,    /* Output proc. */
  175.     NULL,        /* Seek proc. */
  176.     NULL,        /* Set option proc. */
  177.     TcpGetOptionProc,    /* Get option proc. */
  178. };
  179.  
  180. /*
  181.  * Socket notification window.  This window is used to receive socket
  182.  * notification events.
  183.  */
  184.  
  185.  
  186. /*
  187.  *----------------------------------------------------------------------
  188.  *
  189.  * InitSockets --
  190.  *
  191.  *    Initialize the socket module.  Attempts to load the wsock32.dll
  192.  *    library and set up the OS2Sock function table.  If successful,
  193.  *    registers the event window for the socket notifier code.
  194.  *
  195.  * Results:
  196.  *    Returns 1 on successful initialization, 0 on failure.
  197.  *
  198.  * Side effects:
  199.  *    Dynamically loads wsock32.dll, and registers a new window
  200.  *    class and creates a window for use in asynchronous socket
  201.  *    notification.
  202.  *
  203.  *----------------------------------------------------------------------
  204.  */
  205.  
  206. static int
  207. InitSockets()
  208. {
  209.     /*
  210.      * Initialize the function table.
  211.      */
  212.  
  213. #ifdef DEBUG
  214.     printf("InitSockets\n");
  215. #endif
  216.  
  217.     OS2Sock.accept = accept;
  218.     OS2Sock.bind = bind;
  219.     OS2Sock.connect = connect;
  220.     OS2Sock.ioctlsocket = (int (APIENTRYPTR)(SOCKET s, long cmd,
  221.                            u_long *argp))ioctl;
  222.     OS2Sock.getsockopt = getsockopt;
  223.     OS2Sock.htons = _swaps;
  224.     OS2Sock.inet_addr = inet_addr;
  225.     OS2Sock.inet_ntoa = inet_ntoa;
  226.     OS2Sock.listen = listen;
  227.     OS2Sock.ntohs = _swaps;
  228.     OS2Sock.recv = recv;
  229.     OS2Sock.send = send;
  230.     OS2Sock.shutdown = shutdown;
  231.     OS2Sock.setsockopt = setsockopt;
  232.     OS2Sock.socket = socket;
  233.     OS2Sock.gethostbyaddr = gethostbyaddr;
  234.     OS2Sock.gethostbyname = gethostbyname;
  235.     OS2Sock.gethostname = gethostname;
  236.     OS2Sock.getpeername = getpeername;
  237.     OS2Sock.getservbyname = getservbyname;
  238.     OS2Sock.getsockname = getsockname;
  239.  
  240.     return 1;
  241. }
  242.  
  243. /*
  244.  *----------------------------------------------------------------------
  245.  *
  246.  * TcpCloseProc --
  247.  *
  248.  *    This procedure is called by the generic IO level to perform
  249.  *    channel type specific cleanup on a socket based channel
  250.  *    when the channel is closed.
  251.  *
  252.  * Results:
  253.  *    0 if successful, the value of errno if failed.
  254.  *
  255.  * Side effects:
  256.  *    Closes the socket.
  257.  *
  258.  *----------------------------------------------------------------------
  259.  */
  260.  
  261.     /* ARGSUSED */
  262. static int
  263. TcpCloseProc(instanceData, interp, inFile, outFile)
  264.     ClientData instanceData;    /* The socket to close. */
  265.     Tcl_Interp *interp;        /* Unused. */
  266.     Tcl_File inFile, outFile;    /* Unused. */
  267. {
  268.     SocketInfo *infoPtr = (SocketInfo *) instanceData;
  269.     int errorCode = 0;
  270.  
  271.     /*
  272.      * Clean up the OS socket handle.
  273.      */
  274.     
  275.     if ((*OS2Sock.shutdown)(infoPtr->socket, HOW_SNDRCV) == SOCKET_ERROR) {
  276.     errorCode = errno;
  277.     }
  278.  
  279.     /*
  280.      * Delete a file handler that may be active for this socket.
  281.      * Channel handlers are already deleted in the generic IO close
  282.      * code which called this function.
  283.      */
  284.     
  285.     Tcl_DeleteFileHandler(infoPtr->file);
  286.  
  287.     /*
  288.      * Free the file handle.  As a side effect, this will call the
  289.      * SocketFreeProc to release the SocketInfo associated with this file.
  290.      */
  291.  
  292.     Tcl_FreeFile(infoPtr->file);
  293.  
  294.     return errorCode;
  295. }
  296.  
  297. /*
  298.  *----------------------------------------------------------------------
  299.  *
  300.  * SocketFreeProc --
  301.  *
  302.  *    This callback is invoked by Tcl_FreeFile in order to delete
  303.  *    the notifier data associated with a file handle.
  304.  *
  305.  * Results:
  306.  *    None.
  307.  *
  308.  * Side effects:
  309.  *    Removes the SocketInfo from the global socket list.
  310.  *
  311.  *----------------------------------------------------------------------
  312.  */
  313.  
  314. static void
  315. SocketFreeProc(clientData)
  316.     ClientData clientData;
  317. {
  318.     SocketInfo *infoPtr = (SocketInfo *) clientData;
  319.  
  320.     /*
  321.      * Remove the socket from socketList.
  322.      */
  323.  
  324.     if (infoPtr == socketList) {
  325.     socketList = infoPtr->nextPtr;
  326.     } else {
  327.     SocketInfo *p;
  328.     for (p = socketList; p != NULL; p = p->nextPtr) {
  329.         if (p->nextPtr == infoPtr) {
  330.         p->nextPtr = infoPtr->nextPtr;
  331.         break;
  332.         }
  333.     }
  334.     }
  335.     ckfree((char *) infoPtr);
  336. }
  337.  
  338. /*
  339.  *----------------------------------------------------------------------
  340.  *
  341.  * NewSocketInfo --
  342.  *
  343.  *    This function allocates and initializes a new SocketInfo
  344.  *    structure.
  345.  *
  346.  * Results:
  347.  *    Returns a newly allocated SocketInfo.
  348.  *
  349.  * Side effects:
  350.  *    Adds the socket to the global socket list.
  351.  *
  352.  *----------------------------------------------------------------------
  353.  */
  354.  
  355. static SocketInfo *
  356. NewSocketInfo(file)
  357.     Tcl_File file;
  358. {
  359.     SocketInfo *infoPtr;
  360.  
  361.     infoPtr = (SocketInfo *) ckalloc((unsigned) sizeof(SocketInfo));
  362.     infoPtr->socket = (SOCKET) Tcl_GetFileInfo(file, NULL);
  363.     infoPtr->flags = 0;
  364.     infoPtr->checkMask = 0;
  365.     infoPtr->watchMask = 0;
  366.     infoPtr->eventMask = 0;
  367.     infoPtr->file = file;
  368.     infoPtr->acceptProc = NULL;
  369.     infoPtr->nextPtr = socketList;
  370.     socketList = infoPtr;
  371.  
  372.     Tcl_SetNotifierData(file, SocketFreeProc, (ClientData) infoPtr);
  373.     return infoPtr;
  374. }
  375.  
  376. /*
  377.  *----------------------------------------------------------------------
  378.  *
  379.  * CreateSocket --
  380.  *
  381.  *    This function opens a new socket and initializes the
  382.  *    SocketInfo structure.
  383.  *
  384.  * Results:
  385.  *    Returns a new SocketInfo, or NULL with an error in interp.
  386.  *
  387.  * Side effects:
  388.  *    Adds a new socket to the socketList.
  389.  *
  390.  *----------------------------------------------------------------------
  391.  */
  392.  
  393. static SocketInfo *
  394. CreateSocket(interp, port, host, server, myaddr, myport, async)
  395.     Tcl_Interp *interp;        /* For error reporting; can be NULL. */
  396.     int port;            /* Port number to open. */
  397.     char *host;            /* Name of host on which to open port. */
  398.     int server;            /* 1 if socket should be a server socket,
  399.                  * else 0 for a client socket. */
  400.     char *myaddr;        /* Optional client-side address */
  401.     int myport;            /* Optional client-side port */
  402.     int async;            /* If nonzero, connect client socket
  403.                                  * asynchronously. Unused. */
  404. {
  405.     int status;
  406.     struct sockaddr_in sockaddr;    /* Socket address */
  407.     struct sockaddr_in mysockaddr;    /* Socket address for client */
  408.     SOCKET sock;
  409.  
  410. #ifdef DEBUG
  411.     printf("CreateSocket port %d, host %s, server %d, cl-adr %s, cl-p %d\n",
  412.            port, host, server, myaddr, myport);
  413. #endif
  414.  
  415.     if (! CreateSocketAddress(&sockaddr, host, port)) {
  416.     goto addressError;
  417.     }
  418.     if ((myaddr != NULL || myport != 0) &&
  419.         ! CreateSocketAddress(&mysockaddr, myaddr, myport)) {
  420.     goto addressError;
  421.     }
  422.  
  423.     sock = (*OS2Sock.socket)(PF_INET, SOCK_STREAM, 0);
  424.     if (sock == INVALID_SOCKET) {
  425.     goto addressError;
  426.     }
  427. #ifdef DEBUG
  428.     printf("Created socket %d\n", sock);
  429. #endif
  430.  
  431.     /*
  432.      * Set kernel space buffering
  433.      */
  434.  
  435.     TclSockMinimumBuffers(sock, TCP_BUFFER_SIZE);
  436.  
  437.     if (server) {
  438.     /*
  439.      * Bind to the specified port.  Note that we must not call setsockopt
  440.      * with SO_REUSEADDR because Microsoft allows addresses to be reused
  441.      * even if they are still in use.
  442.      */
  443.     
  444.     status = (*OS2Sock.bind)(sock, (struct sockaddr *) &sockaddr,
  445.         sizeof(sockaddr));
  446. #ifdef DEBUG
  447.         printf("Bind: %d\n", status);
  448. #endif
  449.     if (status != SOCKET_ERROR) {
  450.         (*OS2Sock.listen)(sock, 5);
  451.     }
  452.     } else {
  453.     if (myaddr != NULL || myport != 0) { 
  454.         status = (*OS2Sock.bind)(sock, (struct sockaddr *) &mysockaddr,
  455.             sizeof(struct sockaddr));
  456. #ifdef DEBUG
  457.             printf("Bind: %d\n", status);
  458. #endif
  459.         if (status < 0) {
  460.         goto bindError;
  461.         }
  462.     }
  463.     status = (*OS2Sock.connect)(sock, (struct sockaddr *) &sockaddr,
  464.         sizeof(sockaddr));
  465. #ifdef DEBUG
  466.         printf("Connect: %d (error %d)\n", status, errno);
  467. #endif
  468.     }
  469.     if (status != SOCKET_ERROR) {
  470.     int flag = 1;
  471.     status = (*OS2Sock.ioctlsocket)(sock, FIONBIO, (u_long *)&flag);
  472. #ifdef DEBUG
  473.         printf("Ioctlsocket: %d\n", status);
  474. #endif
  475.     }
  476.  
  477. bindError:
  478.     if (status == SOCKET_ERROR) {
  479.         if (interp != NULL) {
  480.             Tcl_AppendResult(interp, "couldn't open socket: ",
  481.                     Tcl_PosixError(interp), (char *) NULL);
  482.         }
  483.         (*OS2Sock.shutdown)(sock, HOW_SNDRCV);
  484.         return NULL;
  485.     }
  486.  
  487.     /*
  488.      * Add this socket to the global list of sockets.
  489.      */
  490.  
  491.     return NewSocketInfo(Tcl_GetFile((ClientData) sock, TCL_OS2_SOCKET));
  492.  
  493. addressError:
  494.     if (interp != NULL) {
  495.     Tcl_AppendResult(interp, "couldn't open socket: ",
  496.         Tcl_PosixError(interp), (char *) NULL);
  497.     }
  498.     return NULL;
  499. }
  500.  
  501. /*
  502.  *----------------------------------------------------------------------
  503.  *
  504.  * CreateSocketAddress --
  505.  *
  506.  *    This function initializes a sockaddr structure for a host and port.
  507.  *
  508.  * Results:
  509.  *    1 if the host was valid, 0 if the host could not be converted to
  510.  *    an IP address.
  511.  *
  512.  * Side effects:
  513.  *    Fills in the *sockaddrPtr structure.
  514.  *
  515.  *----------------------------------------------------------------------
  516.  */
  517.  
  518. static int
  519. CreateSocketAddress(sockaddrPtr, host, port)
  520.     struct sockaddr_in *sockaddrPtr;    /* Socket address */
  521.     char *host;                /* Host.  NULL implies INADDR_ANY */
  522.     int port;                /* Port number */
  523. {
  524.     struct hostent *hostent;        /* Host database entry */
  525.     struct in_addr addr;        /* For 64/32 bit madness */
  526.  
  527. #ifdef DEBUG
  528.     printf("CreateSocketAddress \"%s\":%d\n", host, port);
  529.     fflush(stdout);
  530. #endif
  531.  
  532.     (void) memset((char *) sockaddrPtr, '\0', sizeof(struct sockaddr_in));
  533.     sockaddrPtr->sin_family = AF_INET;
  534.     sockaddrPtr->sin_port = (*OS2Sock.htons)((short) (port & 0xFFFF));
  535. #ifdef DEBUG
  536.     printf("sinPort %d\n", sockaddrPtr->sin_port);
  537.     fflush(stdout);
  538. #endif
  539.     if (host == NULL) {
  540.     addr.s_addr = INADDR_ANY;
  541.     } else {
  542.         addr.s_addr = (*OS2Sock.inet_addr)(host);
  543. #ifdef DEBUG
  544.         printf("addr.s_addr %d\n", addr.s_addr);
  545. #endif
  546.         if (addr.s_addr == (unsigned long) -1) {
  547.             hostent = (*OS2Sock.gethostbyname)(host);
  548. #ifdef DEBUG
  549.             printf("hostent %x\n", hostent);
  550. #endif
  551.             if (hostent != NULL) {
  552.                 memcpy((char *) &addr,
  553.                         (char *) hostent->h_addr_list[0],
  554.                         (size_t) hostent->h_length);
  555.             } else {
  556. #ifdef    EHOSTUNREACH
  557.                 errno = EHOSTUNREACH;
  558.     #ifdef DEBUG
  559.                 printf("gethostbyname ERROR EHOSTUNREACH\n");
  560.     #endif
  561. #else
  562.     #ifdef ENXIO
  563.                 errno = ENXIO;
  564.         #ifdef DEBUG
  565.                 printf("gethostbyname ERROR ENXIO\n");
  566.         #endif
  567.     #else
  568.         #ifdef DEBUG
  569.                 printf("gethostbyname ERROR ?\n");
  570.         #endif
  571.     #endif
  572. #endif
  573.         return 0;    /* Error. */
  574.         }
  575.     }
  576.     }
  577.  
  578.     /*
  579.      * NOTE: On 64 bit machines the assignment below is rumored to not
  580.      * do the right thing. Please report errors related to this if you
  581.      * observe incorrect behavior on 64 bit machines such as DEC Alphas.
  582.      * Should we modify this code to do an explicit memcpy?
  583.      */
  584.  
  585.     sockaddrPtr->sin_addr.s_addr = addr.s_addr;
  586.     return 1;    /* Success. */
  587. }
  588.  
  589. /*
  590.  *----------------------------------------------------------------------
  591.  *
  592.  * Tcl_OpenTcpClient --
  593.  *
  594.  *    Opens a TCP client socket and creates a channel around it.
  595.  *
  596.  * Results:
  597.  *    The channel or NULL if failed.  An error message is returned
  598.  *    in the interpreter on failure.
  599.  *
  600.  * Side effects:
  601.  *    Opens a client socket and creates a new channel.
  602.  *
  603.  *----------------------------------------------------------------------
  604.  */
  605.  
  606. Tcl_Channel
  607. Tcl_OpenTcpClient(interp, port, host, myaddr, myport, async)
  608.     Tcl_Interp *interp;            /* For error reporting; can be NULL. */
  609.     int port;                /* Port number to open. */
  610.     char *host;                /* Host on which to open port. */
  611.     char *myaddr;            /* Client-side address */
  612.     int myport;                /* Client-side port */
  613.     int async;                /* If nonzero, should connect
  614.                                          * client socket asynchronously. */
  615. {
  616.     Tcl_Channel chan;
  617.     SocketInfo *infoPtr;
  618.     char channelName[20];
  619.  
  620. #ifdef DEBUG
  621.     printf("Tcl_OpenTcpClient port %d host %s myaddr %s myport %d async %d\n",
  622.            port, host, myaddr, myport, async);
  623. #endif
  624.  
  625.     if (TclHasSockets(interp) != TCL_OK) {
  626.     return NULL;
  627.     }
  628.  
  629.     /*
  630.      * Create a new client socket and wrap it in a channel.
  631.      */
  632.  
  633.     infoPtr = CreateSocket(interp, port, host, 0, myaddr, myport, async);
  634.     if (infoPtr == NULL) {
  635.     return NULL;
  636.     }
  637.  
  638.     sprintf(channelName, "sock%d", infoPtr->socket);
  639. #ifdef DEBUG
  640.     printf("Tcl_OpenTcpClient creating socket %s\n", channelName);
  641. #endif
  642.  
  643.     chan = Tcl_CreateChannel(&tcpChannelType, channelName, infoPtr->file,
  644.         infoPtr->file, (ClientData) infoPtr);
  645.     if (Tcl_SetChannelOption(interp, chan, "-translation", "auto crlf") ==
  646.             TCL_ERROR) {
  647.         Tcl_Close((Tcl_Interp *) NULL, chan);
  648. #ifdef DEBUG
  649.         printf("ERROR: Tcl_SetChannelOption translation failed\n");
  650. #endif
  651.         return (Tcl_Channel) NULL;
  652.     }
  653.     if (Tcl_SetChannelOption(NULL, chan, "-eofchar", "") == TCL_ERROR) {
  654.         Tcl_Close((Tcl_Interp *) NULL, chan);
  655. #ifdef DEBUG
  656.         printf("ERROR: Tcl_SetChannelOption eofchar failed\n");
  657. #endif
  658.         return (Tcl_Channel) NULL;
  659.     }
  660.     return chan;
  661. }
  662.  
  663. /*
  664.  *----------------------------------------------------------------------
  665.  *
  666.  * Tcl_OpenTcpServer --
  667.  *
  668.  *    Opens a TCP server socket and creates a channel around it.
  669.  *
  670.  * Results:
  671.  *    The channel or NULL if failed.  An error message is returned
  672.  *    in the interpreter on failure.
  673.  *
  674.  * Side effects:
  675.  *    Opens a server socket and creates a new channel.
  676.  *
  677.  *----------------------------------------------------------------------
  678.  */
  679.  
  680. Tcl_Channel
  681. Tcl_OpenTcpServer(interp, port, host, acceptProc, acceptProcData)
  682.     Tcl_Interp *interp;            /* For error reporting - may be
  683.                                          * NULL. */
  684.     int port;                /* Port number to open. */
  685.     char *host;                /* Name of local host. */
  686.     Tcl_TcpAcceptProc *acceptProc;    /* Callback for accepting connections
  687.                                          * from new clients. */
  688.     ClientData acceptProcData;        /* Data for the callback. */
  689. {
  690.     Tcl_Channel chan;
  691.     SocketInfo *infoPtr;
  692.     char channelName[20];
  693.  
  694. #ifdef DEBUG
  695.     printf("Tcl_OpenTcpServer port %d host %s\n", port, host);
  696. #endif
  697.  
  698.     if (TclHasSockets(interp) != TCL_OK) {
  699.     return NULL;
  700.     }
  701.  
  702.     /*
  703.      * Create a new server socket and wrap it in a channel.
  704.      */
  705.  
  706.     infoPtr = CreateSocket(interp, port, host, 1, NULL, 0, 0);
  707.     if (infoPtr == NULL) {
  708.     return NULL;
  709.     }
  710.  
  711.     infoPtr->acceptProc = acceptProc;
  712.     infoPtr->acceptProcData = acceptProcData;
  713.  
  714.     /*
  715.      * Set up the callback mechanism for accepting connections
  716.      * from new clients. The caller will use Tcl_TcpRegisterCallback
  717.      * to register a callback to call when a new connection is
  718.      * accepted.
  719.      */
  720.  
  721.     Tcl_CreateFileHandler(infoPtr->file, TCL_READABLE, TcpAccept,
  722.             (ClientData) infoPtr);
  723.  
  724.     sprintf(channelName, "sock%d", infoPtr->socket);
  725. #ifdef DEBUG
  726.     printf("Tcl_OpenTcpServer creating socket %s\n", channelName);
  727. #endif
  728.  
  729.     chan = Tcl_CreateChannel(&tcpChannelType, channelName, NULL, NULL,
  730.         (ClientData) infoPtr);
  731.     if (Tcl_SetChannelOption(interp, chan, "-eofchar", "") == TCL_ERROR) {
  732.         Tcl_Close((Tcl_Interp *) NULL, chan);
  733.         return (Tcl_Channel) NULL;
  734.     }
  735.  
  736.     return chan;
  737. }
  738.  
  739. /*
  740.  *----------------------------------------------------------------------
  741.  *
  742.  * TcpAccept --
  743.  *    Accept a TCP socket connection.  This is called by the event loop,
  744.  *    and it in turns calls any registered callbacks for this channel.
  745.  *
  746.  * Results:
  747.  *    None.
  748.  *
  749.  * Side effects:
  750.  *    Evals the Tcl script associated with the server socket.
  751.  *
  752.  *----------------------------------------------------------------------
  753.  */
  754.  
  755.     /* ARGSUSED */
  756. static void
  757. TcpAccept(data, mask)
  758.     ClientData data;            /* Callback token. */
  759.     int mask;                /* Not used. */
  760. {
  761.     SOCKET newSocket;
  762.     SocketInfo *infoPtr = (SocketInfo *) data;
  763.     SocketInfo *newInfoPtr;
  764.     struct sockaddr_in addr;
  765.     int len;
  766.     Tcl_Channel chan;
  767.     char channelName[20];
  768.     int flag = 1;
  769.  
  770. #ifdef DEBUG
  771.     printf("TcpAccept\n");
  772.     fflush(stdout);
  773. #endif
  774.  
  775.     len = sizeof(struct sockaddr_in);
  776.     newSocket = (*OS2Sock.accept)(infoPtr->socket, (struct sockaddr *)&addr,
  777.         &len);
  778.  
  779.     infoPtr->checkMask &= ~TCL_READABLE;
  780.  
  781.     if (newSocket == INVALID_SOCKET) {
  782.         return;
  783.     }
  784.  
  785.     /*
  786.      * Clear the inherited event mask.
  787.      */
  788.  
  789. /*
  790.     (*OS2Sock.WSAAsyncSelect)(newSocket, socketWindow, 0, 0);
  791. */
  792.  
  793.     /*
  794.      * Set the socket into non-blocking mode.
  795.      */
  796.  
  797.     if ((*OS2Sock.ioctlsocket)(newSocket, FIONBIO, (u_long *)&flag) != 0) {
  798.     (*OS2Sock.soclose)(newSocket);
  799.     return;
  800.     }
  801.  
  802.     /*
  803.      * Add this socket to the global list of sockets.
  804.      */
  805.  
  806.     newInfoPtr = NewSocketInfo(Tcl_GetFile((ClientData) newSocket,
  807.         TCL_OS2_SOCKET));
  808.  
  809.  
  810.     sprintf(channelName, "sock%d", newSocket);
  811.     chan = Tcl_CreateChannel(&tcpChannelType, channelName, newInfoPtr->file,
  812.         newInfoPtr->file, (ClientData) newInfoPtr);
  813.     if (Tcl_SetChannelOption(NULL, chan, "-translation", "auto crlf") ==
  814.             TCL_ERROR) {
  815.         Tcl_Close((Tcl_Interp *) NULL, chan);
  816.         return;
  817.     }
  818.     if (Tcl_SetChannelOption(NULL, chan, "-eofchar", "") == TCL_ERROR) {
  819.         Tcl_Close((Tcl_Interp *) NULL, chan);
  820.         return;
  821.     }
  822.  
  823.     /*
  824.      * Invoke the accept callback procedure.
  825.      */
  826.  
  827.     if (infoPtr->acceptProc != NULL) {
  828.     (infoPtr->acceptProc) (infoPtr->acceptProcData, chan,
  829.         (*OS2Sock.inet_ntoa)(addr.sin_addr),
  830.         (*OS2Sock.ntohs)(addr.sin_port));
  831.     }
  832. }
  833.  
  834. /*
  835.  *----------------------------------------------------------------------
  836.  *
  837.  * TcpInputProc --
  838.  *
  839.  *    This procedure is called by the generic IO level to read data from
  840.  *    a socket based channel.
  841.  *
  842.  * Results:
  843.  *    The number of bytes read or -1 on error.
  844.  *
  845.  * Side effects:
  846.  *    Consumes input from the socket.
  847.  *
  848.  *----------------------------------------------------------------------
  849.  */
  850.  
  851. static int
  852. TcpInputProc(instanceData, inFile, buf, toRead, errorCodePtr)
  853.     ClientData instanceData;        /* The socket state. */
  854.     Tcl_File inFile;            /* Not used. */
  855.     char *buf;                /* Where to store data. */
  856.     int toRead;                /* Maximum number of bytes to read. */
  857.     int *errorCodePtr;            /* Where to store error codes. */
  858. {
  859.     SocketInfo *infoPtr = (SocketInfo *) instanceData;
  860.     int bytesRead;
  861.     
  862.     *errorCodePtr = 0;
  863.     bytesRead = (*OS2Sock.recv)(infoPtr->socket, buf, toRead, 0);
  864.     if (bytesRead == SOCKET_ERROR) {
  865.         if (errno != ECONNRESET) {
  866.             *errorCodePtr = errno;
  867.         }
  868.         bytesRead = -1;
  869.     }
  870.  
  871.     /*
  872.      * Clear the readable bit in the check mask.  If an async handler
  873.      * is still registered for this socket, then it will generate a new
  874.      * event if there is still data available.  When the event is
  875.      * processed, the readable bit will be turned back on.
  876.      */
  877.  
  878.     infoPtr->checkMask &= ~TCL_READABLE;
  879.     return bytesRead;
  880. }
  881.  
  882. /*
  883.  *----------------------------------------------------------------------
  884.  *
  885.  * TcpOutputProc --
  886.  *
  887.  *    This procedure is called by the generic IO level to write data
  888.  *    to a socket based channel.
  889.  *
  890.  * Results:
  891.  *    The number of bytes written or -1 on failure.
  892.  *
  893.  * Side effects:
  894.  *    Produces output on the socket.
  895.  *
  896.  *----------------------------------------------------------------------
  897.  */
  898.  
  899. static int
  900. TcpOutputProc(instanceData, outFile, buf, toWrite, errorCodePtr)
  901.     ClientData instanceData;        /* The socket state. */
  902.     Tcl_File outFile;            /* The socket to write to. */
  903.     char *buf;                /* Where to get data. */
  904.     int toWrite;            /* Maximum number of bytes to write. */
  905.     int *errorCodePtr;            /* Where to store error codes. */
  906. {
  907.     SocketInfo *infoPtr = (SocketInfo *) instanceData;
  908.     int bytesWritten;
  909.  
  910.     *errorCodePtr = 0;
  911.     bytesWritten = (*OS2Sock.send)(infoPtr->socket, buf, toWrite, 0);
  912.     if (bytesWritten == SOCKET_ERROR) {
  913.     if (errno == EWOULDBLOCK) {
  914.         infoPtr->checkMask &= ~TCL_WRITABLE;
  915.     }
  916.         *errorCodePtr = errno;
  917.         return -1;
  918.     }
  919.  
  920.     /*
  921.      * Clear the readable bit in the check mask.  If an async handler
  922.      * is still registered for this socket, then it will generate a new
  923.      * event if there is still data available.  When the event is
  924.      * processed, the readable bit will be turned back on.
  925.      */
  926.  
  927.     infoPtr->checkMask &= (~(TCL_WRITABLE));
  928.  
  929.     return bytesWritten;
  930. }
  931.  
  932. /*
  933.  *----------------------------------------------------------------------
  934.  *
  935.  * TcpGetOptionProc --
  936.  *
  937.  *    Computes an option value for a TCP socket based channel, or a
  938.  *    list of all options and their values.
  939.  *
  940.  *    Note: This code is based on code contributed by John Haxby.
  941.  *
  942.  * Results:
  943.  *    A standard Tcl result. The value of the specified option or a
  944.  *    list of all options and    their values is returned in the
  945.  *    supplied DString.
  946.  *
  947.  * Side effects:
  948.  *    None.
  949.  *
  950.  *----------------------------------------------------------------------
  951.  */
  952.  
  953. static int
  954. TcpGetOptionProc(instanceData, optionName, dsPtr)
  955.     ClientData instanceData;        /* Socket state. */
  956.     char *optionName;            /* Name of the option to
  957.                                          * retrieve the value for, or
  958.                                          * NULL to get all options and
  959.                                          * their values. */
  960.     Tcl_DString *dsPtr;            /* Where to store the computed
  961.                                          * value; initialized by caller. */
  962. {
  963.     SocketInfo *infoPtr;
  964.     struct sockaddr_in sockname;
  965.     struct sockaddr_in peername;
  966.     struct hostent *hostEntPtr;
  967.     SOCKET sock;
  968.     int size = sizeof(struct sockaddr_in);
  969.     size_t len = 0;
  970.     char buf[128];
  971.  
  972.     infoPtr = (SocketInfo *) instanceData;
  973.     sock = (int) infoPtr->socket;
  974.     if (optionName != (char *) NULL) {
  975.         len = strlen(optionName);
  976.     }
  977.  
  978.     if ((len == 0) ||
  979.             ((len > 1) && (optionName[1] == 'p') &&
  980.                     (strncmp(optionName, "-peername", len) == 0))) {
  981.         if ((*OS2Sock.getpeername)(sock, (struct sockaddr *) &peername, &size)
  982.                 >= 0) {
  983.             if (len == 0) {
  984.                 Tcl_DStringAppendElement(dsPtr, "-peername");
  985.                 Tcl_DStringStartSublist(dsPtr);
  986.             }
  987.             Tcl_DStringAppendElement(dsPtr,
  988.                     (*OS2Sock.inet_ntoa)(peername.sin_addr));
  989.             hostEntPtr = (*OS2Sock.gethostbyaddr)(
  990.                 (char *) &(peername.sin_addr), sizeof(peername.sin_addr),
  991.                 PF_INET);
  992.             if (hostEntPtr != (struct hostent *) NULL) {
  993.                 Tcl_DStringAppendElement(dsPtr, hostEntPtr->h_name);
  994.             } else {
  995.                 Tcl_DStringAppendElement(dsPtr,
  996.                         (*OS2Sock.inet_ntoa)(peername.sin_addr));
  997.             }
  998.             sprintf(buf, "%d", (*OS2Sock.ntohs)(peername.sin_port));
  999.             Tcl_DStringAppendElement(dsPtr, buf);
  1000.             if (len == 0) {
  1001.                 Tcl_DStringEndSublist(dsPtr);
  1002.             } else {
  1003.                 return TCL_OK;
  1004.             }
  1005.         }
  1006.     }
  1007.  
  1008.     if ((len == 0) ||
  1009.             ((len > 1) && (optionName[1] == 's') &&
  1010.                     (strncmp(optionName, "-sockname", len) == 0))) {
  1011.         if ((*OS2Sock.getsockname)(sock, (struct sockaddr *) &sockname, &size)
  1012.                 >= 0) {
  1013.             if (len == 0) {
  1014.                 Tcl_DStringAppendElement(dsPtr, "-sockname");
  1015.                 Tcl_DStringStartSublist(dsPtr);
  1016.             }
  1017.             Tcl_DStringAppendElement(dsPtr,
  1018.                     (*OS2Sock.inet_ntoa)(sockname.sin_addr));
  1019.             hostEntPtr = (*OS2Sock.gethostbyaddr)(
  1020.                 (char *) &(sockname.sin_addr), sizeof(peername.sin_addr),
  1021.                 PF_INET);
  1022.             if (hostEntPtr != (struct hostent *) NULL) {
  1023.                 Tcl_DStringAppendElement(dsPtr, hostEntPtr->h_name);
  1024.             } else {
  1025.                 Tcl_DStringAppendElement(dsPtr,
  1026.                         (*OS2Sock.inet_ntoa)(sockname.sin_addr));
  1027.             }
  1028.             sprintf(buf, "%d", (*OS2Sock.ntohs)(sockname.sin_port));
  1029.             Tcl_DStringAppendElement(dsPtr, buf);
  1030.             if (len == 0) {
  1031.                 Tcl_DStringEndSublist(dsPtr);
  1032.             } else {
  1033.                 return TCL_OK;
  1034.             }
  1035.         }
  1036.     }
  1037.  
  1038.     if (len > 0) {
  1039.         Tcl_SetErrno(EINVAL);
  1040.         return TCL_ERROR;
  1041.     }
  1042.  
  1043.     return TCL_OK;
  1044. }
  1045.  
  1046. /*
  1047.  *----------------------------------------------------------------------
  1048.  *
  1049.  * TclOS2WatchSocket --
  1050.  *
  1051.  *    This function imlements the socket specific portion of the
  1052.  *    Tcl_WatchFile function in the notifier.
  1053.  *
  1054.  * Results:
  1055.  *    None.
  1056.  *
  1057.  * Side effects:
  1058.  *    The watched socket will be placed into non-blocking mode, and
  1059.  *    an entry on the asynch handler list will be created if necessary. 
  1060.  *
  1061.  *----------------------------------------------------------------------
  1062.  */
  1063.  
  1064. void
  1065. TclOS2WatchSocket(file, mask)
  1066.     Tcl_File file;        /* Socket to watch. */
  1067.     int mask;            /* OR'ed combination of TCL_READABLE,
  1068.                  * TCL_WRITABLE, and TCL_EXCEPTION:
  1069.                  * indicates conditions to wait for
  1070.                  * in select. */
  1071. {
  1072.     SocketInfo *infoPtr = (SocketInfo *) Tcl_GetNotifierData(file, NULL);
  1073.     Tcl_Time dontBlock;
  1074.  
  1075.     dontBlock.sec = 0; dontBlock.usec = 0;
  1076.  
  1077.     /*
  1078.      * Create socket info on demand if necessary.  We should only enter this
  1079.      * code if the socket was created outside of Tcl.  Since this may be
  1080.      * the first time that the socket code has been called, we need to invoke
  1081.      * TclHasSockets to ensure that everything is initialized properly.
  1082.      */
  1083.  
  1084.     if (infoPtr == NULL) {
  1085.     if (TclHasSockets(NULL) != TCL_OK) {
  1086.         return;
  1087.     }
  1088.     infoPtr = NewSocketInfo(file);
  1089.     }
  1090.  
  1091.     infoPtr->flags |= SOCKET_WATCH;
  1092.  
  1093.     /*
  1094.      * Check if any bits are set on the checkMask. If there are, this
  1095.      * means that the socket already had events on it, and we need to
  1096.      * check it immediately. To do this, set the maximum block time to
  1097.      * zero.
  1098.      */
  1099.  
  1100.     if (infoPtr->checkMask != 0) {
  1101.         Tcl_SetMaxBlockTime(&dontBlock);
  1102.         return;
  1103.     }
  1104.         
  1105.     /*
  1106.      * If the new mask includes more conditions than the current mask,
  1107.      * then we mark the socket as unregistered so it will be reregistered
  1108.      * the next time we enter Tcl_WaitForEvent.
  1109.      */
  1110.  
  1111.     mask |= infoPtr->watchMask;
  1112.     if (infoPtr->watchMask != mask) {
  1113.     infoPtr->flags &= (~(SOCKET_REGISTERED));
  1114.     infoPtr->watchMask = mask;
  1115.     }
  1116. }
  1117.  
  1118. /*
  1119.  *----------------------------------------------------------------------
  1120.  *
  1121.  * TclOS2NotifySocket --
  1122.  *
  1123.  *    Set up event notifiers for any sockets that are being watched.
  1124.  *    Also, clean up any sockets that are no longer being watched.
  1125.  *
  1126.  * Results:
  1127.  *    None.
  1128.  *
  1129.  * Side effects:
  1130.  *    Adds and removes asynch select handlers.
  1131.  *
  1132.  *----------------------------------------------------------------------
  1133.  */
  1134.  
  1135. void
  1136. TclOS2NotifySocket()
  1137. {
  1138.     SocketInfo *infoPtr;
  1139.  
  1140.     if (socketList == NULL) {
  1141.     return;
  1142.     }
  1143.  
  1144.     /*
  1145.      * Establish or remove any notifiers.
  1146.      */
  1147.  
  1148.     for (infoPtr = socketList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
  1149.     if (infoPtr->flags & SOCKET_WATCH) {
  1150.         if (!(infoPtr->flags & SOCKET_REGISTERED)) {
  1151.         int events = 0;
  1152.  
  1153.         if (infoPtr->watchMask & TCL_READABLE) {
  1154.             events |= (FD_READ | FD_ACCEPT | FD_CLOSE);
  1155.         } else if (infoPtr->watchMask & TCL_WRITABLE) {
  1156.             events |= (FD_WRITE | FD_CONNECT);
  1157.         }
  1158.  
  1159.                 /*
  1160.                  * If the new event interest mask does not match what is
  1161.                  * currently set into the socket, set the new mask.
  1162.                  */
  1163.  
  1164.                 if (events != infoPtr->eventMask) {
  1165.                     infoPtr->eventMask = events;
  1166. /*
  1167.                     (*OS2Sock.WSAAsyncSelect)(infoPtr->socket, socketWindow,
  1168.                             SOCKET_MESSAGE, events);
  1169. */
  1170.                 }
  1171.         }
  1172.     } else {
  1173.         if (infoPtr->flags & SOCKET_REGISTERED) {
  1174.                 infoPtr->eventMask = 0;
  1175. /*
  1176.         (*OS2Sock.WSAAsyncSelect)(infoPtr->socket, socketWindow, 0, 0);
  1177. */
  1178.         }
  1179.     }
  1180.     }
  1181. }
  1182.  
  1183. /*
  1184.  *----------------------------------------------------------------------
  1185.  *
  1186.  * TclOS2SocketReady --
  1187.  *
  1188.  *    This function is invoked by Tcl_FileReady to check whether
  1189.  *    the specified conditions are present on a socket.
  1190.  *
  1191.  * Results:
  1192.  *    The return value is 0 if none of the conditions specified by
  1193.  *    mask were true for socket the last time the system checked.
  1194.  *    If any of the conditions were true, then the return value is a
  1195.  *    mask of those that were true.
  1196.  *
  1197.  * Side effects:
  1198.  *    None.
  1199.  *
  1200.  *----------------------------------------------------------------------
  1201.  */
  1202.  
  1203. int
  1204. TclOS2SocketReady(file, mask)
  1205.     Tcl_File file;    /* File handle for a stream. */
  1206.     int mask;            /* OR'ed combination of TCL_READABLE,
  1207.                  * TCL_WRITABLE, and TCL_EXCEPTION:
  1208.                  * indicates conditions caller cares about. */
  1209. {
  1210. /*
  1211.     SocketInfo *infoPtr = (SocketInfo *) Tcl_GetNotifierData(file, NULL);
  1212.  
  1213.     infoPtr->flags &= (~(SOCKET_WATCH));
  1214.     return (infoPtr->checkMask & mask);
  1215. */
  1216.     int result, ret, fd, type;
  1217.     fd_set readfd, writefd, exceptfd;
  1218.     struct timeval timeout;
  1219.  
  1220.     fd = (int) Tcl_GetFileInfo(file, &type);
  1221.  
  1222.     timeout.tv_sec = 0;
  1223.     timeout.tv_usec = 100;
  1224.     FD_ZERO(&readfd);
  1225.     FD_SET(fd, &readfd);
  1226.     FD_ZERO(&writefd);
  1227.     FD_SET(fd, &writefd);
  1228.     FD_ZERO(&exceptfd);
  1229.     FD_SET(fd, &exceptfd);
  1230.  
  1231.     ret = select(fd+1, &readfd, &writefd, &exceptfd, &timeout);
  1232. #ifdef DEBUG
  1233.     printf("TclOS2SocketReady, select (fd %d) returns %d\n", fd, ret);
  1234.     for (result=0; result < (FD_SETSIZE+31)/32; result++) {
  1235.         printf("    %x %x %x\n", readfd.fds_bits[result],
  1236.                writefd.fds_bits[result], exceptfd.fds_bits[result]);
  1237.     }
  1238.     printf("    mask & TCL_READABLE %x, FD_ISSET(fd, &readfd) %x\n",
  1239.            mask & TCL_READABLE, FD_ISSET(fd, &readfd));
  1240.     printf("    mask & TCL_WRITABLE %x, FD_ISSET(fd, &writefd) %x\n",
  1241.            mask & TCL_WRITABLE, FD_ISSET(fd, &writefd));
  1242.     printf("    mask & TCL_EXCEPTION %x, FD_ISSET(fd, &exceptfd) %x\n",
  1243.            mask & TCL_EXCEPTION, FD_ISSET(fd, &exceptfd));
  1244.     fflush(stdout);
  1245. #endif
  1246.     if (ret == 0 || ret == -1) {
  1247.         return 0;
  1248.     }
  1249.  
  1250.     result = 0;
  1251.     if ((mask & TCL_READABLE) && FD_ISSET(fd, &readfd)) {
  1252.         result |= TCL_READABLE;
  1253.     }
  1254.     if ((mask & TCL_WRITABLE) && FD_ISSET(fd, &writefd)) {
  1255.         result |= TCL_WRITABLE;
  1256.     }
  1257.     if ((mask & TCL_EXCEPTION) && FD_ISSET(fd, &exceptfd)) {
  1258.         result |= TCL_EXCEPTION;
  1259.     }
  1260. #ifdef DEBUG
  1261.     printf("    result %d (readfd %x, writefd %x, exceptfd %x)\n", result,
  1262.            readfd, writefd, exceptfd);
  1263.     fflush(stdout);
  1264. #endif
  1265.     return result;
  1266. }
  1267.  
  1268. /*
  1269.  *----------------------------------------------------------------------
  1270.  *
  1271.  * Tcl_GetHostName --
  1272.  *
  1273.  *    Returns the name of the local host.
  1274.  *
  1275.  * Results:
  1276.  *    Returns a string containing the host name, or NULL on error.
  1277.  *    The returned string must be freed by the caller.
  1278.  *
  1279.  * Side effects:
  1280.  *    None.
  1281.  *
  1282.  *----------------------------------------------------------------------
  1283.  */
  1284.  
  1285. char *
  1286. Tcl_GetHostName()
  1287. {
  1288.     static int  hostnameInitialized = 0;
  1289.     static char hostname[255];    /* This buffer should be big enough for
  1290.                                  * hostname plus domain name. */
  1291.  
  1292.     if (TclHasSockets(NULL) != TCL_OK) {
  1293.     return "";
  1294.     }
  1295.  
  1296.     if (hostnameInitialized) {
  1297.         return hostname;
  1298.     }
  1299.     if ((*OS2Sock.gethostname)(hostname, 100) == 0) {
  1300.         hostnameInitialized = 1;
  1301.         return hostname;
  1302.     }
  1303.     return (char *) NULL;
  1304. }
  1305.  
  1306. /*
  1307.  *----------------------------------------------------------------------
  1308.  *
  1309.  * TclHasSockets --
  1310.  *
  1311.  *    This function determines whether sockets are available on the
  1312.  *    current system and returns an error in interp if they are not.
  1313.  *    Note that interp may be NULL.
  1314.  *
  1315.  * Results:
  1316.  *    Returns TCL_OK if the system supports sockets, or TCL_ERROR with
  1317.  *    an error in interp.
  1318.  *
  1319.  * Side effects:
  1320.  *    None.
  1321.  *
  1322.  *----------------------------------------------------------------------
  1323.  */
  1324.  
  1325. int
  1326. TclHasSockets(interp)
  1327.     Tcl_Interp *interp;
  1328. {
  1329.     static int initialized = 0;    /* 1 if the socket system has been
  1330.                  * initialized. */
  1331.     static int hasSockets = 0;    /* 1 if the system supports sockets. */
  1332.  
  1333.     if (!initialized) {
  1334.         hasSockets = InitSockets();
  1335.         initialized = 1;
  1336.     }
  1337.     
  1338.     if (hasSockets) {
  1339.     return TCL_OK;
  1340.     }
  1341.     if (interp != NULL) {
  1342.     Tcl_AppendResult(interp, "sockets are not available on this system",
  1343.         NULL);
  1344.     }
  1345.     return TCL_ERROR;
  1346. }
  1347.  
  1348. /*
  1349.  *----------------------------------------------------------------------
  1350.  *
  1351.  * getsockopt, et al. --
  1352.  *
  1353.  *    These functions are wrappers that let us bind the socket
  1354.  *    API dynamically so we can run on systems that don't have
  1355.  *    the socket dll.  We need wrappers for these interfaces
  1356.  *    because they are called from the generic Tcl code 
  1357.  *
  1358.  * Results:
  1359.  *    As defined for each function.
  1360.  *
  1361.  * Side effects:
  1362.  *    As defined for each function.
  1363.  *
  1364.  *----------------------------------------------------------------------
  1365.  */
  1366.  
  1367. /*
  1368. int APIENTRY 
  1369. getsockopt(SOCKET s, int level, int optname, char  * optval,
  1370.     int  *optlen)
  1371. {
  1372.     return (*OS2Sock.getsockopt)(s, level, optname, optval, optlen);
  1373. }
  1374.  
  1375. int APIENTRY 
  1376. setsockopt(SOCKET s, int level, int optname, const char  * optval,
  1377.     int optlen)
  1378. {
  1379.     return (*OS2Sock.setsockopt)(s, level, optname, optval, optlen);
  1380. }
  1381.  
  1382. u_short APIENTRY 
  1383. ntohs(u_short netshort)
  1384. {
  1385.     return (*OS2Sock.ntohs)(netshort);
  1386. }
  1387.  
  1388. struct servent  * APIENTRY 
  1389. getservbyname(const char  * name, const char  * proto)
  1390. {
  1391.     return (*OS2Sock.getservbyname)(name, proto);
  1392. }
  1393. */
  1394.