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