Tcl Source Code

1999-03-24    <[email protected]>

	* win/tclWinSock.c: Make sockets thread-safe on Windows. The
	current implementation uses windows to handle events on the
	socket, one for each thread (thread local storage). Previously,
	there was only one window shared between threads, which didn't
	work. [Bug: 1326]

1999-03-23    <[email protected]>

	* tools/tcl.wse: Fixed file association to look in the right place
	for the wish icon. [Bug: 1544]

	* tests/winNotify.test: 
	* tests/ioCmd.test: 

# Commands tested in this file: socket.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: socket.test,v 1.1.2.9 1999/03/24 23:53:17 redman Exp $

# Running socket tests with a remote server:
# ------------------------------------------
# 
# Some tests in socket.test depend on the existence of a remote server to
# which they connect. The remote server must be an instance of tcltest and it
# must run the script found in the file "remote.tcl" in this directory. You

# server (via exec) on platforms that support this, on the local host,
# listening at port 2048. If all fails, a message is printed and the tests
# using the remote server are not performed.

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

# Some tests require the testthread command

set ::tcltest::testConfig(testthread) \
	[expr {[info commands testthread] != {}}]

#
# If remoteServerIP or remoteServerPort are not set, check in the
# environment variables for externally set values.
#

if {![info exists remoteServerIP]} {

    
    vwait x

    removeFile script1
    removeFile script2
    set x
} {accepted socket was not inherited}

test socket-13.1 {Testing use of shared socket between two threads} \
	{socket testthread} {

    set mainthread [testthread names]
    proc ThreadReap {} {
	global mainthread
	testthread errorproc ThreadNullError
	while {[llength [testthread names]] > 1} {
	    foreach tid [testthread names] {
		if {$tid != $mainthread} {
		    catch {testthread send -async $tid {testthread exit}}
		    update
		}
	    }
	}
	testthread errorproc ThreadError
	return [llength [testthread names]]
    }

    removeFile script

    set f [open script w]
    puts $f {
	set f [socket -server accept 2828]
	proc accept {s a p} {
            fileevent $s readable [list echo $s]
            fconfigure $s -buffering line
        }
	proc echo {s} {
	     global i
             set l [gets $s]
             if {[eof $s]} {
                 global x
                 close $s
                 set x done
             } else { 
	         incr i
                 puts $s $l
             }
	}
	set i 0
	puts ready
	set timer [after 20000 "set x done"]
	vwait x
	after cancel $timer
	close $f
	puts "done $i"

	# thread cleans itself up.
	testhread exit
    }
    close $f
    
    # create a thread
    set serverthread [testthread create { source script } ]
    update
    

    set s [socket 127.0.0.1 2828]
    fconfigure $s -buffering line
    catch {
	puts $s "hello"
	gets $s result
    }
    close $s

    ThreadReap
    set result
} hello

# cleanup
if {[string match sock* $commandSocket] == 1} {
   puts $commandSocket exit
   flush $commandSocket
}
catch {close $commandSocket}

/* 
 * tclWinSock.c --
 *
 *	This file contains Windows-specific socket related code.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclWinSock.c,v 1.1.2.7 1999/03/24 23:53:18 redman Exp $
 */

#include "tclWinInt.h"

/*
 * The following variable is used to tell whether this module has been
 * initialized.

 * 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 {
    HINSTANCE hInstance;	/* Handle to WinSock library. */

    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);

					 * for this socket */

typedef struct ThreadSpecificData {
    /*
     * Every open socket has an entry on the following list.
     */
    
    HWND hwnd;			/* Handle to window for socket messages. */
    SocketInfo *socketList;
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;

/*
 * Static functions defined in this file.

 */

static void
InitSockets()
{
    WSADATA wsaData;
    OSVERSIONINFO info;
    static WNDCLASSA class;
    ThreadSpecificData *tsdPtr = 
	(ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);

    if (! initialized) {
	initialized = 1;
	Tcl_CreateExitHandler(SocketExitHandler, (ClientData) NULL);
    

		(winSock.WSACleanup == NULL) ||
		(winSock.WSAGetLastError == NULL) ||
		(winSock.WSAAsyncSelect == NULL)) {
	    goto unloadLibrary;
	}
	
	/*












	 * Create the async notification window with a new class.  We
	 * must create a new class to avoid a Windows 95 bug that causes
	 * us to get the wrong message number for socket events if the
	 * message window is a subclass of a static control.
	 */
    
	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;

	if (RegisterClassA(&class)) {






	    TclWinConvertError(GetLastError());
	    (*winSock.WSACleanup)();
	    goto unloadLibrary;
	}
	
	/*
	 * Initialize the winsock library and check the version number.
	 */
    
	if ((*winSock.WSAStartup)(WSA_VERSION_REQD, &wsaData) != 0) {
	    goto unloadLibrary;
	}
	if (wsaData.wVersion != WSA_VERSION_REQD) {
	    (*winSock.WSACleanup)();
	    goto unloadLibrary;
	}
    }

    /*
     * Check for per-thread initialization.
     */

    if (tsdPtr == NULL) {
	tsdPtr = TCL_TSD_INIT(&dataKey);
	tsdPtr->socketList = NULL;
    
	tsdPtr->hwnd = CreateWindowA("TclSocket", "TclSocket", 
		WS_TILED, 0, 0, 0, 0, NULL, NULL, class.hInstance, NULL);

	if (tsdPtr->hwnd == NULL) {
	    goto unloadLibrary;
	}
	    
	Tcl_CreateEventSource(SocketSetupProc, SocketCheckProc, NULL);
	Tcl_CreateThreadExitHandler(SocketThreadExitHandler, NULL);
    }
    return;

unloadLibrary:
    FreeLibrary(winSock.hInstance);

    /* ARGSUSED */
static void
SocketExitHandler(clientData)
    ClientData clientData;              /* Not used. */
{
    Tcl_MutexLock(&socketMutex);
    if (winSock.hInstance) {

	UnregisterClassA("TclSocket", TclWinGetTclInstance());
	(*winSock.WSACleanup)();
	FreeLibrary(winSock.hInstance);
	winSock.hInstance = NULL;
    }
    initialized = 0;
    hostnameInitialized = 0;

 */

    /* ARGSUSED */
static void
SocketThreadExitHandler(clientData)
    ClientData clientData;              /* Not used. */
{
    ThreadSpecificData *tsdPtr = 
	(ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);

    DestroyWindow(tsdPtr->hwnd);

    Tcl_DeleteEventSource(SocketSetupProc, SocketCheckProc, NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * TclpHasSockets --

	 * We must check to see if data is really available, since someone
	 * could have consumed the data in the meantime.  Turn off async
	 * notification so select will work correctly.	If the socket is
	 * still readable, notify the channel driver, otherwise reset the
	 * async select handler and keep waiting.
	 */

	(void) (*winSock.WSAAsyncSelect)(infoPtr->socket, tsdPtr->hwnd, 0, 0);

	FD_ZERO(&readFds);
	FD_SET(infoPtr->socket, &readFds);
	timeout.tv_usec = 0;
	timeout.tv_sec = 0;
 
	if ((*winSock.select)(0, &readFds, NULL, NULL, &timeout) != 0) {
	    mask |= TCL_READABLE;
	} else {
	    (void) (*winSock.WSAAsyncSelect)(infoPtr->socket, tsdPtr->hwnd,
		    SOCKET_MESSAGE, infoPtr->selectEvents);
	    infoPtr->readyEvents &= ~(FD_READ);
	}
    }
    if (events & (FD_WRITE | FD_CONNECT)) {
	mask |= TCL_WRITABLE;
    }

    u_long flag = 1;			/* Indicates nonblocking mode. */
    int asyncConnect = 0;		/* Will be 1 if async connect is
                                         * in progress. */
    struct sockaddr_in sockaddr;	/* Socket address */
    struct sockaddr_in mysockaddr;	/* Socket address for client */
    SOCKET sock;
    SocketInfo *infoPtr;		/* The returned value. */
    ThreadSpecificData *tsdPtr = 
	(ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);

    /*
     * Check that WinSock is initialized; do not call it if not, to
     * prevent system crashes. This can happen at exit time if the exit
     * handler for WinSock ran before other exit handlers that want to
     * use sockets.
     */

    /*
     * Register for interest in events in the select mask.  Note that this
     * automatically places the socket into non-blocking mode.
     */

    (*winSock.ioctlsocket)(sock, FIONBIO, &flag);
    (void) (*winSock.WSAAsyncSelect)(infoPtr->socket, tsdPtr->hwnd,
	    SOCKET_MESSAGE, infoPtr->selectEvents);

    return infoPtr;

error:
    TclWinConvertWSAError((*winSock.WSAGetLastError)());
    if (interp != NULL) {

    SocketInfo *infoPtr;	/* Information about this socket. */
    int events;			/* Events to look for. */
    int *errorCodePtr;		/* Where to store errors? */
{
    MSG msg;
    int result = 1;
    int oldMode;
    ThreadSpecificData *tsdPtr = 
	(ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);

    /*
     * Be sure to disable event servicing so we are truly modal.
     */

    oldMode = Tcl_SetServiceMode(TCL_SERVICE_NONE);
    
    /*
     * Reset WSAAsyncSelect so we have a fresh set of events pending.
     */

    (void) (*winSock.WSAAsyncSelect)(infoPtr->socket, tsdPtr->hwnd, 0, 0);
    (void) (*winSock.WSAAsyncSelect)(infoPtr->socket, tsdPtr->hwnd,
	    SOCKET_MESSAGE, infoPtr->selectEvents);

    while (1) {
	/*
	 * Process all outstanding messages on the socket window.
	 */

	while (PeekMessage(&msg, tsdPtr->hwnd, 0, 0, PM_REMOVE)) {
	    DispatchMessage(&msg);
	}
	
	if (infoPtr->lastError) {
	    *errorCodePtr = infoPtr->lastError;
	    result = 0;
	    break;

Tcl_Channel
Tcl_MakeTcpClientChannel(sock)
    ClientData sock;		/* The socket to wrap up into a channel. */
{
    SocketInfo *infoPtr;
    char channelName[16 + TCL_INTEGER_SPACE];
    ThreadSpecificData *tsdPtr = 
	(ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);

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

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

    TclSockMinimumBuffers((SOCKET) sock, TCP_BUFFER_SIZE);

    infoPtr = NewSocketInfo((SOCKET) sock);

    /*
     * Start watching for read/write events on the socket.
     */

    infoPtr->selectEvents = FD_READ | FD_CLOSE | FD_WRITE;
    (void) (*winSock.WSAAsyncSelect)(infoPtr->socket, tsdPtr->hwnd,
	    SOCKET_MESSAGE, infoPtr->selectEvents);

    wsprintfA(channelName, "sock%d", infoPtr->socket);
    infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
	    (ClientData) infoPtr, (TCL_READABLE | TCL_WRITABLE));
    Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto crlf");
    return infoPtr->channel;

    SocketInfo *infoPtr;	/* Socket to accept. */
{
    SOCKET newSocket;
    SocketInfo *newInfoPtr;
    struct sockaddr_in addr;
    int len;
    char channelName[16 + TCL_INTEGER_SPACE];
    ThreadSpecificData *tsdPtr = 
	(ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);

    /*
     * Accept the incoming connection request.
     */

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

    newInfoPtr = NewSocketInfo(newSocket);

    /*
     * Select on read/write events and create the channel.
     */

    newInfoPtr->selectEvents = (FD_READ | FD_WRITE | FD_CLOSE);
    (void) (*winSock.WSAAsyncSelect)(newInfoPtr->socket, tsdPtr->hwnd, 
	    SOCKET_MESSAGE, newInfoPtr->selectEvents);

    wsprintfA(channelName, "sock%d", newInfoPtr->socket);
    newInfoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
	    (ClientData) newInfoPtr, (TCL_READABLE | TCL_WRITABLE));
    if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-translation",
	    "auto crlf") == TCL_ERROR) {

    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;
    int error;
    ThreadSpecificData *tsdPtr = 
	(ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
    
    *errorCodePtr = 0;

    /*
     * Check that WinSock is initialized; do not call it if not, to
     * prevent system crashes. This can happen at exit time if the exit
     * handler for WinSock ran before other exit handlers that want to

     * Note that we clear the FD_READ bit because read events are level
     * triggered so a new event will be generated if there is still data
     * available to be read.  We have to simulate blocking behavior here
     * since we are always using non-blocking sockets.
     */

    while (1) {
	(void) (*winSock.WSAAsyncSelect)(infoPtr->socket, tsdPtr->hwnd,
		0, 0);
	bytesRead = (*winSock.recv)(infoPtr->socket, buf, toRead, 0);
	infoPtr->readyEvents &= ~(FD_READ);
  
	/*
	 * Check for end-of-file condition or successful read.
	 */

	if (!WaitForSocketEvent(infoPtr, FD_READ|FD_CLOSE, errorCodePtr)) {
	    bytesRead = -1;
	    break;
  	}
    }
    
    (void) (*winSock.WSAAsyncSelect)(infoPtr->socket, tsdPtr->hwnd,
 	    SOCKET_MESSAGE, infoPtr->selectEvents);
    return bytesRead;
}

/*
 *----------------------------------------------------------------------
 *

    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;
    int error;
    ThreadSpecificData *tsdPtr = 
	(ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);

    *errorCodePtr = 0;

    /*
     * Check that WinSock is initialized; do not call it if not, to
     * prevent system crashes. This can happen at exit time if the exit
     * handler for WinSock ran before other exit handlers that want to

    
    if ((infoPtr->flags & SOCKET_ASYNC_CONNECT)
	    && ! WaitForSocketEvent(infoPtr,  FD_CONNECT, errorCodePtr)) {
	return -1;
    }

    while (1) {
	(void) (*winSock.WSAAsyncSelect)(infoPtr->socket, tsdPtr->hwnd,
		0, 0);
	bytesWritten = (*winSock.send)(infoPtr->socket, buf, toWrite, 0);
	if (bytesWritten != SOCKET_ERROR) {
	    /*
	     * Since Windows won't generate a new write event until we hit
	     * an overflow condition, we need to force the event loop to
	     * poll until the condition changes.

	if (!WaitForSocketEvent(infoPtr, FD_WRITE|FD_CLOSE, errorCodePtr)) {
	    bytesWritten = -1;
	    break;
	}
    }

    (void) (*winSock.WSAAsyncSelect)(infoPtr->socket, tsdPtr->hwnd,
	    SOCKET_MESSAGE, infoPtr->selectEvents);
    return bytesWritten;
}

/*
 *----------------------------------------------------------------------
 *