Tcl Source Code

Check-in [92cfbef048]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Reduce amount of unreachable code. Refactor Win socket and load code to be less baroque in its internals.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 92cfbef04802afe414b04f8fff6a36b61d5ae27d
User & Date: dkf 2012-04-05 09:34:56
References
2012-04-11
20:36
fix windows build broken by [92cfbef048] (Refactor Win socket and load code to be less baroque in it... check-in: c8d80a632a user: jan.nijtmans tags: trunk
Context
2012-04-06
23:44
merged check-in: 57ffafa704 user: jan.nijtmans tags: trunk
2012-04-05
16:29
merge trunk check-in: f24817c9e5 user: dkf tags: tip-400-impl
09:34
Reduce amount of unreachable code. Refactor Win socket and load code to be less baroque in its inter... check-in: 92cfbef048 user: dkf tags: trunk
2012-04-04
20:51
Fix [Bug 3514761] and related ensemble/construction problems. check-in: 9569a8471a user: dkf tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclEnsemble.c.

1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858

	/*
	 * Record what arguments the script sent in so that things like
	 * Tcl_WrongNumArgs can give the correct error message. Parameters
	 * 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 =
		    2 + ensemblePtr->numParameters;
	    iPtr->ensembleRewrite.numInsertedObjs =
		    prefixObjc + ensemblePtr->numParameters;
	    TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL,
		    NULL);
	} else {
	    register int ni = 2 + ensemblePtr->numParameters
		    - iPtr->ensembleRewrite.numInsertedObjs;
				/* Position in objv of new front of insertion
				 * relative to old one. */
	    if (ni > 0) {
		iPtr->ensembleRewrite.numRemovedObjs += ni;
		iPtr->ensembleRewrite.numInsertedObjs += prefixObjc-1;
	    } else {
		iPtr->ensembleRewrite.numInsertedObjs += prefixObjc-2;
	    }
	}
#endif

	/*
	 * Hand off to the target command.
	 */

	iPtr->evalFlags |= TCL_EVAL_REDIRECT;
	return Tcl_NREvalObj(interp, copyPtr, TCL_EVAL_INVOKE);







<
<
<
<
<




















<







1819
1820
1821
1822
1823
1824
1825





1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845

1846
1847
1848
1849
1850
1851
1852

	/*
	 * Record what arguments the script sent in so that things like
	 * Tcl_WrongNumArgs can give the correct error message. Parameters
	 * count both as inserted and removed arguments.
	 */






	if (iPtr->ensembleRewrite.sourceObjs == NULL) {
	    iPtr->ensembleRewrite.sourceObjs = objv;
	    iPtr->ensembleRewrite.numRemovedObjs =
		    2 + ensemblePtr->numParameters;
	    iPtr->ensembleRewrite.numInsertedObjs =
		    prefixObjc + ensemblePtr->numParameters;
	    TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL,
		    NULL);
	} else {
	    register int ni = 2 + ensemblePtr->numParameters
		    - iPtr->ensembleRewrite.numInsertedObjs;
				/* Position in objv of new front of insertion
				 * relative to old one. */
	    if (ni > 0) {
		iPtr->ensembleRewrite.numRemovedObjs += ni;
		iPtr->ensembleRewrite.numInsertedObjs += prefixObjc-1;
	    } else {
		iPtr->ensembleRewrite.numInsertedObjs += prefixObjc-2;
	    }
	}


	/*
	 * Hand off to the target command.
	 */

	iPtr->evalFlags |= TCL_EVAL_REDIRECT;
	return Tcl_NREvalObj(interp, copyPtr, TCL_EVAL_INVOKE);

Changes to generic/tclFileName.c.

2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
	    }
	} else if (strchr(separators, *pattern) == NULL) {
	    break;
	}
	count++;
    }

    /*
     * 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.
     */

    openBrace = closeBrace = NULL;
    quoted = 0;







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







2155
2156
2157
2158
2159
2160
2161





























































2162
2163
2164
2165
2166
2167
2168
	    }
	} else if (strchr(separators, *pattern) == NULL) {
	    break;
	}
	count++;
    }






























































    /*
     * Look for the first matching pair of braces or the first directory
     * separator that is not inside a pair of braces.
     */

    openBrace = closeBrace = NULL;
    quoted = 0;
2274
2275
2276
2277
2278
2279
2280
2281
2282

2283
2284
2285
2286
2287
2288
2289

    /*
     * Substitute the alternate patterns from the braces and recurse.
     */

    if (openBrace != NULL) {
	char *element;

	Tcl_DString newName;

	Tcl_DStringInit(&newName);

	/*
	 * For each element within in the outermost pair of braces, append the
	 * element and the remainder to the fixed portion before the first
	 * brace and recursively call DoGlob.
	 */







<

>







2213
2214
2215
2216
2217
2218
2219

2220
2221
2222
2223
2224
2225
2226
2227
2228

    /*
     * Substitute the alternate patterns from the braces and recurse.
     */

    if (openBrace != NULL) {
	char *element;

	Tcl_DString newName;

	Tcl_DStringInit(&newName);

	/*
	 * For each element within in the outermost pair of braces, append the
	 * element and the remainder to the fixed portion before the first
	 * brace and recursively call DoGlob.
	 */
2324
2325
2326
2327
2328
2329
2330


2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
     * Alternatively, if there are no globbing characters then again there are
     * two cases. If we're at the end of the string, we just need to check for
     * the given path's existence and type. If we're not at the end of the
     * string, we recurse.
     */

    if (*p != '\0') {


	/*
	 * 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;
    } else {
	firstSpecialChar = strpbrk(pattern, "*[]?\\");
    }








>
>





<







2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276

2277
2278
2279
2280
2281
2282
2283
     * Alternatively, if there are no globbing characters then again there are
     * two cases. If we're at the end of the string, we just need to check for
     * the given path's existence and type. If we're not at the end of the
     * string, we recurse.
     */

    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.
	 */


	*p = '\0';
	firstSpecialChar = strpbrk(pattern, "*[]?\\");
	*p = savedChar;
    } else {
	firstSpecialChar = strpbrk(pattern, "*[]?\\");
    }

2394
2395
2396
2397
2398
2399
2400

2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420



2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
		    Tcl_DecrRefCount(subdirv[i]);
		    subdirv[i] = copy;
		    Tcl_ListObjLength(NULL, matchesObj, &end);
		    while (repair < end) {
			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);
			Tcl_ListObjReplace(NULL, matchesObj, repair, 1,
				1, &newObj);
			repair++;
		    }
		    repair = -1;
		}
	    }
	}
	TclDecrRefCount(subdirsPtr);
	return result;
    }

    /*
     * We reach here with no pattern char in current section
     */

    if (*p == '\0') {



	/*
	 * This is the code path reached by a command like 'glob foo'.
	 *
	 * There are no more wildcards in the pattern and no more unprocessed
	 * characters in the pattern, so now we can construct the path, and
	 * pass it to Tcl_FSMatchInDirectory with an empty pattern to verify
	 * the existence of the file and check it is of the correct type (if a
	 * 'types' flag it given -- if no such flag was given, we could just
	 * use 'Tcl_FSLStat', but for simplicity we keep to a common
	 * approach).
	 */

	int length;
	Tcl_DString append;

	Tcl_DStringInit(&append);
	Tcl_DStringAppend(&append, pattern, p-pattern);

	if (pathPtr != NULL) {
	    (void) Tcl_GetStringFromObj(pathPtr, &length);
	} else {
	    length = 0;







>




















>
>
>












<
<
<







2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376



2377
2378
2379
2380
2381
2382
2383
		    Tcl_DecrRefCount(subdirv[i]);
		    subdirv[i] = copy;
		    Tcl_ListObjLength(NULL, matchesObj, &end);
		    while (repair < end) {
			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);
			Tcl_ListObjReplace(NULL, matchesObj, repair, 1,
				1, &newObj);
			repair++;
		    }
		    repair = -1;
		}
	    }
	}
	TclDecrRefCount(subdirsPtr);
	return result;
    }

    /*
     * We reach here with no pattern char in current section
     */

    if (*p == '\0') {
	int length;
	Tcl_DString append;

	/*
	 * This is the code path reached by a command like 'glob foo'.
	 *
	 * There are no more wildcards in the pattern and no more unprocessed
	 * characters in the pattern, so now we can construct the path, and
	 * pass it to Tcl_FSMatchInDirectory with an empty pattern to verify
	 * the existence of the file and check it is of the correct type (if a
	 * 'types' flag it given -- if no such flag was given, we could just
	 * use 'Tcl_FSLStat', but for simplicity we keep to a common
	 * approach).
	 */




	Tcl_DStringInit(&append);
	Tcl_DStringAppend(&append, pattern, p-pattern);

	if (pathPtr != NULL) {
	    (void) Tcl_GetStringFromObj(pathPtr, &length);
	} else {
	    length = 0;
2460
2461
2462
2463
2464
2465
2466
2467
2468


2469
2470
2471
2472
2473
2474
2475
		if ((*name == '\\' && name[1] == '/') || (*name == '/')) {
		    Tcl_DStringAppend(&append, "/", 1);
		} else {
		    Tcl_DStringAppend(&append, ".", 1);
		}
	    }
#if defined(__CYGWIN__) && !defined(__WIN32__)
	    DLLIMPORT extern int cygwin_conv_to_posix_path(const char *, char *);
	    {


		char winbuf[MAXPATHLEN+1];

		cygwin_conv_to_posix_path(Tcl_DStringValue(&append), winbuf);
		Tcl_DStringFree(&append);
		Tcl_DStringAppend(&append, winbuf, -1);
	    }
#endif /* __CYGWIN__ && __WIN32__ */







<

>
>







2401
2402
2403
2404
2405
2406
2407

2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
		if ((*name == '\\' && name[1] == '/') || (*name == '/')) {
		    Tcl_DStringAppend(&append, "/", 1);
		} else {
		    Tcl_DStringAppend(&append, ".", 1);
		}
	    }
#if defined(__CYGWIN__) && !defined(__WIN32__)

	    {
		DLLIMPORT extern int cygwin_conv_to_posix_path(const char *,
			char *);
		char winbuf[MAXPATHLEN+1];

		cygwin_conv_to_posix_path(Tcl_DStringValue(&append), winbuf);
		Tcl_DStringFree(&append);
		Tcl_DStringAppend(&append, winbuf, -1);
	    }
#endif /* __CYGWIN__ && __WIN32__ */

Changes to generic/tclHash.c.

42
43
44
45
46
47
48
49


50
51
52
53
54
55
56
 */

static Tcl_HashEntry *	AllocArrayEntry(Tcl_HashTable *tablePtr, void *keyPtr);
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.


 */

#if 0
static Tcl_HashEntry *	AllocOneWordEntry(Tcl_HashTable *tablePtr,
			    void *keyPtr);
static int		CompareOneWordKeys(void *keyPtr, Tcl_HashEntry *hPtr);
static unsigned int	HashOneWordKey(Tcl_HashTable *tablePtr, void *keyPtr);







|
>
>







42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
 */

static Tcl_HashEntry *	AllocArrayEntry(Tcl_HashTable *tablePtr, void *keyPtr);
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. Not actually declared because
 * this is a critical path that is implemented in the core hash table access
 * function.
 */

#if 0
static Tcl_HashEntry *	AllocOneWordEntry(Tcl_HashTable *tablePtr,
			    void *keyPtr);
static int		CompareOneWordKeys(void *keyPtr, Tcl_HashEntry *hPtr);
static unsigned int	HashOneWordKey(Tcl_HashTable *tablePtr, void *keyPtr);

Changes to generic/tclIOSock.c.

173
174
175
176
177
178
179

180
181
182
183
184
185
186
187
188
189

190
191
192


193
194
195

196
197
198
199
200
201
202
            } else if (strcmp(family, "inet6") == 0) {
                hints.ai_family = AF_INET6;
            }
        }
    }

    hints.ai_socktype = SOCK_STREAM;

#if 0
    /*
     * We found some problems when using AI_ADDRCONFIG, e.g. on systems that
     * have no networking besides the loopback interface and want to resolve
     * 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
     */


    hints.ai_flags |= AI_ADDRCONFIG;
#endif
#endif

    if (willBind) {
	hints.ai_flags |= AI_PASSIVE;
    } 

    result = getaddrinfo(native, portstring, &hints, addrlist);

    if (host != NULL) {







>







<
<
<
>



>
>

|
|
>







173
174
175
176
177
178
179
180
181
182
183
184
185
186
187



188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
            } else if (strcmp(family, "inet6") == 0) {
                hints.ai_family = AF_INET6;
            }
        }
    }

    hints.ai_socktype = SOCK_STREAM;

#if 0
    /*
     * We found some problems when using AI_ADDRCONFIG, e.g. on systems that
     * have no networking besides the loopback interface and want to resolve
     * 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.



     *
     * 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 /* AI_ADDRCONFIG && !_AIX && !__hpux */
#endif /* 0 */

    if (willBind) {
	hints.ai_flags |= AI_PASSIVE;
    } 

    result = getaddrinfo(native, portstring, &hints, addrlist);

    if (host != NULL) {

Changes to generic/tclLoad.c.

869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
	code = TCL_ERROR;
#endif
    }

  done:
    Tcl_DStringFree(&pkgName);
    Tcl_DStringFree(&tmp);
    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;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_StaticPackage --







|



<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







869
870
871
872
873
874
875
876
877
878
879






























880
881
882
883
884
885
886
	code = TCL_ERROR;
#endif
    }

  done:
    Tcl_DStringFree(&pkgName);
    Tcl_DStringFree(&tmp);
    if (!complain && (code != TCL_OK)) {
	code = TCL_OK;
	Tcl_ResetResult(interp);
    }






























    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_StaticPackage --

Changes to generic/tclOOInt.h.

376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
#define PUBLIC_METHOD     0x01	/* This is a public (exported) method. */
#define PRIVATE_METHOD    0x02	/* This is a private (class's direct instances
				 * only) method. */
#define OO_UNKNOWN_METHOD 0x04	/* This is an unknown method. */
#define CONSTRUCTOR	  0x08	/* This is a constructor. */
#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.
 */

typedef struct {
    const char *name;		/* Name of the method in question. */
    int isPublic;		/* Whether the method is public by default. */







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







376
377
378
379
380
381
382















383
384
385
386
387
388
389
#define PUBLIC_METHOD     0x01	/* This is a public (exported) method. */
#define PRIVATE_METHOD    0x02	/* This is a private (class's direct instances
				 * only) method. */
#define OO_UNKNOWN_METHOD 0x04	/* This is an unknown method. */
#define CONSTRUCTOR	  0x08	/* This is a constructor. */
#define DESTRUCTOR	  0x10	/* This is a destructor. */
















/*
 * Structure containing definition information about basic class methods.
 */

typedef struct {
    const char *name;		/* Name of the method in question. */
    int isPublic;		/* Whether the method is public by default. */

Changes to generic/tclThreadAlloc.c.

808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
 */

static void
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++;
}

static void
UnlockBucket(
    Cache *cachePtr,







<
<
|
<
<
<
<
<
<







808
809
810
811
812
813
814


815






816
817
818
819
820
821
822
 */

static void
LockBucket(
    Cache *cachePtr,
    int bucket)
{


    Tcl_MutexLock(bucketInfo[bucket].lockPtr);






    cachePtr->buckets[bucket].numLocks++;
    sharedPtr->buckets[bucket].numLocks++;
}

static void
UnlockBucket(
    Cache *cachePtr,

Changes to generic/tclUtil.c.

4117
4118
4119
4120
4121
4122
4123
4124
4125
4126
4127
4128
4129
4130
4131
4132
4133
4134
4135
4136
4137
4138
4139
4140
4141
4142
4143
4144
    }
    Tcl_DStringSetLength(dsPtr, dsStr - dsStrStart);

    if (exactPtr) {
	*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);
    }
    Tcl_DStringFree(dsPtr);
    return TCL_ERROR;
}







<
<
<
<
<
<



<
<
<
<
<







4117
4118
4119
4120
4121
4122
4123






4124
4125
4126





4127
4128
4129
4130
4131
4132
4133
    }
    Tcl_DStringSetLength(dsPtr, dsStr - dsStrStart);

    if (exactPtr) {
	*exactPtr = (anchorLeft && anchorRight);
    }







    return TCL_OK;

  invalidGlob:





    if (interp != NULL) {
	Tcl_AppendResult(interp, msg, NULL);
	Tcl_SetErrorCode(interp, "TCL", "RE2GLOB", code, NULL);
    }
    Tcl_DStringFree(dsPtr);
    return TCL_ERROR;
}

Changes to generic/tclVar.c.

758
759
760
761
762
763
764
765
766
767
768
769
770
771
772

	part1Ptr->typePtr = &tclParsedVarNameType;
	part1Ptr->internalRep.twoPtrValue.ptr1 = NULL;
	part1Ptr->internalRep.twoPtrValue.ptr2 = NULL;
    }

  donePart1:
#if 0
    if (varPtr == NULL) {
	if (flags & TCL_LEAVE_ERR_MSG) {
	    part1 = TclGetString(part1Ptr);
	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg,
		    "cached variable reference is NULL.", -1);
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
		    TclGetString(part1Ptr), NULL);







|







758
759
760
761
762
763
764
765
766
767
768
769
770
771
772

	part1Ptr->typePtr = &tclParsedVarNameType;
	part1Ptr->internalRep.twoPtrValue.ptr1 = NULL;
	part1Ptr->internalRep.twoPtrValue.ptr2 = NULL;
    }

  donePart1:
#if 0 /* ENABLE_NS_VARNAME_CACHING perhaps? */
    if (varPtr == NULL) {
	if (flags & TCL_LEAVE_ERR_MSG) {
	    part1 = TclGetString(part1Ptr);
	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg,
		    "cached variable reference is NULL.", -1);
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
		    TclGetString(part1Ptr), NULL);
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
     */

    oldValuePtr = varPtr->value.objPtr;
    if (flags & TCL_LIST_ELEMENT && !(flags & TCL_APPEND_VALUE)) {
	varPtr->value.objPtr = NULL;
    }
    if (flags & (TCL_APPEND_VALUE|TCL_LIST_ELEMENT)) {
#if 0
	/*
	 * Can't happen now!
	 */

	if (TclIsVarUndefined(varPtr) && (oldValuePtr != NULL)) {
	    TclDecrRefCount(oldValuePtr);	/* Discard old value. */
	    varPtr->value.objPtr = NULL;







|







1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
     */

    oldValuePtr = varPtr->value.objPtr;
    if (flags & TCL_LIST_ELEMENT && !(flags & TCL_APPEND_VALUE)) {
	varPtr->value.objPtr = NULL;
    }
    if (flags & (TCL_APPEND_VALUE|TCL_LIST_ELEMENT)) {
#if 0 /* ENABLE_NS_VARNAME_CACHING perhaps? */
	/*
	 * Can't happen now!
	 */

	if (TclIsVarUndefined(varPtr) && (oldValuePtr != NULL)) {
	    TclDecrRefCount(oldValuePtr);	/* Discard old value. */
	    varPtr->value.objPtr = NULL;

Changes to win/tclWinLoad.c.

10
11
12
13
14
15
16

17

18
19

20
21
22
23
24

25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclWinInt.h"

/*

 * Mutex protecting static data in this file;

 */


static Tcl_Mutex loadMutex;

/*
 * Name of the directory in the native filesystem where DLLs used in this
 * process are copied prior to loading.

 */

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);


/*
 *----------------------------------------------------------------------
 *
 * TclpDlopen --
 *
 *	Dynamically loads a binary code file into memory and returns a handle







>
|
>


>
|


<
<
>


|
|
<
|
<
<
|
<







10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25


26
27
28
29
30

31


32

33
34
35
36
37
38
39
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclWinInt.h"

/*
 * 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 WCHAR *dllDirectoryName = NULL;
static Tcl_Mutex dllDirectoryNameMutex;

/*


 * Static functions defined within this file.
 */

static void *		FindSymbol(Tcl_Interp *interp,
			    Tcl_LoadHandle loadHandle, const char *symbol);

static void		InitDLLDirectoryName(void);


static void		UnloadFile(Tcl_LoadHandle loadHandle);


/*
 *----------------------------------------------------------------------
 *
 * TclpDlopen --
 *
 *	Dynamically loads a binary code file into memory and returns a handle
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
    /*
     * First try the full path the user gave us. This is particularly
     * important if the cwd is inside a vfs, and we are trying to load using a
     * relative path.
     */

    nativeName = Tcl_FSGetNativePath(pathPtr);
    hInstance = LoadLibraryEx(nativeName, NULL,
	    LOAD_WITH_ALTERED_SEARCH_PATH);
    if (hInstance == NULL) {
	/*
	 * Let the OS loader examine the binary search path for whatever
	 * string the user gave us which hopefully refers to a file on the
	 * binary path.
	 */

	Tcl_DString ds;
	const char *fileName = Tcl_GetString(pathPtr);

	nativeName = Tcl_WinUtfToTChar(fileName, -1, &ds);
	hInstance = LoadLibraryEx(nativeName, NULL,
		LOAD_WITH_ALTERED_SEARCH_PATH);
	Tcl_DStringFree(&ds);
    }

    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);

	/*
	 * Check for possible DLL errors. This doesn't work quite right,
	 * because Windows seems to only return ERROR_MOD_NOT_FOUND for just
	 * about any problem, but it's better than nothing. It'd be even







|
<








<

|








<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







69
70
71
72
73
74
75
76

77
78
79
80
81
82
83
84

85
86
87
88
89
90
91
92
93
94

















95
96
97
98
99
100
101
    /*
     * First try the full path the user gave us. This is particularly
     * important if the cwd is inside a vfs, and we are trying to load using a
     * relative path.
     */

    nativeName = Tcl_FSGetNativePath(pathPtr);
    hInstance = LoadLibraryEx(nativeName,NULL,LOAD_WITH_ALTERED_SEARCH_PATH);

    if (hInstance == NULL) {
	/*
	 * Let the OS loader examine the binary search path for whatever
	 * string the user gave us which hopefully refers to a file on the
	 * binary path.
	 */

	Tcl_DString ds;


	nativeName = Tcl_WinUtfToTChar(Tcl_GetString(pathPtr), -1, &ds);
	hInstance = LoadLibraryEx(nativeName, NULL,
		LOAD_WITH_ALTERED_SEARCH_PATH);
	Tcl_DStringFree(&ds);
    }

    if (hInstance == NULL) {
	DWORD lastError = GetLastError();


















	Tcl_AppendResult(interp, "couldn't load library \"",
		Tcl_GetString(pathPtr), "\": ", NULL);

	/*
	 * Check for possible DLL errors. This doesn't work quite right,
	 * because Windows seems to only return ERROR_MOD_NOT_FOUND for just
	 * about any problem, but it's better than nothing. It'd be even
181
182
183
184
185
186
187
188
189
190
191
192
193

194
195
196
197
198
199
200
201
202
203
204
205

206
207
208
209
210
211
212
 *	Returns a pointer to the function associated with 'symbol' if it is
 *	found. Otherwise returns NULL and may leave an error message in the
 *	interp's result.
 *
 *----------------------------------------------------------------------
 */

void *
FindSymbol(
    Tcl_Interp *interp,
    Tcl_LoadHandle loadHandle,
    const char *symbol)
{

    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);
    if (proc == NULL) {
	Tcl_DString ds;
	const char* sym2;

	Tcl_DStringInit(&ds);
	Tcl_DStringAppend(&ds, "_", 1);
	sym2 = Tcl_DStringAppend(&ds, symbol, -1);
	proc = (Tcl_PackageInitProc *) GetProcAddress(hInstance, sym2);
	Tcl_DStringFree(&ds);
    }
    if (proc == NULL && interp != NULL) {







|





>

<






|


|
>







160
161
162
163
164
165
166
167
168
169
170
171
172
173
174

175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
 *	Returns a pointer to the function associated with 'symbol' if it is
 *	found. Otherwise returns NULL and may leave an error message in the
 *	interp's result.
 *
 *----------------------------------------------------------------------
 */

static void *
FindSymbol(
    Tcl_Interp *interp,
    Tcl_LoadHandle loadHandle,
    const char *symbol)
{
    HINSTANCE hInstance = (HINSTANCE) loadHandle->clientData;
    Tcl_PackageInitProc *proc = NULL;


    /*
     * For each symbol, check for both Symbol and _Symbol, since Borland
     * generates C symbols with a leading '_' by default.
     */

    proc = (void *) GetProcAddress(hInstance, symbol);
    if (proc == NULL) {
	Tcl_DString ds;
	const char *sym2;

	Tcl_DStringInit(&ds);
	Tcl_DStringAppend(&ds, "_", 1);
	sym2 = Tcl_DStringAppend(&ds, symbol, -1);
	proc = (Tcl_PackageInitProc *) GetProcAddress(hInstance, sym2);
	Tcl_DStringFree(&ds);
    }
    if (proc == NULL && interp != NULL) {
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
 *
 * Side effects:
 *	Code removed from memory.
 *
 *----------------------------------------------------------------------
 */

void
UnloadFile(
    Tcl_LoadHandle loadHandle)	/* loadHandle returned by a previous call to
				 * TclpDlopen(). The loadHandle is a token
				 * that represents the loaded file. */
{
    HINSTANCE hInstance = (HINSTANCE) loadHandle->clientData;








|







210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
 *
 * Side effects:
 *	Code removed from memory.
 *
 *----------------------------------------------------------------------
 */

static void
UnloadFile(
    Tcl_LoadHandle loadHandle)	/* loadHandle returned by a previous call to
				 * TclpDlopen(). The loadHandle is a token
				 * that represents the loaded file. */
{
    HINSTANCE hInstance = (HINSTANCE) loadHandle->clientData;

273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299

300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342

343
344
345
346
347
348
349
350
351

352
353
354
355
356

357
358

359
360
361
362
363
364
365

366
367
368
369














































































370
371
372
373
374
375
376
377
378
    Tcl_DString *bufPtr)	/* Initialized empty dstring. Append package
				 * name to this if possible. */
{
    return 0;
}

/*
 *-----------------------------------------------------------------------------
 *
 * TclpTempFileNameForLibrary --
 *
 *	Constructs a temporary file name for loading a shared object (DLL).
 *
 * Results:
 *	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.
 *
 *-----------------------------------------------------------------------------
 */

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 */

    /*
     * 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;
    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);

	    }
	}
	Tcl_MutexUnlock(&loadMutex);
    }
    if (dllDirectoryName == NULL) {

	Tcl_AppendResult(interp, "couldn't create temporary directory: ",
		Tcl_PosixError(interp), NULL);

    }
    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;
    }














































































}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







|









|
|
|
|

|


|
|
>
|
<

<
<
<
|
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
<
<
<
<
<
<
<
<
|
|
<
<
<
<
<
|
>
|
<
<
<
<
<
<
<
|
>
|
|
|
|
<
>
|
<
>
|





<
>
|
|
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>









253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281

282



283
284


















285








286
287





288
289
290







291
292
293
294
295
296

297
298

299
300
301
302
303
304
305

306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
    Tcl_DString *bufPtr)	/* Initialized empty dstring. Append package
				 * name to this if possible. */
{
    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * TclpTempFileNameForLibrary --
 *
 *	Constructs a temporary file name for loading a shared object (DLL).
 *
 * Results:
 *	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.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclpTempFileNameForLibrary(
    Tcl_Interp *interp,		/* Tcl interpreter. */
    Tcl_Obj *path)		/* Path name of the DLL in the VFS. */

{



    Tcl_Obj *fileName;		/* Name of the temp file. */
    Tcl_Obj *tail;		/* Tail of the source path. */



























    Tcl_MutexLock(&dllDirectoryNameMutex);
    if (dllDirectoryName == NULL) {





	if (InitDLLDirectoryName() == TCL_ERROR) {
	    Tcl_AppendResult(interp, "couldn't create temporary directory: ",
		    Tcl_PosixError(interp), NULL);







	    Tcl_MutexUnlock(&dllDirectoryNameMutex);
	    return 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;

    }
    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;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to win/tclWinSock.c.

43
44
45
46
47
48
49







50
51
52
53
54
55
56
 *
 *   (Ad 2) The main functions for this are SocketSetupProc() and
 *          SocketCheckProc().
 */

#include "tclWinInt.h"








#ifdef _MSC_VER
#   pragma comment (lib, "ws2_32")
#endif

/*
 * Support for control over sockets' KEEPALIVE and NODELAY behavior is
 * currently disabled.







>
>
>
>
>
>
>







43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
 *
 *   (Ad 2) The main functions for this are SocketSetupProc() and
 *          SocketCheckProc().
 */

#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

/*
 * Support for control over sockets' KEEPALIVE and NODELAY behavior is
 * currently disabled.
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103

104
105
106
107
108
109
110
    0, 0, NULL, NULL, InitializeHostName, NULL, NULL
};

/*
 * 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

/*
 * 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;
    struct sockaddr_in6 sa6;
    struct sockaddr_storage sas;
} address;








|
|
|
|
|





>







94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
    0, 0, NULL, NULL, InitializeHostName, NULL, NULL
};

/*
 * 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

/*
 * 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;
    struct sockaddr_in6 sa6;
    struct sockaddr_storage sas;
} address;

202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
/*
 * Static functions defined in this file.
 */

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);
static LRESULT CALLBACK	SocketProc(HWND hwnd, UINT message, WPARAM wParam,
			    LPARAM lParam);
static int		SocketsEnabled(void);
static void		TcpAccept(TcpFdList *fds);







<
<
<
<







210
211
212
213
214
215
216




217
218
219
220
221
222
223
/*
 * Static functions defined in this file.
 */

static SocketInfo *	CreateSocket(Tcl_Interp *interp, int port,
			    const char *host, int server, const char *myaddr,
			    int myport, int async);




static void		InitSockets(void);
static SocketInfo *	NewSocketInfo(SOCKET socket);
static void		SocketExitHandler(ClientData clientData);
static LRESULT CALLBACK	SocketProc(HWND hwnd, UINT message, WPARAM wParam,
			    LPARAM lParam);
static int		SocketsEnabled(void);
static void		TcpAccept(TcpFdList *fds);
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
 *
 *----------------------------------------------------------------------
 */

static void
InitSockets(void)
{
    DWORD id;
    WSADATA wsaData;
    DWORD err;
    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);

    if (!initialized) {
	initialized = 1;
	TclCreateLateExitHandler(SocketExitHandler, NULL);

	/*







|

<







284
285
286
287
288
289
290
291
292

293
294
295
296
297
298
299
 *
 *----------------------------------------------------------------------
 */

static void
InitSockets(void)
{
    DWORD id, err;
    WSADATA wsaData;

    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);

    if (!initialized) {
	initialized = 1;
	TclCreateLateExitHandler(SocketExitHandler, NULL);

	/*
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357









358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397

	/*
	 * Initialize the winsock library and check the interface version
	 * actually loaded. We only ask for the 1.1 interface and do require
	 * 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);
	if (err != 0) {
	    TclWinConvertError(err);
	    goto initFailure;
	}

	/*
	 * 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.
	 */

	if (MAKEWORD(HIBYTE(wsaData.wVersion), LOBYTE(wsaData.wVersion))
		< MAKEWORD(WSA_VERSION_MINOR, WSA_VERSION_MAJOR)) {
	    TclWinConvertError(WSAVERNOTSUPPORTED);
	    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;
	}

	SetThreadPriority(tsdPtr->socketThread, THREAD_PRIORITY_HIGHEST);

	/*
	 * Wait for the thread to signal when the window has been created and
	 * if it is ready to go.
	 */

	WaitForSingleObject(tsdPtr->readyEvent, INFINITE);

	if (tsdPtr->hwnd == NULL) {
	    goto initFailure; /* Trouble creating the window */
	}

	Tcl_CreateEventSource(SocketSetupProc, SocketCheckProc, NULL);
    }
    return;

  initFailure:
    TclpFinalizeSockets();
    initialized = -1;
    return;
}







<
<
|
|
<







|
|








<
<
<
<






|
>
>
>
>
>
>
>
>
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|

|

|
|
|
|

|

|
|
|

|
<







321
322
323
324
325
326
327


328
329

330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346




347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394

395
396
397
398
399
400
401

	/*
	 * Initialize the winsock library and check the interface version
	 * actually loaded. We only ask for the 1.1 interface and do require
	 * that it not be less than 1.1.
	 */



	err = WSAStartup((WORD) MAKEWORD(WSA_VERSION_MAJOR,WSA_VERSION_MINOR),
		&wsaData);

	if (err != 0) {
	    TclWinConvertError(err);
	    goto initFailure;
	}

	/*
	 * 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.
	 */

	if (MAKEWORD(HIBYTE(wsaData.wVersion), LOBYTE(wsaData.wVersion))
		< MAKEWORD(WSA_VERSION_MINOR, WSA_VERSION_MAJOR)) {
	    TclWinConvertError(WSAVERNOTSUPPORTED);
	    WSACleanup();
	    goto initFailure;
	}




    }

    /*
     * Check for per-thread initialization.
     */

    if (tsdPtr != NULL) {
	return;
    }

    /*
     * 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.
     */

    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;
    }

    SetThreadPriority(tsdPtr->socketThread, THREAD_PRIORITY_HIGHEST);

    /*
     * Wait for the thread to signal when the window has been created and if
     * it is ready to go.
     */

    WaitForSingleObject(tsdPtr->readyEvent, INFINITE);

    if (tsdPtr->hwnd == NULL) {
	goto initFailure;	/* Trouble creating the window. */
    }

    Tcl_CreateEventSource(SocketSetupProc, SocketCheckProc, NULL);

    return;

  initFailure:
    TclpFinalizeSockets();
    initialized = -1;
    return;
}
413
414
415
416
417
418
419

420
421
422
423
424
425
426
 */

    /* ARGSUSED */
static int
SocketsEnabled(void)
{
    int enabled;

    Tcl_MutexLock(&socketMutex);
    enabled = (initialized == 1);
    Tcl_MutexUnlock(&socketMutex);
    return enabled;
}









>







417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
 */

    /* ARGSUSED */
static int
SocketsEnabled(void)
{
    int enabled;

    Tcl_MutexLock(&socketMutex);
    enabled = (initialized == 1);
    Tcl_MutexUnlock(&socketMutex);
    return enabled;
}


443
444
445
446
447
448
449

450
451
452
453
454
455
456

    /* ARGSUSED */
static void
SocketExitHandler(
    ClientData clientData)		/* Not used. */
{
    Tcl_MutexLock(&socketMutex);

    /*
     * Make sure the socket event handling window is cleaned-up for, at
     * most, this thread.
     */

    TclpFinalizeSockets();
    UnregisterClass(classname, TclWinGetTclInstance());







>







448
449
450
451
452
453
454
455
456
457
458
459
460
461
462

    /* ARGSUSED */
static void
SocketExitHandler(
    ClientData clientData)		/* Not used. */
{
    Tcl_MutexLock(&socketMutex);

    /*
     * Make sure the socket event handling window is cleaned-up for, at
     * most, this thread.
     */

    TclpFinalizeSockets();
    UnregisterClass(classname, TclWinGetTclInstance());
479
480
481
482
483
484
485




486



487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
 */

void
TclpFinalizeSockets(void)
{
    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);





    if (tsdPtr != 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;
	    }
	    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);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclpHasSockets --
 *







>
>
>
>
|
>
>
>
|
|
|

|
|
|
|

|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
<







485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523

524
525
526
527
528
529
530
 */

void
TclpFinalizeSockets(void)
{
    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);

    /*
     * Careful! This is a finalizer!
     */

    if (tsdPtr == NULL) {
	return;
    }

    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;
	}
	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);

}

/*
 *----------------------------------------------------------------------
 *
 * TclpHasSockets --
 *
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
SocketEventProc(
    Tcl_Event *evPtr,		/* Event to service. */
    int flags)			/* Flags that indicate what events to handle,
				 * such as TCL_FILE_EVENTS. */
{
    SocketInfo *infoPtr;
    SocketEvent *eventPtr = (SocketEvent *) evPtr;
    int mask = 0;
    int events;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    TcpFdList *fds;

    if (!(flags & TCL_FILE_EVENTS)) {
	return 0;
    }








|
<







685
686
687
688
689
690
691
692

693
694
695
696
697
698
699
SocketEventProc(
    Tcl_Event *evPtr,		/* Event to service. */
    int flags)			/* Flags that indicate what events to handle,
				 * such as TCL_FILE_EVENTS. */
{
    SocketInfo *infoPtr;
    SocketEvent *eventPtr = (SocketEvent *) evPtr;
    int mask = 0, events;

    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    TcpFdList *fds;

    if (!(flags & TCL_FILE_EVENTS)) {
	return 0;
    }

735
736
737
738
739
740
741

742
743
744
745
746
747
748
	 * do this before calling Tcl_NotifyChannel so we don't have to watch
	 * out for the channel being deleted out from under us. This may cause
	 * a redundant trip through the event loop, but it's simpler than
	 * trying to do unwind protection.
	 */

	Tcl_Time blockTime = { 0, 0 };

	Tcl_SetMaxBlockTime(&blockTime);
	mask |= TCL_READABLE|TCL_WRITABLE;
    } else if (events & FD_READ) {
	fd_set readFds;
	struct timeval timeout;

	/*







>







746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
	 * do this before calling Tcl_NotifyChannel so we don't have to watch
	 * out for the channel being deleted out from under us. This may cause
	 * a redundant trip through the event loop, but it's simpler than
	 * trying to do unwind protection.
	 */

	Tcl_Time blockTime = { 0, 0 };

	Tcl_SetMaxBlockTime(&blockTime);
	mask |= TCL_READABLE|TCL_WRITABLE;
    } else if (events & FD_READ) {
	fd_set readFds;
	struct timeval timeout;

	/*
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911

912
913
914
915
916
917
918
919
920
921
922
923
924

925
926
927
928
929
930
931
932
static int
TcpClose2Proc(
    ClientData instanceData,	/* The socket to close. */
    Tcl_Interp *interp,		/* For error reporting. */
    int flags)			/* Flags that indicate which side to close. */
{
    SocketInfo *infoPtr = instanceData;
    int errorCode = 0;
    int 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;
	}

    if (shutdown(infoPtr->sockets->fd,sd) == SOCKET_ERROR) {
	TclWinConvertError((DWORD) WSAGetLastError());
	errorCode = Tcl_GetErrno();
    }

    return errorCode;
}








|
<




<
|
>
|
|
|
|
|
|
|
|
|
|
|
|
|
>
|







909
910
911
912
913
914
915
916

917
918
919
920

921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
static int
TcpClose2Proc(
    ClientData instanceData,	/* The socket to close. */
    Tcl_Interp *interp,		/* For error reporting. */
    int flags)			/* Flags that indicate which side to close. */
{
    SocketInfo *infoPtr = instanceData;
    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;
    }

    if (shutdown(infoPtr->sockets->fd, sd) == SOCKET_ERROR) {
	TclWinConvertError((DWORD) WSAGetLastError());
	errorCode = Tcl_GetErrno();
    }

    return errorCode;
}

1008
1009
1010
1011
1012
1013
1014
1015

1016

1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031




1032

1033
1034
1035

1036
1037
1038
1039
1040

1041
1042
1043
1044
1045
1046
1047
    int async)			/* If nonzero, connect client socket
				 * asynchronously. */
{
    u_long flag = 1;		/* Indicates nonblocking mode. */
    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 */

    const char *errorMsg = NULL;
    SOCKET sock = INVALID_SOCKET;
    SocketInfo *infoPtr = NULL;	/* The returned value. */
    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);

    /*
     * 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()) {
	return NULL;
    }





    if (!TclCreateSocketAddress(interp, &addrlist, host, port, server, &errorMsg)) {

	goto error;
    }
    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) {
		TclWinConvertError((DWORD) WSAGetLastError());
		continue;
	    }








|
>
|
>















>
>
>
>
|
>


|
>





>







1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
    int async)			/* If nonzero, connect client socket
				 * asynchronously. */
{
    u_long flag = 1;		/* Indicates nonblocking mode. */
    int asyncConnect = 0;	/* Will be 1 if async connect is in
				 * progress. */
    unsigned short chosenport = 0;
    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. */
    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);

    /*
     * 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()) {
	return NULL;
    }

    /*
     * 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)) {
	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) {
		TclWinConvertError((DWORD) WSAGetLastError());
		continue;
	    }

1061
1062
1063
1064
1065
1066
1067

1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091

1092
1093
1094
1095

1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
	    /*
	     * Make sure we use the same port when opening two server sockets
	     * for IPv4 and IPv6.
	     *
	     * 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);
	    }

	    /*
	     * 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, addrPtr->ai_addr, addrPtr->ai_addrlen)
		== SOCKET_ERROR) {
		TclWinConvertError((DWORD) WSAGetLastError());
		closesocket(sock);
		continue;
	    }
	    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).
	     */

	    if (listen(sock, SOMAXCONN) == SOCKET_ERROR) {
		TclWinConvertError((DWORD) WSAGetLastError());
		closesocket(sock);
		continue;
	    }







>


|













|







>




>






|
|
|







1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
	    /*
	     * Make sure we use the same port when opening two server sockets
	     * for IPv4 and IPv6.
	     *
	     * 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);
	    }

	    /*
	     * 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, addrPtr->ai_addr, addrPtr->ai_addrlen)
		    == SOCKET_ERROR) {
		TclWinConvertError((DWORD) WSAGetLastError());
		closesocket(sock);
		continue;
	    }
	    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).
	     */

	    if (listen(sock, SOMAXCONN) == SOCKET_ERROR) {
		TclWinConvertError((DWORD) WSAGetLastError());
		closesocket(sock);
		continue;
	    }
1140
1141
1142
1143
1144
1145
1146

1147
1148
1149
1150
1151
1152
1153
		addrPtr = addrPtr->ai_next) {
	    for (myaddrPtr = myaddrlist; myaddrPtr != NULL;
		    myaddrPtr = myaddrPtr->ai_next) {
		/*
		 * No need to try combinations of local and remote addresses
		 * of different families.
		 */

		if (myaddrPtr->ai_family != addrPtr->ai_family) {
		    continue;
		}

		sock = socket(myaddrPtr->ai_family, SOCK_STREAM, 0);
		if (sock == INVALID_SOCKET) {
		    TclWinConvertError((DWORD) WSAGetLastError());







>







1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
		addrPtr = addrPtr->ai_next) {
	    for (myaddrPtr = myaddrlist; myaddrPtr != NULL;
		    myaddrPtr = myaddrPtr->ai_next) {
		/*
		 * No need to try combinations of local and remote addresses
		 * of different families.
		 */

		if (myaddrPtr->ai_family != addrPtr->ai_family) {
		    continue;
		}

		sock = socket(myaddrPtr->ai_family, SOCK_STREAM, 0);
		if (sock == INVALID_SOCKET) {
		    TclWinConvertError((DWORD) WSAGetLastError());
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206

1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241

1242
1243

1244
1245
1246
1247
1248
1249
1250
1251
1252

1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347

		SetHandleInformation((HANDLE) sock, HANDLE_FLAG_INHERIT, 0);

		/*
		 * Set kernel space buffering
		 */

		TclSockMinimumBuffers((void *)sock, TCP_BUFFER_SIZE);

		/*
		 * Try to bind to a local port.
		 */

		if (bind(sock, myaddrPtr->ai_addr, myaddrPtr->ai_addrlen)
		    == SOCKET_ERROR) {
		    TclWinConvertError((DWORD) WSAGetLastError());
		    goto looperror;
		}
		/*
		 * Set the socket into nonblocking mode if the connect should
		 * be done in the background.
		 */
		if (async) {
		    if (ioctlsocket(sock, (long) FIONBIO, &flag)
			== SOCKET_ERROR) {
			TclWinConvertError((DWORD) WSAGetLastError());
			goto looperror;
		    }
		}

		/*
		 * Attempt to connect to the remote socket.
		 */

		if (connect(sock, addrPtr->ai_addr, addrPtr->ai_addrlen)
		    == SOCKET_ERROR) {
		    TclWinConvertError((DWORD) WSAGetLastError());
		    if (Tcl_GetErrno() != EAGAIN) {
			goto looperror;
		    }

		    /*
		     * The connection is progressing in the background.
		     */

		    asyncConnect = 1;

		    goto connected;
		} else {
		    goto connected;
		}
	    looperror:
		if (sock != INVALID_SOCKET) {
		    closesocket(sock);
		    sock = INVALID_SOCKET;
		}
	    }
	}
	goto error;

    connected:
	/*
	 * Add this socket to the global list of sockets.
	 */

	infoPtr = NewSocketInfo(sock);

	/*
	 * 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;
	if (asyncConnect) {
	    infoPtr->flags |= SOCKET_ASYNC_CONNECT;
	    infoPtr->selectEvents |= FD_CONNECT;
	}
    }

  error:
    if (addrlist == NULL)
	freeaddrinfo(addrlist);

    if (myaddrlist == NULL)
	freeaddrinfo(myaddrlist);


    /*
     * Register for interest in events in the select mask. Note that this
     * automatically places the socket into non-blocking mode.
     */

    if (infoPtr != NULL) {
	ioctlsocket(sock, (long) FIONBIO, &flag);
	SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, (LPARAM) infoPtr);


	return infoPtr;
    }

    if (interp != NULL) {
	Tcl_AppendResult(interp, "couldn't open socket: ",
		Tcl_PosixError(interp), NULL);
    }
    if (sock != INVALID_SOCKET) {
	closesocket(sock);
    }
    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

/*
 *----------------------------------------------------------------------
 *
 * WaitForSocketEvent --
 *
 *	Waits until one of the specified events occurs on a socket.
 *







|






|







<
|

|
|
<







|










>
|
<
<
|

















|
|










|

>
|

>








|
>














<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207

1208
1209
1210
1211

1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231


1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291










































































1292
1293
1294
1295
1296
1297
1298

		SetHandleInformation((HANDLE) sock, HANDLE_FLAG_INHERIT, 0);

		/*
		 * Set kernel space buffering
		 */

		TclSockMinimumBuffers((void *) sock, TCP_BUFFER_SIZE);

		/*
		 * Try to bind to a local port.
		 */

		if (bind(sock, myaddrPtr->ai_addr, myaddrPtr->ai_addrlen)
			== SOCKET_ERROR) {
		    TclWinConvertError((DWORD) WSAGetLastError());
		    goto looperror;
		}
		/*
		 * Set the socket into nonblocking mode if the connect should
		 * be done in the background.
		 */

		if (async && ioctlsocket(sock, (long) FIONBIO, &flag)
			== SOCKET_ERROR) {
		    TclWinConvertError((DWORD) WSAGetLastError());
		    goto looperror;

		}

		/*
		 * Attempt to connect to the remote socket.
		 */

		if (connect(sock, addrPtr->ai_addr, addrPtr->ai_addrlen)
			== SOCKET_ERROR) {
		    TclWinConvertError((DWORD) WSAGetLastError());
		    if (Tcl_GetErrno() != EAGAIN) {
			goto looperror;
		    }

		    /*
		     * The connection is progressing in the background.
		     */

		    asyncConnect = 1;
		}
		goto connected;



	    looperror:
		if (sock != INVALID_SOCKET) {
		    closesocket(sock);
		    sock = INVALID_SOCKET;
		}
	    }
	}
	goto error;

    connected:
	/*
	 * Add this socket to the global list of sockets.
	 */

	infoPtr = NewSocketInfo(sock);

	/*
	 * 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;
	if (asyncConnect) {
	    infoPtr->flags |= SOCKET_ASYNC_CONNECT;
	    infoPtr->selectEvents |= FD_CONNECT;
	}
    }

  error:
    if (addrlist == NULL) {
	freeaddrinfo(addrlist);
    }
    if (myaddrlist == NULL) {
	freeaddrinfo(myaddrlist);
    }

    /*
     * Register for interest in events in the select mask. Note that this
     * automatically places the socket into non-blocking mode.
     */

    if (infoPtr != NULL) {
	ioctlsocket(sock, (long) FIONBIO, &flag);
	SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
		(LPARAM) infoPtr);

	return infoPtr;
    }

    if (interp != NULL) {
	Tcl_AppendResult(interp, "couldn't open socket: ",
		Tcl_PosixError(interp), NULL);
    }
    if (sock != INVALID_SOCKET) {
	closesocket(sock);
    }
    return NULL;
}











































































/*
 *----------------------------------------------------------------------
 *
 * WaitForSocketEvent --
 *
 *	Waits until one of the specified events occurs on a socket.
 *
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387

    /*
     * Reset WSAAsyncSelect so we have a fresh set of events pending.
     */

    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) UNSELECT,
	    (LPARAM) infoPtr);

    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
	    (LPARAM) infoPtr);

    while (1) {
	if (infoPtr->lastError) {
	    *errorCodePtr = infoPtr->lastError;
	    result = 0;







<







1324
1325
1326
1327
1328
1329
1330

1331
1332
1333
1334
1335
1336
1337

    /*
     * Reset WSAAsyncSelect so we have a fresh set of events pending.
     */

    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) UNSELECT,
	    (LPARAM) infoPtr);

    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
	    (LPARAM) infoPtr);

    while (1) {
	if (infoPtr->lastError) {
	    *errorCodePtr = infoPtr->lastError;
	    result = 0;
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
	return NULL;
    }

    sprintf(channelName, "sock%Id", (size_t) infoPtr->sockets->fd);

    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;
    }
    return infoPtr->channel;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_MakeTcpClientChannel --
 *







|
|
|
|
<
|
|
|
|

|







1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408

1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
	return NULL;
    }

    sprintf(channelName, "sock%Id", (size_t) infoPtr->sockets->fd);

    infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
	    infoPtr, (TCL_READABLE | TCL_WRITABLE));
    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
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_MakeTcpClientChannel --
 *
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
    infoPtr = NewSocketInfo((SOCKET) sock);

    /*
     * Start watching for read/write events on the socket.
     */

    infoPtr->selectEvents = FD_READ | FD_CLOSE | FD_WRITE;
    SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
	    (WPARAM) SELECT, (LPARAM) infoPtr);

    sprintf(channelName, "sock%Id", (size_t) infoPtr->sockets->fd);
    infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
	    infoPtr, (TCL_READABLE | TCL_WRITABLE));
    Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto crlf");
    return infoPtr->channel;
}







|
<







1455
1456
1457
1458
1459
1460
1461
1462

1463
1464
1465
1466
1467
1468
1469
    infoPtr = NewSocketInfo((SOCKET) sock);

    /*
     * Start watching for read/write events on the socket.
     */

    infoPtr->selectEvents = FD_READ | FD_CLOSE | FD_WRITE;
    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)infoPtr);


    sprintf(channelName, "sock%Id", (size_t) infoPtr->sockets->fd);
    infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
	    infoPtr, (TCL_READABLE | TCL_WRITABLE));
    Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto crlf");
    return infoPtr->channel;
}
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583

    sprintf(channelName, "sock%Id", (size_t) infoPtr->sockets->fd);

    infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
	    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;
}

/*
 *----------------------------------------------------------------------







|
|







1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531

    sprintf(channelName, "sock%Id", (size_t) infoPtr->sockets->fd);

    infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
	    infoPtr, 0);
    if (Tcl_SetChannelOption(interp, infoPtr->channel, "-eofchar", "")
	    == TCL_ERROR) {
	Tcl_Close(NULL, infoPtr->channel);
	return NULL;
    }

    return infoPtr->channel;
}

/*
 *----------------------------------------------------------------------
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622

1623
1624
1625
1626
1627
1628
1629

    /*
     * Accept the incoming connection request.
     */

    len = sizeof(SOCKADDR_IN);

    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);

    /*
     * Clear the ready mask so we can detect the next connection request. Note
     * that connection requests are level triggered, so if there is a request
     * already pending, a new event will be generated.
     */







|





>







1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578

    /*
     * Accept the incoming connection request.
     */

    len = sizeof(SOCKADDR_IN);

    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);

    /*
     * Clear the ready mask so we can detect the next connection request. Note
     * that connection requests are level triggered, so if there is a request
     * already pending, a new event will be generated.
     */
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
    newInfoPtr = NewSocketInfo(newSocket);

    /*
     * Select on read/write events and create the channel.
     */

    newInfoPtr->selectEvents = (FD_READ | FD_WRITE | FD_CLOSE);
    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);
	return;
    }
    if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-eofchar", "")
	    == TCL_ERROR) {
	Tcl_Close((Tcl_Interp *) NULL, newInfoPtr->channel);
	return;
    }

    /*
     * Invoke the accept callback function.
     */








|
|






|




|







1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
    newInfoPtr = NewSocketInfo(newSocket);

    /*
     * Select on read/write events and create the channel.
     */

    newInfoPtr->selectEvents = (FD_READ | FD_WRITE | FD_CLOSE);
    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(NULL, newInfoPtr->channel);
	return;
    }
    if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-eofchar", "")
	    == TCL_ERROR) {
	Tcl_Close(NULL, newInfoPtr->channel);
	return;
    }

    /*
     * Invoke the accept callback function.
     */

1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837

	if (!WaitForSocketEvent(infoPtr, FD_READ|FD_CLOSE, errorCodePtr)) {
	    bytesRead = -1;
	    break;
	}
    }

    SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
	    (WPARAM) SELECT, (LPARAM) infoPtr);

    return bytesRead;
}

/*
 *----------------------------------------------------------------------
 *







|
<







1771
1772
1773
1774
1775
1776
1777
1778

1779
1780
1781
1782
1783
1784
1785

	if (!WaitForSocketEvent(infoPtr, FD_READ|FD_CLOSE, errorCodePtr)) {
	    bytesRead = -1;
	    break;
	}
    }

    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)infoPtr);


    return bytesRead;
}

/*
 *----------------------------------------------------------------------
 *
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946

	if (!WaitForSocketEvent(infoPtr, FD_WRITE|FD_CLOSE, errorCodePtr)) {
	    bytesWritten = -1;
	    break;
	}
    }

    SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
	    (WPARAM) SELECT, (LPARAM) infoPtr);

    return bytesWritten;
}

/*
 *----------------------------------------------------------------------
 *







|
<







1879
1880
1881
1882
1883
1884
1885
1886

1887
1888
1889
1890
1891
1892
1893

	if (!WaitForSocketEvent(infoPtr, FD_WRITE|FD_CLOSE, errorCodePtr)) {
	    bytesWritten = -1;
	    break;
	}
    }

    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)infoPtr);


    return bytesWritten;
}

/*
 *----------------------------------------------------------------------
 *
2113
2114
2115
2116
2117
2118
2119

2120
2121
2122
2123
2124
2125
2126
	reverseDNS = NI_NUMERICHOST;
    }

    if ((len == 0) || ((len > 1) && (optionName[1] == 'p') &&
	    (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");
		Tcl_DStringStartSublist(dsPtr);
	    }

	    getnameinfo(&(peername.sa), size, host, sizeof(host),







>







2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
	reverseDNS = NI_NUMERICHOST;
    }

    if ((len == 0) || ((len > 1) && (optionName[1] == 'p') &&
	    (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");
		Tcl_DStringStartSublist(dsPtr);
	    }

	    getnameinfo(&(peername.sa), size, host, sizeof(host),
2166
2167
2168
2169
2170
2171
2172
2173
2174

2175
2176
2177
2178
2179
2180
2181
	    Tcl_DStringStartSublist(dsPtr);
	}
	for (fds = infoPtr->sockets; fds != NULL; fds = fds->next) {
	    sock = fds->fd;
	    size = sizeof(sockname);
	    if (getsockname(sock, &(sockname.sa), &size) >= 0) {
		int flags = reverseDNS;
		found = 1;


		getnameinfo(&sockname.sa, size, host, sizeof(host),
			NULL, 0, NI_NUMERICHOST);
		Tcl_DStringAppendElement(dsPtr, host);

		/*
		 * We don't want to resolve INADDR_ANY and sin6addr_any; they
		 * can sometimes cause problems (and never have a name).







<

>







2114
2115
2116
2117
2118
2119
2120

2121
2122
2123
2124
2125
2126
2127
2128
2129
	    Tcl_DStringStartSublist(dsPtr);
	}
	for (fds = infoPtr->sockets; fds != NULL; fds = fds->next) {
	    sock = fds->fd;
	    size = sizeof(sockname);
	    if (getsockname(sock, &(sockname.sa), &size) >= 0) {
		int flags = reverseDNS;


		found = 1;
		getnameinfo(&sockname.sa, size, host, sizeof(host),
			NULL, 0, NI_NUMERICHOST);
		Tcl_DStringAppendElement(dsPtr, host);

		/*
		 * We don't want to resolve INADDR_ANY and sin6addr_any; they
		 * can sometimes cause problems (and never have a name).
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320

2321
2322
2323
2324
2325
2326
2327
				 * TCL_READABLE, TCL_WRITABLE and
				 * TCL_EXCEPTION. */
{
    SocketInfo *infoPtr = instanceData;

    /*
     * Update the watch events mask. Only if the socket is not a server
     * socket. Fix for SF Tcl Bug #557878.
     */

    if (!infoPtr->acceptProc) {
	infoPtr->watchEvents = 0;
	if (mask & TCL_READABLE) {
	    infoPtr->watchEvents |= (FD_READ|FD_CLOSE|FD_ACCEPT);
	}
	if (mask & TCL_WRITABLE) {
	    infoPtr->watchEvents |= (FD_WRITE|FD_CLOSE|FD_CONNECT);
	}

	/*
	 * If there are any conditions already set, then tell the notifier to
	 * poll rather than block.
	 */

	if (infoPtr->readyEvents & infoPtr->watchEvents) {
	    Tcl_Time blockTime = { 0, 0 };

	    Tcl_SetMaxBlockTime(&blockTime);
	}
    }
}

/*
 *----------------------------------------------------------------------







|


















>







2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
				 * TCL_READABLE, TCL_WRITABLE and
				 * TCL_EXCEPTION. */
{
    SocketInfo *infoPtr = instanceData;

    /*
     * Update the watch events mask. Only if the socket is not a server
     * socket. [Bug 557878]
     */

    if (!infoPtr->acceptProc) {
	infoPtr->watchEvents = 0;
	if (mask & TCL_READABLE) {
	    infoPtr->watchEvents |= (FD_READ|FD_CLOSE|FD_ACCEPT);
	}
	if (mask & TCL_WRITABLE) {
	    infoPtr->watchEvents |= (FD_WRITE|FD_CLOSE|FD_CONNECT);
	}

	/*
	 * If there are any conditions already set, then tell the notifier to
	 * poll rather than block.
	 */

	if (infoPtr->readyEvents & infoPtr->watchEvents) {
	    Tcl_Time blockTime = { 0, 0 };

	    Tcl_SetMaxBlockTime(&blockTime);
	}
    }
}

/*
 *----------------------------------------------------------------------
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
    MSG msg;
    ThreadSpecificData *tsdPtr = arg;

    /*
     * Create a dummy window receiving socket events.
     */

    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.
     */

    SetEvent(tsdPtr->readyEvent);








|
|







2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
    MSG msg;
    ThreadSpecificData *tsdPtr = arg;

    /*
     * Create a dummy window receiving socket events.
     */

    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.
     */

    SetEvent(tsdPtr->readyEvent);

2669
2670
2671
2672
2673
2674
2675
2676




2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693




2694
2695
2696
2697
2698
2699
2700
 * Side effects:
 *	As defined for each function.
 *
 *----------------------------------------------------------------------
 */

int
TclWinGetSockOpt(SOCKET s, int level, int optname, char *optval,




	int *optlen)
{
    /*
     * 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()) {
	return SOCKET_ERROR;
    }

    return getsockopt(s, level, optname, optval, optlen);
}

int
TclWinSetSockOpt(SOCKET s, int level, int optname, const char *optval,




    int optlen)
{
    /*
     * 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.
     */







|
>
>
>
>
|















|
>
>
>
>







2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
 * Side effects:
 *	As defined for each function.
 *
 *----------------------------------------------------------------------
 */

int
TclWinGetSockOpt(
    SOCKET s,
    int level,
    int optname,
    char *optval,
    int *optlen)
{
    /*
     * 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()) {
	return SOCKET_ERROR;
    }

    return getsockopt(s, level, optname, optval, optlen);
}

int
TclWinSetSockOpt(
    SOCKET s,
    int level,
    int optname,
    const char *optval,
    int optlen)
{
    /*
     * 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.
     */