Index: tclWinSock.c
===================================================================
RCS file: /cvsroot/tcl/tcl/win/tclWinSock.c,v
retrieving revision 1.25
diff -c -r1.25 tclWinSock.c
*** tclWinSock.c	24 Jan 2002 01:34:16 -0000	1.25
--- tclWinSock.c	17 May 2002 22:48:09 -0000
***************
*** 194,199 ****
--- 194,200 ----
  			    int mode));
  static int		TcpCloseProc _ANSI_ARGS_((ClientData instanceData,
  	            	    Tcl_Interp *interp));
+ static Tcl_DriverSetOptionProc TcpSetOptionProc;
  static int		TcpGetOptionProc _ANSI_ARGS_((ClientData instanceData,
  		            Tcl_Interp *interp, CONST char *optionName,
  			    Tcl_DString *optionValue));
***************
*** 221,227 ****
      TcpInputProc,		/* Input proc. */
      TcpOutputProc,		/* Output proc. */
      NULL,			/* Seek proc. */
!     NULL,			/* Set option proc. */
      TcpGetOptionProc,		/* Get option proc. */
      TcpWatchProc,		/* Set up notifier to watch this channel. */
      TcpGetHandleProc,		/* Get an OS handle from channel. */
--- 222,228 ----
      TcpInputProc,		/* Input proc. */
      TcpOutputProc,		/* Output proc. */
      NULL,			/* Seek proc. */
!     TcpSetOptionProc,		/* Set option proc. */
      TcpGetOptionProc,		/* Get option proc. */
      TcpWatchProc,		/* Set up notifier to watch this channel. */
      TcpGetHandleProc,		/* Get an OS handle from channel. */
***************
*** 1859,1864 ****
--- 1860,1929 ----
  /*
   *----------------------------------------------------------------------
   *
+  * TcpSetOptionProc --
+  *
+  *	Sets Tcp channel specific options.
+  *
+  * Results:
+  *	...
+  *
+  * Side effects:
+  *	...
+  *
+  *----------------------------------------------------------------------
+  */
+ 
+ static int
+ TcpSetOptionProc (
+     ClientData instanceData,	/* Socket state. */
+     Tcl_Interp *interp,		/* For error reporting - can be NULL. */
+     CONST char *optionName,	/* Name of the option to set. */
+     CONST char *value)		/* New value for option. */
+ {
+     SocketInfo *infoPtr;
+     SOCKET sock;
+     BOOL val = FALSE;
+     int boolVar, rtn;
+ 
+     /*
+      * Check that WinSock is initialized; do not call it if not, to
+      * prevent system crashes. This can happen at exit time if the exit
+      * handler for WinSock ran before other exit handlers that want to
+      * use sockets.
+      */
+ 
+     if (!SocketsEnabled()) {
+ 	if (interp) {
+ 	    Tcl_AppendResult(interp, "winsock is not initialized", NULL);
+ 	}
+         return TCL_ERROR;
+     }
+ 
+     infoPtr = (SocketInfo *) instanceData;
+     sock = infoPtr->socket;
+ 
+     if (!stricmp(optionName, "-keepalive")) {
+ 	if (Tcl_GetBoolean(interp, value, &boolVar) != TCL_OK) {
+ 	    return TCL_ERROR;
+ 	}
+ 	if (boolVar) val = TRUE;
+ 	rtn = winSock.setsockopt(sock, SOL_SOCKET, SO_KEEPALIVE,
+ 		(const char *) &val, sizeof(BOOL));
+ 	if (rtn != 0) {
+ 	    TclWinConvertWSAError(winSock.WSAGetLastError());
+ 	    if (interp) {
+ 		Tcl_AppendResult(interp, "couldn't set socket option: ",
+ 			Tcl_PosixError(interp), NULL);
+ 	    }
+ 	    return TCL_ERROR;
+ 	}
+     }
+     return TCL_OK;
+ }
+ 
+ /*
+  *----------------------------------------------------------------------
+  *
   * TcpGetOptionProc --
   *
   *	Computes an option value for a TCP socket based channel, or a
***************
*** 2028,2035 ****
  	}
      }
  
      if (len > 0) {
!         return Tcl_BadChannelOption(interp, optionName, "peername sockname");
      }
  
      return TCL_OK;
--- 2093,2119 ----
  	}
      }
  
+     if ((len == 0) ||
+             ((len > 1) && (optionName[1] == 'k') &&
+                     (strncmp(optionName, "-keepalive", len) == 0))) {
+ 	int optlen;
+ 	BOOL ka;
+     
+         if (len == 0) {
+             Tcl_DStringAppendElement(dsPtr, "-keepalive");
+         }
+ 	optlen = sizeof(BOOL);
+ 	winSock.getsockopt(sock, SOL_SOCKET, SO_KEEPALIVE, (char *)&ka,
+ 		&optlen);
+ 	if (ka) {
+ 	    Tcl_DStringAppendElement(dsPtr, "1");
+ 	} else {
+ 	    Tcl_DStringAppendElement(dsPtr, "0");
+ 	}
+     }
+ 
      if (len > 0) {
!         return Tcl_BadChannelOption(interp, optionName, "peername sockname keepalive");
      }
  
      return TCL_OK;