read() errors or EOF shall not prevent write(). This allows for proper graceful closing. Prevent the threadActionProc from doing anything if we are exiting as the TclpFinailize order problem still exists.

socket types from the build for easier testing of the required tcl api changes.

generic/tcl.decls

@@ -12,7 +12,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: tcl.decls,v 1.155 2008/12/02 19:40:40 dgp Exp $
+# RCS: @(#) $Id: tcl.decls,v 1.155.2.5 2008/12/12 21:44:31 davygrvy Exp $
 
 library tcl
 
@@ -2212,6 +2212,21 @@ declare 606 generic {
     void Tcl_SetErrorLine(Tcl_Interp *interp, int value)
 }
 
+# TIP 162
+declare 607 generic {
+    Tcl_Channel Tcl_OpenServerChannel(Tcl_Interp *interp, const char *port,
+		const char *myhost, const char *type, Tcl_SocketAcceptProc *acceptProc,
+		ClientData callbackData)
+}
+declare 608 generic {
+    Tcl_Channel Tcl_OpenClientChannel(Tcl_Interp *interp, const char *port,
+	    const char *host, const char *myaddr, const char *myport,
+	    const char *type, int async)
+}
+declare 609 generic {
+    Tcl_Channel Tcl_MakeSocketClientChannel(ClientData sock)
+}
+
 ##############################################################################
 
 # Define the platform specific public Tcl interface.  These functions are
@@ -2227,7 +2242,6 @@ interface tclPlat
 # Windows specific functions
 
 # Added in Tcl 8.1
-
 declare 0 win {
     TCHAR * Tcl_WinUtfToTChar(const char *str, int len, Tcl_DString *dsPtr)
 }
@@ -2235,6 +2249,17 @@ declare 1 win {
     char * Tcl_WinTCharToUtf(const TCHAR *str, int len, Tcl_DString *dsPtr)
 }
 
+# TIP 281
+declare 2 win {
+    const char * Tcl_WinErrId (unsigned int errorCode)
+}
+declare 3 win {
+    const char * Tcl_WinErrMsg(unsigned int errorCode)
+}
+declare 4 win {
+    const char * Tcl_WinError(Tcl_Interp *interp, unsigned int errorCode)
+}
+
 ################################
 # Mac OS X specific functions
 

generic/tcl.h

@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tcl.h,v 1.280 2008/12/02 19:40:41 dgp Exp $
+ * RCS: @(#) $Id: tcl.h,v 1.280.2.1 2008/12/05 02:17:29 davygrvy Exp $
  */
 
 #ifndef _TCL
@@ -708,6 +708,8 @@ typedef int (Tcl_ObjCmdProc) (ClientData clientData, Tcl_Interp *interp,
 typedef int (Tcl_PackageInitProc) (Tcl_Interp *interp);
 typedef int (Tcl_PackageUnloadProc) (Tcl_Interp *interp, int flags);
 typedef void (Tcl_PanicProc) (const char *format, ...);
+typedef void (Tcl_SocketAcceptProc) (ClientData callbackData, Tcl_Channel chan,
+	const char *address, const char *port);
 typedef void (Tcl_TcpAcceptProc) (ClientData callbackData, Tcl_Channel chan,
 	char *address, int port);
 typedef void (Tcl_TimerProc) (ClientData clientData);

generic/tclDecls.h

@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclDecls.h,v 1.157 2008/12/02 19:40:41 dgp Exp $
+ * RCS: @(#) $Id: tclDecls.h,v 1.157.2.3 2008/12/07 06:40:29 davygrvy Exp $
  */
 
 #ifndef _TCLDECLS
@@ -3667,6 +3667,28 @@ EXTERN int		Tcl_GetErrorLine (Tcl_Interp * interp);
 /* 606 */
 EXTERN void		Tcl_SetErrorLine (Tcl_Interp * interp, int value);
 #endif
+#ifndef Tcl_OpenServerChannel_TCL_DECLARED
+#define Tcl_OpenServerChannel_TCL_DECLARED
+/* 607 */
+EXTERN Tcl_Channel	Tcl_OpenServerChannel (Tcl_Interp * interp,
+				const char * port, const char * myhost,
+				const char * type,
+				Tcl_SocketAcceptProc * acceptProc,
+				ClientData callbackData);
+#endif
+#ifndef Tcl_OpenClientChannel_TCL_DECLARED
+#define Tcl_OpenClientChannel_TCL_DECLARED
+/* 608 */
+EXTERN Tcl_Channel	Tcl_OpenClientChannel (Tcl_Interp * interp,
+				const char * port, const char * host,
+				const char * myaddr, const char * myport,
+				const char * type, int async);
+#endif
+#ifndef Tcl_MakeSocketClientChannel_TCL_DECLARED
+#define Tcl_MakeSocketClientChannel_TCL_DECLARED
+/* 609 */
+EXTERN Tcl_Channel	Tcl_MakeSocketClientChannel (ClientData sock);
+#endif
 
 typedef struct TclStubHooks {
     const struct TclPlatStubs *tclPlatStubs;
@@ -4333,6 +4355,9 @@ typedef struct TclStubs {
     int (*tcl_ParseArgsObjv) (Tcl_Interp * interp, const Tcl_ArgvInfo * argTable, int * objcPtr, Tcl_Obj *const * objv, Tcl_Obj *** remObjv); /* 604 */
     int (*tcl_GetErrorLine) (Tcl_Interp * interp); /* 605 */
     void (*tcl_SetErrorLine) (Tcl_Interp * interp, int value); /* 606 */
+    Tcl_Channel (*tcl_OpenServerChannel) (Tcl_Interp * interp, const char * port, const char * myhost, const char * type, Tcl_SocketAcceptProc * acceptProc, ClientData callbackData); /* 607 */
+    Tcl_Channel (*tcl_OpenClientChannel) (Tcl_Interp * interp, const char * port, const char * host, const char * myaddr, const char * myport, const char * type, int async); /* 608 */
+    Tcl_Channel (*tcl_MakeSocketClientChannel) (ClientData sock); /* 609 */
 } TclStubs;
 
 #if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
@@ -6833,6 +6858,18 @@ extern const TclStubs *tclStubsPtr;
 #define Tcl_SetErrorLine \
 	(tclStubsPtr->tcl_SetErrorLine) /* 606 */
 #endif
+#ifndef Tcl_OpenServerChannel
+#define Tcl_OpenServerChannel \
+	(tclStubsPtr->tcl_OpenServerChannel) /* 607 */
+#endif
+#ifndef Tcl_OpenClientChannel
+#define Tcl_OpenClientChannel \
+	(tclStubsPtr->tcl_OpenClientChannel) /* 608 */
+#endif
+#ifndef Tcl_MakeSocketClientChannel
+#define Tcl_MakeSocketClientChannel \
+	(tclStubsPtr->tcl_MakeSocketClientChannel) /* 609 */
+#endif
 
 #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
 

generic/tclIOCmd.c

@@ -8,13 +8,13 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclIOCmd.c,v 1.59 2008/10/16 22:34:19 nijtmans Exp $
+ * RCS: @(#) $Id: tclIOCmd.c,v 1.59.2.4 2008/12/12 20:28:46 davygrvy Exp $
  */
 
 #include "tclInt.h"
 
 /*
- * Callback structure for accept callback in a TCP server.
+ * Callback structure for accept callback in a socket server.
  */
 
 typedef struct AcceptCallback {
@@ -38,23 +38,22 @@ static Tcl_ThreadDataKey dataKey;
  * Static functions for this file:
  */
 
-static void		FinalizeIOCmdTSD(ClientData clientData);
-static void		AcceptCallbackProc(ClientData callbackData,
-			    Tcl_Channel chan, char *address, int port);
-static int		ChanPendingObjCmd(ClientData unused,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const objv[]);
-static int		ChanTruncateObjCmd(ClientData dummy,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const objv[]);
-static void		RegisterTcpServerInterpCleanup(Tcl_Interp *interp,
-			    AcceptCallback *acceptCallbackPtr);
-static void		TcpAcceptCallbacksDeleteProc(ClientData clientData,
-			    Tcl_Interp *interp);
-static void		TcpServerCloseProc(ClientData callbackData);
-static void		UnregisterTcpServerInterpCleanupProc(
-			    Tcl_Interp *interp,
-			    AcceptCallback *acceptCallbackPtr);
+static void			FinalizeIOCmdTSD(ClientData clientData);
+static Tcl_SocketAcceptProc	AcceptCallbackProc;
+static int			ChanPendingObjCmd(ClientData unused,
+				    Tcl_Interp *interp, int objc,
+				    Tcl_Obj *const objv[]);
+static int			ChanTruncateObjCmd(ClientData dummy,
+				    Tcl_Interp *interp, int objc,
+				    Tcl_Obj *const objv[]);
+static void			RegisterTcpServerInterpCleanup(Tcl_Interp *interp,
+				    AcceptCallback *acceptCallbackPtr);
+static void			TcpAcceptCallbacksDeleteProc(ClientData clientData,
+				    Tcl_Interp *interp);
+static void			TcpServerCloseProc(ClientData callbackData);
+static void			UnregisterTcpServerInterpCleanupProc(
+				    Tcl_Interp *interp,
+				    AcceptCallback *acceptCallbackPtr);
 
 /*
  *----------------------------------------------------------------------
@@ -1298,11 +1297,11 @@ static void
 AcceptCallbackProc(
     ClientData callbackData,	/* The data stored when the callback was
 				 * created in the call to
-				 * Tcl_OpenTcpServer. */
+				 * Tcl_OpenServerChannel. */
     Tcl_Channel chan,		/* Channel for the newly accepted
 				 * connection. */
-    char *address,		/* Address of client that was accepted. */
-    int port)			/* Port of client that was accepted. */
+    const char *address,	/* Address of client that was accepted. */
+    const char *port)		/* Port of client that was accepted. */
 {
     AcceptCallback *acceptCallbackPtr = (AcceptCallback *) callbackData;
 
@@ -1313,7 +1312,6 @@ AcceptCallbackProc(
      */
 
     if (acceptCallbackPtr->interp != NULL) {
-	char portBuf[TCL_INTEGER_SPACE];
 	char *script = acceptCallbackPtr->script;
 	Tcl_Interp *interp = acceptCallbackPtr->interp;
 	int result;
@@ -1321,7 +1319,6 @@ AcceptCallbackProc(
 	Tcl_Preserve(script);
 	Tcl_Preserve(interp);
 
-	TclFormatInt(portBuf, port);
 	Tcl_RegisterChannel(interp, chan);
 
 	/*
@@ -1332,7 +1329,7 @@ AcceptCallbackProc(
 	Tcl_RegisterChannel(NULL, chan);
 
 	result = Tcl_VarEval(interp, script, " ", Tcl_GetChannelName(chan),
-		" ", address, " ", portBuf, NULL);
+		" ", address, " ", port, NULL);
 	if (result != TCL_OK) {
 	    TclBackgroundException(interp, result);
 	    Tcl_UnregisterChannel(interp, chan);
@@ -1419,19 +1416,25 @@ Tcl_SocketObjCmd(
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
     static const char *const socketOptions[] = {
-	"-async", "-myaddr", "-myport","-server", NULL
+	"-async", "-myaddr", "-myport", "-server", "-type", NULL
     };
     enum socketOptions {
-	SKT_ASYNC, SKT_MYADDR, SKT_MYPORT, SKT_SERVER
+	SKT_ASYNC, SKT_MYADDR, SKT_MYPORT, SKT_SERVER, SKT_TYPE
     };
-    int optionIndex, a, server = 0, port, myport = 0, async = 0;
-    char *host, *script = NULL, *myaddr = NULL;
+    int optionIndex, a, server = 0, async = 0;
+    char *host, *type, *port = NULL, *myport = NULL, *script = NULL, *myaddr = NULL;
     Tcl_Channel chan;
 
     if (TclpHasSockets(interp) != TCL_OK) {
 	return TCL_ERROR;
     }
 
+    /*
+     * Default to AF_INET (IPv4) for name lookups.
+     */
+
+    type = "tcp4";
+
     for (a = 1; a < objc; a++) {
 	const char *arg = Tcl_GetString(objv[a]);
 
@@ -1444,11 +1447,6 @@ Tcl_SocketObjCmd(
 	}
 	switch ((enum socketOptions) optionIndex) {
 	case SKT_ASYNC:
-	    if (server == 1) {
-		Tcl_AppendResult(interp,
-			"cannot set -async option for server sockets", NULL);
-		return TCL_ERROR;
-	    }
 	    async = 1;
 	    break;
 	case SKT_MYADDR:
@@ -1460,27 +1458,16 @@ Tcl_SocketObjCmd(
 	    }
 	    myaddr = TclGetString(objv[a]);
 	    break;
-	case SKT_MYPORT: {
-	    char *myPortName;
-
+	case SKT_MYPORT:
 	    a++;
 	    if (a >= objc) {
 		Tcl_AppendResult(interp,
 			"no argument given for -myport option", NULL);
 		return TCL_ERROR;
 	    }
-	    myPortName = TclGetString(objv[a]);
-	    if (TclSockGetPort(interp, myPortName, "tcp", &myport) != TCL_OK) {
-		return TCL_ERROR;
-	    }
+	    myport = TclGetString(objv[a]);
 	    break;
-	}
 	case SKT_SERVER:
-	    if (async == 1) {
-		Tcl_AppendResult(interp,
-			"cannot set -async option for server sockets", NULL);
-		return TCL_ERROR;
-	    }
 	    server = 1;
 	    a++;
 	    if (a >= objc) {
@@ -1490,10 +1477,26 @@ Tcl_SocketObjCmd(
 	    }
 	    script = TclGetString(objv[a]);
 	    break;
+	case SKT_TYPE:
+	    a++;
+	    if (a >= objc) {
+		Tcl_AppendResult(interp,
+			"no argument given for -type option", (char *) NULL);
+		return TCL_ERROR;
+	    }
+	    type = TclGetString(objv[a]);
+	    break;
 	default:
 	    Tcl_Panic("Tcl_SocketObjCmd: bad option index to SocketOptions");
 	}
     }
+    if (async && server) {
+	Tcl_AppendResult(interp,
+	    "cannot set -async option for server sockets",
+	    (char *) NULL);
+	return TCL_ERROR;
+    }
+
     if (server) {
 	host = myaddr;		/* NULL implies INADDR_ANY */
 	if (myport != 0) {
@@ -1510,19 +1513,16 @@ Tcl_SocketObjCmd(
     wrongNumArgs:
 	iPtr = (Interp *) interp;
 	Tcl_WrongNumArgs(interp, 1, objv,
-		"?-myaddr addr? ?-myport myport? ?-async? host port");
+		"?-myaddr addr? ?-myport myport? ?-type type? ?-async? host port");
 	iPtr->flags |= INTERP_ALTERNATE_WRONG_ARGS;
 	Tcl_WrongNumArgs(interp, 1, objv,
-		"-server command ?-myaddr addr? port");
+		"-server command ?-myaddr addr? ?-type type? port");
 	iPtr->flags &= ~INTERP_ALTERNATE_WRONG_ARGS;
 	return TCL_ERROR;
     }
 
     if (a == objc-1) {
-	if (TclSockGetPort(interp, TclGetString(objv[a]), "tcp",
-		&port) != TCL_OK) {
-	    return TCL_ERROR;
-	}
+	port = TclGetString(objv[a]);
     } else {
 	goto wrongNumArgs;
     }
@@ -1536,7 +1536,7 @@ Tcl_SocketObjCmd(
 	memcpy(copyScript, script, len);
 	acceptCallbackPtr->script = copyScript;
 	acceptCallbackPtr->interp = interp;
-	chan = Tcl_OpenTcpServer(interp, port, host, AcceptCallbackProc,
+	chan = Tcl_OpenServerChannel(interp, port, host, type, AcceptCallbackProc,
 		acceptCallbackPtr);
 	if (chan == NULL) {
 	    ckfree(copyScript);
@@ -1561,7 +1561,7 @@ Tcl_SocketObjCmd(
 
 	Tcl_CreateCloseHandler(chan, TcpServerCloseProc, acceptCallbackPtr);
     } else {
-	chan = Tcl_OpenTcpClient(interp, port, host, myaddr, myport, async);
+	chan = Tcl_OpenClientChannel(interp, port, host, myaddr, myport, type, async);
 	if (chan == NULL) {
 	    return TCL_ERROR;
 	}

generic/tclPlatDecls.h

@@ -6,7 +6,7 @@
  * Copyright (c) 1998-1999 by Scriptics Corporation.
  * All rights reserved.
  *
- * RCS: @(#) $Id: tclPlatDecls.h,v 1.33 2008/10/22 20:23:59 nijtmans Exp $
+ * RCS: @(#) $Id: tclPlatDecls.h,v 1.33.2.2 2008/12/12 21:44:32 davygrvy Exp $
  */
 
 #ifndef _TCLPLATDECLS
@@ -60,6 +60,22 @@ EXTERN TCHAR *		Tcl_WinUtfToTChar (const char * str, int len,
 EXTERN char *		Tcl_WinTCharToUtf (const TCHAR * str, int len,
 				Tcl_DString * dsPtr);
 #endif
+#ifndef Tcl_WinErrId_TCL_DECLARED
+#define Tcl_WinErrId_TCL_DECLARED
+/* 2 */
+EXTERN const char *	Tcl_WinErrId (unsigned int errorCode);
+#endif
+#ifndef Tcl_WinErrMsg_TCL_DECLARED
+#define Tcl_WinErrMsg_TCL_DECLARED
+/* 3 */
+EXTERN const char *	Tcl_WinErrMsg (unsigned int errorCode);
+#endif
+#ifndef Tcl_WinError_TCL_DECLARED
+#define Tcl_WinError_TCL_DECLARED
+/* 4 */
+EXTERN const char *	Tcl_WinError (Tcl_Interp * interp,
+				unsigned int errorCode);
+#endif
 #endif /* WIN */
 #ifdef MAC_OSX_TCL /* MACOSX */
 #ifndef Tcl_MacOSXOpenBundleResources_TCL_DECLARED
@@ -87,6 +103,9 @@ typedef struct TclPlatStubs {
 #ifdef __WIN32__ /* WIN */
     TCHAR * (*tcl_WinUtfToTChar) (const char * str, int len, Tcl_DString * dsPtr); /* 0 */
     char * (*tcl_WinTCharToUtf) (const TCHAR * str, int len, Tcl_DString * dsPtr); /* 1 */
+    const char * (*tcl_WinErrId) (unsigned int errorCode); /* 2 */
+    const char * (*tcl_WinErrMsg) (unsigned int errorCode); /* 3 */
+    const char * (*tcl_WinError) (Tcl_Interp * interp, unsigned int errorCode); /* 4 */
 #endif /* WIN */
 #ifdef MAC_OSX_TCL /* MACOSX */
     int (*tcl_MacOSXOpenBundleResources) (Tcl_Interp * interp, const char * bundleName, int hasResourceFile, int maxPathLen, char * libraryPath); /* 0 */
@@ -113,6 +132,18 @@ extern const TclPlatStubs *tclPlatStubsPtr;
 #define Tcl_WinTCharToUtf \
 	(tclPlatStubsPtr->tcl_WinTCharToUtf) /* 1 */
 #endif
+#ifndef Tcl_WinErrId
+#define Tcl_WinErrId \
+	(tclPlatStubsPtr->tcl_WinErrId) /* 2 */
+#endif
+#ifndef Tcl_WinErrMsg
+#define Tcl_WinErrMsg \
+	(tclPlatStubsPtr->tcl_WinErrMsg) /* 3 */
+#endif
+#ifndef Tcl_WinError
+#define Tcl_WinError \
+	(tclPlatStubsPtr->tcl_WinError) /* 4 */
+#endif
 #endif /* WIN */
 #ifdef MAC_OSX_TCL /* MACOSX */
 #ifndef Tcl_MacOSXOpenBundleResources

generic/tclStubInit.c

@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclStubInit.c,v 1.168 2008/12/02 19:40:41 dgp Exp $
+ * RCS: @(#) $Id: tclStubInit.c,v 1.168.2.3 2008/12/12 20:28:46 davygrvy Exp $
  */
 
 #include "tclInt.h"
@@ -395,6 +395,9 @@ static const TclPlatStubs tclPlatStubs = {
 #ifdef __WIN32__ /* WIN */
     Tcl_WinUtfToTChar, /* 0 */
     Tcl_WinTCharToUtf, /* 1 */
+    Tcl_WinErrId, /* 2 */
+    Tcl_WinErrMsg, /* 3 */
+    Tcl_WinError, /* 4 */
 #endif /* WIN */
 #ifdef MAC_OSX_TCL /* MACOSX */
     Tcl_MacOSXOpenBundleResources, /* 0 */
@@ -1132,6 +1135,9 @@ static const TclStubs tclStubs = {
     Tcl_ParseArgsObjv, /* 604 */
     Tcl_GetErrorLine, /* 605 */
     Tcl_SetErrorLine, /* 606 */
+    Tcl_OpenServerChannel, /* 607 */
+    Tcl_OpenClientChannel, /* 608 */
+    Tcl_MakeSocketClientChannel, /* 609 */
 };
 
 /* !END!: Do not edit above this line. */

unix/README

@@ -1,7 +1,7 @@
 Tcl UNIX README
 ---------------
 
-RCS: @(#) $Id: README,v 1.31 2008/02/12 10:07:19 dkf Exp $
+RCS: @(#) $Id: README,v 1.31.4.1 2008/12/12 05:25:38 davygrvy Exp $
 
 This is the directory where you configure, compile, test, and install UNIX
 versions of Tcl. This directory also contains source files for Tcl that are
@@ -47,6 +47,15 @@ How To Compile And Install Tcl:
     refer to the autoconf documentation (not included here). Tcl's "configure"
     supports the following special switches in addition to the standard ones:
 
+
+	--enable-inet6		If this switch is specified, Tcl will
+				compile itself with inet6 (ipv6) support if
+				it can figure out how to do that on this
+				platform.  This is the default on platforms
+				where we know how to use ipv6.
+	--disable-inet6		If this switch is set, Tcl will compile
+				without IPv6 support, even if your
+				system supports it.
 	--enable-threads	If this switch is set, Tcl will compile itself
 				with multithreading support.
 	--disable-load		If this switch is specified then Tcl will

unix/tclUnixChan.c

@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclUnixChan.c,v 1.96 2008/10/26 12:45:04 dkf Exp $
+ * RCS: @(#) $Id: tclUnixChan.c,v 1.96.2.3 2008/12/12 05:25:38 davygrvy Exp $
  */
 
 #include "tclInt.h"	/* Internal definitions for Tcl. */
@@ -147,12 +147,12 @@ typedef struct TtyAttrs {
  * This structure describes per-instance state of a tcp based channel.
  */
 
-typedef struct TcpState {
+typedef struct SocketState {
     Tcl_Channel channel;	/* Channel associated with this file. */
     int fd;			/* The socket itself. */
     int flags;			/* ORed combination of the bitfields defined
 				 * below. */
-    Tcl_TcpAcceptProc *acceptProc;
+    Tcl_SocketAcceptProc *acceptProc;
 				/* Proc to call on accept. */
     ClientData acceptProcData;	/* The data for the accept proc. */
 } TcpState;
@@ -192,11 +192,11 @@ typedef struct TcpState {
  * Static routines for this file:
  */
 
-static TcpState *	CreateSocket(Tcl_Interp *interp, int port,
+static SocketState *	CreateSocket(Tcl_Interp *interp, const char *port,
 			    const char *host, int server, const char *myaddr,
-			    int myport, int async);
+			    const char *myport, int async);
 static int		CreateSocketAddress(struct sockaddr_in *sockaddrPtr,
-			    const char *host, int port, int willBind,
+			    const char *host, const char *port,
 			    const char **errorMsgPtr);
 static int		FileBlockModeProc(ClientData instanceData, int mode);
 static int		FileCloseProc(ClientData instanceData,
@@ -2261,7 +2261,7 @@ TcpGetHandleProc(
 static TcpState *
 CreateSocket(
     Tcl_Interp *interp,		/* For error reporting; can be NULL. */
-    int port,			/* Port number to open. */
+    const char *port,		/* Port number (or service) to open. */
     const char *host,		/* Name of host on which to open port. NULL
 				 * implies INADDR_ANY */
     int server,			/* 1 if socket should be a server socket, else
@@ -2409,9 +2409,7 @@ static int
 CreateSocketAddress(
     struct sockaddr_in *sockaddrPtr,	/* Socket address */
     const char *host,			/* Host. NULL implies INADDR_ANY */
-    int port,				/* Port number */
-    int willBind,			/* Is this an address to bind() to or
-					 * to connect() to? */
+    const char *port,			/* Port or service */
     const char **errorMsgPtr)		/* Place to store the error message
 					 * detail, if available. */
 {
@@ -2421,20 +2419,13 @@ CreateSocketAddress(
     Tcl_DString ds;
     int result;
 
-    if (host == NULL) {
-	sockaddrPtr->sin_family = AF_INET;
-	sockaddrPtr->sin_addr.s_addr = INADDR_ANY;
-    addPort:
-	sockaddrPtr->sin_port = htons((unsigned short) (port & 0xFFFF));
-	return 1;
-    }
-
     (void) memset(&hints, 0, sizeof(struct addrinfo));
-    hints.ai_family = AF_INET;
+    /*
+     * Get address family hint from output sockaddr_in
+     */
+    hints.ai_family = sockaddrPtr->sin_family;
     hints.ai_socktype = SOCK_STREAM;
-    if (willBind) {
-	hints.ai_flags |= AI_PASSIVE;
-    }
+    hints.ai_flags = ((host) ? NULL : AI_PASSIVE);
 
     /*
      * Note that getaddrinfo() *is* thread-safe. If a platform doesn't get
@@ -2442,12 +2433,11 @@ CreateSocketAddress(
      */
 
     native = Tcl_UtfToExternalDString(NULL, host, -1, &ds);
-    result = getaddrinfo(native, NULL, &hints, &resPtr);
+    result = getaddrinfo(native, port, &hints, &resPtr);
     Tcl_DStringFree(&ds);
     if (result == 0) {
 	memcpy(sockaddrPtr, resPtr->ai_addr, sizeof(struct sockaddr_in));
 	freeaddrinfo(resPtr);
-	goto addPort;
     }
 
     /*
@@ -2475,7 +2465,9 @@ CreateSocketAddress(
     }
 #else /* !HAVE_GETADDRINFO */
     struct in_addr addr;		/* For 64/32 bit madness */
+    int portNum;
 
+    TclFormatInt(port, &portNum);
     (void) memset(sockaddrPtr, '\0', sizeof(struct sockaddr_in));
     sockaddrPtr->sin_family = AF_INET;
     sockaddrPtr->sin_port = htons((unsigned short) (port & 0xFFFF));
@@ -2552,9 +2544,9 @@ CreateSocketAddress(
  */
 
 Tcl_Channel
-Tcl_OpenTcpClient(
+Tcl_OpenClientChannel(
     Tcl_Interp *interp,		/* For error reporting; can be NULL. */
-    int port,			/* Port number to open. */
+    const char *port,			/* Port number to open. */
     const char *host,		/* Host on which to open port. */
     const char *myaddr,		/* Client-side address */
     int myport,			/* Client-side port */
@@ -2676,39 +2668,58 @@ MakeTcpClientChannelMode(
 Tcl_Channel
 Tcl_OpenTcpServer(
     Tcl_Interp *interp,		/* For error reporting - may be NULL. */
-    int port,			/* Port number to open. */
+    const char *port,			/* Port number to open. */
     const char *myHost,		/* Name of local host. */
     Tcl_TcpAcceptProc *acceptProc,
 				/* Callback for accepting connections from new
 				 * clients. */
     ClientData acceptProcData)	/* Data for the callback. */
 {
-    TcpState *statePtr;
-    char channelName[16 + TCL_INTEGER_SPACE];
+    char portName[TCL_INTEGER_SPACE];
+    Tcl_Channel chan;
+
+    TclFormatInt(portName, port);
 
     /*
      * Create a new client socket and wrap it in a channel.
      */
 
-    statePtr = CreateSocket(interp, port, myHost, 1, NULL, 0, 0);
-    if (statePtr == NULL) {
+    chan = Tcl_OpenServerChannel(interp, portName, myHost, "tcp4", acceptProc, acceptProcData);
+    if chan == NULL) {
 	return NULL;
     }
 
-    statePtr->acceptProc = acceptProc;
-    statePtr->acceptProcData = acceptProcData;
+    return chan;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_OpenServerChannel --
+ *
+ *	Opens a network server socket and creates a channel around it.
+ *
+ * Results:
+ *	The channel or NULL if failed. If an error occurred, an error message
+ *	is left in the interp's result if interp is not NULL.
+ *
+ * Side effects:
+ *	Opens a server socket and creates a new channel.
+ *
+ *----------------------------------------------------------------------
+ */
 
-    /*
-     * Set up the callback mechanism for accepting connections from new
-     * clients.
-     */
-
-    Tcl_CreateFileHandler(statePtr->fd, TCL_READABLE, TcpAccept,
-	    (ClientData) statePtr);
-    sprintf(channelName, "sock%d", statePtr->fd);
-    statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
-	    (ClientData) statePtr, 0);
-    return statePtr->channel;
+Tcl_Channel
+Tcl_OpenServerChannel(
+    Tcl_Interp *interp,		/* For error reporting - may be NULL. */
+    const char *port,		/* Port or service to open. */
+    const char *myHost,		/* Name of local host. */
+    Tcl_SocketAcceptProc *acceptProc,
+				/* Callback for accepting connections from new
+				 * clients. */
+    ClientData acceptProcData)	/* Data for the callback. */
+{
+//todo
 }
 
 /*
@@ -2739,6 +2750,7 @@ TcpAccept(
     struct sockaddr_in addr;	/* The remote address */
     socklen_t len;		/* For accept interface */
     char channelName[16 + TCL_INTEGER_SPACE];
+    char portStr[TCL_INTEGER_SPACE];
 
     sockState = (TcpState *) data;
 
@@ -2769,10 +2781,12 @@ TcpAccept(
     Tcl_SetChannelOption(NULL, newSockState->channel, "-translation",
 	    "auto crlf");
 
+    TclFormatInt(portStr, ntohs(addr.sin_port))
+
     if (sockState->acceptProc != NULL) {
 	sockState->acceptProc(sockState->acceptProcData,
 		newSockState->channel, inet_ntoa(addr.sin_addr),
-		ntohs(addr.sin_port));
+		portStr);
     }
 }
 

unix/tclUnixSock.c

@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclUnixSock.c,v 1.21 2008/04/27 22:21:35 dkf Exp $
+ * RCS: @(#) $Id: tclUnixSock.c,v 1.21.2.1 2008/12/12 05:25:38 davygrvy Exp $
  */
 
 #include "tclInt.h"
@@ -46,12 +46,25 @@ InitializeHostName(
 
 #ifndef NO_UNAME
     struct utsname u;
+    int fail;
+#ifdef HAVE_GETADDRINFO
+    struct addrinfo hints;
+    struct addrinfo *res;
+#else
     struct hostent *hp;
+#endif /* !HAVE_GETADDRINFO */
 
     memset(&u, (int) 0, sizeof(struct utsname));
     if (uname(&u) > -1) {				/* INTL: Native. */
-        hp = TclpGetHostByName(u.nodename);		/* INTL: Native. */
-	if (hp == NULL) {
+#ifdef HAVE_GETADDRINFO
+	memset(&hints,0,sizeof(struct addrinfo));
+	hints.ai_flags = AI_CANONNAME;
+	fail = getaddrinfo(u.nodename,NULL,&hints,&res);
+#else
+        hp   = TclpGetHostByName(u.nodename);			/* INTL: Native. */
+	fail = (hp == NULL);
+#endif /* !HAVE_GETADDRINFO */
+	if (fail) {
 	    /*
 	     * Sometimes the nodename is fully qualified, but gets truncated
 	     * as it exceeds SYS_NMLN. See if we can just get the immediate
@@ -65,12 +78,21 @@ InitializeHostName(
 
 		memcpy(node, u.nodename, (size_t) (dot - u.nodename));
 		node[dot - u.nodename] = '\0';
-		hp = TclpGetHostByName(node);
+#ifdef HAVE_GETADDRINFO
+		fail = getaddrinfo(node,NULL,&hints,&res);
+#else
+		hp   = TclpGetHostByName(node);
+		fail = (hp == NULL);
+#endif /* !HAVE_GETADDRINFO */
 		ckfree(node);
 	    }
 	}
-        if (hp != NULL) {
+	if (!fail) {
+#ifdef HAVE_GETADDRINFO
+	    native = res->ai_canonname;
+#else
 	    native = hp->h_name;
+#endif /* !HAVE_GETADDRINFO */
         } else {
 	    native = u.nodename;
         }
@@ -109,6 +131,11 @@ InitializeHostName(
     *lengthPtr = strlen(native);
     *valuePtr = ckalloc((unsigned) (*lengthPtr) + 1);
     memcpy(*valuePtr, native, (size_t)(*lengthPtr)+1);
+#ifdef HAVE_GETADDRINFO
+    if (!fail) {
+        freeaddrinfo(res);
+    }
+#endif
 }
 
 /*

win/makefile.vc

@@ -13,7 +13,7 @@
 # Copyright (c) 2003-2008 Pat Thoyts.
 #
 #------------------------------------------------------------------------------
-# RCS: @(#) $Id: makefile.vc,v 1.191 2008/10/14 22:28:52 patthoyts Exp $
+# RCS: @(#) $Id: makefile.vc,v 1.191.2.2 2008/12/12 20:28:46 davygrvy Exp $
 #------------------------------------------------------------------------------
 
 # Check to see we are configured to build with MSVC (MSDEVDIR or MSVCDIR)
@@ -335,7 +335,8 @@ TCLOBJS = \
 	$(TMP_DIR)\tclWinLoad.obj \
 	$(TMP_DIR)\tclWinNotify.obj \
 	$(TMP_DIR)\tclWinPipe.obj \
-	$(TMP_DIR)\tclWinSock.obj \
+	$(TMP_DIR)\tclWinsockCore.obj \
+	$(TMP_DIR)\tclWinsockTCP.obj \
 	$(TMP_DIR)\tclWinThrd.obj \
 	$(TMP_DIR)\tclWinTime.obj \
 	$(TMP_DIR)\bncore.obj \

win/tclWinPort.h

@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclWinPort.h,v 1.50 2007/12/13 15:28:44 dgp Exp $
+ * RCS: @(#) $Id: tclWinPort.h,v 1.50.4.4 2008/12/12 05:26:52 davygrvy Exp $
  */
 
 #ifndef _TCLWINPORT
@@ -68,15 +68,38 @@
 
 #include <time.h>
 
+/*
+ * Enables WS03 special features.
+ */
+#define _WIN32_WINNT 0x0502
+
 #define WIN32_LEAN_AND_MEAN
 #include <windows.h>
 #undef WIN32_LEAN_AND_MEAN
 
+/* winsock2.h should check for the intrinsic _WIN32, but doesn't. */
+#ifndef WIN32
+#define WIN32
+#endif
+
 /*
  * Ask for the winsock function typedefs, also.
  */
+
 #define INCL_WINSOCK_API_TYPEDEFS   1
 #include <winsock2.h>
+#include <ws2tcpip.h>
+#include <wspiapi.h>
+#include <mswsock.h>
+#include <svcguid.h>
+#include <nspapi.h>
+
+/*
+ * TIP 162 (IPv6).  The network layer manages this for us as
+ * getaddrinfo() is an always existing inlined function from ws2tcpip.h
+ */
+
+#define HAVE_GETADDRINFO
 
 /*
  * Define EINPROGRESS in terms of WSAEINPROGRESS.
@@ -494,8 +517,8 @@
 
 /*
  * The following defines map from standard socket names to our internal
- * wrappers that redirect through the winSock function table (see the
- * file tclWinSock.c).
+ * wrappers that redirect through our Winsock wrappers (see the
+ * file tclWinsockCore.c).
  */
 
 #define getservbyname	TclWinGetServByName
@@ -505,7 +528,6 @@
 /* This type is not defined in the Windows headers */
 #define socklen_t       int
 
-
 /*
  * The following macros have trivial definitions, allowing generic code to 
  * address platform-specific issues.

win/tclWinsockBTH.c

@@ -0,0 +1,95 @@
+/* reserved for all things Bluetooth */
+
+#include "tclWinInt.h"
+#include "tclWinsockCore.h"
+
+#include <ws2bth.h>
+//#include <Bthsdpdef.h>
+//#include <BluetoothAPIs.h>
+
+static Tcl_NetCreateClientProc OpenBthClientChannel;
+static Tcl_NetCreateServerProc OpenBthServerChannel;
+static Tcl_NetDecodeAddrProc DecodeBthSockaddr;
+static Tcl_NetResolverProc ResolveBth;
+
+WS2ProtocolData bthProtoData = {
+    AF_BTH,
+    SOCK_STREAM,
+    BTHPROTO_RFCOMM,
+    sizeof(SOCKADDR_BTH),
+    0,
+    OpenBthClientChannel,
+    OpenBthServerChannel,
+    DecodeBthSockaddr,
+    ResolveBth,
+    NULL,
+    NULL,
+    NULL,
+    NULL,
+    NULL,
+    NULL,
+    NULL
+};
+
+Tcl_Obj *
+DecodeBthSockaddr (
+    SocketInfo *info,
+    LPSOCKADDR addr,
+    int noLookup)
+{
+    Tcl_Obj *result;
+    SOCKADDR_BTH *bthaddr = (SOCKADDR_BTH *) addr;
+    DWORD len = 1024;
+    char buffer[1024];
+
+    // this is a general call for "display purposes"
+    // until a better solution is found.
+
+    if (WSAAddressToString((LPSOCKADDR)bthaddr, bthProtoData.addrLen,
+	    NULL, buffer, &len) == SOCKET_ERROR) {
+	// error'd
+	return NULL;
+    }
+    // TODO: probably not in utf-8
+    result = Tcl_NewStringObj(buffer, len);
+    return result;
+}
+
+int
+ResolveBth (
+    int command,
+    Tcl_Obj *question,
+    Tcl_Obj *argument,
+    Tcl_Obj **answers)
+{
+    // TODO
+    return TCL_ERROR;
+}
+
+Tcl_Channel
+OpenBthClientChannel(
+    Tcl_Interp *interp,		/* For error reporting; can be NULL. */
+    const char *port,		/* Port (number|service) to open. */
+    const char *host,		/* Host on which to open port. */
+    const char *myaddr,		/* Client-side address. */
+    const char *myport,		/* Client-side port (number|service).*/
+    int async,			/* If nonzero, should connect
+				 * client socket asynchronously. */
+    int afhint)
+{
+    return NULL;
+}
+
+Tcl_Channel
+OpenBthServerChannel(
+    Tcl_Interp *interp,		/* For error reporting, may be NULL. */
+    const char *port,		/* Port (number|service) to open. */
+    const char *host,		/* Name of host for binding. */
+    Tcl_SocketAcceptProc *acceptProc,
+				/* Callback for accepting connections
+				 * from new clients. */
+    ClientData acceptProcData,	/* Data for the callback. */
+    int afhint)
+{
+    return NULL;
+}

win/tclWinsockCore.h

@@ -0,0 +1,342 @@
+/*
+ * Make sure to remove the redirection defines set in tclWinPort.h that is in
+ * use in other sections of the core, except for us.
+ */
+
+#undef getservbyname
+#undef getsockopt
+#undef ntohs
+#undef setsockopt
+
+
+/* 
+ * Thread safe linked-list management state bitmasks.
+ */
+#define IOCP_LL_NOLOCK		(1<<0)
+#define IOCP_LL_NODESTROY	(1<<1)
+
+/* Linked-List node object. */
+struct _ListNode;
+struct _List;
+typedef struct _ListNode {
+    struct _ListNode *next;	/* node in back */
+    struct _ListNode *prev;	/* node in back */
+    struct _List *ll;		/* parent linked-list */
+    LPVOID lpItem;		/* storage item */
+} LLNODE, *LPLLNODE;
+
+/* Linked-List object. */
+typedef struct _List {
+    struct _ListNode *front;	/* head of list */
+    struct _ListNode *back;	/* tail of list */
+    LONG lCount;		/* nodes contained */
+    CRITICAL_SECTION lock;	/* accessor lock */
+    HANDLE haveData;		/* event when data is added to an empty list */
+} LLIST, *LPLLIST;
+
+/* forward reference */
+struct SocketInfo;
+
+/*
+ * This is our per I/O buffer. It contains a WSAOVERLAPPED structure as well
+ * as other necessary information for handling an IO operation on a socket.
+ */
+typedef struct _BufferInfo {
+    WSAOVERLAPPED ol;
+    struct SocketInfo *parent;
+    SOCKET socket;	    /* Used for AcceptEx client socket */
+    DWORD WSAerr;	    /* Any error that occured for this operation. */
+    BYTE *buf;		    /* Buffer for recv/send/AcceptEx */
+    BYTE *last;		    /* buffer position if last read operation was a partial copy */
+    SIZE_T buflen;	    /* Length of the buffer */
+    SIZE_T used;	    /* Length of the buffer used (post operation) */
+#   define OP_ACCEPT	0   /* AcceptEx() */
+#   define OP_READ	1   /* WSARecv()/WSARecvFrom() */
+#   define OP_WRITE	2   /* WSASend()/WSASendTo() */
+#   define OP_CONNECT	3   /* ConnectEx() */
+#   define OP_DISCONNECT 4  /* DisconnectEx() */
+#   define OP_QOS	5   /* Quality of Service notices. */
+#   define OP_TRANSMIT	6   /* TransmitFile() */
+#   define OP_IOCTL	7   /* WSAIoctl() */
+#   define OP_LOOKUP	8   /* TODO: For future use, WSANSIoctl()?? */
+    int operation;	    /* Type of operation issued */
+    SOCKADDR_STORAGE addr;  /* addr storage space for WSARecvFrom/WSASendTo. */
+    LLNODE node;	    /* linked list node */
+} BufferInfo;
+
+#define QOS_BUFFER_SZ 16000
+
+/*
+ * The following structure is used to store the data associated with
+ * each socket.
+ */
+
+#define IOCP_EOF	    (1<<0)
+#define IOCP_CLOSING	    (1<<1)
+#define IOCP_ASYNC	    (1<<2)
+#define IOCP_CLOSABLE	    (1<<3)
+
+enum IocpRecvMode {
+    IOCP_RECVMODE_ZERO_BYTE,
+    IOCP_RECVMODE_FLOW_CTRL,
+    IOCP_RECVMODE_BURST_DETECT
+};
+
+/* forward references. */
+struct WS2ProtocolData;
+typedef struct ThreadSpecificData {
+    Tcl_ThreadId threadId;
+    LPLLIST readySockets;
+    LPLLIST deadSockets;
+} ThreadSpecificData;
+extern Tcl_ThreadDataKey dataKey;
+
+#include <pshpack4.h>
+
+typedef struct SocketInfo {
+    Tcl_Channel channel;	    /* Tcl channel for this socket. */
+    SOCKET socket;		    /* Windows SOCKET handle. */
+    DWORD flags;		    /* info about this socket. */
+
+    /* we need 32-bit alignment for these: */
+    volatile LONG markedReady;	    /* indicates we are on the readySockets list.
+				     * Access must be protected within the
+				     * tsdPtr->readySockets->lock critical
+				     * section. */
+    volatile LONG outstandingOps;   /* Count of all overlapped operations. */
+    volatile LONG outstandingSends; /* Count of overlapped WSASend() operations. */
+    volatile LONG outstandingSendCap; /* Limit of outstanding overlapped WSASend
+				     * operations allowed. */
+    volatile LONG outstandingAccepts; /* Count of overlapped AcceptEx() operations. */
+    volatile LONG outstandingAcceptCap; /* Limit of outstanding overlapped AcceptEx
+				     * operations allowed. */
+    volatile LONG outstandingRecvs; /* Count of overlapped WSARecv() operations. */
+    volatile LONG outstandingRecvCap; /* Limit of outstanding overlapped WSARecv
+				     * operations allowed. */
+    SIZE_T outstandingRecvBufferCap; /* limit to how many unread buffers
+				     * in llPendingRecv are allowed. */
+    int needRecvRestart;	    /* When the buffer cap is hit, this is set. */
+
+    enum IocpRecvMode recvMode;	    /* mode in use */
+
+    int watchMask;		    /* events we are interested in. */
+    struct WS2ProtocolData *proto;  /* Network protocol info. */
+
+    CRITICAL_SECTION tsdLock;	    /* accessor for the TSD block */
+    ThreadSpecificData *tsdHome;    /* TSD block for getting back to our
+				     * origin. */
+    /* For listening sockets: */
+    LPLLIST readyAccepts;	    /* Ready accepts() in queue. */
+    Tcl_SocketAcceptProc *acceptProc;  /* Proc to call on accept. */
+    ClientData acceptProcData;	    /* The data for the accept proc. */
+
+    /* Neutral SOCKADDR data: */
+    LPSOCKADDR localAddr;	    /* Local sockaddr. */
+    LPSOCKADDR remoteAddr;	    /* Remote sockaddr. */
+
+    DWORD lastError;		    /* Error code from last operation. */
+    LPLLIST llPendingRecv;	    /* Our pending recv list. */
+    LLNODE node;		    /* linked list node for the readySockts list. */
+} SocketInfo;
+
+#include <poppack.h>
+
+typedef Tcl_Obj * (Tcl_NetDecodeAddrProc) (SocketInfo *info, LPSOCKADDR addr, int noLookup);
+
+/* name resolver */
+#define TCL_NET_RESOLVER_QUERY	    0
+#define TCL_NET_RESOLVER_REGISTER   1
+#define TCL_NET_RESOLVER_UNREGISTER 2
+
+typedef int (Tcl_NetResolverProc)(Tcl_Interp *interp, int command, int hint,
+	    Tcl_Obj *question, Tcl_Obj **answers);
+typedef Tcl_Channel (Tcl_NetCreateClientProc)(Tcl_Interp *interp, const char *port,
+	    const char *host, const char *myaddr, const char *myport,
+	    int async, int afhint);
+typedef Tcl_Channel (Tcl_NetCreateServerProc)(Tcl_Interp *interp, const char *port,
+		const char *myhost, Tcl_SocketAcceptProc *acceptProc,
+		ClientData callbackData, int afhint);
+/*
+ * Specific protocol information is stored here and shared to all
+ * SocketInfo objects of that type.
+ */
+typedef struct WS2ProtocolData {
+    int af;		    /* Address family. */
+    int	type;		    /* Address type. */
+    int	protocol;	    /* Protocol type. */
+    size_t addrLen;	    /* Length of protocol specific SOCKADDR */
+    int afhint;		    /* Address family hint (for getaddrinfo(). */
+    Tcl_NetCreateClientProc	*CreateClient;
+    Tcl_NetCreateServerProc	*CreateServer;
+    Tcl_NetDecodeAddrProc	*DecodeSockAddr;
+    Tcl_NetResolverProc		*Resolver;
+
+    /* LSP specific extension functions */
+    LPFN_ACCEPTEX		_AcceptEx;
+    LPFN_GETACCEPTEXSOCKADDRS	_GetAcceptExSockaddrs;
+    LPFN_CONNECTEX		_ConnectEx;
+    LPFN_DISCONNECTEX		_DisconnectEx;
+    LPFN_TRANSMITFILE		_TransmitFile;
+    /* The only caveat of using this TransmitFile extension API is that
+       on Windows NT Workstation or Windows 2000 Professional only two
+       requests will be processed at a time. You must be running on
+       Windows NT or Windows 2000 Server, Windows 2000 Advanced Server,
+       or Windows 2000 Data Center to get full usage of this specialized
+       API. */
+    LPFN_TRANSMITPACKETS	_TransmitPackets;
+    LPFN_WSARECVMSG		_WSARecvMsg;
+} WS2ProtocolData;
+
+
+
+typedef struct AcceptInfo {
+    SOCKADDR_STORAGE local;
+    int localLen;
+    SOCKADDR_STORAGE remote;
+    int remoteLen;
+    SocketInfo *clientInfo;
+    LLNODE node;
+} AcceptInfo;
+
+/*
+ * Only one subsystem is ever created, but we group it within a
+ * struct just to be organized.
+ */
+
+typedef struct CompletionPortInfo {
+    HANDLE port;	    /* The completion port handle. */
+    HANDLE heap;	    /* General private heap used for objects 
+			     * that don't need to interact with Tcl
+			     * directly. */
+    HANDLE NPPheap;	    /* Special private heap for all data that
+			     * will be set with special attributes for
+			     * the non-paged pool (WSABUF and
+			     * OVERLAPPED) */
+    HANDLE thread;	    /* The single thread for handling the
+			     * completion routine for the entire
+			     * process. */
+} CompletionPortInfo;
+
+/*
+ * ----------------------------------------------------------------------
+ * Some stuff that needs to be switches or fconfigures, but aren't yet.
+ * ----------------------------------------------------------------------
+ */
+
+/*
+ * Default number of overlapped AcceptEx calls to place on a new
+ * listening socket.  Base minimum allowed, found by experimentation.
+ * This is the base pool count.  Don't go below this number or the
+ * listening socket will start returning errors quite easily.
+ *
+ * Use the -backlog fconfigure on the listening socket to set the
+ * pool size.  Each overlapped AcceptEx call will reserve ~500 bytes
+ * of the non-paged memory pool.  Larger IS better, if you don't mind
+ * the memory in reserve.  Choose a good sized -backlog such as 500
+ * if you want it "bunker buster proof".  The NP pool is a global
+ * resource for all processes and is said to have a limit around 1/4 of
+ * the physical memory.  500 overlapped AccepEx calls * ~500 bytes = ~250K
+ * of reserved NP pool memory.  Only use such high -backlog sizes
+ * for VERY heavy load servers that you want to handle SYN attacks
+ * gracefully.
+ */
+
+/* This is the -backlog fconfigure's default value. */
+#define IOCP_ACCEPT_CAP		    20
+
+/*
+ * We do not want an initial recv() with a new connection.  Use of this
+ * feature would require a watchdog thread for doing clean-up of mid-state
+ * (connected, but no data yet) connections and is just asking to be a DoS
+ * hole..  Not only that, but only works on protocols where the client
+ * speaks first.  HTTPD may be one, but many others are not.
+ *
+ *  !DO NOT USE THIS FEATURE!  Turn it off.
+ */
+#define IOCP_ACCEPT_BUFSIZE	    0
+
+/*
+ * Initial count of how many WSARecv(From) calls to place on a connected
+ * socket.  The actual count can grow automatically based on burst
+ * activity to the cap count (See the recursion used in PostOverlappedRecv
+ * for details).
+ */
+
+#define IOCP_INITIAL_RECV_COUNT	    1
+/* This is the -recvburst fconfigure's default value. */
+#define IOCP_RECV_CAP		    20
+
+/*
+ * How large do we want the receive buffers?  Use multiples of the
+ * page size only (4096) as windows will lock this on page boundaries
+ * anyways.
+ */
+
+#define IOCP_RECV_BUFSIZE	    4096
+
+/*
+ * Initial (default) cap on send concurrency.  This is the -sendcap
+ * fconfigure's default value.
+ */
+
+#define IOCP_SEND_CAP		    20
+
+extern Tcl_ChannelType IocpStreamChannelType;
+extern Tcl_ChannelType IocpPacketChannelType;
+extern CompletionPortInfo IocpSubSystem;
+
+extern void IocpInitProtocolData (SOCKET sock, WS2ProtocolData *pdata);
+extern int CreateSocketAddress (const char *addr, const char *port,
+	LPADDRINFO inhints, LPADDRINFO *result);
+extern void FreeSocketAddress(LPADDRINFO addrinfo);
+extern BOOL FindProtocolInfo(int af, int type, int protocol, DWORD flags,
+	WSAPROTOCOL_INFO *pinfo);
+extern DWORD PostOverlappedAccept (SocketInfo *infoPtr,
+	BufferInfo *acceptobj, int useBurst);
+extern DWORD PostOverlappedRecv (SocketInfo *infoPtr,
+	BufferInfo *recvobj, int useBurst, int ForcePostOnError);
+extern DWORD PostOverlappedQOS (SocketInfo *infoPtr, BufferInfo *bufPtr);
+extern void FreeBufferObj(BufferInfo *obj);
+extern BufferInfo * GetBufferObj (SocketInfo *infoPtr, SIZE_T buflen);
+extern SocketInfo * NewSocketInfo (SOCKET socket);
+extern void FreeSocketInfo (SocketInfo *infoPtr);
+
+/* thread safe linked list procedures */
+extern LPLLIST IocpLLCreate (void);
+extern BOOL IocpLLDestroy (LPLLIST ll);
+extern LPLLNODE IocpLLPushBack (LPLLIST ll, LPVOID lpItem, LPLLNODE pnode,
+	DWORD dwState);
+extern LPLLNODE IocpLLPushFront (LPLLIST ll, LPVOID lpItem, LPLLNODE pnode,
+	DWORD dwState);
+extern BOOL IocpLLPop (LPLLNODE pnode, DWORD dwState);
+extern BOOL IocpLLPopAll (LPLLIST ll, LPLLNODE snode, DWORD dwState);
+extern LPVOID IocpLLPopBack (LPLLIST ll, DWORD dwState, DWORD timeout);
+extern LPVOID IocpLLPopFront (LPLLIST ll, DWORD dwState, DWORD timeout);
+extern BOOL IocpLLIsNotEmpty (LPLLIST ll);
+extern BOOL IocpLLNodeDestroy (LPLLNODE node);
+extern SIZE_T IocpLLGetCount (LPLLIST ll);
+
+/* private memory stuff */
+extern __inline LPVOID	IocpAlloc (SIZE_T size);
+extern __inline LPVOID  IocpReAlloc (LPVOID block, SIZE_T size);
+extern __inline BOOL	IocpFree (LPVOID block);
+extern __inline LPVOID	IocpNPPAlloc (SIZE_T size);
+extern __inline LPVOID  IocpNPPReAlloc (LPVOID block, SIZE_T size);
+extern __inline BOOL	IocpNPPFree (LPVOID block);
+
+extern Tcl_NetDecodeAddrProc DecodeIpSockaddr;
+extern Tcl_NetResolverProc ResolveIp;
+
+extern WS2ProtocolData tcpAnyProtoData;
+extern WS2ProtocolData tcp4ProtoData;
+extern WS2ProtocolData tcp6ProtoData;
+#if 0 /* for now */
+extern WS2ProtocolData udpAnyProtoData;
+extern WS2ProtocolData udp4ProtoData;
+extern WS2ProtocolData udp6ProtoData;
+extern WS2ProtocolData bthProtoData;
+extern WS2ProtocolData irdaProtoData;
+#endif
+
+extern ThreadSpecificData *InitSockets(void);
+

win/tclWinsockIrDA.c

@@ -0,0 +1,341 @@
+/* reserved for IrDA's IrLAP/LSAP sockets protocol */
+
+#include "tclWinInt.h"
+#include "tclWinsockCore.h"
+#include <af_irda.h>
+
+static Tcl_NetCreateClientProc OpenIrdaClientChannel;
+static Tcl_NetCreateServerProc OpenIrdaServerChannel;
+static Tcl_NetDecodeAddrProc DecodeIrdaSockaddr;
+static Tcl_NetResolverProc ResolveIrDA;
+
+WS2ProtocolData irdaProtoData = {
+    AF_IRDA,
+    SOCK_STREAM,
+    0,
+    sizeof(SOCKADDR_IRDA),
+    0,
+    OpenIrdaClientChannel,
+    OpenIrdaServerChannel,
+    DecodeIrdaSockaddr,
+    ResolveIrDA,	/* resolver */
+    NULL,
+    NULL,
+    NULL,
+    NULL,
+    NULL,
+    NULL,
+    NULL
+};
+
+static SocketInfo *	CreateIrdaSocket(Tcl_Interp *interp,
+				CONST char *port, CONST char *host,
+				int server, CONST char *myaddr,
+				CONST char *myport, int async);
+static int		Do_IrDA_Discovery (Tcl_Obj **answers);
+static int		Do_IrDA_Query (Tcl_Obj *deviceId, Tcl_Obj *serviceName,
+				Tcl_Obj **answers);
+
+
+
+Tcl_Obj *
+DecodeIrdaSockaddr (
+    SocketInfo *info,
+    LPSOCKADDR addr,
+    int noLookup)
+{
+    char formatedId[12];
+    Tcl_Obj *result = Tcl_NewObj();
+    SOCKADDR_IRDA *irdaaddr = (SOCKADDR_IRDA *) addr;
+    Tcl_DString ds;
+
+    /* DeviceID (address) */
+    sprintf(formatedId, "%02x-%02x-%02x-%02x",
+	    irdaaddr->irdaDeviceID[0], irdaaddr->irdaDeviceID[1],
+	    irdaaddr->irdaDeviceID[2], irdaaddr->irdaDeviceID[3]);
+    Tcl_ListObjAppendElement(NULL, result,
+	    Tcl_NewStringObj(formatedId, 11));
+
+    if (noLookup) {
+	Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj("", -1));
+    } else {
+	// TODO: resolve DeviceID to DeviceName, how?
+	Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj("", -1));
+    }
+
+    /* Service Name (port) */
+    Tcl_ExternalToUtfDString(NULL, irdaaddr->irdaServiceName, 22, &ds);
+    Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj(
+	    Tcl_DStringValue(&ds), -1));
+    Tcl_DStringFree(&ds);
+
+    return result;
+}
+
+
+int
+ResolveIrDA (
+    Tcl_Interp *interp,
+    int command,
+    int hint,
+    Tcl_Obj *question,
+    Tcl_Obj **answers)
+{
+    switch (command) {
+	case TCL_NET_RESOLVER_QUERY:
+	    /* asterix means "get all", aka discovery.. */
+	    if (strcmp(Tcl_GetString(question), "*") == 0) {
+		if (Do_IrDA_Discovery(answers) != TCL_OK) {
+		    return TCL_ERROR;
+		}
+	    } else {
+		if (Do_IrDA_Query(question, answers) != TCL_OK) {
+		    return TCL_ERROR;
+		}
+	    }
+	    break;
+	case TCL_NET_RESOLVER_REGISTER:
+	case TCL_NET_RESOLVER_UNREGISTER:
+	    /* TODO */
+	    break;
+    }
+    return TCL_OK;
+}
+
+
+int
+Do_IrDA_Discovery (Tcl_Obj **answers)
+{
+    SOCKET sock;
+    DEVICELIST *deviceListStruct;
+    IRDA_DEVICE_INFO* thisDevice;
+    int code, charSet, nameLen, size, limit;
+    unsigned i, bit;
+    char isocharset[] = "iso-8859-?", *nameEnc;
+    Tcl_Encoding enc;
+    Tcl_Obj* entry[3];
+    const char *hints1[] = {
+	"PnP", "PDA", "Computer", "Printer", "Modem", "Fax", "LAN", NULL
+    };
+    const char *hints2[] = {
+	"Telephony", "Server", "Comm", "Message", "HTTP", "OBEX", NULL
+    };
+    char formatedId[12];
+    Tcl_DString deviceDString;
+
+    /* dunno... */
+    limit = 20;
+
+    /*
+     * First make an IrDA socket.
+     */
+
+    sock = WSASocket(AF_IRDA, SOCK_STREAM, 0, NULL, 0,
+	    WSA_FLAG_OVERLAPPED);
+
+    if (sock == INVALID_SOCKET) {
+	//SendWinErrorData(407, "Cannot create IrDA socket", WSAGetLastError());
+	return TCL_ERROR;
+    }
+
+    /*
+     * Alloc the list we'll hand to getsockopt.
+     */
+
+    size = sizeof(DEVICELIST) - sizeof(IRDA_DEVICE_INFO)
+	    + (sizeof(IRDA_DEVICE_INFO) * limit);
+    deviceListStruct = (DEVICELIST *) ckalloc(size);
+    deviceListStruct->numDevice = 0;
+
+    code = getsockopt(sock, SOL_IRLMP, IRLMP_ENUMDEVICES,
+	    (char*) deviceListStruct, &size);
+
+    if (code == SOCKET_ERROR) {
+	//SendWinErrorData(408, "getsockopt() failed", WSAGetLastError());
+	ckfree((char *)deviceListStruct);
+	return TCL_ERROR;
+    }
+
+    /*
+     * Create the output Tcl_Obj, if none exists there.
+     */
+
+    if (*answers == NULL) {
+	*answers = Tcl_NewObj();
+    }
+
+    for (i = 0; i < deviceListStruct->numDevice; i++) {
+	thisDevice = deviceListStruct->Device+i;
+	sprintf(formatedId, "%02x-%02x-%02x-%02x",
+		thisDevice->irdaDeviceID[0], thisDevice->irdaDeviceID[1],
+		thisDevice->irdaDeviceID[2], thisDevice->irdaDeviceID[3]);
+	entry[0] = Tcl_NewStringObj(formatedId, 11);
+	charSet = (thisDevice->irdaCharSet) & 0xff;
+	switch (charSet) {
+	    case 0xff:
+		nameEnc = "unicode"; break;
+	    case 0:
+		nameEnc = "ascii"; break;
+	    default:
+		nameEnc = isocharset; 
+		isocharset[9] = charSet + '0';
+		break;
+	}
+	enc = Tcl_GetEncoding(NULL, nameEnc);
+	nameLen = (thisDevice->irdaDeviceName)[21] ? 22 :
+		strlen(thisDevice->irdaDeviceName);
+	Tcl_ExternalToUtfDString(enc, thisDevice->irdaDeviceName,
+		nameLen, &deviceDString);
+	Tcl_FreeEncoding(enc);
+	entry[1] = Tcl_NewStringObj(Tcl_DStringValue(&deviceDString),
+		Tcl_DStringLength(&deviceDString));
+	Tcl_DStringFree(&deviceDString);
+	entry[2] = Tcl_NewObj();
+	for (bit=0; hints1[bit]; ++bit) {
+	    if (thisDevice->irdaDeviceHints1 & (1<<bit))
+		Tcl_ListObjAppendElement(NULL, entry[2],
+			Tcl_NewStringObj(hints1[bit],-1));
+	}
+	for (bit=0; hints2[bit]; ++bit) {
+	    if (thisDevice->irdaDeviceHints2 & (1<<bit))
+		Tcl_ListObjAppendElement(NULL, entry[2],
+			Tcl_NewStringObj(hints2[bit],-1));
+	}
+	Tcl_ListObjAppendElement(NULL, *answers,
+		Tcl_NewListObj(3, entry));
+    }
+
+    ckfree((char *)deviceListStruct);
+    closesocket(sock);
+
+    return TCL_OK;
+}
+
+int
+Do_IrDA_Query (Tcl_Obj *deviceId, Tcl_Obj *serviceName,
+	Tcl_Obj **answers)
+{
+    SOCKET sock;
+    int code, size = sizeof(IAS_QUERY);
+    IAS_QUERY iasQuery;
+
+    /*
+     * Decode irdaDeviceId
+     */
+    code = sscanf(Tcl_GetString(deviceId), "%02x-%02x-%02x-%02x",
+	&iasQuery.irdaDeviceID[0], &iasQuery.irdaDeviceID[1],
+	&iasQuery.irdaDeviceID[2], &iasQuery.irdaDeviceID[3]);
+    if (code != 4) {
+	//SendProtocolError(409, "Malformed IrDA DeviceID.  Must be in the form \"FF-FF-FF-FF.\"");
+	return TCL_ERROR;
+    }
+
+    /*
+     * First, make an IrDA socket.
+     */
+
+    sock = socket(AF_IRDA, SOCK_STREAM, 0);
+
+    if (sock == INVALID_SOCKET) {
+	//SendWinErrorData(407, "Cannot create IrDA socket", WSAGetLastError());
+	return TCL_ERROR;
+    }
+    strcpy(iasQuery.irdaAttribName, "IrDA:TinyTP:LsapSel");
+    strncpy(iasQuery.irdaClassName, Tcl_GetString(serviceName), 64);
+
+    code = getsockopt(sock, SOL_IRLMP, IRLMP_IAS_QUERY,
+	    (char*) &iasQuery, &size);
+
+    if (code == SOCKET_ERROR) {
+	if (WSAGetLastError() != WSAECONNREFUSED) {
+	    //SendWinErrorData(408, "getsockopt() failed", WSAGetLastError());
+	} else {
+	    //SendProtocolError(410, "No such service.");
+	}
+	closesocket(sock);
+	return TCL_ERROR;
+    }
+
+    /*
+     * Create the output Tcl_Obj, if none exists there.
+     */
+
+    if (*answers == NULL) {
+	*answers = Tcl_NewObj();
+    }
+
+    closesocket(sock);
+
+    switch (iasQuery.irdaAttribType) {
+	case IAS_ATTRIB_INT:
+	    Tcl_SetIntObj(*answers, iasQuery.irdaAttribute.irdaAttribInt);
+	    return TCL_OK;
+	case IAS_ATTRIB_OCTETSEQ:
+	    Tcl_SetByteArrayObj(*answers, iasQuery.irdaAttribute.irdaAttribOctetSeq.OctetSeq,
+		    iasQuery.irdaAttribute.irdaAttribOctetSeq.Len);
+	    return TCL_OK;
+	case IAS_ATTRIB_STR: {
+		Tcl_Encoding enc;
+		char isocharset[] = "iso-8859-?", *nameEnc;
+		int charSet = iasQuery.irdaAttribute.irdaAttribUsrStr.CharSet  & 0xff;
+		Tcl_DString deviceDString;
+		switch (charSet) {
+		    case 0xff:
+			nameEnc = "unicode";
+			break;
+		    case 0:
+			nameEnc = "ascii";
+			break;
+		    default:
+			nameEnc = isocharset; 
+			isocharset[9] = charSet + '0';
+			break;
+		}
+		enc = Tcl_GetEncoding(NULL, nameEnc);
+		Tcl_ExternalToUtfDString(enc, iasQuery.irdaAttribute.irdaAttribUsrStr.UsrStr,
+			iasQuery.irdaAttribute.irdaAttribUsrStr.Len, &deviceDString);
+		Tcl_FreeEncoding(enc);
+		Tcl_SetStringObj(*answers, Tcl_DStringValue(&deviceDString),
+			Tcl_DStringLength(&deviceDString));
+		Tcl_DStringFree(&deviceDString);
+	    }
+	    return TCL_OK;
+	case IAS_ATTRIB_NO_CLASS:
+	    Tcl_SetStringObj(*answers, "no such class", -1);
+	    return TCL_OK;
+	case IAS_ATTRIB_NO_ATTRIB:
+	    Tcl_SetStringObj(*answers, "no such attribute", -1);
+	    return TCL_OK;
+	default:
+	    Tcl_Panic("No such arm.");
+	    return TCL_ERROR;  /* makes compiler happy */
+    }
+}
+
+Tcl_Channel
+OpenIrdaClientChannel(
+    Tcl_Interp *interp,		/* For error reporting; can be NULL. */
+    const char *port,		/* Port (number|service) to open. */
+    const char *host,		/* Host on which to open port. */
+    const char *myaddr,		/* Client-side address. */
+    const char *myport,		/* Client-side port (number|service).*/
+    int async,			/* If nonzero, should connect
+				 * client socket asynchronously. */
+    int afhint)
+{
+    return NULL;
+}
+
+Tcl_Channel
+OpenIrdaServerChannel(
+    Tcl_Interp *interp,		/* For error reporting, may be NULL. */
+    const char *port,		/* Port (number|service) to open. */
+    const char *host,		/* Name of host for binding. */
+    Tcl_SocketAcceptProc *acceptProc,
+				/* Callback for accepting connections
+				 * from new clients. */
+    ClientData acceptProcData,	/* Data for the callback. */
+    int afhint)
+{
+    return NULL;
+}

win/tclWinsockTCP.c

@@ -0,0 +1,672 @@
+#include "tclWinInt.h"
+#include "tclWinsockCore.h"
+
+/* ISO hack for dumb VC++ */
+#ifdef _MSC_VER
+#define   snprintf	_snprintf
+#endif
+
+
+
+static SocketInfo *	CreateTcpSocket(Tcl_Interp *interp,
+				const char *port, const char *host,
+				int server, const char *myaddr,
+				const char *myport, int async, int afhint);
+static int		DoIpResolve (int hint, Tcl_Obj *question,
+				Tcl_Obj **answers);
+static int		isIp (Tcl_Obj *name);
+static Tcl_NetCreateClientProc OpenTcpClientChannel;
+static Tcl_NetCreateServerProc OpenTcpServerChannel;
+
+#if 0
+const FLOWSPEC flowspec_notraffic = {
+    QOS_NOT_SPECIFIED,
+    QOS_NOT_SPECIFIED,
+    QOS_NOT_SPECIFIED,
+    QOS_NOT_SPECIFIED,
+    QOS_NOT_SPECIFIED,
+    SERVICETYPE_NOTRAFFIC,
+    QOS_NOT_SPECIFIED,
+    QOS_NOT_SPECIFIED
+};
+
+const FLOWSPEC flowspec_g711 = {
+    8500,
+    680,
+    17000,
+    QOS_NOT_SPECIFIED,
+    QOS_NOT_SPECIFIED,
+    SERVICETYPE_CONTROLLEDLOAD,
+    340,
+    340
+};
+
+const FLOWSPEC flowspec_guaranteed = {
+    17000,
+    1260,
+    34000,
+    QOS_NOT_SPECIFIED,
+    QOS_NOT_SPECIFIED,
+    SERVICETYPE_GUARANTEED,
+    340,
+    340
+};
+#endif
+
+WS2ProtocolData tcpAnyProtoData = {
+    AF_INET,
+    SOCK_STREAM,
+    IPPROTO_TCP,
+    sizeof(SOCKADDR_IN),
+    AF_UNSPEC,
+    OpenTcpClientChannel,
+    OpenTcpServerChannel,
+    DecodeIpSockaddr,
+    ResolveIp,
+    NULL,
+    NULL,
+    NULL,
+    NULL,
+    NULL,
+    NULL,
+    NULL
+};
+
+WS2ProtocolData tcp4ProtoData = {
+    AF_INET,
+    SOCK_STREAM,
+    IPPROTO_TCP,
+    sizeof(SOCKADDR_IN),
+    AF_INET,
+    OpenTcpClientChannel,
+    OpenTcpServerChannel,
+    DecodeIpSockaddr,
+    ResolveIp,
+    NULL,
+    NULL,
+    NULL,
+    NULL,
+    NULL,
+    NULL,
+    NULL
+};
+
+WS2ProtocolData tcp6ProtoData = {
+    AF_INET6,
+    SOCK_STREAM,
+    IPPROTO_TCP,
+    sizeof(SOCKADDR_IN6),
+    AF_INET6,
+    OpenTcpClientChannel,
+    OpenTcpServerChannel,
+    DecodeIpSockaddr,
+    ResolveIp,
+    NULL,
+    NULL,
+    NULL,
+    NULL,
+    NULL,
+    NULL,
+    NULL
+};
+
+
+Tcl_Obj *isIpRE_IPv4 = NULL;
+Tcl_Obj *isIpRE_IPv6 = NULL;
+Tcl_Obj *isIpRE_IPv6Comp = NULL;
+Tcl_Obj *isIpRE_4in6 = NULL;
+Tcl_Obj *isIpRE_4in6Comp = NULL;
+
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DecodeIpSockaddr --
+ *
+ *	Decodes the info from the sockaddr_in.
+ *
+ * Results:
+ *	A Tcl_Obj* as a list in the form {IP, name, port}.  name will
+ *	be empty, if the resolve fails.  The caller must free the
+ *	Tcl_Obj* when done.
+ *
+ * Side effects:
+ *	Reverse resolve may block for an unknown amount of time.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+DecodeIpSockaddr (SocketInfo *info, LPSOCKADDR addr, int noLookup)
+{
+    char name[NI_MAXHOST];
+    Tcl_Obj *result = Tcl_NewObj();
+
+    /*
+     * Get the numeric IP string.
+     */
+    if (getnameinfo(addr, info->proto->addrLen, name, NI_MAXHOST, NULL,
+	    0, NI_NUMERICHOST) == NO_ERROR) {
+	Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj(name, -1));
+    } else {
+	Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj("", -1));
+    }
+
+    /*
+     * Get the reverse resolved name through DNS from the IP.
+     * This may block for an unknown amount of time.  Defaults
+     * to a numeric if DNS can not resolve to a name.
+     */
+    if (noLookup) {
+	Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj("", -1));
+    } else {
+	if (getnameinfo(addr, info->proto->addrLen, name, NI_MAXHOST, NULL,
+		0, 0) == NO_ERROR) {
+	    Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj(name, -1));
+	} else {
+	    Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj("", -1));
+	}
+    }
+
+    /*
+     * Get port numeric string.  Defaults to the port number if the
+     * service name is unknown.
+     */
+    if (getnameinfo(addr, info->proto->addrLen, NULL, 0, name,
+	    NI_MAXSERV, NI_NUMERICSERV) == NO_ERROR) {
+	Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj(name, -1));
+    } else {
+	Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj("", -1));
+    }
+
+    return result;
+}
+
+int
+ResolveIp(
+    Tcl_Interp *interp,	    /* for error reporting, maybe NULL. */
+    int command,	    /* the command to perform. */
+    int hint,		    /* adress family hint for getaddrinfo. */
+    Tcl_Obj *question,	    /* the query to request. */
+    Tcl_Obj **answers)
+{
+    switch (command) {
+	case TCL_NET_RESOLVER_QUERY:
+	    if (DoIpResolve(hint, question, answers) != TCL_OK) {
+		goto error;
+	    }
+	    break;
+	case TCL_NET_RESOLVER_REGISTER:
+	case TCL_NET_RESOLVER_UNREGISTER:
+	    WSASetLastError(WSAEOPNOTSUPP);
+	    goto error;
+    }
+    return TCL_OK;
+
+error:
+    if (interp != NULL) {
+	Tcl_AppendResult(interp, "couldn't resolve: ",
+		Tcl_WinError(interp, WSAGetLastError()), NULL);
+    }
+    return TCL_ERROR;
+}
+
+int
+DoIpResolve (int hint, Tcl_Obj *question, Tcl_Obj **answers)
+{
+    struct addrinfo hints;
+    struct addrinfo *hostaddr, *addr;
+    int result, type, len;
+    CONST char *utf8Chars;
+    Tcl_DString dnsTxt;
+    Tcl_Encoding dnsEnc;
+
+    memset(&hints, 0, sizeof(struct addrinfo));
+    hints.ai_flags  = 0;
+    hints.ai_family = hint;
+    hints.ai_socktype = 0;
+    hints.ai_protocol = 0;
+
+    /* RFC3490 */
+    dnsEnc = Tcl_GetEncoding(NULL, "ascii");
+    utf8Chars = Tcl_GetStringFromObj(question, &len);
+    Tcl_UtfToExternalDString(dnsEnc, utf8Chars, len, &dnsTxt);
+
+    if ((result = getaddrinfo(Tcl_DStringValue(&dnsTxt), NULL, &hints,
+	    &hostaddr)) != 0) {
+	goto error1;
+    }
+
+    if (*answers == NULL) {
+	*answers = Tcl_NewObj();
+    }
+
+    if (isIp(question)) {
+	/* question was a numeric IP, return a hostname. */
+	type = NI_NAMEREQD;
+    } else {
+	/* question was a hostname, return a numeric IP. */
+	type = NI_NUMERICHOST;
+    }
+
+    addr = hostaddr;
+    while (addr != NULL) {
+	char hostStr[NI_MAXHOST];
+	int err;
+
+	err = getnameinfo(addr->ai_addr, addr->ai_addrlen, hostStr,
+		NI_MAXHOST, NULL, 0, type);
+
+	if (err == 0) {
+	    Tcl_ExternalToUtfDString(dnsEnc, hostStr, -1, &dnsTxt);
+	    Tcl_ListObjAppendElement(NULL, *answers,
+		    Tcl_NewStringObj(Tcl_DStringValue(&dnsTxt),
+		    Tcl_DStringLength(&dnsTxt)));
+	} else {
+	    goto error2;
+	}
+	addr = addr->ai_next;
+    }
+
+    return TCL_OK;
+
+error2:
+    freeaddrinfo(hostaddr);
+error1:
+    Tcl_DStringFree(&dnsTxt);
+    return TCL_ERROR;
+}
+
+int
+isIp (Tcl_Obj *name)
+{
+    if (isIpRE_IPv4 == NULL) {
+	/* lazy init */
+	/* TODO: add a cleanup procedure through an exit handler or something */
+	isIpRE_IPv4 = Tcl_NewStringObj("^((25[0-5]|2[0-4]\\d|[0-1]?\\d?\\d)(\\.(25[0-5]|2[0-4]\\d|[0-1]?\\d?\\d)){3})$", -1);
+	Tcl_IncrRefCount(isIpRE_IPv4);
+	isIpRE_IPv6 = Tcl_NewStringObj("^((?:[[:xdigit:]]{1,4}:){7}[[:xdigit:]]{1,4})$", -1);
+	Tcl_IncrRefCount(isIpRE_IPv6);
+	isIpRE_IPv6Comp = Tcl_NewStringObj("^((?:[[:xdigit:]]{1,4}(?::[[:xdigit:]]{1,4})*)?)::((?:[[:xdigit:]]{1,4}(?::[[:xdigit:]]{1,4})*)?)$", -1);
+	Tcl_IncrRefCount(isIpRE_IPv6Comp);
+	isIpRE_4in6 = Tcl_NewStringObj("^(((?:[[:xdigit:]]{1,4}:){6,6})(25[0-5]|2[0-4]\\d|[0-1]?\\d?\\d)(\\.(25[0-5]|2[0-4]\\d|[0-1]?\\d?\\d)){3})$", -1);
+	Tcl_IncrRefCount(isIpRE_4in6);
+	isIpRE_4in6Comp = Tcl_NewStringObj("^(((?:[[:xdigit:]]{1,4}(?::[[:xdigit:]]{1,4})*)?)::((?:[[:xdigit:]]{1,4}:)*)(25[0-5]|2[0-4]\\d|[0-1]?\\d?\\d)(\\.(25[0-5]|2[0-4]\\d|[0-1]?\\d?\\d)){3})$", -1);
+	Tcl_IncrRefCount(isIpRE_4in6Comp);
+    }
+    if (
+	Tcl_RegExpMatchObj(NULL, name, isIpRE_IPv4) ||
+	Tcl_RegExpMatchObj(NULL, name, isIpRE_IPv6) ||
+	Tcl_RegExpMatchObj(NULL, name, isIpRE_IPv6Comp) ||
+	Tcl_RegExpMatchObj(NULL, name, isIpRE_4in6) ||
+	Tcl_RegExpMatchObj(NULL, name, isIpRE_4in6Comp))
+    {
+	return 1;
+    }
+    return 0;
+}
+
+
+Tcl_Channel
+OpenTcpClientChannel(
+    Tcl_Interp *interp,		/* For error reporting; can be NULL. */
+    const char *port,		/* Port (number|service) to open. */
+    const char *host,		/* Host on which to open port. */
+    const char *myaddr,		/* Client-side address. */
+    const char *myport,		/* Client-side port (number|service).*/
+    int async,			/* If nonzero, should connect
+				 * client socket asynchronously. */
+    int afhint)
+{
+    SocketInfo *infoPtr;
+    char channelName[4 + TCL_INTEGER_SPACE];
+
+
+    /*
+     * Create a new client socket and wrap it in a channel.
+     */
+
+    infoPtr = CreateTcpSocket(interp, port, host, 0, myaddr, myport, async, afhint);
+    if (infoPtr == NULL) {
+	return NULL;
+    }
+    snprintf(channelName, 4 + TCL_INTEGER_SPACE, "sock%lu", infoPtr->socket);
+    infoPtr->channel = Tcl_CreateChannel(&IocpStreamChannelType, channelName,
+	    (ClientData) infoPtr, (TCL_READABLE | TCL_WRITABLE));
+    if (Tcl_SetChannelOption(interp, infoPtr->channel, "-translation",
+	    "auto crlf") == TCL_ERROR) {
+        Tcl_Close((Tcl_Interp *) NULL, infoPtr->channel);
+        return (Tcl_Channel) NULL;
+    }
+    if (Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "")
+	    == TCL_ERROR) {
+        Tcl_Close((Tcl_Interp *) NULL, infoPtr->channel);
+        return (Tcl_Channel) NULL;
+    }
+
+    return infoPtr->channel;
+}
+
+Tcl_Channel
+OpenTcpServerChannel(
+    Tcl_Interp *interp,		/* For error reporting, may be NULL. */
+    const char *port,		/* Port (number|service) to open. */
+    const char *host,		/* Name of host for binding. */
+    Tcl_SocketAcceptProc *acceptProc,
+				/* Callback for accepting connections
+				 * from new clients. */
+    ClientData acceptProcData,	/* Data for the callback. */
+    int afhint)
+{
+    SocketInfo *infoPtr;
+    char channelName[4 + TCL_INTEGER_SPACE];
+
+    /*
+     * Create a new client socket and wrap it in a channel.
+     */
+
+    infoPtr = CreateTcpSocket(interp, port, host, 1 /*server*/, NULL, 0, 0, afhint);
+    if (infoPtr == NULL) {
+	return NULL;
+    }
+
+    infoPtr->acceptProc = acceptProc;
+    infoPtr->acceptProcData = acceptProcData;
+    snprintf(channelName, 4 + TCL_INTEGER_SPACE, "sock%lu", infoPtr->socket);
+    infoPtr->channel = Tcl_CreateChannel(&IocpStreamChannelType, channelName,
+	    (ClientData) infoPtr, 0);
+    if (Tcl_SetChannelOption(interp, infoPtr->channel, "-eofchar", "")
+	    == TCL_ERROR) {
+        Tcl_Close((Tcl_Interp *) NULL, infoPtr->channel);
+        return (Tcl_Channel) NULL;
+    }
+
+    return infoPtr->channel;
+}
+
+static SocketInfo *
+CreateTcpSocket(
+    Tcl_Interp *interp,		/* For error reporting; can be NULL. */
+    const char *port,		/* Port to open. */
+    const char *host,		/* Name of host on which to open port. */
+    int server,			/* 1 if socket should be a server socket,
+				 * else 0 for a client socket. */
+    const char *myaddr,		/* Optional client-side address */
+    const char *myport,		/* Optional client-side port */
+    int async,			/* If nonzero, connect client socket
+				 * asynchronously. */
+    int afhint)
+{
+    u_long flag = 1;		/* Indicates nonblocking mode. */
+    int asyncConnect = 0;	/* Will be 1 if async connect is
+				 * in progress. */
+    LPADDRINFO hostaddr;	/* Socket address */
+    LPADDRINFO mysockaddr;	/* Socket address for client */
+    SOCKET sock = INVALID_SOCKET;
+    SocketInfo *infoPtr = NULL;	/* The returned value. */
+    BufferInfo *bufPtr;		/* The returned value. */
+    DWORD bytes;
+    BOOL code;
+    int i;
+    WS2ProtocolData *pdata;
+    ADDRINFO hints;
+    LPADDRINFO addr;
+    WSAPROTOCOL_INFO wpi;
+    ThreadSpecificData *tsdPtr = InitSockets();
+
+    ZeroMemory(&hints, sizeof(hints));
+    hints.ai_family   = afhint;
+    hints.ai_socktype = SOCK_STREAM;
+    hints.ai_protocol = IPPROTO_TCP;
+
+    if (host == NULL && !strcmp(port, "0")) {
+	/* Win2K hack.  Ask for port 1, then set to 0 so getaddrinfo() doesn't bomb. */
+	if (! CreateSocketAddress(host, "1", &hints, &hostaddr)) {
+	    goto error1;
+	}
+	addr = hostaddr;
+	while (addr) {
+	    if (addr->ai_family == AF_INET) {
+		((LPSOCKADDR_IN)addr->ai_addr)->sin_port = INADDR_ANY;
+	    } else {
+		IN6ADDR_SETANY((LPSOCKADDR_IN6) addr->ai_addr);
+	    }
+	    addr = addr->ai_next;
+	}
+    } else {
+	if (!CreateSocketAddress(host, port, &hints, &hostaddr)) {
+	    goto error1;
+	}
+    }
+    addr = hostaddr;
+
+    if (myaddr != NULL || myport != NULL) {
+	if (!CreateSocketAddress(myaddr, myport, addr, &mysockaddr)) {
+	    goto error2;
+	}
+    } else if (!server) {
+	/* Win2K hack.  Ask for port 1, then set to 0 so getaddrinfo() doesn't bomb. */
+	if (!CreateSocketAddress(NULL, "1", addr, &mysockaddr)) {
+	    goto error2;
+	}
+	if (mysockaddr->ai_family == AF_INET) {
+	    ((LPSOCKADDR_IN)mysockaddr->ai_addr)->sin_port = INADDR_ANY;
+	} else {
+	    IN6ADDR_SETANY((LPSOCKADDR_IN6) mysockaddr->ai_addr);
+	}
+    }
+
+
+    switch (addr->ai_family) {
+    case AF_INET:
+	pdata = &tcp4ProtoData; break;
+    case AF_INET6:
+	pdata = &tcp6ProtoData; break;
+    default:
+	Tcl_Panic("very bad protocol family returned from getaddrinfo()");
+    }
+
+    code = FindProtocolInfo(pdata->af, pdata->type, pdata->protocol,
+	    0 /*XP1_QOS_SUPPORTED*/, &wpi);
+    if (code == FALSE) {
+	goto error2;
+    }
+
+    sock = WSASocket(FROM_PROTOCOL_INFO, FROM_PROTOCOL_INFO,
+	    FROM_PROTOCOL_INFO, &wpi, 0, WSA_FLAG_OVERLAPPED);
+    if (sock == INVALID_SOCKET) {
+	goto error2;
+    }
+
+    IocpInitProtocolData(sock, pdata);
+
+    /*
+     * Win-NT has a misfeature that sockets are inherited in child
+     * processes by default.  Turn off the inherit bit.
+     */
+
+    SetHandleInformation((HANDLE)sock, HANDLE_FLAG_INHERIT, 0);
+
+    /*
+     * Turn off the internal send buffing.  We get more speed and are
+     * more efficient by reducing memcpy calls as the stack will use
+     * our overlapped buffers directly.
+     */
+
+    i = 0;
+    if (setsockopt(sock, SOL_SOCKET, SO_SNDBUF,
+	    (const char *) &i, sizeof(int)) == SOCKET_ERROR) {
+	goto error2;
+    }
+
+    infoPtr = NewSocketInfo(sock);
+    infoPtr->proto = pdata;
+
+    /* Info needed to get back to this thread. */
+    infoPtr->tsdHome = tsdPtr;
+
+    if (server) {
+
+	/*
+	 * Associate the socket and its SocketInfo struct to the completion
+	 * port.  Implies an automatic set to non-blocking.
+	 */
+	if (CreateIoCompletionPort((HANDLE)sock, IocpSubSystem.port,
+		(ULONG_PTR)infoPtr, 0) == NULL) {
+	    WSASetLastError(GetLastError());
+	    goto error2;
+	}
+
+	/*
+	 * Bind to the specified port.  Note that we must not call
+	 * setsockopt with SO_REUSEADDR because Microsoft allows
+	 * addresses to be reused even if they are still in use.
+         *
+         * Bind should not be affected by the socket having already been
+         * set into nonblocking mode. If there is trouble, this is one
+	 * place to look for bugs.
+	 */
+    
+	if (bind(sock, addr->ai_addr,
+		addr->ai_addrlen) == SOCKET_ERROR) {
+            goto error2;
+        }
+
+	FreeSocketAddress(hostaddr);
+
+        /*
+         * Set the maximum number of pending connect requests to the
+         * max value allowed on each platform (Win32 and Win32s may be
+         * different, and there may be differences between TCP/IP stacks).
+         */
+        
+	if (listen(sock, SOMAXCONN) == SOCKET_ERROR) {
+	    goto error1;
+	}
+
+	/* create the queue for holding ready ones */
+	infoPtr->readyAccepts = IocpLLCreate();
+
+	/* post default IOCP_INITIAL_ACCEPT_COUNT accepts. */
+        for(i=0; i < IOCP_ACCEPT_CAP ;i++) {
+	    BufferInfo *bufPtr;
+	    bufPtr = GetBufferObj(infoPtr, 0);
+	    if (PostOverlappedAccept(infoPtr, bufPtr, 0) != NO_ERROR) {
+		/* Oh no, the AcceptEx failed. */
+		FreeBufferObj(bufPtr);
+		goto error1;
+	    }
+        }
+
+    } else {
+
+        /*
+         * bind to a local address.  ConnectEx needs this.
+         */
+
+	if (bind(sock, mysockaddr->ai_addr,
+		mysockaddr->ai_addrlen) == SOCKET_ERROR) {
+	    FreeSocketAddress(mysockaddr);
+	    goto error2;
+	}
+	FreeSocketAddress(mysockaddr);
+
+	/*
+	 * Attempt to connect to the remote.
+	 */
+
+	if (async) {
+	    bufPtr = GetBufferObj(infoPtr, 0);
+	    bufPtr->operation = OP_CONNECT;
+
+	    /*
+	     * Associate the socket and its SocketInfo struct to the
+	     * completion port.  Implies an automatic set to
+	     * non-blocking.
+	     */
+	    if (CreateIoCompletionPort((HANDLE)sock, IocpSubSystem.port,
+		    (ULONG_PTR)infoPtr, 0) == NULL) {
+		WSASetLastError(GetLastError());
+		goto error2;
+	    }
+
+	    InterlockedIncrement(&infoPtr->outstandingOps);
+
+	    code = pdata->_ConnectEx(sock, addr->ai_addr,
+		    addr->ai_addrlen, NULL, 0, &bytes, &bufPtr->ol);
+
+	    FreeSocketAddress(hostaddr);
+
+	    if (code == FALSE) {
+		if (WSAGetLastError() != WSA_IO_PENDING) {
+		    InterlockedDecrement(&infoPtr->outstandingOps);
+		    FreeBufferObj(bufPtr);
+		    goto error1;
+		}
+	    }
+	} else {
+	    code = connect(sock, addr->ai_addr, addr->ai_addrlen);
+	    FreeSocketAddress(hostaddr);
+	    if (code == SOCKET_ERROR) {
+		goto error1;
+	    }
+
+	    /* Associate the socket and its SocketInfo struct to the
+	     * completion port.  Implies an automatic set to
+	     * non-blocking. */
+	    if (CreateIoCompletionPort((HANDLE)sock, IocpSubSystem.port,
+		    (ULONG_PTR)infoPtr, 0) == NULL) {
+		WSASetLastError(GetLastError());
+		goto error1;
+	    }
+
+	    infoPtr->llPendingRecv = IocpLLCreate();
+
+	    /* post IOCP_INITIAL_RECV_COUNT recvs. */
+	    for(i=0; i < IOCP_INITIAL_RECV_COUNT ;i++) {
+		bufPtr = GetBufferObj(infoPtr,
+			(infoPtr->recvMode == IOCP_RECVMODE_ZERO_BYTE ? 0 : IOCP_RECV_BUFSIZE));
+		if (PostOverlappedRecv(infoPtr, bufPtr, 0, 0)) {
+		    FreeBufferObj(bufPtr);
+		    goto error1;
+		}
+	    }
+#if 0
+	    {
+		int ret;
+		QOS clientQos;
+		DWORD dwBytes;
+
+		ZeroMemory(&clientQos, sizeof(QOS));
+		clientQos.SendingFlowspec = flowspec_g711;
+		clientQos.ReceivingFlowspec =  flowspec_notraffic;
+		clientQos.ProviderSpecific.buf = NULL;
+		clientQos.ProviderSpecific.len = 0;
+
+		/*clientQos.SendingFlowspec.ServiceType |= 
+			SERVICE_NO_QOS_SIGNALING;
+		clientQos.ReceivingFlowspec.ServiceType |= 
+			SERVICE_NO_QOS_SIGNALING;*/
+
+		ret = WSAIoctl(sock, SIO_SET_QOS, &clientQos, 
+		    sizeof(clientQos), NULL, 0, &dwBytes, NULL, NULL);
+	    }
+		bufPtr = GetBufferObj(infoPtr, QOS_BUFFER_SZ);
+		PostOverlappedQOS(infoPtr, bufPtr);
+#endif
+	}
+    }
+
+    return infoPtr;
+
+error2:
+    FreeSocketAddress(hostaddr);
+error1:
+    FreeSocketInfo(infoPtr);
+    if (interp != NULL) {
+	Tcl_AppendResult(interp, "couldn't open socket: ",
+		Tcl_WinError(interp, WSAGetLastError()), NULL);
+    }
+    return NULL;
+}

win/tclWinsockUDP.c

@@ -0,0 +1,322 @@
+/* reserved for Pat Thoyts and tcludp */
+#include "tclWinInt.h"
+#include "tclWinsockCore.h"
+
+/* ISO hack for dumb VC++ */
+#ifdef _MSC_VER
+#define   snprintf	_snprintf
+#endif
+
+static Tcl_NetCreateClientProc OpenUdpClientChannel;
+
+WS2ProtocolData udpAnyProtoData = {
+    AF_INET,
+    SOCK_DGRAM,
+    IPPROTO_UDP,
+    sizeof(SOCKADDR_IN),
+    AF_UNSPEC,
+    OpenUdpClientChannel,
+    NULL,
+    DecodeIpSockaddr,
+    NULL, /* resolver */
+    NULL,
+    NULL,
+    NULL,
+    NULL,
+    NULL,
+    NULL,
+    NULL
+};
+
+WS2ProtocolData udp4ProtoData = {
+    AF_INET,
+    SOCK_DGRAM,
+    IPPROTO_UDP,
+    sizeof(SOCKADDR_IN),
+    AF_INET,
+    OpenUdpClientChannel,
+    NULL,
+    DecodeIpSockaddr,
+    NULL, /* resolver */
+    NULL,
+    NULL,
+    NULL,
+    NULL,
+    NULL,
+    NULL
+};
+
+WS2ProtocolData udp6ProtoData = {
+    AF_INET6,
+    SOCK_DGRAM,
+    IPPROTO_UDP,
+    sizeof(SOCKADDR_IN6),
+    AF_INET6,
+    OpenUdpClientChannel,
+    NULL,
+    DecodeIpSockaddr,
+    NULL,
+    NULL,
+    NULL,
+    NULL,
+    NULL,
+    NULL,
+    NULL
+};
+
+static SocketInfo *	CreateUdpSocket(Tcl_Interp *interp,
+				const char *port, const char *host,
+				const char *myaddr,
+				const char *myport, int afhint);
+
+
+Tcl_Channel
+OpenUdpClientChannel(
+    Tcl_Interp *interp,		/* For error reporting; can be NULL. */
+    const char *port,		/* Port (number|service) to open. */
+    const char *host,		/* Host on which to open port. */
+    const char *myaddr,		/* Client-side address. */
+    const char *myport,		/* Client-side port (number|service).*/
+    int async,			/* If nonzero, should connect
+				 * client socket asynchronously. */
+    int afhint)
+{
+    SocketInfo *infoPtr;
+    char channelName[4 + TCL_INTEGER_SPACE];
+
+
+    /*
+     * Create a new client socket and wrap it in a channel.
+     */
+
+    infoPtr = CreateUdpSocket(interp, port, host, myaddr, myport, afhint);
+    if (infoPtr == NULL) {
+	return NULL;
+    }
+    snprintf(channelName, 4 + TCL_INTEGER_SPACE, "sock%lu", infoPtr->socket);
+    infoPtr->channel = Tcl_CreateChannel(&IocpPacketChannelType, channelName,
+	    (ClientData) infoPtr, (TCL_READABLE | TCL_WRITABLE));
+    if (Tcl_SetChannelOption(interp, infoPtr->channel, "-translation",
+	    "binary") == TCL_ERROR) {
+        Tcl_Close((Tcl_Interp *) NULL, infoPtr->channel);
+        return (Tcl_Channel) NULL;
+    }
+    if (Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "")
+	    == TCL_ERROR) {
+        Tcl_Close((Tcl_Interp *) NULL, infoPtr->channel);
+        return (Tcl_Channel) NULL;
+    }
+
+    return infoPtr->channel;
+}
+
+SocketInfo *
+CreateUdpSocket(
+	Tcl_Interp *interp,
+	const char *port,
+	const char *host,
+	const char *myaddr,
+	const char *myport,
+	int afhint)
+{
+    u_long flag = 1;		/* Indicates nonblocking mode. */
+    int asyncConnect = 0;	/* Will be 1 if async connect is
+				 * in progress. */
+    LPADDRINFO hostaddr;	/* Socket address for peer */
+    LPADDRINFO mysockaddr;	/* Socket address for client */
+    SOCKET sock = INVALID_SOCKET;
+    SocketInfo *infoPtr = NULL;	/* The returned value. */
+    BufferInfo *bufPtr;		/* The returned value. */
+    DWORD reuse;
+    BOOL code;
+    int i;
+    WS2ProtocolData *pdata;
+    ADDRINFO hints;
+    LPADDRINFO addr;
+    WSAPROTOCOL_INFO wpi;
+    ThreadSpecificData *tsdPtr = InitSockets();
+
+    ZeroMemory(&hints, sizeof(hints));
+    hints.ai_family   = afhint;
+    hints.ai_socktype = SOCK_STREAM;
+    hints.ai_protocol = IPPROTO_TCP;
+
+    if (host == NULL && !strcmp(port, "0")) {
+	/* Win2K hack.  Ask for port 1, then set to 0 so getaddrinfo() doesn't bomb. */
+	if (! CreateSocketAddress(host, "1", &hints, &hostaddr)) {
+	    goto error1;
+	}
+	addr = hostaddr;
+	while (addr) {
+	    if (addr->ai_family == AF_INET) {
+		((LPSOCKADDR_IN)addr->ai_addr)->sin_port = INADDR_ANY;
+	    } else {
+		IN6ADDR_SETANY((LPSOCKADDR_IN6) addr->ai_addr);
+	    }
+	    addr = addr->ai_next;
+	}
+    } else {
+	if (! CreateSocketAddress(host, port, &hints, &hostaddr)) {
+	    goto error1;
+	}
+    }
+    addr = hostaddr;
+
+    if (myaddr != NULL || myport != NULL) {
+	if (!CreateSocketAddress(myaddr, myport, addr, &mysockaddr)) {
+	    goto error2;
+	}
+    } else if (1) {
+	/* Win2K hack.  Ask for port 1, then set to 0 so getaddrinfo() doesn't bomb. */
+	if (!CreateSocketAddress(NULL, "1", addr, &mysockaddr)) {
+	    goto error2;
+	}
+	if (mysockaddr->ai_family == AF_INET) {
+	    ((LPSOCKADDR_IN)mysockaddr->ai_addr)->sin_port = INADDR_ANY;
+	} else {
+	    IN6ADDR_SETANY((LPSOCKADDR_IN6) mysockaddr->ai_addr);
+	}
+    }
+
+
+    switch (addr->ai_family) {
+    case AF_INET:
+	pdata = &udp4ProtoData; break;
+    case AF_INET6:
+	pdata = &udp6ProtoData; break;
+    default:
+	Tcl_Panic("very bad protocol family returned from getaddrinfo()");
+    }
+
+    code = FindProtocolInfo(pdata->af, pdata->type, pdata->protocol,
+	    0 /*XP1_QOS_SUPPORTED*/, &wpi);
+    if (code == FALSE) {
+	goto error2;
+    }
+
+    sock = WSASocket(FROM_PROTOCOL_INFO, FROM_PROTOCOL_INFO,
+	    FROM_PROTOCOL_INFO, &wpi, 0, WSA_FLAG_OVERLAPPED);
+    if (sock == INVALID_SOCKET) {
+	goto error2;
+    }
+
+    IocpInitProtocolData(sock, pdata);
+
+    /*
+     * Win-NT has a misfeature that sockets are inherited in child
+     * processes by default.  Turn off the inherit bit.
+     */
+
+    SetHandleInformation((HANDLE)sock, HANDLE_FLAG_INHERIT, 0);
+
+    /*
+     * Turn off the internal send buffing.  We get more speed and are
+     * more efficient by reducing memcpy calls as the stack will use
+     * our overlapped buffers directly.
+     */
+
+    i = 0;
+    if (setsockopt(sock, SOL_SOCKET, SO_SNDBUF,
+	    (const char *) &i, sizeof(int)) == SOCKET_ERROR) {
+	goto error2;
+    }
+
+#if 1
+    /*
+     * Allow us to hijack, or be hijacked
+     */
+    reuse = TRUE;
+    if (setsockopt(sock, SOL_SOCKET, SO_REUSEADDR,
+	    (const char *) &reuse, sizeof(DWORD)) == SOCKET_ERROR) {
+	goto error2;
+    }
+#endif
+
+    infoPtr = NewSocketInfo(sock);
+    infoPtr->proto = pdata;
+
+    /* Info needed to get back to this thread. */
+    infoPtr->tsdHome = tsdPtr;
+
+    /*
+     * bind to a local address.  ConnectEx needs this.
+     */
+
+    if (bind(sock, mysockaddr->ai_addr,
+	    mysockaddr->ai_addrlen) == SOCKET_ERROR) {
+	FreeSocketAddress(mysockaddr);
+	goto error2;
+    }
+    FreeSocketAddress(mysockaddr);
+
+#if 0
+    /*
+     * Associate remote for filtering.
+     */
+
+    code = connect(sock, addr->ai_addr, addr->ai_addrlen);
+    FreeSocketAddress(hostaddr);
+    if (code == SOCKET_ERROR) {
+	goto error1;
+    }
+#endif
+
+    /*
+     * Associate the socket and its SocketInfo struct to the
+     * completion port.  This implies an automatic set to
+     * non-blocking.  We emulate blocking to the Tcl side.
+     */
+    if (CreateIoCompletionPort((HANDLE)sock, IocpSubSystem.port,
+	    (ULONG_PTR)infoPtr, 0) == NULL) {
+	WSASetLastError(GetLastError());
+	goto error1;
+    }
+
+    infoPtr->llPendingRecv = IocpLLCreate();
+
+    /* post IOCP_INITIAL_RECV_COUNT recvs. */
+    for(i=0; i < IOCP_INITIAL_RECV_COUNT ;i++) {
+	bufPtr = GetBufferObj(infoPtr,
+		(infoPtr->recvMode == IOCP_RECVMODE_ZERO_BYTE ? 0 : IOCP_RECV_BUFSIZE));
+	if (PostOverlappedRecv(infoPtr, bufPtr, 0, 0)) {
+	    FreeBufferObj(bufPtr);
+	    goto error1;
+	}
+    }
+#if 0
+    {
+	int ret;
+	QOS clientQos;
+	DWORD dwBytes;
+
+	ZeroMemory(&clientQos, sizeof(QOS));
+	clientQos.SendingFlowspec = flowspec_g711;
+	clientQos.ReceivingFlowspec =  flowspec_notraffic;
+	clientQos.ProviderSpecific.buf = NULL;
+	clientQos.ProviderSpecific.len = 0;
+
+	/*clientQos.SendingFlowspec.ServiceType |= 
+		SERVICE_NO_QOS_SIGNALING;
+	clientQos.ReceivingFlowspec.ServiceType |= 
+		SERVICE_NO_QOS_SIGNALING;*/
+
+	ret = WSAIoctl(sock, SIO_SET_QOS, &clientQos, 
+	    sizeof(clientQos), NULL, 0, &dwBytes, NULL, NULL);
+    }
+    bufPtr = GetBufferObj(infoPtr, QOS_BUFFER_SZ);
+    PostOverlappedQOS(infoPtr, bufPtr);
+#endif
+
+    return infoPtr;
+
+error2:
+    FreeSocketAddress(hostaddr);
+error1:
+    TclWinConvertWSAError(WSAGetLastError());
+    if (interp != NULL) {
+	Tcl_AppendResult(interp, "couldn't open socket: ",
+		Tcl_PosixError(interp), NULL);
+    }
+    FreeSocketInfo(infoPtr);
+    return NULL;
+}