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