PageRenderTime 65ms CodeModel.GetById 2ms app.highlight 51ms RepoModel.GetById 1ms app.codeStats 1ms

/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

Large files files are truncated, but you can click here to view the full 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_O

Large files files are truncated, but you can click here to view the full file