diff options
| -rw-r--r-- | generic/tclEnsemble.c | 6 | ||||
| -rw-r--r-- | generic/tclFileName.c | 76 | ||||
| -rw-r--r-- | generic/tclHash.c | 4 | ||||
| -rw-r--r-- | generic/tclIOSock.c | 12 | ||||
| -rw-r--r-- | generic/tclLoad.c | 32 | ||||
| -rw-r--r-- | generic/tclOOInt.h | 15 | ||||
| -rw-r--r-- | generic/tclThreadAlloc.c | 8 | ||||
| -rw-r--r-- | generic/tclUtil.c | 11 | ||||
| -rw-r--r-- | generic/tclVar.c | 4 | ||||
| -rw-r--r-- | win/tclWinLoad.c | 229 | ||||
| -rw-r--r-- | win/tclWinSock.c | 399 |
11 files changed, 324 insertions, 472 deletions
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index 1283446..f33ad31 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -1823,11 +1823,6 @@ NsEnsembleImplementationCmdNR( * count both as inserted and removed arguments. */ -#if 0 - if (TclInitRewriteEnsemble(interp, 2 + ensemblePtr->numParameters, prefixObjc + ensemblePtr->numParameters, objv)) { - TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL); - } -#else if (iPtr->ensembleRewrite.sourceObjs == NULL) { iPtr->ensembleRewrite.sourceObjs = objv; iPtr->ensembleRewrite.numRemovedObjs = @@ -1848,7 +1843,6 @@ NsEnsembleImplementationCmdNR( iPtr->ensembleRewrite.numInsertedObjs += prefixObjc-2; } } -#endif /* * Hand off to the target command. diff --git a/generic/tclFileName.c b/generic/tclFileName.c index 90bf8d1..b6b89dd 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -2160,67 +2160,6 @@ DoGlob( } /* - * This block of code is not exercised by the Tcl test suite as of Tcl - * 8.5a0. Simplifications to the calling paths suggest it may not be - * necessary any more, since path separators are handled elsewhere. It is - * left in place in case new bugs are reported. - */ - -#if 0 /* PROBABLY_OBSOLETE */ - /* - * Deal with path separators. - */ - - if (pathPtr == NULL) { - /* - * Length used to be the length of the prefix, and lastChar the - * lastChar of the prefix. But, none of this is used any more. - */ - - int length = 0; - char lastChar = 0; - - switch (tclPlatform) { - case TCL_PLATFORM_WINDOWS: - /* - * If this is a drive relative path, add the colon and the - * trailing slash if needed. Otherwise add the slash if this is - * the first absolute element, or a later relative element. Add an - * extra slash if this is a UNC path. - */ - - if (*name == ':') { - Tcl_DStringAppend(&append, ":", 1); - if (count > 1) { - Tcl_DStringAppend(&append, "/", 1); - } - } else if ((*pattern != '\0') && (((length > 0) - && (strchr(separators, lastChar) == NULL)) - || ((length == 0) && (count > 0)))) { - Tcl_DStringAppend(&append, "/", 1); - if ((length == 0) && (count > 1)) { - Tcl_DStringAppend(&append, "/", 1); - } - } - - break; - case TCL_PLATFORM_UNIX: - /* - * Add a separator if this is the first absolute element, or a - * later relative element. - */ - - if ((*pattern != '\0') && (((length > 0) - && (strchr(separators, lastChar) == NULL)) - || ((length == 0) && (count > 0)))) { - Tcl_DStringAppend(&append, "/", 1); - } - break; - } - } -#endif /* PROBABLY_OBSOLETE */ - - /* * Look for the first matching pair of braces or the first directory * separator that is not inside a pair of braces. */ @@ -2278,8 +2217,8 @@ DoGlob( if (openBrace != NULL) { char *element; - Tcl_DString newName; + Tcl_DStringInit(&newName); /* @@ -2328,12 +2267,13 @@ DoGlob( */ if (*p != '\0') { + char savedChar = *p; + /* * Note that we are modifying the string in place. This won't work if * the string is a static. */ - char savedChar = *p; *p = '\0'; firstSpecialChar = strpbrk(pattern, "*[]?\\"); *p = savedChar; @@ -2398,6 +2338,7 @@ DoGlob( const char *bytes; int numBytes; Tcl_Obj *fixme, *newObj; + Tcl_ListObjIndex(NULL, matchesObj, repair, &fixme); bytes = Tcl_GetStringFromObj(fixme, &numBytes); newObj = Tcl_NewStringObj(bytes+2, numBytes-2); @@ -2418,6 +2359,9 @@ DoGlob( */ if (*p == '\0') { + int length; + Tcl_DString append; + /* * This is the code path reached by a command like 'glob foo'. * @@ -2430,9 +2374,6 @@ DoGlob( * approach). */ - int length; - Tcl_DString append; - Tcl_DStringInit(&append); Tcl_DStringAppend(&append, pattern, p-pattern); @@ -2464,8 +2405,9 @@ DoGlob( } } #if defined(__CYGWIN__) && !defined(__WIN32__) - DLLIMPORT extern int cygwin_conv_to_posix_path(const char *, char *); { + DLLIMPORT extern int cygwin_conv_to_posix_path(const char *, + char *); char winbuf[MAXPATHLEN+1]; cygwin_conv_to_posix_path(Tcl_DStringValue(&append), winbuf); diff --git a/generic/tclHash.c b/generic/tclHash.c index c8dc939..90be511 100644 --- a/generic/tclHash.c +++ b/generic/tclHash.c @@ -46,7 +46,9 @@ static int CompareArrayKeys(void *keyPtr, Tcl_HashEntry *hPtr); static unsigned int HashArrayKey(Tcl_HashTable *tablePtr, void *keyPtr); /* - * Prototypes for the one word hash key methods. + * Prototypes for the one word hash key methods. Not actually declared because + * this is a critical path that is implemented in the core hash table access + * function. */ #if 0 diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c index 6921af4..7b7b647 100644 --- a/generic/tclIOSock.c +++ b/generic/tclIOSock.c @@ -177,6 +177,7 @@ TclCreateSocketAddress( } hints.ai_socktype = SOCK_STREAM; + #if 0 /* * We found some problems when using AI_ADDRCONFIG, e.g. on systems that @@ -184,15 +185,16 @@ TclCreateSocketAddress( * localhost. See bugs 3385024, 3382419, 3382431. As the advantage of * using AI_ADDRCONFIG in situations where it works, is probably low, * we'll leave it out for now. After all, it is just an optimisation. - */ -#if defined(AI_ADDRCONFIG) && !defined(_AIX) && !defined(__hpux) - /* + * * Missing on: OpenBSD, NetBSD. * Causes failure when used on AIX 5.1 and HP-UX */ + +#if defined(AI_ADDRCONFIG) && !defined(_AIX) && !defined(__hpux) hints.ai_flags |= AI_ADDRCONFIG; -#endif -#endif +#endif /* AI_ADDRCONFIG && !_AIX && !__hpux */ +#endif /* 0 */ + if (willBind) { hints.ai_flags |= AI_PASSIVE; } diff --git a/generic/tclLoad.c b/generic/tclLoad.c index 202e66a..008a99d 100644 --- a/generic/tclLoad.c +++ b/generic/tclLoad.c @@ -873,40 +873,10 @@ Tcl_UnloadObjCmd( done: Tcl_DStringFree(&pkgName); Tcl_DStringFree(&tmp); - if (!complain && code!=TCL_OK) { + if (!complain && (code != TCL_OK)) { code = TCL_OK; Tcl_ResetResult(interp); } - if (code == TCL_OK) { -#if 0 - /* - * Result of [unload] was not documented in TIP#100, so force to be - * the empty string by commenting this out. DKF. - */ - - Tcl_Obj *resultObjPtr, *objPtr[2]; - - /* - * Our result is the two reference counts. - */ - - TclNewIntObj(objPtr[0], trustedRefCount); - TclNewIntObj(objPtr[1], safeRefCount); - if (objPtr[0] == NULL || objPtr[1] == NULL) { - if (objPtr[0]) { - Tcl_DecrRefCount(objPtr[0]); - } - if (objPtr[1]) { - Tcl_DecrRefCount(objPtr[1]); - } - } else { - TclNewListObj(resultObjPtr, 2, objPtr); - if (resultObjPtr != NULL) { - Tcl_SetObjResult(interp, resultObjPtr); - } - } -#endif - } return code; } diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h index 2d6f324..7988452 100644 --- a/generic/tclOOInt.h +++ b/generic/tclOOInt.h @@ -381,21 +381,6 @@ typedef struct CallContext { #define DESTRUCTOR 0x10 /* This is a destructor. */ /* - * Assorted flags for call frames. Note that bits 1 and 2 are already taken by - * Tcl itself. - */ - -#if 0 -#define FRAME_IS_METHOD 0x4 /* The frame is a method body, and the frame's - * clientData field contains a CallContext - * reference. */ -#define FRAME_IS_OO_DEFINE 0x8 /* The frame is part of the inside workings of - * the [oo::define] command; the clientData - * field contains an Object reference that has - * been confirmed to refer to a class. */ -#endif - -/* * Structure containing definition information about basic class methods. */ diff --git a/generic/tclThreadAlloc.c b/generic/tclThreadAlloc.c index ad1d510..e4261d6 100644 --- a/generic/tclThreadAlloc.c +++ b/generic/tclThreadAlloc.c @@ -812,15 +812,7 @@ LockBucket( Cache *cachePtr, int bucket) { -#if 0 - if (Tcl_MutexTryLock(bucketInfo[bucket].lockPtr) != TCL_OK) { - Tcl_MutexLock(bucketInfo[bucket].lockPtr); - cachePtr->buckets[bucket].numWaits++; - sharedPtr->buckets[bucket].numWaits++; - } -#else Tcl_MutexLock(bucketInfo[bucket].lockPtr); -#endif cachePtr->buckets[bucket].numLocks++; sharedPtr->buckets[bucket].numLocks++; } diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 6ce430b..a1c1996 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -4121,20 +4121,9 @@ TclReToGlob( *exactPtr = (anchorLeft && anchorRight); } -#if 0 - fprintf(stderr, "INPUT RE '%.*s' OUTPUT GLOB '%s' anchor %d:%d \n", - reStrLen, reStr, - Tcl_DStringValue(dsPtr), anchorLeft, anchorRight); - fflush(stderr); -#endif return TCL_OK; invalidGlob: -#if 0 - fprintf(stderr, "INPUT RE '%.*s' NO OUTPUT GLOB %s (%c)\n", - reStrLen, reStr, msg, *p); - fflush(stderr); -#endif if (interp != NULL) { Tcl_AppendResult(interp, msg, NULL); Tcl_SetErrorCode(interp, "TCL", "RE2GLOB", code, NULL); diff --git a/generic/tclVar.c b/generic/tclVar.c index 4df5d43..1bf4abc 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -762,7 +762,7 @@ TclObjLookupVarEx( } donePart1: -#if 0 +#if 0 /* ENABLE_NS_VARNAME_CACHING perhaps? */ if (varPtr == NULL) { if (flags & TCL_LEAVE_ERR_MSG) { part1 = TclGetString(part1Ptr); @@ -1892,7 +1892,7 @@ TclPtrSetVar( varPtr->value.objPtr = NULL; } if (flags & (TCL_APPEND_VALUE|TCL_LIST_ELEMENT)) { -#if 0 +#if 0 /* ENABLE_NS_VARNAME_CACHING perhaps? */ /* * Can't happen now! */ diff --git a/win/tclWinLoad.c b/win/tclWinLoad.c index 3f4d4d9..5848daa 100644 --- a/win/tclWinLoad.c +++ b/win/tclWinLoad.c @@ -14,24 +14,22 @@ #include "tclWinInt.h" /* - * Mutex protecting static data in this file; + * Native name of the directory in the native filesystem where DLLs used in + * this process are copied prior to loading, and mutex used to protect its + * allocation. */ -static Tcl_Mutex loadMutex; +static WCHAR *dllDirectoryName = NULL; +static Tcl_Mutex dllDirectoryNameMutex; /* - * Name of the directory in the native filesystem where DLLs used in this - * process are copied prior to loading. + * Static functions defined within this file. */ -static WCHAR* dllDirectoryName = NULL; - -/* Static functions defined within this file */ - -void* FindSymbol(Tcl_Interp* interp, Tcl_LoadHandle loadHandle, - const char* symbol); -void UnloadFile(Tcl_LoadHandle loadHandle); - +static void * FindSymbol(Tcl_Interp *interp, + Tcl_LoadHandle loadHandle, const char *symbol); +static void InitDLLDirectoryName(void); +static void UnloadFile(Tcl_LoadHandle loadHandle); /* *---------------------------------------------------------------------- @@ -75,8 +73,7 @@ TclpDlopen( */ nativeName = Tcl_FSGetNativePath(pathPtr); - hInstance = LoadLibraryEx(nativeName, NULL, - LOAD_WITH_ALTERED_SEARCH_PATH); + hInstance = LoadLibraryEx(nativeName,NULL,LOAD_WITH_ALTERED_SEARCH_PATH); if (hInstance == NULL) { /* * Let the OS loader examine the binary search path for whatever @@ -85,9 +82,8 @@ TclpDlopen( */ Tcl_DString ds; - const char *fileName = Tcl_GetString(pathPtr); - nativeName = Tcl_WinUtfToTChar(fileName, -1, &ds); + nativeName = Tcl_WinUtfToTChar(Tcl_GetString(pathPtr), -1, &ds); hInstance = LoadLibraryEx(nativeName, NULL, LOAD_WITH_ALTERED_SEARCH_PATH); Tcl_DStringFree(&ds); @@ -96,23 +92,6 @@ TclpDlopen( if (hInstance == NULL) { DWORD lastError = GetLastError(); -#if 0 - /* - * It would be ideal if the FormatMessage stuff worked better, but - * unfortunately it doesn't seem to want to... - */ - - LPTSTR lpMsgBuf; - char *buf; - int size; - - size = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | - FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, lastError, 0, - (LPTSTR) &lpMsgBuf, 0, NULL); - buf = ckalloc(TCL_INTEGER_SPACE + size + 1); - sprintf(buf, "%d %s", lastError, (char *)lpMsgBuf); -#endif - Tcl_AppendResult(interp, "couldn't load library \"", Tcl_GetString(pathPtr), "\": ", NULL); @@ -185,24 +164,25 @@ TclpDlopen( *---------------------------------------------------------------------- */ -void * +static void * FindSymbol( Tcl_Interp *interp, Tcl_LoadHandle loadHandle, const char *symbol) { + HINSTANCE hInstance = (HINSTANCE) loadHandle->clientData; Tcl_PackageInitProc *proc = NULL; - HINSTANCE hInstance = (HINSTANCE)(loadHandle->clientData); /* * For each symbol, check for both Symbol and _Symbol, since Borland * generates C symbols with a leading '_' by default. */ - proc = (void*) GetProcAddress(hInstance, symbol); + proc = (void *) GetProcAddress(hInstance, symbol); if (proc == NULL) { Tcl_DString ds; - const char* sym2; + const char *sym2; + Tcl_DStringInit(&ds); Tcl_DStringAppend(&ds, "_", 1); sym2 = Tcl_DStringAppend(&ds, symbol, -1); @@ -234,7 +214,7 @@ FindSymbol( *---------------------------------------------------------------------- */ -void +static void UnloadFile( Tcl_LoadHandle loadHandle) /* loadHandle returned by a previous call to * TclpDlopen(). The loadHandle is a token @@ -277,7 +257,7 @@ TclGuessPackageName( } /* - *----------------------------------------------------------------------------- + *---------------------------------------------------------------------- * * TclpTempFileNameForLibrary -- * @@ -287,86 +267,125 @@ TclGuessPackageName( * Returns the constructed file name. * * On Windows, a DLL is identified by the final component of its path name. - * Cross linking among DLL's (and hence, preloading) will not work unless - * this name is preserved when copying a DLL from a VFS to a temp file for - * preloading. For this reason, all DLLs in a given process are copied - * to a temp directory, and their names are preserved. + * Cross linking among DLL's (and hence, preloading) will not work unless this + * name is preserved when copying a DLL from a VFS to a temp file for + * preloading. For this reason, all DLLs in a given process are copied to a + * temp directory, and their names are preserved. * - *----------------------------------------------------------------------------- + *---------------------------------------------------------------------- */ -Tcl_Obj* -TclpTempFileNameForLibrary(Tcl_Interp* interp, /* Tcl interpreter */ - Tcl_Obj* path) /* Path name of the DLL in - * the VFS */ +Tcl_Obj * +TclpTempFileNameForLibrary( + Tcl_Interp *interp, /* Tcl interpreter. */ + Tcl_Obj *path) /* Path name of the DLL in the VFS. */ { - size_t nameLen; /* Length of the temp folder name */ - WCHAR name[MAX_PATH]; /* Path name of the temp folder */ - BOOL status; /* Status from Win32 API calls */ - Tcl_Obj* fileName; /* Name of the temp file */ - Tcl_Obj* tail; /* Tail of the source path */ + Tcl_Obj *fileName; /* Name of the temp file. */ + Tcl_Obj *tail; /* Tail of the source path. */ - /* - * Determine the name of the directory to use, and create it. - * (Keep trying with new names until an attempt to create the directory - * succeeds) - */ - - nameLen = 0; + Tcl_MutexLock(&dllDirectoryNameMutex); if (dllDirectoryName == NULL) { - Tcl_MutexLock(&loadMutex); - if (dllDirectoryName == NULL) { - nameLen = GetTempPathW(MAX_PATH, name); - if (nameLen >= MAX_PATH-12) { - Tcl_SetErrno(ENAMETOOLONG); - nameLen = 0; - } else { - wcscpy(name+nameLen, L"TCLXXXXXXXX"); - nameLen += 11; - } - status = 1; - if (nameLen != 0) { - DWORD id; - int i = 0; - id = GetCurrentProcessId(); - for (;;) { - DWORD lastError; - wsprintfW(name+nameLen-8, L"%08x", id); - status = CreateDirectoryW(name, NULL); - if (status) { - break; - } - if ((lastError = GetLastError()) != ERROR_ALREADY_EXISTS) { - TclWinConvertError(lastError); - break; - } else if (++i > 256) { - TclWinConvertError(lastError); - break; - } - id *= 16777619; - } - } - if (status != 0) { - dllDirectoryName = ckalloc((nameLen+1) * sizeof(WCHAR)); - wcscpy(dllDirectoryName, name); - } + if (InitDLLDirectoryName() == TCL_ERROR) { + Tcl_AppendResult(interp, "couldn't create temporary directory: ", + Tcl_PosixError(interp), NULL); + Tcl_MutexUnlock(&dllDirectoryNameMutex); + return NULL; } - Tcl_MutexUnlock(&loadMutex); - } - if (dllDirectoryName == NULL) { - Tcl_AppendResult(interp, "couldn't create temporary directory: ", - Tcl_PosixError(interp), NULL); } + Tcl_MutexUnlock(&dllDirectoryNameMutex); + + /* + * Now we know where to put temporary DLLs, construct the name. + */ + fileName = TclpNativeToNormalized(dllDirectoryName); tail = TclPathPart(interp, path, TCL_PATH_TAIL); if (tail == NULL) { Tcl_DecrRefCount(fileName); return NULL; - } else { - Tcl_AppendToObj(fileName, "/", 1); - Tcl_AppendObjToObj(fileName, tail); - return fileName; } + Tcl_AppendToObj(fileName, "/", 1); + Tcl_AppendObjToObj(fileName, tail); + return fileName; +} + +/* + *---------------------------------------------------------------------- + * + * InitDLLDirectoryName -- + * + * Helper for TclpTempFileNameForLibrary; builds a temporary directory + * that is specific to the current process. Should only be called once + * per process start. Caller must hold dllDirectoryNameMutex. + * + * Results: + * Tcl result code. + * + * Side-effects: + * Creates temp directory. + * Allocates memory pointed to by dllDirectoryName. + * + *---------------------------------------------------------------------- + * [Candidate for process global?] + */ + +static int +InitDLLDirectoryName(void) +{ + size_t nameLen; /* Length of the temp folder name. */ + WCHAR name[MAX_PATH]; /* Path name of the temp folder. */ + DWORD id; /* The process id. */ + DWORD lastError; /* Last error to happen in Win API. */ + int i; + + /* + * Determine the name of the directory to use, and create it. (Keep + * trying with new names until an attempt to create the directory + * succeeds) + */ + + nameLen = GetTempPathW(MAX_PATH, name); + if (nameLen >= MAX_PATH-12) { + Tcl_SetErrno(ENAMETOOLONG); + return TCL_ERROR; + } + + wcscpy(name+nameLen, L"TCLXXXXXXXX"); + nameLen += 11; + + id = GetCurrentProcessId(); + lastError = ERROR_ALREADY_EXISTS; + + for (i=0 ; i<256 ; i++) { + wsprintfW(name+nameLen-8, L"%08x", id); + if (CreateDirectoryW(name, NULL)) { + /* + * Issue: we don't schedule this directory for deletion by anyone. + * Can we ask the OS to do this for us? There appears to be + * potential for using CreateFile (with the flag + * FILE_FLAG_BACKUP_SEMANTICS) and RemoveDirectory to do this... + */ + + goto copyToGlobalBuffer; + } + lastError = GetLastError(); + if (lastError != ERROR_ALREADY_EXISTS) { + break; + } + id *= 16777619; + } + + TclWinConvertError(lastError); + return TCL_ERROR; + + /* + * Store our computed value in the global. + */ + + copyToGlobalBuffer: + dllDirectoryName = ckalloc((nameLen+1) * sizeof(WCHAR)); + wcscpy(dllDirectoryName, name); + return TCL_OK; } /* diff --git a/win/tclWinSock.c b/win/tclWinSock.c index cbaedcb..2f14c17 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -47,6 +47,13 @@ #include "tclWinInt.h" +/* + * Which version of the winsock API do we want? + */ + +#define WSA_VERSION_MAJOR 1 +#define WSA_VERSION_MINOR 1 + #ifdef _MSC_VER # pragma comment (lib, "ws2_32") #endif @@ -91,16 +98,17 @@ static ProcessGlobalValue hostName = { * The following defines declare the messages used on socket windows. */ -#define SOCKET_MESSAGE WM_USER+1 -#define SOCKET_SELECT WM_USER+2 -#define SOCKET_TERMINATE WM_USER+3 -#define SELECT TRUE -#define UNSELECT FALSE +#define SOCKET_MESSAGE WM_USER+1 +#define SOCKET_SELECT WM_USER+2 +#define SOCKET_TERMINATE WM_USER+3 +#define SELECT TRUE +#define UNSELECT FALSE /* * This is needed to comply with the strict aliasing rules of GCC, but it also * simplifies casting between the different sockaddr types. */ + typedef union { struct sockaddr sa; struct sockaddr_in sa4; @@ -206,10 +214,6 @@ static WNDCLASS windowClass; static SocketInfo * CreateSocket(Tcl_Interp *interp, int port, const char *host, int server, const char *myaddr, int myport, int async); -#if 0 -static int CreateSocketAddress(LPSOCKADDR_IN sockaddrPtr, - const char *host, int port); -#endif static void InitSockets(void); static SocketInfo * NewSocketInfo(SOCKET socket); static void SocketExitHandler(ClientData clientData); @@ -284,9 +288,8 @@ static const Tcl_ChannelType tcpChannelType = { static void InitSockets(void) { - DWORD id; + DWORD id, err; WSADATA wsaData; - DWORD err; ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); if (!initialized) { @@ -322,11 +325,8 @@ InitSockets(void) * that it not be less than 1.1. */ -#define WSA_VERSION_MAJOR 1 -#define WSA_VERSION_MINOR 1 -#define WSA_VERSION_REQD MAKEWORD(WSA_VERSION_MAJOR, WSA_VERSION_MINOR) - - err = WSAStartup((WORD)WSA_VERSION_REQD, &wsaData); + err = WSAStartup((WORD) MAKEWORD(WSA_VERSION_MAJOR,WSA_VERSION_MINOR), + &wsaData); if (err != 0) { TclWinConvertError(err); goto initFailure; @@ -334,8 +334,8 @@ InitSockets(void) /* * Note the byte positions ae swapped for the comparison, so that - * 0x0002 (2.0, MAKEWORD(2,0)) doesn't look less than 0x0101 (1.1). - * We want the comparison to be 0x0200 < 0x0101. + * 0x0002 (2.0, MAKEWORD(2,0)) doesn't look less than 0x0101 (1.1). We + * want the comparison to be 0x0200 < 0x0101. */ if (MAKEWORD(HIBYTE(wsaData.wVersion), LOBYTE(wsaData.wVersion)) @@ -344,50 +344,54 @@ InitSockets(void) WSACleanup(); goto initFailure; } - -#undef WSA_VERSION_REQD -#undef WSA_VERSION_MAJOR -#undef WSA_VERSION_MINOR } /* * Check for per-thread initialization. */ - if (tsdPtr == NULL) { - tsdPtr = TCL_TSD_INIT(&dataKey); - tsdPtr->socketList = NULL; - tsdPtr->hwnd = NULL; - tsdPtr->threadId = Tcl_GetCurrentThread(); - tsdPtr->readyEvent = CreateEvent(NULL, FALSE, FALSE, NULL); - if (tsdPtr->readyEvent == NULL) { - goto initFailure; - } - tsdPtr->socketListLock = CreateEvent(NULL, FALSE, TRUE, NULL); - if (tsdPtr->socketListLock == NULL) { - goto initFailure; - } - tsdPtr->socketThread = CreateThread(NULL, 256, SocketThread, tsdPtr, - 0, &id); - if (tsdPtr->socketThread == NULL) { - goto initFailure; - } + if (tsdPtr != NULL) { + return; + } - SetThreadPriority(tsdPtr->socketThread, THREAD_PRIORITY_HIGHEST); + /* + * OK, this thread has never done anything with sockets before. Construct + * a worker thread to handle asynchronous events related to sockets + * assigned to _this_ thread. + */ - /* - * Wait for the thread to signal when the window has been created and - * if it is ready to go. - */ + tsdPtr = TCL_TSD_INIT(&dataKey); + tsdPtr->socketList = NULL; + tsdPtr->hwnd = NULL; + tsdPtr->threadId = Tcl_GetCurrentThread(); + tsdPtr->readyEvent = CreateEvent(NULL, FALSE, FALSE, NULL); + if (tsdPtr->readyEvent == NULL) { + goto initFailure; + } + tsdPtr->socketListLock = CreateEvent(NULL, FALSE, TRUE, NULL); + if (tsdPtr->socketListLock == NULL) { + goto initFailure; + } + tsdPtr->socketThread = CreateThread(NULL, 256, SocketThread, tsdPtr, 0, + &id); + if (tsdPtr->socketThread == NULL) { + goto initFailure; + } - WaitForSingleObject(tsdPtr->readyEvent, INFINITE); + SetThreadPriority(tsdPtr->socketThread, THREAD_PRIORITY_HIGHEST); - if (tsdPtr->hwnd == NULL) { - goto initFailure; /* Trouble creating the window */ - } + /* + * Wait for the thread to signal when the window has been created and if + * it is ready to go. + */ + + WaitForSingleObject(tsdPtr->readyEvent, INFINITE); - Tcl_CreateEventSource(SocketSetupProc, SocketCheckProc, NULL); + if (tsdPtr->hwnd == NULL) { + goto initFailure; /* Trouble creating the window. */ } + + Tcl_CreateEventSource(SocketSetupProc, SocketCheckProc, NULL); return; initFailure: @@ -417,6 +421,7 @@ static int SocketsEnabled(void) { int enabled; + Tcl_MutexLock(&socketMutex); enabled = (initialized == 1); Tcl_MutexUnlock(&socketMutex); @@ -447,6 +452,7 @@ SocketExitHandler( ClientData clientData) /* Not used. */ { Tcl_MutexLock(&socketMutex); + /* * Make sure the socket event handling window is cleaned-up for, at * most, this thread. @@ -483,32 +489,38 @@ TclpFinalizeSockets(void) { ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); - if (tsdPtr != NULL) { - if (tsdPtr->socketThread != NULL) { - if (tsdPtr->hwnd != NULL) { - PostMessage(tsdPtr->hwnd, SOCKET_TERMINATE, 0, 0); + /* + * Careful! This is a finalizer! + */ - /* - * Wait for the thread to exit. This ensures that we are - * completely cleaned up before we leave this function. - */ + if (tsdPtr == NULL) { + return; + } - WaitForSingleObject(tsdPtr->readyEvent, INFINITE); - tsdPtr->hwnd = NULL; - } - CloseHandle(tsdPtr->socketThread); - tsdPtr->socketThread = NULL; - } - if (tsdPtr->readyEvent != NULL) { - CloseHandle(tsdPtr->readyEvent); - tsdPtr->readyEvent = NULL; - } - if (tsdPtr->socketListLock != NULL) { - CloseHandle(tsdPtr->socketListLock); - tsdPtr->socketListLock = NULL; + if (tsdPtr->socketThread != NULL) { + if (tsdPtr->hwnd != NULL) { + PostMessage(tsdPtr->hwnd, SOCKET_TERMINATE, 0, 0); + + /* + * Wait for the thread to exit. This ensures that we are + * completely cleaned up before we leave this function. + */ + + WaitForSingleObject(tsdPtr->readyEvent, INFINITE); + tsdPtr->hwnd = NULL; } - Tcl_DeleteEventSource(SocketSetupProc, SocketCheckProc, NULL); + CloseHandle(tsdPtr->socketThread); + tsdPtr->socketThread = NULL; + } + if (tsdPtr->readyEvent != NULL) { + CloseHandle(tsdPtr->readyEvent); + tsdPtr->readyEvent = NULL; } + if (tsdPtr->socketListLock != NULL) { + CloseHandle(tsdPtr->socketListLock); + tsdPtr->socketListLock = NULL; + } + Tcl_DeleteEventSource(SocketSetupProc, SocketCheckProc, NULL); } /* @@ -677,8 +689,7 @@ SocketEventProc( { SocketInfo *infoPtr; SocketEvent *eventPtr = (SocketEvent *) evPtr; - int mask = 0; - int events; + int mask = 0, events; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); TcpFdList *fds; @@ -739,6 +750,7 @@ SocketEventProc( */ Tcl_Time blockTime = { 0, 0 }; + Tcl_SetMaxBlockTime(&blockTime); mask |= TCL_READABLE|TCL_WRITABLE; } else if (events & FD_READ) { @@ -901,28 +913,28 @@ TcpClose2Proc( int flags) /* Flags that indicate which side to close. */ { SocketInfo *infoPtr = instanceData; - int errorCode = 0; - int sd; + int errorCode = 0, sd; /* * Shutdown the OS socket handle. */ - switch(flags) - { - case TCL_CLOSE_READ: - sd=SD_RECEIVE; - break; - case TCL_CLOSE_WRITE: - sd=SD_SEND; - break; - default: - if (interp) { - Tcl_AppendResult(interp, - "Socket close2proc called bidirectionally", NULL); - } - return TCL_ERROR; + + switch (flags) { + case TCL_CLOSE_READ: + sd = SD_RECEIVE; + break; + case TCL_CLOSE_WRITE: + sd = SD_SEND; + break; + default: + if (interp) { + Tcl_AppendResult(interp, + "Socket close2proc called bidirectionally", NULL); } - if (shutdown(infoPtr->sockets->fd,sd) == SOCKET_ERROR) { + return TCL_ERROR; + } + + if (shutdown(infoPtr->sockets->fd, sd) == SOCKET_ERROR) { TclWinConvertError((DWORD) WSAGetLastError()); errorCode = Tcl_GetErrno(); } @@ -1012,8 +1024,10 @@ CreateSocket( int asyncConnect = 0; /* Will be 1 if async connect is in * progress. */ unsigned short chosenport = 0; - struct addrinfo *addrlist = NULL, *addrPtr; /* socket address */ - struct addrinfo *myaddrlist = NULL, *myaddrPtr; /* Socket address for client */ + struct addrinfo *addrlist = NULL, *addrPtr; + /* Socket address to connect to. */ + struct addrinfo *myaddrlist = NULL, *myaddrPtr; + /* Socket address for our side. */ const char *errorMsg = NULL; SOCKET sock = INVALID_SOCKET; SocketInfo *infoPtr = NULL; /* The returned value. */ @@ -1029,15 +1043,22 @@ CreateSocket( return NULL; } - if (!TclCreateSocketAddress(interp, &addrlist, host, port, server, &errorMsg)) { + /* + * Construct the addresses for each end of the socket. + */ + + if (!TclCreateSocketAddress(interp, &addrlist, host, port, server, + &errorMsg)) { goto error; } - if (!TclCreateSocketAddress(interp, &myaddrlist, myaddr, myport, 1, &errorMsg)) { + if (!TclCreateSocketAddress(interp, &myaddrlist, myaddr, myport, 1, + &errorMsg)) { goto error; } if (server) { TcpFdList *fds = NULL, *newfds; + for (addrPtr = addrlist; addrPtr != NULL; addrPtr = addrPtr->ai_next) { sock = socket(addrPtr->ai_family, SOCK_STREAM, 0); if (sock == INVALID_SOCKET) { @@ -1065,9 +1086,10 @@ CreateSocket( * As sockaddr_in6 uses the same offset and size for the port * member as sockaddr_in, we can handle both through the IPv4 API. */ + if (port == 0 && chosenport != 0) { ((struct sockaddr_in *) addrPtr->ai_addr)->sin_port = - htons(chosenport); + htons(chosenport); } /* @@ -1081,7 +1103,7 @@ CreateSocket( */ if (bind(sock, addrPtr->ai_addr, addrPtr->ai_addrlen) - == SOCKET_ERROR) { + == SOCKET_ERROR) { TclWinConvertError((DWORD) WSAGetLastError()); closesocket(sock); continue; @@ -1089,19 +1111,21 @@ CreateSocket( if (port == 0 && chosenport == 0) { address sockname; socklen_t namelen = sizeof(sockname); + /* * Synchronize port numbers when binding to port 0 of multiple * addresses. */ + if (getsockname(sock, &sockname.sa, &namelen) >= 0) { chosenport = ntohs(sockname.sa4.sin_port); } } /* - * 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). + * 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) { @@ -1144,6 +1168,7 @@ CreateSocket( * No need to try combinations of local and remote addresses * of different families. */ + if (myaddrPtr->ai_family != addrPtr->ai_family) { continue; } @@ -1165,14 +1190,14 @@ CreateSocket( * Set kernel space buffering */ - TclSockMinimumBuffers((void *)sock, TCP_BUFFER_SIZE); + TclSockMinimumBuffers((void *) sock, TCP_BUFFER_SIZE); /* * Try to bind to a local port. */ if (bind(sock, myaddrPtr->ai_addr, myaddrPtr->ai_addrlen) - == SOCKET_ERROR) { + == SOCKET_ERROR) { TclWinConvertError((DWORD) WSAGetLastError()); goto looperror; } @@ -1180,12 +1205,10 @@ CreateSocket( * Set the socket into nonblocking mode if the connect should * be done in the background. */ - if (async) { - if (ioctlsocket(sock, (long) FIONBIO, &flag) + if (async && ioctlsocket(sock, (long) FIONBIO, &flag) == SOCKET_ERROR) { - TclWinConvertError((DWORD) WSAGetLastError()); - goto looperror; - } + TclWinConvertError((DWORD) WSAGetLastError()); + goto looperror; } /* @@ -1193,7 +1216,7 @@ CreateSocket( */ if (connect(sock, addrPtr->ai_addr, addrPtr->ai_addrlen) - == SOCKET_ERROR) { + == SOCKET_ERROR) { TclWinConvertError((DWORD) WSAGetLastError()); if (Tcl_GetErrno() != EAGAIN) { goto looperror; @@ -1204,10 +1227,9 @@ CreateSocket( */ asyncConnect = 1; - goto connected; - } else { - goto connected; } + goto connected; + looperror: if (sock != INVALID_SOCKET) { closesocket(sock); @@ -1225,8 +1247,8 @@ CreateSocket( infoPtr = NewSocketInfo(sock); /* - * Set up the select mask for read/write events. If the - * connect attempt has not completed, include connect events. + * Set up the select mask for read/write events. If the connect + * attempt has not completed, include connect events. */ infoPtr->selectEvents = FD_READ | FD_WRITE | FD_CLOSE; @@ -1237,10 +1259,12 @@ CreateSocket( } error: - if (addrlist == NULL) + if (addrlist == NULL) { freeaddrinfo(addrlist); - if (myaddrlist == NULL) + } + if (myaddrlist == NULL) { freeaddrinfo(myaddrlist); + } /* * Register for interest in events in the select mask. Note that this @@ -1249,7 +1273,8 @@ CreateSocket( if (infoPtr != NULL) { ioctlsocket(sock, (long) FIONBIO, &flag); - SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, (LPARAM) infoPtr); + SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, + (LPARAM) infoPtr); return infoPtr; } @@ -1264,80 +1289,6 @@ CreateSocket( return NULL; } -#if 0 -/* - *---------------------------------------------------------------------- - * - * CreateSocketAddress -- - * - * This function initializes a sockaddr structure for a host and port. - * - * Results: - * 1 if the host was valid, 0 if the host could not be converted to an IP - * address. - * - * Side effects: - * Fills in the *sockaddrPtr structure. - * - *---------------------------------------------------------------------- - */ - -static int -CreateSocketAddress( - LPSOCKADDR_IN sockaddrPtr, /* Socket address */ - const char *host, /* Host. NULL implies INADDR_ANY */ - int port) /* Port number */ -{ - struct hostent *hostent; /* Host database entry */ - struct in_addr addr; /* For 64/32 bit madness */ - - /* - * 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()) { - Tcl_SetErrno(EFAULT); - return 0; - } - - ZeroMemory(sockaddrPtr, sizeof(SOCKADDR_IN)); - sockaddrPtr->sin_family = AF_INET; - sockaddrPtr->sin_port = htons((u_short) (port & 0xFFFF)); - if (host == NULL) { - addr.s_addr = INADDR_ANY; - } else { - addr.s_addr = inet_addr(host); - if (addr.s_addr == INADDR_NONE) { - hostent = gethostbyname(host); - if (hostent != NULL) { - memcpy(&addr, hostent->h_addr, (size_t) hostent->h_length); - } else { -#ifdef EHOSTUNREACH - Tcl_SetErrno(EHOSTUNREACH); -#else -#ifdef ENXIO - Tcl_SetErrno(ENXIO); -#endif -#endif - return 0; /* Error. */ - } - } - } - - /* - * NOTE: On 64 bit machines the assignment below is rumored to not do the - * right thing. Please report errors related to this if you observe - * incorrect behavior on 64 bit machines such as DEC Alphas. Should we - * modify this code to do an explicit memcpy? - */ - - sockaddrPtr->sin_addr.s_addr = addr.s_addr; - return 1; /* Success. */ -} -#endif - /* *---------------------------------------------------------------------- * @@ -1377,7 +1328,6 @@ WaitForSocketEvent( SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) UNSELECT, (LPARAM) infoPtr); - SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, (LPARAM) infoPtr); @@ -1452,17 +1402,16 @@ Tcl_OpenTcpClient( infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, 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; + if (TCL_ERROR == Tcl_SetChannelOption(NULL, infoPtr->channel, + "-translation", "auto crlf")) { + Tcl_Close(NULL, infoPtr->channel); + return NULL; + } else if (TCL_ERROR == Tcl_SetChannelOption(NULL, infoPtr->channel, + "-eofchar", "")) { + Tcl_Close(NULL, infoPtr->channel); + return NULL; } - return infoPtr->channel; + return infoPtr->channel } /* @@ -1510,8 +1459,7 @@ Tcl_MakeTcpClientChannel( */ infoPtr->selectEvents = FD_READ | FD_CLOSE | FD_WRITE; - SendMessage(tsdPtr->hwnd, SOCKET_SELECT, - (WPARAM) SELECT, (LPARAM) infoPtr); + SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)infoPtr); sprintf(channelName, "sock%Id", (size_t) infoPtr->sockets->fd); infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, @@ -1572,8 +1520,8 @@ Tcl_OpenTcpServer( infoPtr, 0); if (Tcl_SetChannelOption(interp, infoPtr->channel, "-eofchar", "") == TCL_ERROR) { - Tcl_Close((Tcl_Interp *) NULL, infoPtr->channel); - return (Tcl_Channel) NULL; + Tcl_Close(NULL, infoPtr->channel); + return NULL; } return infoPtr->channel; @@ -1614,12 +1562,13 @@ TcpAccept( len = sizeof(SOCKADDR_IN); - newSocket = accept(fds->fd, (SOCKADDR *)&addr, &len); + newSocket = accept(fds->fd, (SOCKADDR *) &addr, &len); /* * Protect access to sockets (acceptEventCount, readyEvents) in socketList * by the lock. Fix for SF Tcl Bug 3056775. */ + WaitForSingleObject(tsdPtr->socketListLock, INFINITE); /* @@ -1668,20 +1617,20 @@ TcpAccept( */ newInfoPtr->selectEvents = (FD_READ | FD_WRITE | FD_CLOSE); - SendMessage(tsdPtr->hwnd, SOCKET_SELECT, - (WPARAM) SELECT, (LPARAM) newInfoPtr); + SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, + (LPARAM) newInfoPtr); sprintf(channelName, "sock%Id", (size_t) newInfoPtr->sockets->fd); newInfoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, newInfoPtr, (TCL_READABLE | TCL_WRITABLE)); if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-translation", "auto crlf") == TCL_ERROR) { - Tcl_Close((Tcl_Interp *) NULL, newInfoPtr->channel); + Tcl_Close(NULL, newInfoPtr->channel); return; } if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-eofchar", "") == TCL_ERROR) { - Tcl_Close((Tcl_Interp *) NULL, newInfoPtr->channel); + Tcl_Close(NULL, newInfoPtr->channel); return; } @@ -1826,8 +1775,7 @@ TcpInputProc( } } - SendMessage(tsdPtr->hwnd, SOCKET_SELECT, - (WPARAM) SELECT, (LPARAM) infoPtr); + SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)infoPtr); return bytesRead; } @@ -1935,8 +1883,7 @@ TcpOutputProc( } } - SendMessage(tsdPtr->hwnd, SOCKET_SELECT, - (WPARAM) SELECT, (LPARAM) infoPtr); + SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)infoPtr); return bytesWritten; } @@ -2117,6 +2064,7 @@ TcpGetOptionProc( (strncmp(optionName, "-peername", len) == 0))) { address peername; socklen_t size = sizeof(peername); + if (getpeername(sock, (LPSOCKADDR) &(peername.sa), &size) == 0) { if (len == 0) { Tcl_DStringAppendElement(dsPtr, "-peername"); @@ -2170,8 +2118,8 @@ TcpGetOptionProc( size = sizeof(sockname); if (getsockname(sock, &(sockname.sa), &size) >= 0) { int flags = reverseDNS; - found = 1; + found = 1; getnameinfo(&sockname.sa, size, host, sizeof(host), NULL, 0, NI_NUMERICHOST); Tcl_DStringAppendElement(dsPtr, host); @@ -2299,7 +2247,7 @@ TcpWatchProc( /* * Update the watch events mask. Only if the socket is not a server - * socket. Fix for SF Tcl Bug #557878. + * socket. [Bug 557878] */ if (!infoPtr->acceptProc) { @@ -2318,6 +2266,7 @@ TcpWatchProc( if (infoPtr->readyEvents & infoPtr->watchEvents) { Tcl_Time blockTime = { 0, 0 }; + Tcl_SetMaxBlockTime(&blockTime); } } @@ -2379,8 +2328,8 @@ SocketThread( * Create a dummy window receiving socket events. */ - tsdPtr->hwnd = CreateWindow(classname, classname, - WS_TILED, 0, 0, 0, 0, NULL, NULL, windowClass.hInstance, arg); + tsdPtr->hwnd = CreateWindow(classname, classname, WS_TILED, 0, 0, 0, 0, + NULL, NULL, windowClass.hInstance, arg); /* * Signalize thread creator that we are done creating the window. @@ -2673,8 +2622,12 @@ InitializeHostName( */ int -TclWinGetSockOpt(SOCKET s, int level, int optname, char *optval, - int *optlen) +TclWinGetSockOpt( + SOCKET s, + int level, + int optname, + char *optval, + int *optlen) { /* * Check that WinSock is initialized; do not call it if not, to prevent @@ -2690,7 +2643,11 @@ TclWinGetSockOpt(SOCKET s, int level, int optname, char *optval, } int -TclWinSetSockOpt(SOCKET s, int level, int optname, const char *optval, +TclWinSetSockOpt( + SOCKET s, + int level, + int optname, + const char *optval, int optlen) { /* |