PageRenderTime 115ms CodeModel.GetById 3ms app.highlight 98ms RepoModel.GetById 1ms app.codeStats 0ms

/brlcad/branches/dmtogl/src/other/tcl/win/tclWinSock.c

https://bitbucket.org/vrrm/brl-cad-copy-for-fast-history-browsing-in-git
C | 2605 lines | 1305 code | 322 blank | 978 comment | 294 complexity | 81425ed018c4642916d316a734d01580 MD5 | raw file
   1/*
   2 * tclWinSock.c --
   3 *
   4 *	This file contains Windows-specific socket related code.
   5 *
   6 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
   7 *
   8 * See the file "license.terms" for information on usage and redistribution of
   9 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  10 *
  11 * RCS: @(#) $Id$
  12 */
  13
  14#include "tclWinInt.h"
  15
  16#ifdef _MSC_VER
  17#   pragma comment (lib, "ws2_32")
  18#endif
  19
  20/*
  21 * Support for control over sockets' KEEPALIVE and NODELAY behavior is
  22 * currently disabled.
  23 */
  24
  25#undef TCL_FEATURE_KEEPALIVE_NAGLE
  26
  27/*
  28 * Make sure to remove the redirection defines set in tclWinPort.h that is in
  29 * use in other sections of the core, except for us.
  30 */
  31
  32#undef getservbyname
  33#undef getsockopt
  34#undef ntohs
  35#undef setsockopt
  36
  37/*
  38 * The following variable is used to tell whether this module has been
  39 * initialized.  If 1, initialization of sockets was successful, if -1 then
  40 * socket initialization failed (WSAStartup failed).
  41 */
  42
  43static int initialized = 0;
  44TCL_DECLARE_MUTEX(socketMutex)
  45
  46/*
  47 * The following variable holds the network name of this host.
  48 */
  49
  50static TclInitProcessGlobalValueProc InitializeHostName;
  51static ProcessGlobalValue hostName = {
  52    0, 0, NULL, NULL, InitializeHostName, NULL, NULL
  53};
  54
  55/*
  56 * The following defines declare the messages used on socket windows.
  57 */
  58
  59#define SOCKET_MESSAGE	    WM_USER+1
  60#define SOCKET_SELECT	    WM_USER+2
  61#define SOCKET_TERMINATE    WM_USER+3
  62#define SELECT		    TRUE
  63#define UNSELECT	    FALSE
  64
  65/*
  66 * The following structure is used to store the data associated with each
  67 * socket.
  68 */
  69
  70typedef struct SocketInfo {
  71    Tcl_Channel channel;	/* Channel associated with this socket. */
  72    SOCKET socket;		/* Windows SOCKET handle. */
  73    int flags;			/* Bit field comprised of the flags described
  74				 * below. */
  75    int watchEvents;		/* OR'ed combination of FD_READ, FD_WRITE,
  76				 * FD_CLOSE, FD_ACCEPT and FD_CONNECT that
  77				 * indicate which events are interesting. */
  78    int readyEvents;		/* OR'ed combination of FD_READ, FD_WRITE,
  79				 * FD_CLOSE, FD_ACCEPT and FD_CONNECT that
  80				 * indicate which events have occurred. */
  81    int selectEvents;		/* OR'ed combination of FD_READ, FD_WRITE,
  82				 * FD_CLOSE, FD_ACCEPT and FD_CONNECT that
  83				 * indicate which events are currently being
  84				 * selected. */
  85    int acceptEventCount;	/* Count of the current number of FD_ACCEPTs
  86				 * that have arrived and not yet processed. */
  87    Tcl_TcpAcceptProc *acceptProc;
  88				/* Proc to call on accept. */
  89    ClientData acceptProcData;	/* The data for the accept proc. */
  90    int lastError;		/* Error code from last message. */
  91    struct SocketInfo *nextPtr;	/* The next socket on the per-thread socket
  92				 * list. */
  93} SocketInfo;
  94
  95/*
  96 * The following structure is what is added to the Tcl event queue when a
  97 * socket event occurs.
  98 */
  99
 100typedef struct SocketEvent {
 101    Tcl_Event header;		/* Information that is standard for all
 102				 * events. */
 103    SOCKET socket;		/* Socket descriptor that is ready. Used to
 104				 * find the SocketInfo structure for the file
 105				 * (can't point directly to the SocketInfo
 106				 * structure because it could go away while
 107				 * the event is queued). */
 108} SocketEvent;
 109
 110/*
 111 * This defines the minimum buffersize maintained by the kernel.
 112 */
 113
 114#define TCP_BUFFER_SIZE 4096
 115
 116/*
 117 * The following macros may be used to set the flags field of a SocketInfo
 118 * structure.
 119 */
 120
 121#define SOCKET_ASYNC		(1<<0)	/* The socket is in blocking mode. */
 122#define SOCKET_EOF		(1<<1)	/* A zero read happened on the
 123					 * socket. */
 124#define SOCKET_ASYNC_CONNECT	(1<<2)	/* This socket uses async connect. */
 125#define SOCKET_PENDING		(1<<3)	/* A message has been sent for this
 126					 * socket */
 127
 128typedef struct ThreadSpecificData {
 129    HWND hwnd;			/* Handle to window for socket messages. */
 130    HANDLE socketThread;	/* Thread handling the window */
 131    Tcl_ThreadId threadId;	/* Parent thread. */
 132    HANDLE readyEvent;		/* Event indicating that a socket event is
 133				 * ready. Also used to indicate that the
 134				 * socketThread has been initialized and has
 135				 * started. */
 136    HANDLE socketListLock;	/* Win32 Event to lock the socketList */
 137    SocketInfo *socketList;	/* Every open socket in this thread has an
 138				 * entry on this list. */
 139} ThreadSpecificData;
 140
 141static Tcl_ThreadDataKey dataKey;
 142static WNDCLASS windowClass;
 143
 144/*
 145 * Static functions defined in this file.
 146 */
 147
 148static SocketInfo *	CreateSocket(Tcl_Interp *interp, int port,
 149			    const char *host, int server, const char *myaddr,
 150			    int myport, int async);
 151static int		CreateSocketAddress(LPSOCKADDR_IN sockaddrPtr,
 152			    const char *host, int port);
 153static void		InitSockets(void);
 154static SocketInfo *	NewSocketInfo(SOCKET socket);
 155static void		SocketExitHandler(ClientData clientData);
 156static LRESULT CALLBACK	SocketProc(HWND hwnd, UINT message, WPARAM wParam,
 157			    LPARAM lParam);
 158static int		SocketsEnabled(void);
 159static void		TcpAccept(SocketInfo *infoPtr);
 160static int		WaitForSocketEvent(SocketInfo *infoPtr, int events,
 161			    int *errorCodePtr);
 162static DWORD WINAPI	SocketThread(LPVOID arg);
 163static void		TcpThreadActionProc(ClientData instanceData,
 164			    int action);
 165
 166static Tcl_EventCheckProc	SocketCheckProc;
 167static Tcl_EventProc		SocketEventProc;
 168static Tcl_EventSetupProc	SocketSetupProc;
 169static Tcl_DriverBlockModeProc	TcpBlockProc;
 170static Tcl_DriverCloseProc	TcpCloseProc;
 171static Tcl_DriverSetOptionProc	TcpSetOptionProc;
 172static Tcl_DriverGetOptionProc	TcpGetOptionProc;
 173static Tcl_DriverInputProc	TcpInputProc;
 174static Tcl_DriverOutputProc	TcpOutputProc;
 175static Tcl_DriverWatchProc	TcpWatchProc;
 176static Tcl_DriverGetHandleProc	TcpGetHandleProc;
 177
 178/*
 179 * This structure describes the channel type structure for TCP socket
 180 * based IO.
 181 */
 182
 183static Tcl_ChannelType tcpChannelType = {
 184    "tcp",		    /* Type name. */
 185    TCL_CHANNEL_VERSION_5,  /* v5 channel */
 186    TcpCloseProc,	    /* Close proc. */
 187    TcpInputProc,	    /* Input proc. */
 188    TcpOutputProc,	    /* Output proc. */
 189    NULL,		    /* Seek proc. */
 190    TcpSetOptionProc,	    /* Set option proc. */
 191    TcpGetOptionProc,	    /* Get option proc. */
 192    TcpWatchProc,	    /* Set up notifier to watch this channel. */
 193    TcpGetHandleProc,	    /* Get an OS handle from channel. */
 194    NULL,		    /* close2proc. */
 195    TcpBlockProc,	    /* Set socket into (non-)blocking mode. */
 196    NULL,		    /* flush proc. */
 197    NULL,		    /* handler proc. */
 198    NULL,		    /* wide seek proc */
 199    TcpThreadActionProc,    /* thread action proc */
 200    NULL,		    /* truncate */
 201};
 202
 203/*
 204 *----------------------------------------------------------------------
 205 *
 206 * InitSockets --
 207 *
 208 *	Initialize the socket module.  If winsock startup is successful,
 209 *	registers the event window for the socket notifier code.
 210 *
 211 *	Assumes socketMutex is held.
 212 *
 213 * Results:
 214 *	None.
 215 *
 216 * Side effects:
 217 *	Initializes winsock, registers a new window class and creates a
 218 *	window for use in asynchronous socket notification.
 219 *
 220 *----------------------------------------------------------------------
 221 */
 222
 223static void
 224InitSockets(void)
 225{
 226    DWORD id;
 227    WSADATA wsaData;
 228    DWORD err;
 229    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
 230	    TclThreadDataKeyGet(&dataKey);
 231
 232    if (!initialized) {
 233	initialized = 1;
 234	TclCreateLateExitHandler(SocketExitHandler, (ClientData) NULL);
 235
 236	/*
 237	 * Create the async notification window with a new class. We must
 238	 * create a new class to avoid a Windows 95 bug that causes us to get
 239	 * the wrong message number for socket events if the message window is
 240	 * a subclass of a static control.
 241	 */
 242
 243	windowClass.style = 0;
 244	windowClass.cbClsExtra = 0;
 245	windowClass.cbWndExtra = 0;
 246	windowClass.hInstance = TclWinGetTclInstance();
 247	windowClass.hbrBackground = NULL;
 248	windowClass.lpszMenuName = NULL;
 249	windowClass.lpszClassName = "TclSocket";
 250	windowClass.lpfnWndProc = SocketProc;
 251	windowClass.hIcon = NULL;
 252	windowClass.hCursor = NULL;
 253
 254	if (!RegisterClassA(&windowClass)) {
 255	    TclWinConvertError(GetLastError());
 256	    goto initFailure;
 257	}
 258
 259	/*
 260	 * Initialize the winsock library and check the interface version
 261	 * actually loaded. We only ask for the 1.1 interface and do require
 262	 * that it not be less than 1.1.
 263	 */
 264
 265#define WSA_VERSION_MAJOR 1
 266#define WSA_VERSION_MINOR 1
 267#define WSA_VERSION_REQD  MAKEWORD(WSA_VERSION_MAJOR, WSA_VERSION_MINOR)
 268
 269	err = WSAStartup((WORD)WSA_VERSION_REQD, &wsaData);
 270	if (err != 0) {
 271	    TclWinConvertWSAError(err);
 272	    goto initFailure;
 273	}
 274
 275	/*
 276	 * Note the byte positions are swapped for the comparison, so that
 277	 * 0x0002 (2.0, MAKEWORD(2,0)) doesn't look less than 0x0101 (1.1).
 278	 * We want the comparison to be 0x0200 < 0x0101.
 279	 */
 280
 281	if (MAKEWORD(HIBYTE(wsaData.wVersion), LOBYTE(wsaData.wVersion))
 282		< MAKEWORD(WSA_VERSION_MINOR, WSA_VERSION_MAJOR)) {
 283	    TclWinConvertWSAError(WSAVERNOTSUPPORTED);
 284	    WSACleanup();
 285	    goto initFailure;
 286	}
 287
 288#undef WSA_VERSION_REQD
 289#undef WSA_VERSION_MAJOR
 290#undef WSA_VERSION_MINOR
 291    }
 292
 293    /*
 294     * Check for per-thread initialization.
 295     */
 296
 297    if (tsdPtr == NULL) {
 298	tsdPtr = TCL_TSD_INIT(&dataKey);
 299	tsdPtr->socketList = NULL;
 300	tsdPtr->hwnd       = NULL;
 301	tsdPtr->threadId   = Tcl_GetCurrentThread();
 302	tsdPtr->readyEvent = CreateEvent(NULL, FALSE, FALSE, NULL);
 303	if (tsdPtr->readyEvent == NULL) {
 304	    goto initFailure;
 305	}
 306	tsdPtr->socketListLock = CreateEvent(NULL, FALSE, TRUE, NULL);
 307	if (tsdPtr->socketListLock == NULL) {
 308	    goto initFailure;
 309	}
 310	tsdPtr->socketThread = CreateThread(NULL, 256, SocketThread, tsdPtr,
 311		0, &id);
 312	if (tsdPtr->socketThread == NULL) {
 313	    goto initFailure;
 314	}
 315
 316	SetThreadPriority(tsdPtr->socketThread, THREAD_PRIORITY_HIGHEST);
 317
 318	/*
 319	 * Wait for the thread to signal when the window has been created and
 320	 * if it is ready to go.
 321	 */
 322
 323	WaitForSingleObject(tsdPtr->readyEvent, INFINITE);
 324
 325	if (tsdPtr->hwnd == NULL) {
 326	    goto initFailure; /* Trouble creating the window */
 327	}
 328
 329	Tcl_CreateEventSource(SocketSetupProc, SocketCheckProc, NULL);
 330    }
 331    return;
 332
 333  initFailure:
 334    TclpFinalizeSockets();
 335    initialized = -1;
 336    return;
 337}
 338
 339/*
 340 *----------------------------------------------------------------------
 341 *
 342 * SocketsEnabled --
 343 *
 344 *	Check that the WinSock was successfully initialized.
 345 *
 346 * Results:
 347 *	1 if it is.
 348 *
 349 * Side effects:
 350 *	None.
 351 *
 352 *----------------------------------------------------------------------
 353 */
 354
 355    /* ARGSUSED */
 356static int
 357SocketsEnabled(void)
 358{
 359    int enabled;
 360    Tcl_MutexLock(&socketMutex);
 361    enabled = (initialized == 1);
 362    Tcl_MutexUnlock(&socketMutex);
 363    return enabled;
 364}
 365
 366
 367/*
 368 *----------------------------------------------------------------------
 369 *
 370 * SocketExitHandler --
 371 *
 372 *	Callback invoked during exit clean up to delete the socket
 373 *	communication window and to release the WinSock DLL.
 374 *
 375 * Results:
 376 *	None.
 377 *
 378 * Side effects:
 379 *	None.
 380 *
 381 *----------------------------------------------------------------------
 382 */
 383
 384    /* ARGSUSED */
 385static void
 386SocketExitHandler(
 387    ClientData clientData)		/* Not used. */
 388{
 389    Tcl_MutexLock(&socketMutex);
 390    /*
 391     * Make sure the socket event handling window is cleaned-up for, at
 392     * most, this thread.
 393     */
 394
 395    TclpFinalizeSockets();
 396    UnregisterClass("TclSocket", TclWinGetTclInstance());
 397    WSACleanup();
 398    initialized = 0;
 399    Tcl_MutexUnlock(&socketMutex);
 400}
 401
 402/*
 403 *----------------------------------------------------------------------
 404 *
 405 * TclpFinalizeSockets --
 406 *
 407 *	This function is called from Tcl_FinalizeThread to finalize the
 408 *	platform specific socket subsystem. Also, it may be called from within
 409 *	this module to cleanup the state if unable to initialize the sockets
 410 *	subsystem.
 411 *
 412 * Results:
 413 *	None.
 414 *
 415 * Side effects:
 416 *	Deletes the event source and destroys the socket thread.
 417 *
 418 *----------------------------------------------------------------------
 419 */
 420
 421void
 422TclpFinalizeSockets(void)
 423{
 424    ThreadSpecificData *tsdPtr;
 425
 426    tsdPtr = (ThreadSpecificData *) TclThreadDataKeyGet(&dataKey);
 427    if (tsdPtr != NULL) {
 428	if (tsdPtr->socketThread != NULL) {
 429	    if (tsdPtr->hwnd != NULL) {
 430		PostMessage(tsdPtr->hwnd, SOCKET_TERMINATE, 0, 0);
 431
 432		/*
 433		 * Wait for the thread to exit. This ensures that we are
 434		 * completely cleaned up before we leave this function.
 435		 */
 436
 437		WaitForSingleObject(tsdPtr->readyEvent, INFINITE);
 438		tsdPtr->hwnd = NULL;
 439	    }
 440	    CloseHandle(tsdPtr->socketThread);
 441	    tsdPtr->socketThread = NULL;
 442	}
 443	if (tsdPtr->readyEvent != NULL) {
 444	    CloseHandle(tsdPtr->readyEvent);
 445	    tsdPtr->readyEvent = NULL;
 446	}
 447	if (tsdPtr->socketListLock != NULL) {
 448	    CloseHandle(tsdPtr->socketListLock);
 449	    tsdPtr->socketListLock = NULL;
 450	}
 451	Tcl_DeleteEventSource(SocketSetupProc, SocketCheckProc, NULL);
 452    }
 453}
 454
 455/*
 456 *----------------------------------------------------------------------
 457 *
 458 * TclpHasSockets --
 459 *
 460 *	This function determines whether sockets are available on the current
 461 *	system and returns an error in interp if they are not. Note that
 462 *	interp may be NULL.
 463 *
 464 * Results:
 465 *	Returns TCL_OK if the system supports sockets, or TCL_ERROR with an
 466 *	error in interp (if non-NULL).
 467 *
 468 * Side effects:
 469 *	If not already prepared, initializes the TSD structure and socket
 470 *	message handling thread associated to the calling thread for the
 471 *	subsystem of the driver.
 472 *
 473 *----------------------------------------------------------------------
 474 */
 475
 476int
 477TclpHasSockets(
 478    Tcl_Interp *interp)		/* Where to write an error message if sockets
 479				 * are not present, or NULL if no such message
 480				 * is to be written. */
 481{
 482    Tcl_MutexLock(&socketMutex);
 483    InitSockets();
 484    Tcl_MutexUnlock(&socketMutex);
 485
 486    if (SocketsEnabled()) {
 487	return TCL_OK;
 488    }
 489    if (interp != NULL) {
 490	Tcl_AppendResult(interp, "sockets are not available on this system",
 491		NULL);
 492    }
 493    return TCL_ERROR;
 494}
 495
 496/*
 497 *----------------------------------------------------------------------
 498 *
 499 * SocketSetupProc --
 500 *
 501 *	This function is invoked before Tcl_DoOneEvent blocks waiting for an
 502 *	event.
 503 *
 504 * Results:
 505 *	None.
 506 *
 507 * Side effects:
 508 *	Adjusts the block time if needed.
 509 *
 510 *----------------------------------------------------------------------
 511 */
 512
 513void
 514SocketSetupProc(
 515    ClientData data,		/* Not used. */
 516    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
 517{
 518    SocketInfo *infoPtr;
 519    Tcl_Time blockTime = { 0, 0 };
 520    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 521
 522    if (!(flags & TCL_FILE_EVENTS)) {
 523	return;
 524    }
 525
 526    /*
 527     * Check to see if there is a ready socket.	 If so, poll.
 528     */
 529
 530    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
 531    for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
 532	    infoPtr = infoPtr->nextPtr) {
 533	if (infoPtr->readyEvents & infoPtr->watchEvents) {
 534	    Tcl_SetMaxBlockTime(&blockTime);
 535	    break;
 536	}
 537    }
 538    SetEvent(tsdPtr->socketListLock);
 539}
 540
 541/*
 542 *----------------------------------------------------------------------
 543 *
 544 * SocketCheckProc --
 545 *
 546 *	This function is called by Tcl_DoOneEvent to check the socket event
 547 *	source for events.
 548 *
 549 * Results:
 550 *	None.
 551 *
 552 * Side effects:
 553 *	May queue an event.
 554 *
 555 *----------------------------------------------------------------------
 556 */
 557
 558static void
 559SocketCheckProc(
 560    ClientData data,		/* Not used. */
 561    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
 562{
 563    SocketInfo *infoPtr;
 564    SocketEvent *evPtr;
 565    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 566
 567    if (!(flags & TCL_FILE_EVENTS)) {
 568	return;
 569    }
 570
 571    /*
 572     * Queue events for any ready sockets that don't already have events
 573     * queued (caused by persistent states that won't generate WinSock
 574     * events).
 575     */
 576
 577    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
 578    for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
 579	    infoPtr = infoPtr->nextPtr) {
 580	if ((infoPtr->readyEvents & infoPtr->watchEvents)
 581		&& !(infoPtr->flags & SOCKET_PENDING)) {
 582	    infoPtr->flags |= SOCKET_PENDING;
 583	    evPtr = (SocketEvent *) ckalloc(sizeof(SocketEvent));
 584	    evPtr->header.proc = SocketEventProc;
 585	    evPtr->socket = infoPtr->socket;
 586	    Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
 587	}
 588    }
 589    SetEvent(tsdPtr->socketListLock);
 590}
 591
 592/*
 593 *----------------------------------------------------------------------
 594 *
 595 * SocketEventProc --
 596 *
 597 *	This function is called by Tcl_ServiceEvent when a socket event
 598 *	reaches the front of the event queue. This function is responsible for
 599 *	notifying the generic channel code.
 600 *
 601 * Results:
 602 *	Returns 1 if the event was handled, meaning it should be removed from
 603 *	the queue. Returns 0 if the event was not handled, meaning it should
 604 *	stay on the queue. The only time the event isn't handled is if the
 605 *	TCL_FILE_EVENTS flag bit isn't set.
 606 *
 607 * Side effects:
 608 *	Whatever the channel callback functions do.
 609 *
 610 *----------------------------------------------------------------------
 611 */
 612
 613static int
 614SocketEventProc(
 615    Tcl_Event *evPtr,		/* Event to service. */
 616    int flags)			/* Flags that indicate what events to handle,
 617				 * such as TCL_FILE_EVENTS. */
 618{
 619    SocketInfo *infoPtr;
 620    SocketEvent *eventPtr = (SocketEvent *) evPtr;
 621    int mask = 0;
 622    int events;
 623    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 624
 625    if (!(flags & TCL_FILE_EVENTS)) {
 626	return 0;
 627    }
 628
 629    /*
 630     * Find the specified socket on the socket list.
 631     */
 632
 633    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
 634    for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
 635	    infoPtr = infoPtr->nextPtr) {
 636	if (infoPtr->socket == eventPtr->socket) {
 637	    break;
 638	}
 639    }
 640    SetEvent(tsdPtr->socketListLock);
 641
 642    /*
 643     * Discard events that have gone stale.
 644     */
 645
 646    if (!infoPtr) {
 647	return 1;
 648    }
 649
 650    infoPtr->flags &= ~SOCKET_PENDING;
 651
 652    /*
 653     * Handle connection requests directly.
 654     */
 655
 656    if (infoPtr->readyEvents & FD_ACCEPT) {
 657	TcpAccept(infoPtr);
 658	return 1;
 659    }
 660
 661    /*
 662     * Mask off unwanted events and compute the read/write mask so we can
 663     * notify the channel.
 664     */
 665
 666    events = infoPtr->readyEvents & infoPtr->watchEvents;
 667
 668    if (events & FD_CLOSE) {
 669	/*
 670	 * If the socket was closed and the channel is still interested in
 671	 * read events, then we need to ensure that we keep polling for this
 672	 * event until someone does something with the channel. Note that we
 673	 * do this before calling Tcl_NotifyChannel so we don't have to watch
 674	 * out for the channel being deleted out from under us. This may cause
 675	 * a redundant trip through the event loop, but it's simpler than
 676	 * trying to do unwind protection.
 677	 */
 678
 679	Tcl_Time blockTime = { 0, 0 };
 680	Tcl_SetMaxBlockTime(&blockTime);
 681	mask |= TCL_READABLE|TCL_WRITABLE;
 682    } else if (events & FD_READ) {
 683	fd_set readFds;
 684	struct timeval timeout;
 685
 686	/*
 687	 * We must check to see if data is really available, since someone
 688	 * could have consumed the data in the meantime. Turn off async
 689	 * notification so select will work correctly. If the socket is still
 690	 * readable, notify the channel driver, otherwise reset the async
 691	 * select handler and keep waiting.
 692	 */
 693
 694	SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
 695		(WPARAM) UNSELECT, (LPARAM) infoPtr);
 696
 697	FD_ZERO(&readFds);
 698	FD_SET(infoPtr->socket, &readFds);
 699	timeout.tv_usec = 0;
 700	timeout.tv_sec = 0;
 701
 702	if (select(0, &readFds, NULL, NULL, &timeout) != 0) {
 703	    mask |= TCL_READABLE;
 704	} else {
 705	    infoPtr->readyEvents &= ~(FD_READ);
 706	    SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
 707		    (WPARAM) SELECT, (LPARAM) infoPtr);
 708	}
 709    }
 710    if (events & (FD_WRITE | FD_CONNECT)) {
 711	mask |= TCL_WRITABLE;
 712	if (events & FD_CONNECT && infoPtr->lastError != NO_ERROR) {
 713	    /*
 714	     * Connect errors should also fire the readable handler.
 715	     */
 716
 717	    mask |= TCL_READABLE;
 718	}
 719    }
 720
 721    if (mask) {
 722	Tcl_NotifyChannel(infoPtr->channel, mask);
 723    }
 724    return 1;
 725}
 726
 727/*
 728 *----------------------------------------------------------------------
 729 *
 730 * TcpBlockProc --
 731 *
 732 *	Sets a socket into blocking or non-blocking mode.
 733 *
 734 * Results:
 735 *	0 if successful, errno if there was an error.
 736 *
 737 * Side effects:
 738 *	None.
 739 *
 740 *----------------------------------------------------------------------
 741 */
 742
 743static int
 744TcpBlockProc(
 745    ClientData instanceData,	/* The socket to block/un-block. */
 746    int mode)			/* TCL_MODE_BLOCKING or
 747				 * TCL_MODE_NONBLOCKING. */
 748{
 749    SocketInfo *infoPtr = (SocketInfo *) instanceData;
 750
 751    if (mode == TCL_MODE_NONBLOCKING) {
 752	infoPtr->flags |= SOCKET_ASYNC;
 753    } else {
 754	infoPtr->flags &= ~(SOCKET_ASYNC);
 755    }
 756    return 0;
 757}
 758
 759/*
 760 *----------------------------------------------------------------------
 761 *
 762 * TcpCloseProc --
 763 *
 764 *	This function is called by the generic IO level to perform channel
 765 *	type specific cleanup on a socket based channel when the channel is
 766 *	closed.
 767 *
 768 * Results:
 769 *	0 if successful, the value of errno if failed.
 770 *
 771 * Side effects:
 772 *	Closes the socket.
 773 *
 774 *----------------------------------------------------------------------
 775 */
 776
 777    /* ARGSUSED */
 778static int
 779TcpCloseProc(
 780    ClientData instanceData,	/* The socket to close. */
 781    Tcl_Interp *interp)		/* Unused. */
 782{
 783    SocketInfo *infoPtr = (SocketInfo *) instanceData;
 784    /* TIP #218 */
 785    int errorCode = 0;
 786    /* ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); */
 787
 788    /*
 789     * Check that WinSock is initialized; do not call it if not, to prevent
 790     * system crashes. This can happen at exit time if the exit handler for
 791     * WinSock ran before other exit handlers that want to use sockets.
 792     */
 793
 794    if (SocketsEnabled()) {
 795	/*
 796	 * Clean up the OS socket handle. The default Windows setting for a
 797	 * socket is SO_DONTLINGER, which does a graceful shutdown in the
 798	 * background.
 799	 */
 800
 801	if (closesocket(infoPtr->socket) == SOCKET_ERROR) {
 802	    TclWinConvertWSAError((DWORD) WSAGetLastError());
 803	    errorCode = Tcl_GetErrno();
 804	}
 805    }
 806
 807    /*
 808     * TIP #218. Removed the code removing the structure from the global
 809     * socket list. This is now done by the thread action callbacks, and only
 810     * there. This happens before this code is called. We can free without
 811     * fear of damaging the list.
 812     */
 813
 814    ckfree((char *) infoPtr);
 815    return errorCode;
 816}
 817
 818/*
 819 *----------------------------------------------------------------------
 820 *
 821 * NewSocketInfo --
 822 *
 823 *	This function allocates and initializes a new SocketInfo structure.
 824 *
 825 * Results:
 826 *	Returns a newly allocated SocketInfo.
 827 *
 828 * Side effects:
 829 *	None, except for allocation of memory.
 830 *
 831 *----------------------------------------------------------------------
 832 */
 833
 834static SocketInfo *
 835NewSocketInfo(
 836    SOCKET socket)
 837{
 838    SocketInfo *infoPtr;
 839    /* ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); */
 840
 841    infoPtr = (SocketInfo *) ckalloc((unsigned) sizeof(SocketInfo));
 842    infoPtr->channel = 0;
 843    infoPtr->socket = socket;
 844    infoPtr->flags = 0;
 845    infoPtr->watchEvents = 0;
 846    infoPtr->readyEvents = 0;
 847    infoPtr->selectEvents = 0;
 848    infoPtr->acceptEventCount = 0;
 849    infoPtr->acceptProc = NULL;
 850    infoPtr->acceptProcData = NULL;
 851    infoPtr->lastError = 0;
 852
 853    /*
 854     * TIP #218. Removed the code inserting the new structure into the global
 855     * list. This is now handled in the thread action callbacks, and only
 856     * there.
 857     */
 858
 859    infoPtr->nextPtr = NULL;
 860
 861    return infoPtr;
 862}
 863
 864/*
 865 *----------------------------------------------------------------------
 866 *
 867 * CreateSocket --
 868 *
 869 *	This function opens a new socket and initializes the SocketInfo
 870 *	structure.
 871 *
 872 * Results:
 873 *	Returns a new SocketInfo, or NULL with an error in interp.
 874 *
 875 * Side effects:
 876 *	None, except for allocation of memory.
 877 *
 878 *----------------------------------------------------------------------
 879 */
 880
 881static SocketInfo *
 882CreateSocket(
 883    Tcl_Interp *interp,		/* For error reporting; can be NULL. */
 884    int port,			/* Port number to open. */
 885    const char *host,		/* Name of host on which to open port. */
 886    int server,			/* 1 if socket should be a server socket, else
 887				 * 0 for a client socket. */
 888    const char *myaddr,		/* Optional client-side address */
 889    int myport,			/* Optional client-side port */
 890    int async)			/* If nonzero, connect client socket
 891				 * asynchronously. */
 892{
 893    u_long flag = 1;		/* Indicates nonblocking mode. */
 894    int asyncConnect = 0;	/* Will be 1 if async connect is in
 895				 * progress. */
 896    SOCKADDR_IN sockaddr;	/* Socket address */
 897    SOCKADDR_IN mysockaddr;	/* Socket address for client */
 898    SOCKET sock = INVALID_SOCKET;
 899    SocketInfo *infoPtr;	/* The returned value. */
 900    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
 901	    TclThreadDataKeyGet(&dataKey);
 902
 903    /*
 904     * Check that WinSock is initialized; do not call it if not, to prevent
 905     * system crashes. This can happen at exit time if the exit handler for
 906     * WinSock ran before other exit handlers that want to use sockets.
 907     */
 908
 909    if (!SocketsEnabled()) {
 910	return NULL;
 911    }
 912
 913    if (!CreateSocketAddress(&sockaddr, host, port)) {
 914	goto error;
 915    }
 916    if ((myaddr != NULL || myport != 0) &&
 917	    !CreateSocketAddress(&mysockaddr, myaddr, myport)) {
 918	goto error;
 919    }
 920
 921    sock = socket(AF_INET, SOCK_STREAM, 0);
 922    if (sock == INVALID_SOCKET) {
 923	goto error;
 924    }
 925
 926    /*
 927     * Win-NT has a misfeature that sockets are inherited in child processes
 928     * by default. Turn off the inherit bit.
 929     */
 930
 931    SetHandleInformation((HANDLE) sock, HANDLE_FLAG_INHERIT, 0);
 932
 933    /*
 934     * Set kernel space buffering
 935     */
 936
 937    TclSockMinimumBuffers((int) sock, TCP_BUFFER_SIZE);
 938
 939    if (server) {
 940	/*
 941	 * Bind to the specified port. Note that we must not call setsockopt
 942	 * with SO_REUSEADDR because Microsoft allows addresses to be reused
 943	 * even if they are still in use.
 944	 *
 945	 * Bind should not be affected by the socket having already been set
 946	 * into nonblocking mode. If there is trouble, this is one place to
 947	 * look for bugs.
 948	 */
 949
 950	if (bind(sock, (SOCKADDR *) &sockaddr, sizeof(SOCKADDR_IN))
 951		== SOCKET_ERROR) {
 952	    goto error;
 953	}
 954
 955	/*
 956	 * Set the maximum number of pending connect requests to the max value
 957	 * allowed on each platform (Win32 and Win32s may be different, and
 958	 * there may be differences between TCP/IP stacks).
 959	 */
 960
 961	if (listen(sock, SOMAXCONN) == SOCKET_ERROR) {
 962	    goto error;
 963	}
 964
 965	/*
 966	 * Add this socket to the global list of sockets.
 967	 */
 968
 969	infoPtr = NewSocketInfo(sock);
 970
 971	/*
 972	 * Set up the select mask for connection request events.
 973	 */
 974
 975	infoPtr->selectEvents = FD_ACCEPT;
 976	infoPtr->watchEvents |= FD_ACCEPT;
 977
 978    } else {
 979	/*
 980	 * Try to bind to a local port, if specified.
 981	 */
 982
 983	if (myaddr != NULL || myport != 0) {
 984	    if (bind(sock, (SOCKADDR *) &mysockaddr, sizeof(SOCKADDR_IN))
 985		    == SOCKET_ERROR) {
 986		goto error;
 987	    }
 988	}
 989
 990	/*
 991	 * Set the socket into nonblocking mode if the connect should be done
 992	 * in the background.
 993	 */
 994
 995	if (async) {
 996	    if (ioctlsocket(sock, (long) FIONBIO, &flag) == SOCKET_ERROR) {
 997		goto error;
 998	    }
 999	}
1000
1001	/*
1002	 * Attempt to connect to the remote socket.
1003	 */
1004
1005	if (connect(sock, (SOCKADDR *) &sockaddr,
1006		sizeof(SOCKADDR_IN)) == SOCKET_ERROR) {
1007	    TclWinConvertWSAError((DWORD) WSAGetLastError());
1008	    if (Tcl_GetErrno() != EWOULDBLOCK) {
1009		goto error;
1010	    }
1011
1012	    /*
1013	     * The connection is progressing in the background.
1014	     */
1015
1016	    asyncConnect = 1;
1017	}
1018
1019	/*
1020	 * Add this socket to the global list of sockets.
1021	 */
1022
1023	infoPtr = NewSocketInfo(sock);
1024
1025	/*
1026	 * Set up the select mask for read/write events. If the connect
1027	 * attempt has not completed, include connect events.
1028	 */
1029
1030	infoPtr->selectEvents = FD_READ | FD_WRITE | FD_CLOSE;
1031	if (asyncConnect) {
1032	    infoPtr->flags |= SOCKET_ASYNC_CONNECT;
1033	    infoPtr->selectEvents |= FD_CONNECT;
1034	}
1035    }
1036
1037    /*
1038     * Register for interest in events in the select mask. Note that this
1039     * automatically places the socket into non-blocking mode.
1040     */
1041
1042    ioctlsocket(sock, (long) FIONBIO, &flag);
1043    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, (LPARAM) infoPtr);
1044
1045    return infoPtr;
1046
1047  error:
1048    TclWinConvertWSAError((DWORD) WSAGetLastError());
1049    if (interp != NULL) {
1050	Tcl_AppendResult(interp, "couldn't open socket: ",
1051		Tcl_PosixError(interp), NULL);
1052    }
1053    if (sock != INVALID_SOCKET) {
1054	closesocket(sock);
1055    }
1056    return NULL;
1057}
1058
1059/*
1060 *----------------------------------------------------------------------
1061 *
1062 * CreateSocketAddress --
1063 *
1064 *	This function initializes a sockaddr structure for a host and port.
1065 *
1066 * Results:
1067 *	1 if the host was valid, 0 if the host could not be converted to an IP
1068 *	address.
1069 *
1070 * Side effects:
1071 *	Fills in the *sockaddrPtr structure.
1072 *
1073 *----------------------------------------------------------------------
1074 */
1075
1076static int
1077CreateSocketAddress(
1078    LPSOCKADDR_IN sockaddrPtr,	/* Socket address */
1079    const char *host,		/* Host. NULL implies INADDR_ANY */
1080    int port)			/* Port number */
1081{
1082    struct hostent *hostent;	/* Host database entry */
1083    struct in_addr addr;	/* For 64/32 bit madness */
1084
1085    /*
1086     * Check that WinSock is initialized; do not call it if not, to prevent
1087     * system crashes. This can happen at exit time if the exit handler for
1088     * WinSock ran before other exit handlers that want to use sockets.
1089     */
1090
1091    if (!SocketsEnabled()) {
1092	Tcl_SetErrno(EFAULT);
1093	return 0;
1094    }
1095
1096    ZeroMemory(sockaddrPtr, sizeof(SOCKADDR_IN));
1097    sockaddrPtr->sin_family = AF_INET;
1098    sockaddrPtr->sin_port = htons((u_short) (port & 0xFFFF));
1099    if (host == NULL) {
1100	addr.s_addr = INADDR_ANY;
1101    } else {
1102	addr.s_addr = inet_addr(host);
1103	if (addr.s_addr == INADDR_NONE) {
1104	    hostent = gethostbyname(host);
1105	    if (hostent != NULL) {
1106		memcpy(&addr, hostent->h_addr, (size_t) hostent->h_length);
1107	    } else {
1108#ifdef	EHOSTUNREACH
1109		Tcl_SetErrno(EHOSTUNREACH);
1110#else
1111#ifdef ENXIO
1112		Tcl_SetErrno(ENXIO);
1113#endif
1114#endif
1115		return 0;	/* Error. */
1116	    }
1117	}
1118    }
1119
1120    /*
1121     * NOTE: On 64 bit machines the assignment below is rumored to not do the
1122     * right thing. Please report errors related to this if you observe
1123     * incorrect behavior on 64 bit machines such as DEC Alphas. Should we
1124     * modify this code to do an explicit memcpy?
1125     */
1126
1127    sockaddrPtr->sin_addr.s_addr = addr.s_addr;
1128    return 1;			/* Success. */
1129}
1130
1131/*
1132 *----------------------------------------------------------------------
1133 *
1134 * WaitForSocketEvent --
1135 *
1136 *	Waits until one of the specified events occurs on a socket.
1137 *
1138 * Results:
1139 *	Returns 1 on success or 0 on failure, with an error code in
1140 *	errorCodePtr.
1141 *
1142 * Side effects:
1143 *	Processes socket events off the system queue.
1144 *
1145 *----------------------------------------------------------------------
1146 */
1147
1148static int
1149WaitForSocketEvent(
1150    SocketInfo *infoPtr,	/* Information about this socket. */
1151    int events,			/* Events to look for. */
1152    int *errorCodePtr)		/* Where to store errors? */
1153{
1154    int result = 1;
1155    int oldMode;
1156    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
1157	    TclThreadDataKeyGet(&dataKey);
1158
1159    /*
1160     * Be sure to disable event servicing so we are truly modal.
1161     */
1162
1163    oldMode = Tcl_SetServiceMode(TCL_SERVICE_NONE);
1164
1165    /*
1166     * Reset WSAAsyncSelect so we have a fresh set of events pending.
1167     */
1168
1169    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) UNSELECT,
1170	    (LPARAM) infoPtr);
1171
1172    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
1173	    (LPARAM) infoPtr);
1174
1175    while (1) {
1176	if (infoPtr->lastError) {
1177	    *errorCodePtr = infoPtr->lastError;
1178	    result = 0;
1179	    break;
1180	} else if (infoPtr->readyEvents & events) {
1181	    break;
1182	} else if (infoPtr->flags & SOCKET_ASYNC) {
1183	    *errorCodePtr = EWOULDBLOCK;
1184	    result = 0;
1185	    break;
1186	}
1187
1188	/*
1189	 * Wait until something happens.
1190	 */
1191
1192	WaitForSingleObject(tsdPtr->readyEvent, INFINITE);
1193    }
1194
1195    (void) Tcl_SetServiceMode(oldMode);
1196    return result;
1197}
1198
1199/*
1200 *----------------------------------------------------------------------
1201 *
1202 * Tcl_OpenTcpClient --
1203 *
1204 *	Opens a TCP client socket and creates a channel around it.
1205 *
1206 * Results:
1207 *	The channel or NULL if failed. An error message is returned in the
1208 *	interpreter on failure.
1209 *
1210 * Side effects:
1211 *	Opens a client socket and creates a new channel.
1212 *
1213 *----------------------------------------------------------------------
1214 */
1215
1216Tcl_Channel
1217Tcl_OpenTcpClient(
1218    Tcl_Interp *interp,		/* For error reporting; can be NULL. */
1219    int port,			/* Port number to open. */
1220    const char *host,		/* Host on which to open port. */
1221    const char *myaddr,		/* Client-side address */
1222    int myport,			/* Client-side port */
1223    int async)			/* If nonzero, should connect client socket
1224				 * asynchronously. */
1225{
1226    SocketInfo *infoPtr;
1227    char channelName[16 + TCL_INTEGER_SPACE];
1228
1229    if (TclpHasSockets(interp) != TCL_OK) {
1230	return NULL;
1231    }
1232
1233    /*
1234     * Create a new client socket and wrap it in a channel.
1235     */
1236
1237    infoPtr = CreateSocket(interp, port, host, 0, myaddr, myport, async);
1238    if (infoPtr == NULL) {
1239	return NULL;
1240    }
1241
1242    wsprintfA(channelName, "sock%d", infoPtr->socket);
1243
1244    infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
1245	    (ClientData) infoPtr, (TCL_READABLE | TCL_WRITABLE));
1246    if (Tcl_SetChannelOption(interp, infoPtr->channel, "-translation",
1247	    "auto crlf") == TCL_ERROR) {
1248	Tcl_Close((Tcl_Interp *) NULL, infoPtr->channel);
1249	return (Tcl_Channel) NULL;
1250    }
1251    if (Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "")
1252	    == TCL_ERROR) {
1253	Tcl_Close((Tcl_Interp *) NULL, infoPtr->channel);
1254	return (Tcl_Channel) NULL;
1255    }
1256    return infoPtr->channel;
1257}
1258
1259/*
1260 *----------------------------------------------------------------------
1261 *
1262 * Tcl_MakeTcpClientChannel --
1263 *
1264 *	Creates a Tcl_Channel from an existing client TCP socket.
1265 *
1266 * Results:
1267 *	The Tcl_Channel wrapped around the preexisting TCP socket.
1268 *
1269 * Side effects:
1270 *	None.
1271 *
1272 * NOTE: Code contributed by Mark Diekhans (markd@grizzly.com)
1273 *
1274 *----------------------------------------------------------------------
1275 */
1276
1277Tcl_Channel
1278Tcl_MakeTcpClientChannel(
1279    ClientData sock)		/* The socket to wrap up into a channel. */
1280{
1281    SocketInfo *infoPtr;
1282    char channelName[16 + TCL_INTEGER_SPACE];
1283    ThreadSpecificData *tsdPtr;
1284
1285    if (TclpHasSockets(NULL) != TCL_OK) {
1286	return NULL;
1287    }
1288
1289    tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
1290
1291    /*
1292     * Set kernel space buffering and non-blocking.
1293     */
1294
1295    TclSockMinimumBuffers((int) sock, TCP_BUFFER_SIZE);
1296
1297    infoPtr = NewSocketInfo((SOCKET) sock);
1298
1299    /*
1300     * Start watching for read/write events on the socket.
1301     */
1302
1303    infoPtr->selectEvents = FD_READ | FD_CLOSE | FD_WRITE;
1304    SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
1305	    (WPARAM) SELECT, (LPARAM) infoPtr);
1306
1307    wsprintfA(channelName, "sock%d", infoPtr->socket);
1308    infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
1309	    (ClientData) infoPtr, (TCL_READABLE | TCL_WRITABLE));
1310    Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto crlf");
1311    return infoPtr->channel;
1312}
1313
1314/*
1315 *----------------------------------------------------------------------
1316 *
1317 * Tcl_OpenTcpServer --
1318 *
1319 *	Opens a TCP server socket and creates a channel around it.
1320 *
1321 * Results:
1322 *	The channel or NULL if failed. An error message is returned in the
1323 *	interpreter on failure.
1324 *
1325 * Side effects:
1326 *	Opens a server socket and creates a new channel.
1327 *
1328 *----------------------------------------------------------------------
1329 */
1330
1331Tcl_Channel
1332Tcl_OpenTcpServer(
1333    Tcl_Interp *interp,		/* For error reporting - may be NULL. */
1334    int port,			/* Port number to open. */
1335    const char *host,		/* Name of local host. */
1336    Tcl_TcpAcceptProc *acceptProc,
1337				/* Callback for accepting connections from new
1338				 * clients. */
1339    ClientData acceptProcData)	/* Data for the callback. */
1340{
1341    SocketInfo *infoPtr;
1342    char channelName[16 + TCL_INTEGER_SPACE];
1343
1344    if (TclpHasSockets(interp) != TCL_OK) {
1345	return NULL;
1346    }
1347
1348    /*
1349     * Create a new client socket and wrap it in a channel.
1350     */
1351
1352    infoPtr = CreateSocket(interp, port, host, 1, NULL, 0, 0);
1353    if (infoPtr == NULL) {
1354	return NULL;
1355    }
1356
1357    infoPtr->acceptProc = acceptProc;
1358    infoPtr->acceptProcData = acceptProcData;
1359
1360    wsprintfA(channelName, "sock%d", infoPtr->socket);
1361
1362    infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
1363	    (ClientData) infoPtr, 0);
1364    if (Tcl_SetChannelOption(interp, infoPtr->channel, "-eofchar", "")
1365	    == TCL_ERROR) {
1366	Tcl_Close((Tcl_Interp *) NULL, infoPtr->channel);
1367	return (Tcl_Channel) NULL;
1368    }
1369
1370    return infoPtr->channel;
1371}
1372
1373/*
1374 *----------------------------------------------------------------------
1375 *
1376 * TcpAccept --
1377 *
1378 *	Accept a TCP socket connection. This is called by SocketEventProc and
1379 *	it in turns calls the registered accept function.
1380 *
1381 * Results:
1382 *	None.
1383 *
1384 * Side effects:
1385 *	Invokes the accept proc which may invoke arbitrary Tcl code.
1386 *
1387 *----------------------------------------------------------------------
1388 */
1389
1390static void
1391TcpAccept(
1392    SocketInfo *infoPtr)	/* Socket to accept. */
1393{
1394    SOCKET newSocket;
1395    SocketInfo *newInfoPtr;
1396    SOCKADDR_IN addr;
1397    int len;
1398    char channelName[16 + TCL_INTEGER_SPACE];
1399    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
1400	    TclThreadDataKeyGet(&dataKey);
1401
1402    /*
1403     * Accept the incoming connection request.
1404     */
1405
1406    len = sizeof(SOCKADDR_IN);
1407
1408    newSocket = accept(infoPtr->socket, (SOCKADDR *)&addr,
1409	    &len);
1410
1411    /*
1412     * Clear the ready mask so we can detect the next connection request. Note
1413     * that connection requests are level triggered, so if there is a request
1414     * already pending, a new event will be generated.
1415     */
1416
1417    if (newSocket == INVALID_SOCKET) {
1418	infoPtr->acceptEventCount = 0;
1419	infoPtr->readyEvents &= ~(FD_ACCEPT);
1420	return;
1421    }
1422
1423    /*
1424     * It is possible that more than one FD_ACCEPT has been sent, so an extra
1425     * count must be kept. Decrement the count, and reset the readyEvent bit
1426     * if the count is no longer > 0.
1427     */
1428
1429    infoPtr->acceptEventCount--;
1430
1431    if (infoPtr->acceptEventCount <= 0) {
1432	infoPtr->readyEvents &= ~(FD_ACCEPT);
1433    }
1434
1435    /*
1436     * Win-NT has a misfeature that sockets are inherited in child processes
1437     * by default. Turn off the inherit bit.
1438     */
1439
1440    SetHandleInformation((HANDLE) newSocket, HANDLE_FLAG_INHERIT, 0);
1441
1442    /*
1443     * Add this socket to the global list of sockets.
1444     */
1445
1446    newInfoPtr = NewSocketInfo(newSocket);
1447
1448    /*
1449     * Select on read/write events and create the channel.
1450     */
1451
1452    newInfoPtr->selectEvents = (FD_READ | FD_WRITE | FD_CLOSE);
1453    SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
1454	    (WPARAM) SELECT, (LPARAM) newInfoPtr);
1455
1456    wsprintfA(channelName, "sock%d", newInfoPtr->socket);
1457    newInfoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
1458	    (ClientData) newInfoPtr, (TCL_READABLE | TCL_WRITABLE));
1459    if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-translation",
1460	    "auto crlf") == TCL_ERROR) {
1461	Tcl_Close((Tcl_Interp *) NULL, newInfoPtr->channel);
1462	return;
1463    }
1464    if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-eofchar", "")
1465	    == TCL_ERROR) {
1466	Tcl_Close((Tcl_Interp *) NULL, newInfoPtr->channel);
1467	return;
1468    }
1469
1470    /*
1471     * Invoke the accept callback function.
1472     */
1473
1474    if (infoPtr->acceptProc != NULL) {
1475	(infoPtr->acceptProc) (infoPtr->acceptProcData, newInfoPtr->channel,
1476		inet_ntoa(addr.sin_addr), ntohs(addr.sin_port));
1477    }
1478}
1479
1480/*
1481 *----------------------------------------------------------------------
1482 *
1483 * TcpInputProc --
1484 *
1485 *	This function is called by the generic IO level to read data from a
1486 *	socket based channel.
1487 *
1488 * Results:
1489 *	The number of bytes read or -1 on error.
1490 *
1491 * Side effects:
1492 *	Consumes input from the socket.
1493 *
1494 *----------------------------------------------------------------------
1495 */
1496
1497static int
1498TcpInputProc(
1499    ClientData instanceData,	/* The socket state. */
1500    char *buf,			/* Where to store data. */
1501    int toRead,			/* Maximum number of bytes to read. */
1502    int *errorCodePtr)		/* Where to store error codes. */
1503{
1504    SocketInfo *infoPtr = (SocketInfo *) instanceData;
1505    int bytesRead;
1506    DWORD error;
1507    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
1508	    TclThreadDataKeyGet(&dataKey);
1509
1510    *errorCodePtr = 0;
1511
1512    /*
1513     * Check that WinSock is initialized; do not call it if not, to prevent
1514     * system crashes. This can happen at exit time if the exit handler for
1515     * WinSock ran before other exit handlers that want to use sockets.
1516     */
1517
1518    if (!SocketsEnabled()) {
1519	*errorCodePtr = EFAULT;
1520	return -1;
1521    }
1522
1523    /*
1524     * First check to see if EOF was already detected, to prevent calling the
1525     * socket stack after the first time EOF is detected.
1526     */
1527
1528    if (infoPtr->flags & SOCKET_EOF) {
1529	return 0;
1530    }
1531
1532    /*
1533     * Check to see if the socket is connected before trying to read.
1534     */
1535
1536    if ((infoPtr->flags & SOCKET_ASYNC_CONNECT)
1537	    && !WaitForSocketEvent(infoPtr, FD_CONNECT, errorCodePtr)) {
1538	return -1;
1539    }
1540
1541    /*
1542     * No EOF, and it is connected, so try to read more from the socket. Note
1543     * that we clear the FD_READ bit because read events are level triggered
1544     * so a new event will be generated if there is still data available to be
1545     * read. We have to simulate blocking behavior here since we are always
1546     * using non-blocking sockets.
1547     */
1548
1549    while (1) {
1550	SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
1551		(WPARAM) UNSELECT, (LPARAM) infoPtr);
1552	bytesRead = recv(infoPtr->socket, buf, toRead, 0);
1553	infoPtr->readyEvents &= ~(FD_READ);
1554
1555	/*
1556	 * Check for end-of-file condition or successful read.
1557	 */
1558
1559	if (bytesRead == 0) {
1560	    infoPtr->flags |= SOCKET_EOF;
1561	}
1562	if (bytesRead != SOCKET_ERROR) {
1563	    break;
1564	}
1565
1566	/*
1567	 * If an error occurs after the FD_CLOSE has arrived, then ignore the
1568	 * error and report an EOF.
1569	 */
1570
1571	if (infoPtr->readyEvents & FD_CLOSE) {
1572	    infoPtr->flags |= SOCKET_EOF;
1573	    bytesRead = 0;
1574	    break;
1575	}
1576
1577	error = WSAGetLastError();
1578
1579	/*
1580	 * If an RST comes, then ignore the error and report an EOF just like
1581	 * on unix.
1582	 */
1583
1584	if (error == WSAECONNRESET) {
1585	    infoPtr->flags |= SOCKET_EOF;
1586	    bytesRead = 0;
1587	    break;
1588	}
1589
1590	/*
1591	 * Check for error condition or underflow in non-blocking case.
1592	 */
1593
1594	if ((infoPtr->flags & SOCKET_ASYNC) || (error != WSAEWOULDBLOCK)) {
1595	    TclWinConvertWSAError(error);
1596	    *errorCodePtr = Tcl_GetErrno();
1597	    bytesRead = -1;
1598	    break;
1599	}
1600
1601	/*
1602	 * In the blocking case, wait until the file becomes readable or
1603	 * closed and try again.
1604	 */
1605
1606	if (!WaitForSocketEvent(infoPtr, FD_READ|FD_CLOSE, errorCodePtr)) {
1607	    bytesRead = -1;
1608	    break;
1609	}
1610    }
1611
1612    SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
1613	    (WPARAM) SELECT, (LPARAM) infoPtr);
1614
1615    return bytesRead;
1616}
1617
1618/*
1619 *----------------------------------------------------------------------
1620 *
1621 * TcpOutputProc --
1622 *
1623 *	This function is called by the generic IO level to write data to a
1624 *	socket based channel.
1625 *
1626 * Results:
1627 *	The number of bytes written or -1 on failure.
1628 *
1629 * Side effects:
1630 *	Produces output on the socket.
1631 *
1632 *----------------------------------------------------------------------
1633 */
1634
1635static int
1636TcpOutputProc(
1637    ClientData instanceData,	/* The socket state. */
1638    const char *buf,		/* Where to get data. */
1639    int toWrite,		/* Maximum number of bytes to write. */
1640    int *errorCodePtr)		/* Where to store error codes. */
1641{
1642    SocketInfo *infoPtr = (SocketInfo *) instanceData;
1643    int bytesWritten;
1644    DWORD error;
1645    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
1646	    TclThreadDataKeyGet(&dataKey);
1647
1648    *errorCodePtr = 0;
1649
1650    /*
1651     * Check that WinSock is initialized; do not call it if not, to prevent
1652     * system crashes. This can happen at exit time if the exit handler for
1653     * WinSock ran before other exit handlers that want to use sockets.
1654     */
1655
1656    if (!SocketsEnabled()) {
1657	*errorCodePtr = EFAULT;
1658	return -1;
1659    }
1660
1661    /*
1662     * Check to see if the socket is connected before trying to write.
1663     */
1664
1665    if ((infoPtr->flags & SOCKET_ASYNC_CONNECT)
1666	    && !WaitForSocketEvent(infoPtr, FD_CONNECT, errorCodePtr)) {
1667	return -1;
1668    }
1669
1670    while (1) {
1671	SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
1672		(WPARAM) UNSELECT, (LPARAM) infoPtr);
1673
1674	bytesWritten = send(infoPtr->socket, buf, toWrite, 0);
1675	if (bytesWritten != SOCKET_ERROR) {
1676	    /*
1677	     * Since Windows won't generate a new write event until we hit an
1678	     * overflow condition, we need to force the event loop to poll
1679	     * until the condition changes.
1680	     */
1681
1682	    if (infoPtr->watchEvents & FD_WRITE) {
1683		Tcl_Time blockTime = { 0, 0 };
1684		Tcl_SetMaxBlockTime(&blockTime);
1685	    }
1686	    break;
1687	}
1688
1689	/*
1690	 * Check for error condition or overflow. In the event of overflow, we
1691	 * need to clear the FD_WRITE flag so we can detect the next writable
1692	 * event. Note that Windows only sends a new writable event after a
1693	 * send fails with WSAEWOULDBLOCK.
1694	 */
1695
1696	error = WSAGetLastError();
1697	if (error == WSAEWOULDBLOCK) {
1698	    infoPtr->readyEvents &= ~(FD_WRITE);
1699	    if (infoPtr->flags & SOCKET_ASYNC) {
1700		*errorCodePtr = EWOULDBLOCK;
1701		bytesWritten = -1;
1702		break;
1703	    }
1704	} else {
1705	    TclWinConvertWSAError(error);
1706	    *errorCodePtr = Tcl_GetErrno();
1707	    bytesWritten = -1;
1708	    break;
1709	}
1710
1711	/*
1712	 * In the blocking case, wait until the file becomes writable or
1713	 * closed and try again.
1714	 */
1715
1716	if (!WaitForSocketEvent(infoPtr, FD_WRITE|FD_CLOSE, errorCodePtr)) {
1717	    bytesWritten = -1;
1718	    break;
1719	}
1720    }
1721
1722    SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
1723	    (WPARAM) SELECT, (LPARAM) infoPtr);
1724
1725    return bytesWritten;
1726}
1727
1728/*
1729 *----------------------------------------------------------------------
1730 *
1731 * TcpSetOptionProc --
1732 *
1733 *	Sets Tcp channel specific options.
1734 *
1735 * Results:
1736 *	None, unless an error happens.
1737 *
1738 * Side effects:
1739 *	Changes attributes of the socket at the system level.
1740 *
1741 *----------------------------------------------------------------------
1742 */
1743
1744static int
1745TcpSetOptionProc(
1746    ClientData instanceData,	/* Socket state. */
1747    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
1748    const char *optionName,	/* Name of the option to set. */
1749    const char *value)		/* New value for option. */
1750{
1751    SocketInfo *infoPtr;
1752    SOCKET sock;
1753
1754    /*
1755     * Check that WinSock is initialized; do not call it if not, to prevent
1756     * system crashes. This can happen at exit time if the exit handler for
1757     * WinSock ran before other exit handlers that want to use sockets.
1758     */
1759
1760    if (!SocketsEnabled()) {
1761	if (interp) {
1762	    Tcl_AppendResult(interp, "winsock is not initialized", NULL);
1763	}
1764	return TCL_ERROR;
1765    }
1766
1767    infoPtr = (SocketInfo *) instanceData;
1768    sock = infoPtr->socket;
1769
1770#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
1771    if (!strcasecmp(optionName, "-keepalive")) {
1772	BOOL val = FALSE;
1773	int boolVar, rtn;
1774
1775	if (Tcl_GetBoolean(interp, value, &boolVar) != TCL_OK) {
1776	    return TCL_ERROR;
1777	}
1778	if (boolVar) {
1779	    val = TRUE;
1780	}
1781	rtn = setsockopt(sock, SOL_SOCKET, SO_KEEPALIVE,
1782		(const char *) &val, sizeof(BOOL));
1783	if (rtn != 0) {
1784	    TclWinConvertWSAError(WSAGetLastError());
1785	    if (interp) {
1786		Tcl_AppendResult(interp, "couldn't set socket option: ",
1787			Tcl_PosixError(interp), NULL);
1788	    }
1789	    return TCL_ERROR;
1790	}
1791	return TCL_OK;
1792    } else if (!strcasecmp(optionName, "-nagle")) {
1793	BOOL val = FALSE;
1794	int boolVar, rtn;
1795
1796	if (Tcl_GetBoolean(interp, value, &boolVar) != TCL_OK) {
1797	    return TCL_ERROR;
1798	}
1799	if (!boolVar) {
1800	    val = TRUE;
1801	}
1802	rtn = setsockopt(sock, IPPROTO_TCP, TCP_NODELAY,
1803		(const char *) &val, sizeof(BOOL));
1804	if (rtn != 0) {
1805	    TclWinConvertWSAError(WSAGetLastError());
1806	    if (interp) {
1807		Tcl_AppendResult(interp, "couldn't set socket option: ",
1808			Tcl_PosixError(interp), NULL);
1809	    }
1810	    return TCL_ERROR;
1811	}
1812	return TCL_OK;
1813    }
1814
1815    return Tcl_BadChannelOption(interp, optionName, "keepalive nagle");
1816#else
1817    return Tcl_BadChannelOption(interp, optionName, "");
1818#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/
1819}
1820
1821/*
1822 *----------------------------------------------------------------------
1823 *
1824 * TcpGetOptionProc --
1825 *
1826 *	Computes an option value for a TCP socket based channel, or a list of
1827 *	all options and their values.
1828 *
1829 *	Note: This code is based on code contributed by John Haxby.
1830 *
1831 * Results:
1832 *	A standard Tcl result. The value of the specified option or a list of
1833 *	all options and their values is returned in the supplied DString.
1834 *
1835 * Side effects:
1836 *	None.
1837 *
1838 *----------------------------------------------------------------------
1839 */
1840
1841static int
1842TcpGetOptionProc(
1843    ClientData instanceData,	/* Socket state. */
1844    Tcl_Interp *interp,		/* For error reporting - can be NULL */
1845    const char *optionName,	/* Name of the option to retrieve the value
1846				 * for, or NULL to get all options and their
1847				 * values. */
1848    Tcl_DString *dsPtr)		/* Where to store the computed value;
1849				 * initialized by caller. */
1850{
1851    SocketInfo *infoPtr;
1852    SOCKADDR_IN sockname;
1853    SOCKADDR_IN peername;
1854    struct hostent *hostEntPtr;
1855    SOCKET sock;
1856    int size = sizeof(SOCKADDR_IN);
1857    size_t len = 0;
1858    char buf[TCL_INTEGER_SPACE];
1859
1860    /*
1861     * Check that WinSock is initialized; do not call it if not, to prevent
1862     * system crashes. This can happen at exit time if the exit handler for
1863     * WinSock ran before other exit handlers that want to use sockets.
1864     */
1865
1866    if (!SocketsEnabled()) {
1867	if (interp) {
1868	    Tcl_AppendResult(interp, "winsock is not initialized", NULL);
1869	}
1870	return TCL_ERROR;
1871    }
1872
1873    infoPtr = (SocketInfo *) instanceData;
1874    sock = (int) infoPtr->socket;
1875    if (optionName != NULL) {
1876	len = strlen(optionName);
1877    }
1878
1879    if ((len > 1) && (optionName[1] == 'e') &&
1880	    (strncmp(optionName, "-error", len) == 0)) {
1881	int optlen;
1882	DWORD err;
1883	int ret;
1884
1885	optlen = sizeof(int);
1886	ret = TclWinGetSockOpt((int)sock, SOL_SOCKET, SO_ERROR,
1887		(char *)&err, &optlen);
1888	if (ret == SOCKET_ERROR) {
1889	    err = WSAGetLastError();
1890	}
1891	if (err) {
1892	    TclWinConvertWSAError(err);
1893	    Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(Tcl_GetErrno()), -1);
1894	}
1895	return TCL_OK;
1896    }
1897
1898    if ((len == 0) || ((len > 1) && (optionName[1] == 'p') &&
1899	    (strncmp(optionName, "-peername", len) == 0))) {
1900	if (getpeername(sock, (LPSOCKADDR) &peername, &size) == 0) {
1901	    if (len == 0) {
1902		Tcl_DStringAppendElement(dsPtr, "-peername");
1903		Tcl_DStringStartSublist(dsPtr);
1904	    }
1905	    Tcl_DStringAppendElement(dsPtr, inet_ntoa(peername.sin_addr));
1906
1907	    if (peername.sin_addr.s_addr == 0) {
1908		hostEntPtr = NULL;
1909	    } else {
1910		hostEntPtr = gethostbyaddr((char *) &(peername.sin_addr),
1911			sizeof(peername.sin_addr), AF_INET);
1912	    }
1913	    if (hostEntPtr != NULL) {
1914		Tcl_DStringAppendElement(dsPtr, hostEntPtr->h_name);
1915	    } else {
1916		Tcl_DStringAppendElement(dsPtr, inet_ntoa(peername.sin_addr));
1917	    }
1918	    TclFormatInt(buf, ntohs(peername.sin_port));
1919	    Tcl_DStringAppendElement(dsPtr, buf);
1920	    if (len == 0) {
1921		Tcl_DStringEndSublist(dsPtr);
1922	    } else {
1923		return TCL_OK;
1924	    }
1925	} else {
1926	    /*
1927	     * getpeername failed - but if we were asked for all the options
1928	     * (len==0), don't flag an error at that point because it could be
1929	     * an fconfigure request on a server socket (such sockets have no
1930	     * peer). {Copied from unix/tclUnixChan.c}
1931	     */
1932
1933	    if (len) {
1934		TclWinConvertWSAError((DWORD) WSAGetLastError());
1935		if (interp) {
1936		    Tcl_AppendResult(interp, "can't get peername: ",
1937			    Tcl_PosixError(interp), NULL);
1938		}
1939		return TCL_ERROR;
1940	    }
1941	}
1942    }
1943
1944    if ((len == 0) || ((len > 1) && (optionName[1] == 's') &&
1945	    (strncmp(optionName, "-sockname", len) == 0))) {
1946	if (getsockname(sock, (LPSOCKADDR) &sockname, &size) == 0) {
1947	    if (len == 0) {
1948		Tcl_DStringAppendElement(dsPtr, "-sockname");
1949		Tcl_DStringStartSublist(dsPtr);
1950	    }
1951	    Tcl_DStringAppendElement(dsPtr, inet_ntoa(sockname.sin_addr));
1952	    if (sockname.sin_addr.s_addr == 0) {
1953		hostEntPtr = NULL;
1954	    } else {
1955		hostEntPtr = gethostbyaddr((char *) &(sockname.sin_addr),
1956			sizeof(peername.sin_addr), AF_INET);
1957	    }
1958	    if (hostEntPtr != NULL) {
1959		Tcl_DStringAppendElement(dsPtr, hostEntPtr->h_name);
1960	    } else {
1961		Tcl_DStringAppendElement(dsPtr, inet_ntoa(sockname.sin_addr));
1962	    }
1963	    TclFormatInt(buf, ntohs(sockname.sin_port));
1964	    Tcl_DStringAppendElement(dsPtr, buf);
1965	    if (len == 0) {
1966		Tcl_DStringEndSublist(dsPtr);
1967	    } else {
1968		return TCL_OK;
1969	    }
1970	} else {
1971	    if (interp) {
1972		TclWinConvertWSAError((DWORD) WSAGetLastError());
1973		Tcl_AppendResult(interp, "can't get sockname: ",
1974			Tcl_PosixError(interp), NULL);
1975	    }
1976	    return TCL_ERROR;
1977	}
1978    }
1979
1980#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
1981    if (len == 0 || !strncmp(optionName, "-keepalive", len)) {
1982	int optlen;
1983	BOOL opt = FALSE;
1984
1985	if (len == 0) {
1986	    Tcl_DStringAppendElement(dsPtr, "-keepalive");
1987	}
1988	optlen = sizeof(BOOL);
1989	getsockopt(sock, SOL_SOCKET, SO_KEEPALIVE, (char *)&opt, &optlen);
1990	if (opt) {
1991	    Tcl_DStringAppendElement(dsPtr, "1");
1992	} else {
1993	    Tcl_DStringAppendElement(dsPtr, "0");
1994	}
1995	if (len > 0) {
1996	    return TCL_OK;
1997	}
1998    }
1999
2000    if (len == 0 || !strncmp(optionName, "-nagle", len)) {
2001	int optlen;
2002	BOOL opt = FALSE;
2003
2004	if (len == 0) {
2005	    Tcl_DStringAppendElement(dsPtr, "-nagle");
2006	}
2007	optlen = sizeof(BOOL);
2008	getsockopt(sock, IPPROTO_TCP, TCP_NODELAY, (char *)&opt,
2009		&optlen);
2010	if (opt) {
2011	    Tcl_DStringAppendElement(dsPtr, "0");
2012	} else {
2013	    Tcl_DStringAppendElement(dsPtr, "1");
2014	}
2015	if (len > 0) {
2016	    return TCL_OK;
2017	}
2018    }
2019#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/
2020
2021    if (len > 0) {
2022#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
2023	return Tcl_BadChannelOption(interp, optionName,
2024		"peername sockname keepalive nagle");
2025#else
2026	return Tcl_BadChannelOption(interp, optionName, "peername sockname");
2027#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/
2028    }
2029
2030    return TCL_OK;
2031}
2032
2033/*
2034 *----------------------------------------------------------------------
2035 *
2036 * TcpWatchProc --
2037 *
2038 *	Informs the channel driver of the events that the generic channel code
2039 *	wishes to receive on this socket.
2040 *
2041 * Results:
2042 *	None.
2043 *
2044 * Side effects:
2045 *	May cause the notifier to poll if any of the specified conditions are
2046 *	already true.
2047 *
2048 *----------------------------------------------------------------------
2049 */
2050
2051static void
2052TcpWatchProc(
2053    ClientData instanceData,	/* The socket state. */
2054    int mask)			/* Events of interest; an OR-ed combination of
2055				 * TCL_READABLE, TCL_WRITABLE and
2056				 * TCL_EXCEPTION. */
2057{
2058    SocketInfo *infoPtr = (SocketInfo *) instanceData;
2059
2060    /*
2061     * Update the watch events mask. Only if the socket is not a server
2062     * socket. Fix for SF Tcl Bug #557878.
2063     */
2064
2065    if (!infoPtr->acceptProc) {
2066	infoPtr->watchEvents = 0;
2067	if (mask & TCL_READABLE) {
2068	    infoPtr->watchEvents |= (FD_READ|FD_CLOSE|FD_ACCEPT);
2069	}
2070	if (mask & TCL_WRITABLE) {
2071	    infoPtr->watchEvents |= (FD_WRITE|FD_CLOSE|FD_CONNECT);
2072	}
2073
2074	/*
2075	 * If there are any conditions already set, then tell the notifier to
2076	 * poll rather than block.
2077	 */
2078
2079	if (infoPtr->readyEvents & infoPtr->watchEvents) {
2080	    Tcl_Time blockTime = { 0, 0 };
2081	    Tcl_SetMaxBlockTime(&blockTime);
2082	}
2083    }
2084}
2085
2086/*
2087 *----------------------------------------------------------------------
2088 *
2089 * TcpGetProc --
2090 *
2091 *	Called from Tcl_GetChannelHandle to retrieve an OS handle from inside
2092 *	a TCP socket based channel.
2093 *
2094 * Results:
2095 *	Returns TCL_OK with the socket in handlePtr.
2096 *
2097 * Side effects:
2098 *	None.
2099 *
2100 *----------------------------------------------------------------------
2101 */
2102
2103static int
2104TcpGetHandleProc(
2105    ClientData instanceData,	/* The socket state. */
2106    int direction,		/* Not used. */
2107    ClientData *handlePtr)	/* Where to store the handle. */
2108{
2109    SocketInfo *statePtr = (SocketInfo *) instanceData;
2110
2111    *handlePtr = (ClientData) statePtr->socket;
2112    return TCL_OK;
2113}
2114
2115/*
2116 *----------------------------------------------------------------------
2117 *
2118 * SocketThread --
2119 *
2120 *	Helper thread used to manage the socket event handling window.
2121 *
2122 * Results:
2123 *	1 if unable to create socket event window, 0 otherwise.
2124 *
2125 * Side effects:
2126 *	None.
2127 *
2128 *----------------------------------------------------------------------
2129 */
2130
2131static DWORD WINAPI
2132SocketThread(
2133    LPVOID arg)
2134{
2135    MSG msg;
2136    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)(arg);
2137
2138    /*
2139     * Create a dummy window receiving socket events.
2140     */
2141
2142    tsdPtr->hwnd = CreateWindow("TclSocket", "TclSocket",
2143	    WS_TILED, 0, 0, 0, 0, NULL, NULL, windowClass.hInstance, arg);
2144
2145    /*
2146     * Signalize thread creator that we are done creating the window.
2147     */
2148
2149    SetEvent(tsdPtr->readyEvent);
2150
2151    /*
2152     * If unable to create the window, exit this thread immediately.
2153     */
2154
2155    if (tsdPtr->hwnd == NULL) {
2156	return 1;
2157    }
2158
2159    /*
2160     * Process all messages on the socket window until WM_QUIT. This threads
2161     * exits only when instructed to do so by the call to
2162     * PostMessage(SOCKET_TERMINATE) in TclpFinalizeSockets().
2163     */
2164
2165    while (GetMessage(&msg, NULL, 0, 0) > 0) {
2166	DispatchMessage(&msg);
2167    }
2168
2169    /*
2170     * This releases waiters on thread exit in TclpFinalizeSockets()
2171     */
2172
2173    SetEvent(tsdPtr->readyEvent);
2174
2175    return msg.wParam;
2176}
2177
2178
2179/*
2180 *----------------------------------------------------------------------
2181 *
2182 * SocketProc --
2183 *
2184 *	This function is called when WSAAsyncSelect has been used to register
2185 *	interest in a socket event, and the event has occurred.
2186 *
2187 * Results:
2188 *	0 on success.
2189 *
2190 * Side effects:
2191 *	The flags for the given socket are updated to reflect the event that
2192 *	occured.
2193 *
2194 *----------------------------------------------------------------------
2195 */
2196
2197static LRESULT CALLBACK
2198SocketProc(
2199    HWND hwnd,
2200    UINT message,
2201    WPARAM wParam,
2202    LPARAM lParam)
2203{
2204    int event, error;
2205    SOCKET socket;
2206    SocketInfo *infoPtr;
2207    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
2208#ifdef _WIN64
2209	    GetWindowLongPtr(hwnd, GWLP_USERDATA);
2210#else
2211	    GetWindowLong(hwnd, GWL_USERDATA);
2212#endif
2213
2214    switch (message) {
2215    default:
2216	return DefWindowProc(hwnd, message, wParam, lParam);
2217	break;
2218
2219    case WM_CREATE:
2220	/*
2221	 * Store the initial tsdPtr, it's from a different thread, so it's not
2222	 * directly accessible, but needed.
2223	 */
2224
2225#ifdef _WIN64
2226	SetWindowLongPtr(hwnd, GWLP_USERDATA,
2227		(LONG_PTR) ((LPCREATESTRUCT)lParam)->lpCreateParams);
2228#else
2229	SetWindowLong(hwnd, GWL_USERDATA,
2230		(LONG) ((LPCREATESTRUCT)lParam)->lpCreateParams);
2231#endif
2232	break;
2233
2234    case WM_DESTROY:
2235	PostQuitMessage(0);
2236	break;
2237
2238    case SOCKET_MESSAGE:
2239	event = WSAGETSELECTEVENT(lParam);
2240	error = WSAGETSELECTERROR(lParam);
2241	socket = (SOCKET) wParam;
2242
2243	/*
2244	 * Find the specified socket on the socket list and update its
2245	 * eventState flag.
2246	 */
2247
2248	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
2249	for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
2250		infoPtr = infoPtr->nextPtr) {
2251	    if (infoPtr->socket == socket) {
2252		/*
2253		 * Update the socket state.
2254		 *
2255		 * A count of FD_ACCEPTS is stored, so if an FD_CLOSE event
2256		 * happens, then clear the FD_ACCEPT count. Otherwise,
2257		 * increment the count if the current event is an FD_ACCEPT.
2258		 */
2259
2260		if (event & FD_CLOSE) {
2261		    infoPtr->acceptEventCount = 0;
2262		    infoPtr->readyEvents &= ~(FD_WRITE|FD_ACCEPT);
2263		} else if (event & FD_ACCEPT) {
2264		    infoPtr->acceptEventCount++;
2265		}
2266
2267		if (event & FD_CONNECT) {
2268		    /*
2269		     * The socket is now connected, clear the async connect
2270		     * flag.
2271		     */
2272
2273		    infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
2274
2275		    /*
2276		     * Remember any error that occurred so we can report
2277		     * connection failures.
2278		     */
2279
2280		    if (error != ERROR_SUCCESS) {
2281			TclWinConvertWSAError((DWORD) error);
2282			infoPtr->lastError = Tcl_GetErrno();
2283		    }
2284		}
2285
2286		if (infoPtr->flags & SOCKET_ASYNC_CONNECT) {
2287		    infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
2288		    if (error != ERROR_SUCCESS) {
2289			TclWinConvertWSAError((DWORD) error);
2290			infoPtr->lastError = Tcl_GetErrno();
2291		    }
2292		    infoPtr->readyEvents |= FD_WRITE;
2293		}
2294		infoPtr->readyEvents |= event;
2295
2296		/*
2297		 * Wake up the Main Thread.
2298		 */
2299
2300		SetEvent(tsdPtr->readyEvent);
2301		Tcl_ThreadAlert(tsdPtr->threadId);
2302		break;
2303	    }
2304	}
2305	SetEvent(tsdPtr->socketListLock);
2306	break;
2307
2308    case SOCKET_SELECT:
2309	infoPtr = (SocketInfo *) lParam;
2310	if (wParam == SELECT) {
2311	    WSAAsyncSelect(infoPtr->socket, hwnd,
2312		    SOCKET_MESSAGE, infoPtr->selectEvents);
2313	} else {
2314	    /*
2315	     * Clear the selection mask
2316	     */
2317
2318	    WSAAsyncSelect(infoPtr->socket, hwnd, 0, 0);
2319	}
2320	break;
2321
2322    case SOCKET_TERMINATE:
2323	DestroyWindow(hwnd);
2324	break;
2325    }
2326
2327    return 0;
2328}
2329
2330/*
2331 *----------------------------------------------------------------------
2332 *
2333 * Tcl_GetHostName --
2334 *
2335 *	Returns the name of the local host.
2336 *
2337 * Results:
2338 *	A string containing the network name for this machine. The caller must
2339 *	not modify or free this string.
2340 *
2341 * Side effects:
2342 *	Caches the name to return for future calls.
2343 *
2344 *----------------------------------------------------------------------
2345 */
2346
2347const char *
2348Tcl_GetHostName(void)
2349{
2350    return Tcl_GetString(TclGetProcessGlobalValue(&hostName));
2351}
2352
2353/*
2354 *----------------------------------------------------------------------
2355 *
2356 * InitializeHostName --
2357 *
2358 *	This routine sets the process global value of the name of the local
2359 *	host on which the process is running.
2360 *
2361 * Results:
2362 *	None.
2363 *
2364 *----------------------------------------------------------------------
2365 */
2366
2367void
2368InitializeHostName(
2369    char **valuePtr,
2370    int *lengthPtr,
2371    Tcl_Encoding *encodingPtr)
2372{
2373    WCHAR wbuf[MAX_COMPUTERNAME_LENGTH + 1];
2374    DWORD length = sizeof(wbuf) / sizeof(WCHAR);
2375    Tcl_DString ds;
2376
2377    if ((*tclWinProcs->getComputerNameProc)(wbuf, &length) != 0) {
2378	/*
2379	 * Convert string from native to UTF then change to lowercase.
2380	 */
2381
2382	Tcl_UtfToLower(Tcl_WinTCharToUtf((TCHAR *) wbuf, -1, &ds));
2383
2384    } else {
2385	Tcl_DStringInit(&ds);
2386	if (TclpHasSockets(NULL) == TCL_OK) {
2387	    /*
2388	     * Buffer length of 255 copied slavishly from previous version of
2389	     * this routine. Presumably there's a more "correct" macro value
2390	     * for a properly sized buffer for a gethostname() call.
2391	     * Maintainers are welcome to supply it.
2392	     */
2393
2394	    Tcl_DString inDs;
2395
2396	    Tcl_DStringInit(&inDs);
2397	    Tcl_DStringSetLength(&inDs, 255);
2398	    if (gethostname(Tcl_DStringValue(&inDs),
2399			    Tcl_DStringLength(&inDs)) == 0) {
2400		Tcl_DStringSetLength(&ds, 0);
2401	    } else {
2402		Tcl_ExternalToUtfDString(NULL,
2403			Tcl_DStringValue(&inDs), -1, &ds);
2404	    }
2405	    Tcl_DStringFree(&inDs);
2406	}
2407    }
2408
2409    *encodingPtr = Tcl_GetEncoding(NULL, "utf-8");
2410    *lengthPtr = Tcl_DStringLength(&ds);
2411    *valuePtr = ckalloc((unsigned int) (*lengthPtr)+1);
2412    memcpy(*valuePtr, Tcl_DStringValue(&ds), (size_t)(*lengthPtr)+1);
2413    Tcl_DStringFree(&ds);
2414}
2415
2416/*
2417 *----------------------------------------------------------------------
2418 *
2419 * TclWinGetSockOpt, et al. --
2420 *
2421 *	These functions are wrappers that let us bind the WinSock API
2422 *	dynamically so we can run on systems that don't have the wsock32.dll.
2423 *	We need wrappers for these interfaces because they are called from the
2424 *	generic Tcl code.
2425 *
2426 * Results:
2427 *	As defined for each function.
2428 *
2429 * Side effects:
2430 *	As defined for each function.
2431 *
2432 *----------------------------------------------------------------------
2433 */
2434
2435int
2436TclWinGetSockOpt(
2437    int s,
2438    int level,
2439    int optname,
2440    char * optval,
2441    int FAR *optlen)
2442{
2443    /*
2444     * Check that WinSock is initialized; do not call it if not, to prevent
2445     * system crashes. This can happen at exit time if the exit handler for
2446     * WinSock ran before other exit handlers that want to use sockets.
2447     */
2448
2449    if (!SocketsEnabled()) {
2450	return SOCKET_ERROR;
2451    }
2452
2453    return getsockopt((SOCKET)s, level, optname, optval, optlen);
2454}
2455
2456int
2457TclWinSetSockOpt(
2458    int s,
2459    int level,
2460    int optname,
2461    const char * optval,
2462    int optlen)
2463{
2464    /*
2465     * Check that WinSock is initialized; do not call it if not, to prevent
2466     * system crashes. This can happen at exit time if the exit handler for
2467     * WinSock ran before other exit handlers that want to use sockets.
2468     */
2469
2470    if (!SocketsEnabled()) {
2471	return SOCKET_ERROR;
2472    }
2473
2474    return setsockopt((SOCKET)s, level, optname, optval, optlen);
2475}
2476
2477u_short
2478TclWinNToHS(
2479    u_short netshort)
2480{
2481    /*
2482     * Check that WinSock is initialized; do not call it if not, to prevent
2483     * system crashes. This can happen at exit time if the exit handler for
2484     * WinSock ran before other exit handlers that want to use sockets.
2485     */
2486
2487    if (!SocketsEnabled()) {
2488	return (u_short) -1;
2489    }
2490
2491    return ntohs(netshort);
2492}
2493
2494struct servent *
2495TclWinGetServByName(
2496    const char *name,
2497    const char *proto)
2498{
2499    /*
2500     * Check that WinSock is initialized; do not call it if not, to prevent
2501     * system crashes. This can happen at exit time if the exit handler for
2502     * WinSock ran before other exit handlers that want to use sockets.
2503     */
2504
2505    if (!SocketsEnabled()) {
2506	return NULL;
2507    }
2508
2509    return getservbyname(name, proto);
2510}
2511
2512/*
2513 *----------------------------------------------------------------------
2514 *
2515 * TcpThreadActionProc --
2516 *
2517 *	Insert or remove any thread local refs to this channel.
2518 *
2519 * Results:
2520 *	None.
2521 *
2522 * Side effects:
2523 *	Changes thread local list of valid channels.
2524 *
2525 *----------------------------------------------------------------------
2526 */
2527
2528static void
2529TcpThreadActionProc(
2530    ClientData instanceData,
2531    int action)
2532{
2533    ThreadSpecificData *tsdPtr;
2534    SocketInfo *infoPtr = (SocketInfo *) instanceData;
2535    int notifyCmd;
2536
2537    if (action == TCL_CHANNEL_THREAD_INSERT) {
2538	/*
2539	 * Ensure that socket subsystem is initialized in this thread, or else
2540	 * sockets will not work.
2541	 */
2542
2543	Tcl_MutexLock(&socketMutex);
2544	InitSockets();
2545	Tcl_MutexUnlock(&socketMutex);
2546
2547	tsdPtr = TCL_TSD_INIT(&dataKey);
2548
2549	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
2550	infoPtr->nextPtr = tsdPtr->socketList;
2551	tsdPtr->socketList = infoPtr;
2552	SetEvent(tsdPtr->socketListLock);
2553
2554	notifyCmd = SELECT;
2555    } else {
2556	SocketInfo **nextPtrPtr;
2557	int removed = 0;
2558
2559	tsdPtr = TCL_TSD_INIT(&dataKey);
2560
2561	/*
2562	 * TIP #218, Bugfix: All access to socketList has to be protected by
2563	 * the lock.
2564	 */
2565
2566	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
2567	for (nextPtrPtr = &(tsdPtr->socketList); (*nextPtrPtr) != NULL;
2568		nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
2569	    if ((*nextPtrPtr) == infoPtr) {
2570		(*nextPtrPtr) = infoPtr->nextPtr;
2571		removed = 1;
2572		break;
2573	    }
2574	}
2575	SetEvent(tsdPtr->socketListLock);
2576
2577	/*
2578	 * This could happen if the channel was created in one thread and then
2579	 * moved to another without updating the thread local data in each
2580	 * thread.
2581	 */
2582
2583	if (!removed) {
2584	    Tcl_Panic("file info ptr not on thread channel list");
2585	}
2586
2587	notifyCmd = UNSELECT;
2588    }
2589
2590    /*
2591     * Ensure that, or stop, notifications for the socket occur in this
2592     * thread.
2593     */
2594
2595    SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
2596	    (WPARAM) notifyCmd, (LPARAM) infoPtr);
2597}
2598
2599/*
2600 * Local Variables:
2601 * mode: c
2602 * c-basic-offset: 4
2603 * fill-column: 78
2604 * End:
2605 */