Tcl Source Code

Check-in [74e05afb99]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Make windows sockets implementation thread-safe by making the window used to handle socket events thread-specific (one for each thread).

Added test to socket.test to check for this (should work on all platforms).

Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-1-branch-old
Files: files | file ages | folders
SHA1: 74e05afb9916b0f08a17045e57a45c67724f23d6
User & Date: redman 1999-03-24 23:53:16
Context
1999-03-24
23:53
- added code to print the name of each test file that created files and did not clean them up (the... check-in: 406483ed83 user: hershey tags: core-8-1-branch-old
23:53
Make windows sockets implementation thread-safe by making the window used to handle socket events th... check-in: 74e05afb99 user: redman tags: core-8-1-branch-old
19:26
-fixed quoting error in README examples -added safeFetch to list of exported tcltest procs check-in: 27679ee073 user: hershey tags: core-8-1-branch-old
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.









1
2
3
4
5
6
7







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: 
>
>
>
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
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: 

Changes to tests/socket.test.

6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
..
61
62
63
64
65
66
67





68
69
70
71
72
73
74
....
1568
1569
1570
1571
1572
1573
1574






































































1575
1576
1577
1578
1579
1580
1581
#
# 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.8 1999/03/24 02:49:41 hershey 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]
}






#
# 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}







































































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






|







 







>
>
>
>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
..
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
....
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
#
# 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}

Changes to win/tclWinSock.c.

4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
..
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
...
143
144
145
146
147
148
149

150
151
152
153
154
155
156
...
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
...
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
...
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430












431
432
433
434
435
436
437
438
439








440
441
442
443
444
445
446
...
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
...
529
530
531
532
533
534
535





536
537
538
539
540
541
542
...
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
...
960
961
962
963
964
965
966


967
968
969
970
971
972
973
....
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
....
1221
1222
1223
1224
1225
1226
1227


1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
....
1353
1354
1355
1356
1357
1358
1359


1360
1361
1362
1363
1364
1365
1366
....
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
....
1466
1467
1468
1469
1470
1471
1472


1473
1474
1475
1476
1477
1478
1479
....
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
....
1560
1561
1562
1563
1564
1565
1566


1567
1568
1569
1570
1571
1572
1573
....
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
....
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
....
1684
1685
1686
1687
1688
1689
1690


1691
1692
1693
1694
1695
1696
1697
....
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
....
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
 *	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.6 1999/03/10 06:49:30 stanton 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. */
    HWND hwnd;			/* Handle to window for socket messages. */
    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.
     */
    

    SocketInfo *socketList;
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;

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

static void
InitSockets()
{
    WSADATA wsaData;
    OSVERSIONINFO info;
    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;
	}
	
	/*
	 * 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;
	}
    
	/*
	 * 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.hInstance = TclWinGetTclInstance();
	class.hbrBackground = NULL;
	class.lpszMenuName = NULL;
	class.lpszClassName = "TclSocket";
	class.lpfnWndProc = SocketProc;
	class.hIcon = NULL;
	class.hCursor = NULL;
    
	if (RegisterClassA(&class)) {
	    winSock.hwnd = CreateWindowA("TclSocket", "TclSocket", 
		    WS_TILED, 0, 0, 0, 0, NULL, NULL, class.hInstance, NULL);
	} else {
	    winSock.hwnd = NULL;
	}
	if (winSock.hwnd == NULL) {
	    TclWinConvertError(GetLastError());
	    (*winSock.WSACleanup)();
	    goto unloadLibrary;
	}












    }

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

    if (tsdPtr == NULL) {
	tsdPtr = TCL_TSD_INIT(&dataKey);
	tsdPtr->socketList = NULL;








	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) {
	DestroyWindow(winSock.hwnd);
	UnregisterClassA("TclSocket", TclWinGetTclInstance());
	(*winSock.WSACleanup)();
	FreeLibrary(winSock.hInstance);
	winSock.hInstance = NULL;
    }
    initialized = 0;
    hostnameInitialized = 0;
................................................................................
 */

    /* ARGSUSED */
static void
SocketThreadExitHandler(clientData)
    ClientData clientData;              /* Not used. */
{





    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, winSock.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, winSock.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. */



    /*
     * 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, winSock.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;



    /*
     * 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, winSock.hwnd, 0, 0);
    (void) (*winSock.WSAAsyncSelect)(infoPtr->socket, winSock.hwnd,
	    SOCKET_MESSAGE, infoPtr->selectEvents);

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

	while (PeekMessage(&msg, winSock.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];



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

    /*
     * Set kernel space buffering and non-blocking.
................................................................................
    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, winSock.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];



    /*
     * 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, winSock.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;


    
    *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, winSock.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, winSock.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;



    *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, winSock.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, winSock.hwnd,
	    SOCKET_MESSAGE, infoPtr->selectEvents);
    return bytesWritten;
}
 
/*
 *----------------------------------------------------------------------
 *






|







 







<







 







>







 







|







 







<
<
<
<
<
<
<
<
<
<
<
<







 







|

<
<
<
<
<
<




>
>
>
>
>
>
>
>
>
>
>
>









>
>
>
>
>
>
>
>







 







<







 







>
>
>
>
>







 







|









|







 







>
>







 







|







 







>
>











|
|







|







 







>
>







 







|







 







>
>







 







|







 







>
>







 







|







 







|







 







>
>







 







|







 







|







4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
..
30
31
32
33
34
35
36

37
38
39
40
41
42
43
...
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
...
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
...
384
385
386
387
388
389
390












391
392
393
394
395
396
397
...
400
401
402
403
404
405
406
407
408






409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
...
498
499
500
501
502
503
504

505
506
507
508
509
510
511
...
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
...
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
...
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
....
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
....
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
....
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
....
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
....
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
....
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
....
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
....
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
....
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
....
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
....
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
....
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
 *	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.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.
................................................................................
    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;
}
 
/*
 *----------------------------------------------------------------------
 *