archie/tcl7.6/win/tclWinSock.c

/* 
 * tclWinSock.c --
 *
 *	This file contains Windows-specific socket related code.
 *
 * Copyright (c) 1995-1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tclWinSock.c 1.50 96/10/03 15:01:29
 */

#include "tclInt.h"
#include "tclPort.h"

/*
 * The following structure contains pointers to all of the WinSock API entry
 * points used by Tcl.  It is initialized by InitSockets.  Since we
 * dynamically load Winsock.dll on demand, we must use this function table
 * to refer to functions in the socket API.
 */

static struct {
    SOCKET (PASCAL FAR *accept)(SOCKET s, struct sockaddr FAR *addr,
	    int FAR *addrlen);
    int (PASCAL FAR *bind)(SOCKET s, const struct sockaddr FAR *addr,
	    int namelen);
    int (PASCAL FAR *closesocket)(SOCKET s);
    int (PASCAL FAR *connect)(SOCKET s, const struct sockaddr FAR *name,
	    int namelen);
    int (PASCAL FAR *ioctlsocket)(SOCKET s, long cmd, u_long FAR *argp);
    int (PASCAL FAR *getsockopt)(SOCKET s, int level, int optname,
	    char FAR * optval, int FAR *optlen);
    u_short (PASCAL FAR *htons)(u_short hostshort);
    unsigned long (PASCAL FAR *inet_addr)(const char FAR * cp);
    char FAR * (PASCAL FAR *inet_ntoa)(struct in_addr in);
    int (PASCAL FAR *listen)(SOCKET s, int backlog);
    u_short (PASCAL FAR *ntohs)(u_short netshort);
    int (PASCAL FAR *recv)(SOCKET s, char FAR * buf, int len, int flags);
    int (PASCAL FAR *send)(SOCKET s, const char FAR * buf, int len, int flags);
    int (PASCAL FAR *setsockopt)(SOCKET s, int level, int optname,
	    const char FAR * optval, int optlen);
    int (PASCAL FAR *shutdown)(SOCKET s, int how);
    SOCKET (PASCAL FAR *socket)(int af, int type, int protocol);
    struct hostent FAR * (PASCAL FAR *gethostbyname)(const char FAR * name);
    struct hostent FAR * (PASCAL FAR *gethostbyaddr)(const char FAR *addr,
            int addrlen, int addrtype);
    int (PASCAL FAR *gethostname)(char FAR * name, int namelen);
    int (PASCAL FAR *getpeername)(SOCKET sock, struct sockaddr FAR *name,
            int FAR *namelen);
    struct servent FAR * (PASCAL FAR *getservbyname)(const char FAR * name,
	    const char FAR * proto);
    int (PASCAL FAR *getsockname)(SOCKET sock, struct sockaddr FAR *name,
            int FAR *namelen);
    int (PASCAL FAR *WSAStartup)(WORD wVersionRequired, LPWSADATA lpWSAData);
    int (PASCAL FAR *WSACleanup)(void);
    int (PASCAL FAR *WSAGetLastError)(void);
    int (PASCAL FAR *WSAAsyncSelect)(SOCKET s, HWND hWnd, u_int wMsg,
	    long lEvent);
} winSock;

/*
 * The following define declares a new user message for use on the
 * socket window.
 */

#define SOCKET_MESSAGE	WM_USER+1

/*
 * The following structure is used to store the data associated with
 * each socket.  A Tcl_File of type TCL_WIN_SOCKET will contain a
 * pointer to one of these structures in the clientdata slot.
 */

typedef struct SocketInfo {
    SOCKET socket;		   /* Windows SOCKET handle. */
    int flags;			   /* Bit field comprised of the flags
				    * described below.  */
    int watchMask;		   /* OR'ed combination of TCL_READABLE and
				    * TCL_WRITABLE as set by Tcl_WatchFile. */
    int eventMask;		   /* OR'ed combination of FD_READ, FD_WRITE,
                                    * FD_CLOSE, FD_ACCEPT and FD_CONNECT. */
    int occurredMask;		   /* OR'ed combination of the above flags
                                    * for those events that have actually
                                    * occurred on the socket. */
    Tcl_File file;		   /* The file handle for the socket. */
    Tcl_TcpAcceptProc *acceptProc; /* Proc to call on accept. */
    ClientData acceptProcData;	   /* The data for the accept proc. */
    struct SocketInfo *nextPtr;	   /* The next socket on the global socket
				    * list. */
} SocketInfo;

/*
 * This defines the minimum buffersize maintained by the kernel.
 */

#define TCP_BUFFER_SIZE 4096

/*
 * The following macros may be used to set the flags field of
 * a SocketInfo structure. We leave the first three bits open
 * for TCL_READABLE, TCL_WRITABLE and TCL_EXCEPTION
 */

#define SOCKET_WATCH 	(1<<4)
				/* TclWinWatchSocket has been called since the
				 * last time we entered Tcl_WaitForEvent. */
#define SOCKET_REGISTERED (1<<5)
				/* A valid WSAAsyncSelect handler is
				 * registered. */
#define SOCKET_ASYNCH	(1<<6)
				/* The socket is in asynch mode. */
#define SOCKET_CLOSED	(1<<7)	/* The socket had an FD_CLOSE event. */
#define SOCKET_EOF	(1<<8)	/* A zero read happened on the socket. */

/*
 * Every open socket has an entry on the following list.
 */

static SocketInfo *socketList = NULL;

/*
 * Static functions defined in this file.
 */

static void		CleanupSockets _ANSI_ARGS_((ClientData clientData));
static SocketInfo *	CreateSocket _ANSI_ARGS_((Tcl_Interp *interp,
			    int port, char *host, int server, char *myaddr,
			    int myport, int async));
static int		CreateSocketAddress _ANSI_ARGS_(
			    (struct sockaddr_in *sockaddrPtr,
			    char *host, int port));
static int		InitSockets _ANSI_ARGS_((void));
static SocketInfo *	NewSocketInfo _ANSI_ARGS_((Tcl_File file));
static void		SocketFreeProc _ANSI_ARGS_((ClientData clientData));
static LRESULT CALLBACK	SocketProc _ANSI_ARGS_((HWND hwnd, UINT message,
			    WPARAM wParam, LPARAM lParam));
static void		TcpAccept _ANSI_ARGS_((ClientData data, int mask));
static int		TcpCloseProc _ANSI_ARGS_((ClientData instanceData,
	            	    Tcl_Interp *interp));
static int		TcpGetOptionProc _ANSI_ARGS_((ClientData instanceData,
		            char *optionName, Tcl_DString *optionValue));
static int		TcpInputProc _ANSI_ARGS_((ClientData instanceData,
	            	    char *buf, int toRead, int *errorCode));
static int		TcpOutputProc _ANSI_ARGS_((ClientData instanceData,
	            	    char *buf, int toWrite, int *errorCode));
static void		TcpWatchProc _ANSI_ARGS_((ClientData instanceData,
		            int mask));
static int		TcpReadyProc _ANSI_ARGS_((ClientData instanceData,
		            int mask));
static Tcl_File		TcpGetProc _ANSI_ARGS_((ClientData instanceData,
		            int direction));

/*
 * This structure describes the channel type structure for TCP socket
 * based IO.
 */

static Tcl_ChannelType tcpChannelType = {
    "tcp",		/* Type name. */
    NULL,		/* Block: Not used. */
    TcpCloseProc,	/* Close proc. */
    TcpInputProc,	/* Input proc. */
    TcpOutputProc,	/* Output proc. */
    NULL,		/* Seek proc. */
    NULL,		/* Set option proc. */
    TcpGetOptionProc,	/* Get option proc. */
    TcpWatchProc,	/* Initialize notifier to watch this channel. */
    TcpReadyProc,	/* Are events present? */
    TcpGetProc,		/* Get a Tcl_File from channel. */
};

/*
 * Socket notification window.  This window is used to receive socket
 * notification events.
 */

static HWND socketWindow = NULL;

/*
 * Window class for creating the socket notification window.
 */

static ATOM socketClass;

/*
 * Define version of Winsock required by Tcl.
 */

#define WSA_VERSION_REQD MAKEWORD(1,1)

/*
 *----------------------------------------------------------------------
 *
 * InitSockets --
 *
 *	Initialize the socket module.  Attempts to load the wsock32.dll
 *	library and set up the winSock function table.  If successful,
 *	registers the event window for the socket notifier code.
 *
 * Results:
 *	Returns 1 on successful initialization, 0 on failure.
 *
 * Side effects:
 *	Dynamically loads wsock32.dll, and registers a new window
 *	class and creates a window for use in asynchronous socket
 *	notification.
 *
 *----------------------------------------------------------------------
 */

static int
InitSockets()
{
    WSADATA wsaData;
    WNDCLASS class;
    HINSTANCE handle;

    /*
     * Load the socket DLL and initialize the function table.
     */

    handle = TclWinLoadLibrary("wsock32.dll");
    if (handle != NULL) {
	winSock.accept = (SOCKET (PASCAL FAR *)(SOCKET s,
		struct sockaddr FAR *addr, int FAR *addrlen))
	    GetProcAddress(handle, "accept");
	winSock.bind = (int (PASCAL FAR *)(SOCKET s,
		const struct sockaddr FAR *addr, int namelen))
	    GetProcAddress(handle, "bind");
	winSock.closesocket = (int (PASCAL FAR *)(SOCKET s))
	    GetProcAddress(handle, "closesocket");
	winSock.connect = (int (PASCAL FAR *)(SOCKET s,
		const struct sockaddr FAR *name, int namelen))
	    GetProcAddress(handle, "connect");
	winSock.ioctlsocket = (int (PASCAL FAR *)(SOCKET s, long cmd,
		u_long FAR *argp)) GetProcAddress(handle, "ioctlsocket");
	winSock.getsockopt = (int (PASCAL FAR *)(SOCKET s,
		int level, int optname, char FAR * optval, int FAR *optlen))
	    GetProcAddress(handle, "getsockopt");
	winSock.htons = (u_short (PASCAL FAR *)(u_short hostshort))
	    GetProcAddress(handle, "htons");
	winSock.inet_addr = (unsigned long (PASCAL FAR *)(const char FAR *cp))
	    GetProcAddress(handle, "inet_addr");
	winSock.inet_ntoa = (char FAR * (PASCAL FAR *)(struct in_addr in))
	    GetProcAddress(handle, "inet_ntoa");
	winSock.listen = (int (PASCAL FAR *)(SOCKET s, int backlog))
	    GetProcAddress(handle, "listen");
	winSock.ntohs = (u_short (PASCAL FAR *)(u_short netshort))
	    GetProcAddress(handle, "ntohs");
	winSock.recv = (int (PASCAL FAR *)(SOCKET s, char FAR * buf,
		int len, int flags)) GetProcAddress(handle, "recv");
	winSock.send = (int (PASCAL FAR *)(SOCKET s, const char FAR * buf,
		int len, int flags)) GetProcAddress(handle, "send");
	winSock.setsockopt = (int (PASCAL FAR *)(SOCKET s, int level,
		int optname, const char FAR * optval, int optlen))
	    GetProcAddress(handle, "setsockopt");
	winSock.shutdown = (int (PASCAL FAR *)(SOCKET s, int how))
	    GetProcAddress(handle, "shutdown");
	winSock.socket = (SOCKET (PASCAL FAR *)(int af, int type,
		int protocol)) GetProcAddress(handle, "socket");
        winSock.gethostbyaddr = (struct hostent FAR * (PASCAL FAR *)
                (const char FAR *addr, int addrlen, int addrtype))
            GetProcAddress(handle, "gethostbyaddr");
	winSock.gethostbyname = (struct hostent FAR * (PASCAL FAR *)
		(const char FAR *name))
	    GetProcAddress(handle, "gethostbyname");
	winSock.gethostname = (int (PASCAL FAR *)(char FAR * name,
		int namelen)) GetProcAddress(handle, "gethostname");
        winSock.getpeername = (int (PASCAL FAR *)(SOCKET sock,
                struct sockaddr FAR *name, int FAR *namelen))
            GetProcAddress(handle, "getpeername");
	winSock.getservbyname = (struct servent FAR * (PASCAL FAR *)
		(const char FAR * name, const char FAR * proto))
	    GetProcAddress(handle, "getservbyname");
        winSock.getsockname = (int (PASCAL FAR *)(SOCKET sock,
                struct sockaddr FAR *name, int FAR *namelen))
            GetProcAddress(handle, "getsockname");
	winSock.WSAStartup = (int (PASCAL FAR *)(WORD wVersionRequired,
		LPWSADATA lpWSAData)) GetProcAddress(handle, "WSAStartup");
	winSock.WSACleanup = (int (PASCAL FAR *)(void))
	    GetProcAddress(handle, "WSACleanup");
	winSock.WSAGetLastError = (int (PASCAL FAR *)(void))
	    GetProcAddress(handle, "WSAGetLastError");
	winSock.WSAAsyncSelect = (int (PASCAL FAR *)(SOCKET s, HWND hWnd,
		u_int wMsg, long lEvent))
	    GetProcAddress(handle, "WSAAsyncSelect");
    }

    /*
     * Initialize the winsock library and check the version number.
     */

    if ((*winSock.WSAStartup)(WSA_VERSION_REQD, &wsaData) != 0) {
	return 0;
    }
    if (wsaData.wVersion != WSA_VERSION_REQD) {
	(*winSock.WSACleanup)();
	return 0;
    }

    /*
     * Register the async notification window class and window.
     */

    class.style = 0;
    class.cbClsExtra = 0;
    class.cbWndExtra = 0;
    class.hInstance = TclWinGetTclInstance();
    class.hbrBackground = NULL;
    class.lpszMenuName = NULL;
    class.lpszClassName = "TclSocket";
    class.lpfnWndProc = SocketProc;
    class.hIcon = NULL;
    class.hCursor = NULL;

    socketClass = RegisterClass(&class);
    if (!socketClass) {
	TclWinConvertError(GetLastError());
	(*winSock.WSACleanup)();
	return 0;
    }
    socketWindow = CreateWindowEx(0, (LPCTSTR)socketClass, "TclSocket",
	    WS_OVERLAPPED, 0, 0, 0, 0, NULL, NULL,
	    TclWinGetTclInstance(), NULL);
    if (socketWindow == NULL) {
	TclWinConvertError(GetLastError());
	UnregisterClass((LPCTSTR)socketClass, TclWinGetTclInstance());
	(*winSock.WSACleanup)();
	return 0;
    }

    Tcl_CreateExitHandler(CleanupSockets, (ClientData) NULL);
    return 1;
}

/*
 *----------------------------------------------------------------------
 *
 * CleanupSockets --
 *
 *	Callback invoked during exit clean up to release the WinSock
 *      DLL.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Releases the WinSock DLL.
 *
 *----------------------------------------------------------------------
 */

    /* ARGSUSED */
static void
CleanupSockets(clientData)
    ClientData clientData;              /* Not used. */
{
    DestroyWindow(socketWindow);
    UnregisterClass((LPCTSTR)socketClass, TclWinGetTclInstance());
    (*winSock.WSACleanup)();
}

/*
 *----------------------------------------------------------------------
 *
 * TcpCloseProc --
 *
 *	This procedure is called by the generic IO level to perform
 *	channel type specific cleanup on a socket based channel
 *	when the channel is closed.
 *
 * Results:
 *	0 if successful, the value of errno if failed.
 *
 * Side effects:
 *	Closes the socket.
 *
 *----------------------------------------------------------------------
 */

    /* ARGSUSED */
static int
TcpCloseProc(instanceData, interp)
    ClientData instanceData;	/* The socket to close. */
    Tcl_Interp *interp;		/* Unused. */
{
    SocketInfo *infoPtr = (SocketInfo *) instanceData;
    int errorCode = 0;

    /*
     * Clean up the OS socket handle.
     */
    
    (void) ((*winSock.shutdown)(infoPtr->socket, 2));
    if ((*winSock.closesocket)(infoPtr->socket) == SOCKET_ERROR) {
	TclWinConvertWSAError((*winSock.WSAGetLastError)());
	errorCode = errno;
    }

    /*
     * Delete a file handler that may be active for this socket.
     * Channel handlers are already deleted in the generic IO close
     * code which called this function.
     */
    
    Tcl_DeleteFileHandler(infoPtr->file);

    /*
     * Free the file handle.  As a side effect, this will call the
     * SocketFreeProc to release the SocketInfo associated with this file.
     */

    Tcl_FreeFile(infoPtr->file);

    return errorCode;
}

/*
 *----------------------------------------------------------------------
 *
 * SocketFreeProc --
 *
 *	This callback is invoked by Tcl_FreeFile in order to delete
 *	the notifier data associated with a file handle.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Removes the SocketInfo from the global socket list.
 *
 *----------------------------------------------------------------------
 */

static void
SocketFreeProc(clientData)
    ClientData clientData;
{
    SocketInfo *infoPtr = (SocketInfo *) clientData;

    /*
     * Remove the socket from socketList.
     */

    if (infoPtr == socketList) {
	socketList = infoPtr->nextPtr;
    } else {
	SocketInfo *p;
	for (p = socketList; p != NULL; p = p->nextPtr) {
	    if (p->nextPtr == infoPtr) {
		p->nextPtr = infoPtr->nextPtr;
		break;
	    }
	}
    }
    ckfree((char *) infoPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * NewSocketInfo --
 *
 *	This function allocates and initializes a new SocketInfo
 *	structure.
 *
 * Results:
 *	Returns a newly allocated SocketInfo.
 *
 * Side effects:
 *	Adds the socket to the global socket list.
 *
 *----------------------------------------------------------------------
 */

static SocketInfo *
NewSocketInfo(file)
    Tcl_File file;
{
    SocketInfo *infoPtr;

    infoPtr = (SocketInfo *) ckalloc((unsigned) sizeof(SocketInfo));
    infoPtr->socket = (SOCKET) Tcl_GetFileInfo(file, NULL);
    infoPtr->flags = 0;
    infoPtr->watchMask = 0;
    infoPtr->eventMask = 0;
    infoPtr->occurredMask = 0;
    infoPtr->file = file;
    infoPtr->acceptProc = NULL;
    infoPtr->nextPtr = socketList;
    socketList = infoPtr;

    Tcl_SetNotifierData(file, SocketFreeProc, (ClientData) infoPtr);
    return infoPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * CreateSocket --
 *
 *	This function opens a new socket and initializes the
 *	SocketInfo structure.
 *
 * Results:
 *	Returns a new SocketInfo, or NULL with an error in interp.
 *
 * Side effects:
 *	Adds a new socket to the socketList.
 *
 *----------------------------------------------------------------------
 */

static SocketInfo *
CreateSocket(interp, port, host, server, myaddr, myport, async)
    Tcl_Interp *interp;		/* For error reporting; can be NULL. */
    int port;			/* Port number to open. */
    char *host;			/* Name of host on which to open port. */
    int server;			/* 1 if socket should be a server socket,
				 * else 0 for a client socket. */
    char *myaddr;		/* Optional client-side address */
    int myport;			/* Optional client-side port */
    int async;			/* If nonzero, connect client socket
                                 * asynchronously. Unused. */
{
    int status;
    struct sockaddr_in sockaddr;	/* Socket address */
    struct sockaddr_in mysockaddr;	/* Socket address for client */
    SOCKET sock;

    if (! CreateSocketAddress(&sockaddr, host, port)) {
	goto addressError;
    }
    if ((myaddr != NULL || myport != 0) &&
	    ! CreateSocketAddress(&mysockaddr, myaddr, myport)) {
	goto addressError;
    }

    sock = (*winSock.socket)(AF_INET, SOCK_STREAM, 0);
    if (sock == INVALID_SOCKET) {
	goto addressError;
    }

    /*
     * Set kernel space buffering
     */

    TclSockMinimumBuffers(sock, TCP_BUFFER_SIZE);

    if (server) {
	/*
	 * Bind to the specified port.  Note that we must not call setsockopt
	 * with SO_REUSEADDR because Microsoft allows addresses to be reused
	 * even if they are still in use.
	 */
    
	status = (*winSock.bind)(sock, (struct sockaddr *) &sockaddr,
		sizeof(sockaddr));
	if (status != SOCKET_ERROR) {
	    (*winSock.listen)(sock, 5);
	}
    } else {
	if (myaddr != NULL || myport != 0) { 
	    status = (*winSock.bind)(sock, (struct sockaddr *) &mysockaddr,
		    sizeof(struct sockaddr));
	    if (status < 0) {
		goto bindError;
	    }
	}
	status = (*winSock.connect)(sock, (struct sockaddr *) &sockaddr,
		sizeof(sockaddr));
    }
    if (status != SOCKET_ERROR) {
	u_long flag = 1;
	status = (*winSock.ioctlsocket)(sock, FIONBIO, &flag);
    }

bindError:
    if (status == SOCKET_ERROR) {
	TclWinConvertWSAError((*winSock.WSAGetLastError)());
        if (interp != NULL) {
            Tcl_AppendResult(interp, "couldn't open socket: ",
                    Tcl_PosixError(interp), (char *) NULL);
        }
        (*winSock.closesocket)(sock);
        return NULL;
    }

    /*
     * Add this socket to the global list of sockets.
     */

    return NewSocketInfo(Tcl_GetFile((ClientData) sock, TCL_WIN_SOCKET));

addressError:
    TclWinConvertWSAError((*winSock.WSAGetLastError)());
    if (interp != NULL) {
	Tcl_AppendResult(interp, "couldn't open socket: ",
		Tcl_PosixError(interp), (char *) NULL);
    }
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * CreateSocketAddress --
 *
 *	This function initializes a sockaddr structure for a host and port.
 *
 * Results:
 *	1 if the host was valid, 0 if the host could not be converted to
 *	an IP address.
 *
 * Side effects:
 *	Fills in the *sockaddrPtr structure.
 *
 *----------------------------------------------------------------------
 */

static int
CreateSocketAddress(sockaddrPtr, host, port)
    struct sockaddr_in *sockaddrPtr;	/* Socket address */
    char *host;				/* Host.  NULL implies INADDR_ANY */
    int port;				/* Port number */
{
    struct hostent *hostent;		/* Host database entry */
    struct in_addr addr;		/* For 64/32 bit madness */

    (void) memset((char *) sockaddrPtr, '\0', sizeof(struct sockaddr_in));
    sockaddrPtr->sin_family = AF_INET;
    sockaddrPtr->sin_port = (*winSock.htons)((short) (port & 0xFFFF));
    if (host == NULL) {
	addr.s_addr = INADDR_ANY;
    } else {
        addr.s_addr = (*winSock.inet_addr)(host);
        if (addr.s_addr == INADDR_NONE) {
            hostent = (*winSock.gethostbyname)(host);
            if (hostent != NULL) {
                memcpy((char *) &addr,
                        (char *) hostent->h_addr_list[0],
                        (size_t) hostent->h_length);
            } else {
#ifdef	EHOSTUNREACH
                errno = EHOSTUNREACH;
#else
#ifdef ENXIO
                errno = ENXIO;
#endif
#endif
		return 0;	/* Error. */
	    }
	}
    }

    /*
     * NOTE: On 64 bit machines the assignment below is rumored to not
     * do the right thing. Please report errors related to this if you
     * observe incorrect behavior on 64 bit machines such as DEC Alphas.
     * Should we modify this code to do an explicit memcpy?
     */

    sockaddrPtr->sin_addr.s_addr = addr.s_addr;
    return 1;	/* Success. */
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_OpenTcpClient --
 *
 *	Opens a TCP client socket and creates a channel around it.
 *
 * Results:
 *	The channel or NULL if failed.  An error message is returned
 *	in the interpreter on failure.
 *
 * Side effects:
 *	Opens a client socket and creates a new channel.
 *
 *----------------------------------------------------------------------
 */

Tcl_Channel
Tcl_OpenTcpClient(interp, port, host, myaddr, myport, async)
    Tcl_Interp *interp;			/* For error reporting; can be NULL. */
    int port;				/* Port number to open. */
    char *host;				/* Host on which to open port. */
    char *myaddr;			/* Client-side address */
    int myport;				/* Client-side port */
    int async;				/* If nonzero, should connect
                                         * client socket asynchronously. */
{
    Tcl_Channel chan;
    SocketInfo *infoPtr;
    char channelName[20];

    if (TclHasSockets(interp) != TCL_OK) {
	return NULL;
    }

    /*
     * Create a new client socket and wrap it in a channel.
     */

    infoPtr = CreateSocket(interp, port, host, 0, myaddr, myport, async);
    if (infoPtr == NULL) {
	return NULL;
    }

    sprintf(channelName, "sock%d", infoPtr->socket);

    chan = Tcl_CreateChannel(&tcpChannelType, channelName,
	    (ClientData) infoPtr, (TCL_READABLE | TCL_WRITABLE));
    if (Tcl_SetChannelOption(interp, chan, "-translation", "auto crlf") ==
            TCL_ERROR) {
        Tcl_Close((Tcl_Interp *) NULL, chan);
        return (Tcl_Channel) NULL;
    }
    if (Tcl_SetChannelOption(NULL, chan, "-eofchar", "") == TCL_ERROR) {
        Tcl_Close((Tcl_Interp *) NULL, chan);
        return (Tcl_Channel) NULL;
    }
    return chan;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_MakeTcpClientChannel --
 *
 *	Creates a Tcl_Channel from an existing client TCP socket.
 *
 * Results:
 *	The Tcl_Channel wrapped around the preexisting TCP socket.
 *
 * Side effects:
 *	None.
 *
 * NOTE: Code contributed by Mark Diekhans (markd@grizzly.com)
 *
 *----------------------------------------------------------------------
 */

Tcl_Channel
Tcl_MakeTcpClientChannel(sock)
    ClientData sock;		/* The socket to wrap up into a channel. */
{
    SocketInfo *infoPtr;
    char channelName[20];
    Tcl_Channel chan;
    int flag = 1;

    if (TclHasSockets(NULL) != TCL_OK) {
	return NULL;
    }

    /*
     * Set kernel space buffering and non-blocking.
     */

    TclSockMinimumBuffers((SOCKET) sock, TCP_BUFFER_SIZE);

    if ((*winSock.ioctlsocket)((SOCKET)sock, FIONBIO, &flag) == SOCKET_ERROR) {
	TclWinConvertWSAError ((*winSock.WSAGetLastError)());
        return NULL;
    }

    infoPtr = NewSocketInfo (Tcl_GetFile((ClientData) sock,
                                         TCL_WIN_SOCKET));

    sprintf(channelName, "sock%d", infoPtr->socket);

    chan = Tcl_CreateChannel(&tcpChannelType, channelName,
	    (ClientData) infoPtr, (TCL_READABLE | TCL_WRITABLE));
    if (Tcl_SetChannelOption((Tcl_Interp *) NULL, chan,
                             "-translation", "auto crlf") ==
            TCL_ERROR) {
        Tcl_Close((Tcl_Interp *) NULL, chan);
        return (Tcl_Channel) NULL;
    }
    if (Tcl_SetChannelOption(NULL, chan, "-eofchar", "") == TCL_ERROR) {
        Tcl_Close((Tcl_Interp *) NULL, chan);
        return (Tcl_Channel) NULL;
    }
    return chan;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_OpenTcpServer --
 *
 *	Opens a TCP server socket and creates a channel around it.
 *
 * Results:
 *	The channel or NULL if failed.  An error message is returned
 *	in the interpreter on failure.
 *
 * Side effects:
 *	Opens a server socket and creates a new channel.
 *
 *----------------------------------------------------------------------
 */

Tcl_Channel
Tcl_OpenTcpServer(interp, port, host, acceptProc, acceptProcData)
    Tcl_Interp *interp;			/* For error reporting - may be
                                         * NULL. */
    int port;				/* Port number to open. */
    char *host;				/* Name of local host. */
    Tcl_TcpAcceptProc *acceptProc;	/* Callback for accepting connections
                                         * from new clients. */
    ClientData acceptProcData;		/* Data for the callback. */
{
    Tcl_Channel chan;
    SocketInfo *infoPtr;
    char channelName[20];

    if (TclHasSockets(interp) != TCL_OK) {
	return NULL;
    }

    /*
     * Create a new client socket and wrap it in a channel.
     */

    infoPtr = CreateSocket(interp, port, host, 1, NULL, 0, 0);
    if (infoPtr == NULL) {
	return NULL;
    }

    infoPtr->acceptProc = acceptProc;
    infoPtr->acceptProcData = acceptProcData;

    /*
     * Set up the callback mechanism for accepting connections
     * from new clients. The caller will use Tcl_TcpRegisterCallback
     * to register a callback to call when a new connection is
     * accepted.
     */

    Tcl_CreateFileHandler(infoPtr->file, TCL_READABLE, TcpAccept,
            (ClientData) infoPtr);

    sprintf(channelName, "sock%d", infoPtr->socket);

    chan = Tcl_CreateChannel(&tcpChannelType, channelName,
	    (ClientData) infoPtr, 0);
    if (Tcl_SetChannelOption(interp, chan, "-eofchar", "") == TCL_ERROR) {
        Tcl_Close((Tcl_Interp *) NULL, chan);
        return (Tcl_Channel) NULL;
    }

    return chan;
}

/*
 *----------------------------------------------------------------------
 *
 * TcpAccept --
 *	Accept a TCP socket connection.  This is called by the event loop,
 *	and it in turns calls any registered callbacks for this channel.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Evals the Tcl script associated with the server socket.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
static void
TcpAccept(data, mask)
    ClientData data;			/* Callback token. */
    int mask;				/* Not used. */
{
    SOCKET newSocket;
    SocketInfo *infoPtr = (SocketInfo *) data;
    SocketInfo *newInfoPtr;
    struct sockaddr_in addr;
    int len;
    Tcl_Channel chan;
    char channelName[20];
    u_long flag = 1;

    len = sizeof(struct sockaddr_in);
    newSocket = (*winSock.accept)(infoPtr->socket, (struct sockaddr *)&addr,
	    &len);

    infoPtr->flags= (~(TCL_READABLE));

    if (newSocket == INVALID_SOCKET) {
        return;
    }

    /*
     * Clear the inherited event mask.
     */

    (*winSock.WSAAsyncSelect)(newSocket, socketWindow, 0, 0);

    /*
     * Set the socket into non-blocking mode.
     */

    if ((*winSock.ioctlsocket)(newSocket, FIONBIO, &flag) != 0) {
	(*winSock.closesocket)(newSocket);
	return;
    }

    /*
     * Add this socket to the global list of sockets.
     */

    newInfoPtr = NewSocketInfo(Tcl_GetFile((ClientData) newSocket,
	    TCL_WIN_SOCKET));


    sprintf(channelName, "sock%d", newSocket);
    chan = Tcl_CreateChannel(&tcpChannelType, channelName,
	    (ClientData) newInfoPtr, (TCL_READABLE | TCL_WRITABLE));
    if (Tcl_SetChannelOption(NULL, chan, "-translation", "auto crlf") ==
            TCL_ERROR) {
        Tcl_Close((Tcl_Interp *) NULL, chan);
        return;
    }
    if (Tcl_SetChannelOption(NULL, chan, "-eofchar", "") == TCL_ERROR) {
        Tcl_Close((Tcl_Interp *) NULL, chan);
        return;
    }

    /*
     * Invoke the accept callback procedure.
     */

    if (infoPtr->acceptProc != NULL) {
	(infoPtr->acceptProc) (infoPtr->acceptProcData, chan,
		(*winSock.inet_ntoa)(addr.sin_addr),
		(*winSock.ntohs)(addr.sin_port));
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TcpInputProc --
 *
 *	This procedure is called by the generic IO level to read data from
 *	a socket based channel.
 *
 * Results:
 *	The number of bytes read or -1 on error.
 *
 * Side effects:
 *	Consumes input from the socket.
 *
 *----------------------------------------------------------------------
 */

static int
TcpInputProc(instanceData, buf, toRead, errorCodePtr)
    ClientData instanceData;		/* The socket state. */
    char *buf;				/* Where to store data. */
    int toRead;				/* Maximum number of bytes to read. */
    int *errorCodePtr;			/* Where to store error codes. */
{
    SocketInfo *infoPtr = (SocketInfo *) instanceData;
    int bytesRead;
    
    *errorCodePtr = 0;

    /*
     * First check to see if EOF was already detected, to prevent
     * calling the socket stack after the first time EOF is detected.
     */

    if (infoPtr->flags & SOCKET_EOF) {
	return 0;
    }
    
    /*
     * No EOF yet, so try to read more from the socket.
     */

    bytesRead = (*winSock.recv)(infoPtr->socket, buf, toRead, 0);
    if (bytesRead == SOCKET_ERROR) {
	TclWinConvertWSAError((*winSock.WSAGetLastError)());
        *errorCodePtr = errno;
        bytesRead = -1;
    }

    /*
     * Ensure that the socket stays readable until we get either an EWOULDBLOCK
     * or a zero sized read.
     */

    if (errno == EWOULDBLOCK) {
	infoPtr->flags &= (~(TCL_READABLE));
    } else if (bytesRead == 0) {
	infoPtr->flags |= SOCKET_EOF;
    } else {
	infoPtr->flags |= TCL_READABLE;
    }

    return bytesRead;
}

/*
 *----------------------------------------------------------------------
 *
 * TcpOutputProc --
 *
 *	This procedure is called by the generic IO level to write data
 *	to a socket based channel.
 *
 * Results:
 *	The number of bytes written or -1 on failure.
 *
 * Side effects:
 *	Produces output on the socket.
 *
 *----------------------------------------------------------------------
 */

static int
TcpOutputProc(instanceData, buf, toWrite, errorCodePtr)
    ClientData instanceData;		/* The socket state. */
    char *buf;				/* Where to get data. */
    int toWrite;			/* Maximum number of bytes to write. */
    int *errorCodePtr;			/* Where to store error codes. */
{
    SocketInfo *infoPtr = (SocketInfo *) instanceData;
    int bytesWritten;

    *errorCodePtr = 0;
    bytesWritten = (*winSock.send)(infoPtr->socket, buf, toWrite, 0);
    if (bytesWritten == SOCKET_ERROR) {
	TclWinConvertWSAError((*winSock.WSAGetLastError)());
	if (errno == EWOULDBLOCK) {
	    infoPtr->flags &= (~(TCL_WRITABLE));
	}
        *errorCodePtr = errno;
        return -1;
    }

    /*
     * Clear the writable bit in the flags.  If an async handler
     * is still registered for this socket, then it will generate a new
     * event if there is still data available.  When the event is
     * processed, the readable bit will be turned back on.
     */

    infoPtr->flags &= (~(TCL_WRITABLE));

    return bytesWritten;
}

/*
 *----------------------------------------------------------------------
 *
 * TcpGetOptionProc --
 *
 *	Computes an option value for a TCP socket based channel, or a
 *	list of all options and their values.
 *
 *	Note: This code is based on code contributed by John Haxby.
 *
 * Results:
 *	A standard Tcl result. The value of the specified option or a
 *	list of all options and	their values is returned in the
 *	supplied DString.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TcpGetOptionProc(instanceData, optionName, dsPtr)
    ClientData instanceData;		/* Socket state. */
    char *optionName;			/* Name of the option to
                                         * retrieve the value for, or
                                         * NULL to get all options and
                                         * their values. */
    Tcl_DString *dsPtr;			/* Where to store the computed
                                         * value; initialized by caller. */
{
    SocketInfo *infoPtr;
    struct sockaddr_in sockname;
    struct sockaddr_in peername;
    struct hostent *hostEntPtr;
    SOCKET sock;
    int size = sizeof(struct sockaddr_in);
    size_t len = 0;
    char buf[128];

    infoPtr = (SocketInfo *) instanceData;
    sock = (int) infoPtr->socket;
    if (optionName != (char *) NULL) {
        len = strlen(optionName);
    }

    if ((len == 0) ||
            ((len > 1) && (optionName[1] == 'p') &&
                    (strncmp(optionName, "-peername", len) == 0))) {
        if ((*winSock.getpeername)(sock, (struct sockaddr *) &peername, &size)
                >= 0) {
            if (len == 0) {
                Tcl_DStringAppendElement(dsPtr, "-peername");
                Tcl_DStringStartSublist(dsPtr);
            }
            Tcl_DStringAppendElement(dsPtr,
                    (*winSock.inet_ntoa)(peername.sin_addr));
            hostEntPtr = (*winSock.gethostbyaddr)(
                (char *) &(peername.sin_addr), sizeof(peername.sin_addr),
                AF_INET);
            if (hostEntPtr != (struct hostent *) NULL) {
                Tcl_DStringAppendElement(dsPtr, hostEntPtr->h_name);
            } else {
                Tcl_DStringAppendElement(dsPtr,
                        (*winSock.inet_ntoa)(peername.sin_addr));
            }
            sprintf(buf, "%d", (*winSock.ntohs)(peername.sin_port));
            Tcl_DStringAppendElement(dsPtr, buf);
            if (len == 0) {
                Tcl_DStringEndSublist(dsPtr);
            } else {
                return TCL_OK;
            }
        }
    }

    if ((len == 0) ||
            ((len > 1) && (optionName[1] == 's') &&
                    (strncmp(optionName, "-sockname", len) == 0))) {
        if ((*winSock.getsockname)(sock, (struct sockaddr *) &sockname, &size)
                >= 0) {
            if (len == 0) {
                Tcl_DStringAppendElement(dsPtr, "-sockname");
                Tcl_DStringStartSublist(dsPtr);
            }
            Tcl_DStringAppendElement(dsPtr,
                    (*winSock.inet_ntoa)(sockname.sin_addr));
            hostEntPtr = (*winSock.gethostbyaddr)(
                (char *) &(sockname.sin_addr), sizeof(peername.sin_addr),
                AF_INET);
            if (hostEntPtr != (struct hostent *) NULL) {
                Tcl_DStringAppendElement(dsPtr, hostEntPtr->h_name);
            } else {
                Tcl_DStringAppendElement(dsPtr,
                        (*winSock.inet_ntoa)(sockname.sin_addr));
            }
            sprintf(buf, "%d", (*winSock.ntohs)(sockname.sin_port));
            Tcl_DStringAppendElement(dsPtr, buf);
            if (len == 0) {
                Tcl_DStringEndSublist(dsPtr);
            } else {
                return TCL_OK;
            }
        }
    }

    if (len > 0) {
        Tcl_SetErrno(EINVAL);
        return TCL_ERROR;
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TcpWatchProc --
 *
 *	Initialize the notifier to watch Tcl_Files from this channel.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Sets up the notifier so that a future event on the channel will
 *	be seen by Tcl.
 *
 *----------------------------------------------------------------------
 */

static void
TcpWatchProc(instanceData, mask)
    ClientData instanceData;		/* The socket state. */
    int mask;				/* Events of interest; an OR-ed
                                         * combination of TCL_READABLE,
                                         * TCL_WRITABEL and TCL_EXCEPTION. */
{
    SocketInfo *infoPtr = (SocketInfo *) instanceData;

    Tcl_WatchFile(infoPtr->file, mask);
}

/*
 *----------------------------------------------------------------------
 *
 * TcpReadyProc --
 *
 *	Called by the notifier to check whether events of interest are
 *	present on the channel.
 *
 * Results:
 *	Returns OR-ed combination of TCL_READABLE, TCL_WRITABLE and
 *	TCL_EXCEPTION to indicate which events of interest are present.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TcpReadyProc(instanceData, mask)
    ClientData instanceData;		/* The socket state. */
    int mask;				/* Events of interest; an OR-ed
                                         * combination of TCL_READABLE,
                                         * TCL_WRITABLE and TCL_EXCEPTION. */
{
    SocketInfo *infoPtr = (SocketInfo *) instanceData;

    return Tcl_FileReady(infoPtr->file, mask);
}

/*
 *----------------------------------------------------------------------
 *
 * TcpGetProc --
 *
 *	Called from Tcl_GetChannelFile to retrieve Tcl_Files from inside
 *	a TCP socket based channel.
 *
 * Results:
 *	The appropriate Tcl_File or NULL if not present. 
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
static Tcl_File
TcpGetProc(instanceData, direction)
    ClientData instanceData;		/* The socket state. */
    int direction;			/* Which Tcl_File to retrieve? */
{
    SocketInfo *statePtr = (SocketInfo *) instanceData;

    return statePtr->file;
}

/*
 *----------------------------------------------------------------------
 *
 * TclWinWatchSocket --
 *
 *	This function imlements the socket specific portion of the
 *	Tcl_WatchFile function in the notifier.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The watched socket will be placed into non-blocking mode, and
 *	an entry on the asynch handler list will be created if necessary. 
 *
 *----------------------------------------------------------------------
 */

void
TclWinWatchSocket(file, mask)
    Tcl_File file;		/* Socket to watch. */
    int mask;			/* OR'ed combination of TCL_READABLE,
				 * TCL_WRITABLE, and TCL_EXCEPTION:
				 * indicates conditions to wait for
				 * in select. */
{
    SocketInfo *infoPtr = (SocketInfo *) Tcl_GetNotifierData(file, NULL);
    Tcl_Time dontBlock;

    dontBlock.sec = 0; dontBlock.usec = 0;

    /*
     * Create socket info on demand if necessary.  We should only enter this
     * code if the socket was created outside of Tcl.  Since this may be
     * the first time that the socket code has been called, we need to invoke
     * TclHasSockets to ensure that everything is initialized properly.
     */

    if (infoPtr == NULL) {
	if (TclHasSockets(NULL) != TCL_OK) {
	    return;
	}
	infoPtr = NewSocketInfo(file);
    }

    infoPtr->flags |= SOCKET_WATCH;
        
    /*
     * If the new mask includes more conditions than the current mask,
     * then we mark the socket as unregistered so it will be reregistered
     * the next time we enter Tcl_WaitForEvent.
     */

    mask |= infoPtr->watchMask;
    if (infoPtr->watchMask != mask) {
	infoPtr->flags &= (~(SOCKET_REGISTERED));
	infoPtr->watchMask = mask;
    }

    /*
     * Check if any bits are set on the flags. If there are, this
     * means that the socket already had events on it, and we need to
     * check it immediately. To do this, set the maximum block time to
     * zero.
     */

    if ((infoPtr->flags & (TCL_READABLE|TCL_WRITABLE|TCL_EXCEPTION)) != 0) {
        Tcl_SetMaxBlockTime(&dontBlock);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclWinNotifySocket --
 *
 *	Set up event notifiers for any sockets that are being watched.
 *	Also, clean up any sockets that are no longer being watched.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Adds and removes asynch select handlers.
 *
 *----------------------------------------------------------------------
 */

void
TclWinNotifySocket()
{
    SocketInfo *infoPtr;

    if (socketList == NULL) {
	return;
    }

    /*
     * Establish or remove any notifiers.
     */

    for (infoPtr = socketList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
	if (infoPtr->flags & SOCKET_WATCH) {
	    if (!(infoPtr->flags & SOCKET_REGISTERED)) {
		int events = 0;
                
		if (infoPtr->watchMask & TCL_READABLE) {
		    events |= (FD_READ | FD_ACCEPT | FD_CLOSE);
		}
                if (infoPtr->watchMask & TCL_WRITABLE) {
		    events |= (FD_WRITE | FD_CONNECT);
		}

                /*
                 * If we are interested in any events, mark the
                 * socket as registered.
                 */

                if (events != 0) {
                    infoPtr->flags |= SOCKET_REGISTERED;
                }

                /*
                 * If the new event interest mask does not match what is
                 * currently set into the socket, set the new mask.
                 */

                if (events != infoPtr->eventMask) {
                    infoPtr->eventMask = events;
                    (*winSock.WSAAsyncSelect)(infoPtr->socket, socketWindow,
                            SOCKET_MESSAGE, events);
                }

	    }
	} else {

            /*
             * We are no longer supposed to be watching this socket. Remove
             * its registration and remember that we are not interested in
             * any events on it.
             */
            
	    if (infoPtr->flags & SOCKET_REGISTERED) {
                infoPtr->flags &= ~(SOCKET_REGISTERED);
                infoPtr->eventMask = 0;
		(*winSock.WSAAsyncSelect)(infoPtr->socket, socketWindow, 0, 0);
	    }
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclWinSocketReady --
 *
 *	This function is invoked by Tcl_FileReady to check whether
 *	the specified conditions are present on a socket.
 *
 * Results:
 *	The return value is 0 if none of the conditions specified by
 *	mask were true for socket the last time the system checked.
 *	If any of the conditions were true, then the return value is a
 *	mask of those that were true.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclWinSocketReady(file, mask)
    Tcl_File file;	/* File handle for a stream. */
    int mask;		/* OR'ed combination of TCL_READABLE,
			 * TCL_WRITABLE, and TCL_EXCEPTION:
			 * indicates conditions caller cares about. */
{
    SocketInfo *infoPtr = (SocketInfo *) Tcl_GetNotifierData(file, NULL);
    int result, status, occurred;
    u_long nBytes;

    result = (infoPtr->flags & mask);
    occurred = infoPtr->occurredMask;
    infoPtr->occurredMask = 0;
    infoPtr->flags &= (~(SOCKET_WATCH));

    if (result & TCL_READABLE) {
        
        /*
         * Must check for readability condition still being present on the
         * socket, because someone might have consumed the data in the
         * meantime. If we are accepting on the socket or it got closed,
         * the socket is readable.
         */

        if (occurred & FD_ACCEPT) {
            /* Empty body. */
        } else if (occurred & FD_CLOSE) {
            /* Remember the FD_CLOSE event. */
            infoPtr->flags |= SOCKET_CLOSED;
        } else {
            
            /*
             * Otherwise it is readable only if there is data present.
	     * NOTE: We do not really care whether FD_READ happened..
             */

            status = (*winSock.ioctlsocket)(infoPtr->socket, FIONREAD,
                    &nBytes);
            if ((status == SOCKET_ERROR) ||
                    ((nBytes == 0) && (!(infoPtr->flags & SOCKET_CLOSED)))) {
                result &= (~(TCL_READABLE));
                infoPtr->flags &= (~(TCL_READABLE));
            }
        }
    }        
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * SocketProc --
 *
 *	This function is called when WSAAsyncSelect has been used
 *	to register interest in a socket event, and the event has
 *	occurred.
 *
 * Results:
 *	0 on success.
 *
 * Side effects:
 *	The flags for the given socket are updated to reflect the
 *	event that occured.
 *
 *----------------------------------------------------------------------
 */

static LRESULT CALLBACK
SocketProc(hwnd, message, wParam, lParam)
    HWND hwnd;
    UINT message;
    WPARAM wParam;
    LPARAM lParam;
{
    int event;
    SOCKET socket;
    SocketInfo *infoPtr;

    if ((hwnd != socketWindow) || (message != SOCKET_MESSAGE)) {
	return DefWindowProc(hwnd, message, wParam, lParam);
    }
    event = WSAGETSELECTEVENT(lParam);
    socket = (SOCKET) wParam;

    /*
     * Find the specified socket on the socket list and update its
     * check flags.
     */

    for (infoPtr = socketList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
	if (infoPtr->socket == socket) {

	    if (event & (FD_READ | FD_ACCEPT | FD_CLOSE)) {
		infoPtr->flags |= TCL_READABLE;
	    }
	    if (event & (FD_WRITE | FD_CONNECT)) {
		infoPtr->flags |= TCL_WRITABLE;
	    }
            infoPtr->occurredMask |= event;
	    break;
	}
    }
    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetHostName --
 *
 *	Returns the name of the local host.
 *
 * Results:
 *	Returns a string containing the host name, or NULL on error.
 *	The returned string must be freed by the caller.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

char *
Tcl_GetHostName()
{
    static int  hostnameInitialized = 0;
    static char hostname[255];	/* This buffer should be big enough for
                                 * hostname plus domain name. */

    if (TclHasSockets(NULL) != TCL_OK) {
	return "";
    }

    if (hostnameInitialized) {
        return hostname;
    }
    if ((*winSock.gethostname)(hostname, 100) == 0) {
        hostnameInitialized = 1;
        return hostname;
    }
    return (char *) NULL;
}
/*
 *----------------------------------------------------------------------
 *
 * TclHasSockets --
 *
 *	This function determines whether sockets are available on the
 *	current system and returns an error in interp if they are not.
 *	Note that interp may be NULL.
 *
 * Results:
 *	Returns TCL_OK if the system supports sockets, or TCL_ERROR with
 *	an error in interp.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclHasSockets(interp)
    Tcl_Interp *interp;
{
    static int initialized = 0;	/* 1 if the socket system has been
				 * initialized. */
    static int hasSockets = 0;	/* 1 if the system supports sockets. */

    if (!initialized) {
	OSVERSIONINFO info;

	initialized = 1;

	/*
	 * Find out if we're running on Win32s.
	 */

	info.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
	GetVersionEx(&info);

	/*
	 * Check to see if Sockets are supported on this system.  Since
	 * win32s panics if we call WSAStartup on a system that doesn't
	 * have winsock.dll, we need to look for it on the system first.
	 * If we find winsock, then load the library and initialize the
	 * stub table.
	 */

	if ((info.dwPlatformId != VER_PLATFORM_WIN32s)
		|| (SearchPath(NULL, "WINSOCK", ".DLL", 0, NULL, NULL) != 0)) {
	    hasSockets = InitSockets();
	}
    }
    
    if (hasSockets) {
	return TCL_OK;
    }
    if (interp != NULL) {
	Tcl_AppendResult(interp, "sockets are not available on this system",
		NULL);
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * TclWinGetSockOpt, et al. --
 *
 *	These functions are wrappers that let us bind the WinSock
 *	API dynamically so we can run on systems that don't have
 *	the wsock32.dll.  We need wrappers for these interfaces
 *	because they are called from the generic Tcl code 
 *
 * Results:
 *	As defined for each function.
 *
 * Side effects:
 *	As defined for each function.
 *
 *----------------------------------------------------------------------
 */

int PASCAL FAR
TclWinGetSockOpt(SOCKET s, int level, int optname, char FAR * optval,
	int FAR *optlen)
{
    return (*winSock.getsockopt)(s, level, optname, optval, optlen);
}

int PASCAL FAR
TclWinSetSockOpt(SOCKET s, int level, int optname, const char FAR * optval,
	int optlen)
{
    return (*winSock.setsockopt)(s, level, optname, optval, optlen);
}

u_short PASCAL FAR
TclWinNToHS(u_short netshort)
{
    return (*winSock.ntohs)(netshort);
}

struct servent FAR * PASCAL FAR
TclWinGetServByName(const char FAR * name, const char FAR * proto)
{
    return (*winSock.getservbyname)(name, proto);
}