Symaptic: os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/win/tclWinFile.c@260cb5ec6c19 (annotated)

sl@0	1	/*
sl@0	2	* tclWinFile.c --
sl@0	3	*
sl@0	4	* This file contains temporary wrappers around UNIX file handling
sl@0	5	* functions. These wrappers map the UNIX functions to Win32 HANDLE-style
sl@0	6	* files, which can be manipulated through the Win32 console redirection
sl@0	7	* interfaces.
sl@0	8	*
sl@0	9	* Copyright (c) 1995-1998 Sun Microsystems, Inc.
sl@0	10	*
sl@0	11	* See the file "license.terms" for information on usage and redistribution
sl@0	12	* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
sl@0	13	*
sl@0	14	* RCS: @(#) $Id: tclWinFile.c,v 1.44.2.18 2006/10/17 04:36:45 dgp Exp $
sl@0	15	*/
sl@0	16
sl@0	17	//#define _WIN32_WINNT 0x0500
sl@0	18
sl@0	19	#include "tclWinInt.h"
sl@0	20	#include <winioctl.h>
sl@0	21	#include <sys/stat.h>
sl@0	22	#include <shlobj.h>
sl@0	23	#include <lmaccess.h> /* For TclpGetUserHome(). */
sl@0	24
sl@0	25	/*
sl@0	26	* The number of 100-ns intervals between the Windows system epoch (1601-01-01
sl@0	27	* on the proleptic Gregorian calendar) and the Posix epoch (1970-01-01).
sl@0	28	*/
sl@0	29
sl@0	30	#define POSIX_EPOCH_AS_FILETIME 116444736000000000
sl@0	31
sl@0	32	/*
sl@0	33	* Declarations for 'link' related information. This information
sl@0	34	* should come with VC++ 6.0, but is not in some older SDKs.
sl@0	35	* In any case it is not well documented.
sl@0	36	*/
sl@0	37	#ifndef IO_REPARSE_TAG_RESERVED_ONE
sl@0	38	# define IO_REPARSE_TAG_RESERVED_ONE 0x000000001
sl@0	39	#endif
sl@0	40	#ifndef IO_REPARSE_TAG_RESERVED_RANGE
sl@0	41	# define IO_REPARSE_TAG_RESERVED_RANGE 0x000000001
sl@0	42	#endif
sl@0	43	#ifndef IO_REPARSE_TAG_VALID_VALUES
sl@0	44	# define IO_REPARSE_TAG_VALID_VALUES 0x0E000FFFF
sl@0	45	#endif
sl@0	46	#ifndef IO_REPARSE_TAG_HSM
sl@0	47	# define IO_REPARSE_TAG_HSM 0x0C0000004
sl@0	48	#endif
sl@0	49	#ifndef IO_REPARSE_TAG_NSS
sl@0	50	# define IO_REPARSE_TAG_NSS 0x080000005
sl@0	51	#endif
sl@0	52	#ifndef IO_REPARSE_TAG_NSSRECOVER
sl@0	53	# define IO_REPARSE_TAG_NSSRECOVER 0x080000006
sl@0	54	#endif
sl@0	55	#ifndef IO_REPARSE_TAG_SIS
sl@0	56	# define IO_REPARSE_TAG_SIS 0x080000007
sl@0	57	#endif
sl@0	58	#ifndef IO_REPARSE_TAG_DFS
sl@0	59	# define IO_REPARSE_TAG_DFS 0x080000008
sl@0	60	#endif
sl@0	61
sl@0	62	#ifndef IO_REPARSE_TAG_RESERVED_ZERO
sl@0	63	# define IO_REPARSE_TAG_RESERVED_ZERO 0x00000000
sl@0	64	#endif
sl@0	65	#ifndef FILE_FLAG_OPEN_REPARSE_POINT
sl@0	66	# define FILE_FLAG_OPEN_REPARSE_POINT 0x00200000
sl@0	67	#endif
sl@0	68	#ifndef IO_REPARSE_TAG_MOUNT_POINT
sl@0	69	# define IO_REPARSE_TAG_MOUNT_POINT 0xA0000003
sl@0	70	#endif
sl@0	71	#ifndef IsReparseTagValid
sl@0	72	# define IsReparseTagValid(x) (!((x)&~IO_REPARSE_TAG_VALID_VALUES)&&((x)>IO_REPARSE_TAG_RESERVED_RANGE))
sl@0	73	#endif
sl@0	74	#ifndef IO_REPARSE_TAG_SYMBOLIC_LINK
sl@0	75	# define IO_REPARSE_TAG_SYMBOLIC_LINK IO_REPARSE_TAG_RESERVED_ZERO
sl@0	76	#endif
sl@0	77	#ifndef FILE_SPECIAL_ACCESS
sl@0	78	# define FILE_SPECIAL_ACCESS (FILE_ANY_ACCESS)
sl@0	79	#endif
sl@0	80	#ifndef FSCTL_SET_REPARSE_POINT
sl@0	81	# define FSCTL_SET_REPARSE_POINT CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 41, METHOD_BUFFERED, FILE_SPECIAL_ACCESS)
sl@0	82	# define FSCTL_GET_REPARSE_POINT CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 42, METHOD_BUFFERED, FILE_ANY_ACCESS)
sl@0	83	# define FSCTL_DELETE_REPARSE_POINT CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 43, METHOD_BUFFERED, FILE_SPECIAL_ACCESS)
sl@0	84	#endif
sl@0	85	#ifndef INVALID_FILE_ATTRIBUTES
sl@0	86	#define INVALID_FILE_ATTRIBUTES ((DWORD)-1)
sl@0	87	#endif
sl@0	88
sl@0	89	/*
sl@0	90	* Maximum reparse buffer info size. The max user defined reparse
sl@0	91	* data is 16KB, plus there's a header.
sl@0	92	*/
sl@0	93
sl@0	94	#define MAX_REPARSE_SIZE 17000
sl@0	95
sl@0	96	/*
sl@0	97	* Undocumented REPARSE_MOUNTPOINT_HEADER_SIZE structure definition.
sl@0	98	* This is found in winnt.h.
sl@0	99	*
sl@0	100	* IMPORTANT: caution when using this structure, since the actual
sl@0	101	* structures used will want to store a full path in the 'PathBuffer'
sl@0	102	* field, but there isn't room (there's only a single WCHAR!). Therefore
sl@0	103	* one must artificially create a larger space of memory and then cast it
sl@0	104	* to this type. We use the 'DUMMY_REPARSE_BUFFER' struct just below to
sl@0	105	* deal with this problem.
sl@0	106	*/
sl@0	107
sl@0	108	#define REPARSE_MOUNTPOINT_HEADER_SIZE 8
sl@0	109	#ifndef REPARSE_DATA_BUFFER_HEADER_SIZE
sl@0	110	typedef struct _REPARSE_DATA_BUFFER {
sl@0	111	DWORD ReparseTag;
sl@0	112	WORD ReparseDataLength;
sl@0	113	WORD Reserved;
sl@0	114	union {
sl@0	115	struct {
sl@0	116	WORD SubstituteNameOffset;
sl@0	117	WORD SubstituteNameLength;
sl@0	118	WORD PrintNameOffset;
sl@0	119	WORD PrintNameLength;
sl@0	120	WCHAR PathBuffer[1];
sl@0	121	} SymbolicLinkReparseBuffer;
sl@0	122	struct {
sl@0	123	WORD SubstituteNameOffset;
sl@0	124	WORD SubstituteNameLength;
sl@0	125	WORD PrintNameOffset;
sl@0	126	WORD PrintNameLength;
sl@0	127	WCHAR PathBuffer[1];
sl@0	128	} MountPointReparseBuffer;
sl@0	129	struct {
sl@0	130	BYTE DataBuffer[1];
sl@0	131	} GenericReparseBuffer;
sl@0	132	};
sl@0	133	} REPARSE_DATA_BUFFER;
sl@0	134	#endif
sl@0	135
sl@0	136	typedef struct {
sl@0	137	REPARSE_DATA_BUFFER dummy;
sl@0	138	WCHAR dummyBuf[MAX_PATH*3];
sl@0	139	} DUMMY_REPARSE_BUFFER;
sl@0	140
sl@0	141	#if defined(_MSC_VER) && ( _MSC_VER <= 1100 )
sl@0	142	#define HAVE_NO_FINDEX_ENUMS
sl@0	143	#elif !defined(_WIN32_WINNT) \|\| (_WIN32_WINNT < 0x0400)
sl@0	144	#define HAVE_NO_FINDEX_ENUMS
sl@0	145	#endif
sl@0	146
sl@0	147	#ifdef HAVE_NO_FINDEX_ENUMS
sl@0	148	/* These two aren't in VC++ 5.2 headers */
sl@0	149	typedef enum _FINDEX_INFO_LEVELS {
sl@0	150	FindExInfoStandard,
sl@0	151	FindExInfoMaxInfoLevel
sl@0	152	} FINDEX_INFO_LEVELS;
sl@0	153	typedef enum _FINDEX_SEARCH_OPS {
sl@0	154	FindExSearchNameMatch,
sl@0	155	FindExSearchLimitToDirectories,
sl@0	156	FindExSearchLimitToDevices,
sl@0	157	FindExSearchMaxSearchOp
sl@0	158	} FINDEX_SEARCH_OPS;
sl@0	159	#endif /* HAVE_NO_FINDEX_ENUMS */
sl@0	160
sl@0	161	/* Other typedefs required by this code */
sl@0	162
sl@0	163	static time_t ToCTime(FILETIME fileTime);
sl@0	164	static void FromCTime(time_t posixTime, FILETIME *fileTime);
sl@0	165
sl@0	166	typedef NET_API_STATUS NET_API_FUNCTION NETUSERGETINFOPROC
sl@0	167	(LPWSTR servername, LPWSTR username, DWORD level, LPBYTE *bufptr);
sl@0	168
sl@0	169	typedef NET_API_STATUS NET_API_FUNCTION NETAPIBUFFERFREEPROC
sl@0	170	(LPVOID Buffer);
sl@0	171
sl@0	172	typedef NET_API_STATUS NET_API_FUNCTION NETGETDCNAMEPROC
sl@0	173	(LPWSTR servername, LPWSTR domainname, LPBYTE *bufptr);
sl@0	174
sl@0	175	/*
sl@0	176	* Declarations for local procedures defined in this file:
sl@0	177	*/
sl@0	178
sl@0	179	static int NativeAccess(CONST TCHAR *path, int mode);
sl@0	180	static int NativeStat(CONST TCHAR path, Tcl_StatBuf statPtr, int checkLinks);
sl@0	181	static unsigned short NativeStatMode(DWORD attr, int checkLinks, int isExec);
sl@0	182	static int NativeIsExec(CONST TCHAR *path);
sl@0	183	static int NativeReadReparse(CONST TCHAR* LinkDirectory,
sl@0	184	REPARSE_DATA_BUFFER* buffer);
sl@0	185	static int NativeWriteReparse(CONST TCHAR* LinkDirectory,
sl@0	186	REPARSE_DATA_BUFFER* buffer);
sl@0	187	static int NativeMatchType(int isDrive, DWORD attr, CONST TCHAR* nativeName,
sl@0	188	Tcl_GlobTypeData *types);
sl@0	189	static int WinIsDrive(CONST char *name, int nameLen);
sl@0	190	static int WinIsReserved(CONST char *path);
sl@0	191	static Tcl_Obj* WinReadLink(CONST TCHAR* LinkSource);
sl@0	192	static Tcl_Obj* WinReadLinkDirectory(CONST TCHAR* LinkDirectory);
sl@0	193	static int WinLink(CONST TCHAR* LinkSource, CONST TCHAR* LinkTarget,
sl@0	194	int linkAction);
sl@0	195	static int WinSymLinkDirectory(CONST TCHAR* LinkDirectory,
sl@0	196	CONST TCHAR* LinkTarget);
sl@0	197
sl@0	198	/*
sl@0	199	*--------------------------------------------------------------------
sl@0	200	*
sl@0	201	* WinLink
sl@0	202	*
sl@0	203	* Make a link from source to target.
sl@0	204	*--------------------------------------------------------------------
sl@0	205	*/
sl@0	206	static int
sl@0	207	WinLink(LinkSource, LinkTarget, linkAction)
sl@0	208	CONST TCHAR* LinkSource;
sl@0	209	CONST TCHAR* LinkTarget;
sl@0	210	int linkAction;
sl@0	211	{
sl@0	212	WCHAR tempFileName[MAX_PATH];
sl@0	213	TCHAR* tempFilePart;
sl@0	214	int attr;
sl@0	215
sl@0	216	/* Get the full path referenced by the target */
sl@0	217	if (!(*tclWinProcs->getFullPathNameProc)(LinkTarget,
sl@0	218	MAX_PATH, tempFileName, &tempFilePart)) {
sl@0	219	/* Invalid file */
sl@0	220	TclWinConvertError(GetLastError());
sl@0	221	return -1;
sl@0	222	}
sl@0	223
sl@0	224	/* Make sure source file doesn't exist */
sl@0	225	attr = (*tclWinProcs->getFileAttributesProc)(LinkSource);
sl@0	226	if (attr != 0xffffffff) {
sl@0	227	Tcl_SetErrno(EEXIST);
sl@0	228	return -1;
sl@0	229	}
sl@0	230
sl@0	231	/* Get the full path referenced by the directory */
sl@0	232	if (!(*tclWinProcs->getFullPathNameProc)(LinkSource,
sl@0	233	MAX_PATH, tempFileName, &tempFilePart)) {
sl@0	234	/* Invalid file */
sl@0	235	TclWinConvertError(GetLastError());
sl@0	236	return -1;
sl@0	237	}
sl@0	238	/* Check the target */
sl@0	239	attr = (*tclWinProcs->getFileAttributesProc)(LinkTarget);
sl@0	240	if (attr == 0xffffffff) {
sl@0	241	/* The target doesn't exist */
sl@0	242	TclWinConvertError(GetLastError());
sl@0	243	return -1;
sl@0	244	} else if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
sl@0	245	/* It is a file */
sl@0	246	if (tclWinProcs->createHardLinkProc == NULL) {
sl@0	247	Tcl_SetErrno(ENOTDIR);
sl@0	248	return -1;
sl@0	249	}
sl@0	250	if (linkAction & TCL_CREATE_HARD_LINK) {
sl@0	251	if (!(*tclWinProcs->createHardLinkProc)(LinkSource, LinkTarget, NULL)) {
sl@0	252	TclWinConvertError(GetLastError());
sl@0	253	return -1;
sl@0	254	}
sl@0	255	return 0;
sl@0	256	} else if (linkAction & TCL_CREATE_SYMBOLIC_LINK) {
sl@0	257	/* Can't symlink files */
sl@0	258	Tcl_SetErrno(ENOTDIR);
sl@0	259	return -1;
sl@0	260	} else {
sl@0	261	Tcl_SetErrno(ENODEV);
sl@0	262	return -1;
sl@0	263	}
sl@0	264	} else {
sl@0	265	if (linkAction & TCL_CREATE_SYMBOLIC_LINK) {
sl@0	266	return WinSymLinkDirectory(LinkSource, LinkTarget);
sl@0	267	} else if (linkAction & TCL_CREATE_HARD_LINK) {
sl@0	268	/* Can't hard link directories */
sl@0	269	Tcl_SetErrno(EISDIR);
sl@0	270	return -1;
sl@0	271	} else {
sl@0	272	Tcl_SetErrno(ENODEV);
sl@0	273	return -1;
sl@0	274	}
sl@0	275	}
sl@0	276	}
sl@0	277
sl@0	278	/*
sl@0	279	*--------------------------------------------------------------------
sl@0	280	*
sl@0	281	* WinReadLink
sl@0	282	*
sl@0	283	* What does 'LinkSource' point to?
sl@0	284	*--------------------------------------------------------------------
sl@0	285	*/
sl@0	286	static Tcl_Obj*
sl@0	287	WinReadLink(LinkSource)
sl@0	288	CONST TCHAR* LinkSource;
sl@0	289	{
sl@0	290	WCHAR tempFileName[MAX_PATH];
sl@0	291	TCHAR* tempFilePart;
sl@0	292	int attr;
sl@0	293
sl@0	294	/* Get the full path referenced by the target */
sl@0	295	if (!(*tclWinProcs->getFullPathNameProc)(LinkSource,
sl@0	296	MAX_PATH, tempFileName, &tempFilePart)) {
sl@0	297	/* Invalid file */
sl@0	298	TclWinConvertError(GetLastError());
sl@0	299	return NULL;
sl@0	300	}
sl@0	301
sl@0	302	/* Make sure source file does exist */
sl@0	303	attr = (*tclWinProcs->getFileAttributesProc)(LinkSource);
sl@0	304	if (attr == 0xffffffff) {
sl@0	305	/* The source doesn't exist */
sl@0	306	TclWinConvertError(GetLastError());
sl@0	307	return NULL;
sl@0	308	} else if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
sl@0	309	/* It is a file - this is not yet supported */
sl@0	310	Tcl_SetErrno(ENOTDIR);
sl@0	311	return NULL;
sl@0	312	} else {
sl@0	313	return WinReadLinkDirectory(LinkSource);
sl@0	314	}
sl@0	315	}
sl@0	316
sl@0	317	/*
sl@0	318	*--------------------------------------------------------------------
sl@0	319	*
sl@0	320	* WinSymLinkDirectory
sl@0	321	*
sl@0	322	* This routine creates a NTFS junction, using the undocumented
sl@0	323	* FSCTL_SET_REPARSE_POINT structure Win2K uses for mount points
sl@0	324	* and junctions.
sl@0	325	*
sl@0	326	* Assumption that LinkTarget is a valid, existing directory.
sl@0	327	*
sl@0	328	* Returns zero on success.
sl@0	329	*--------------------------------------------------------------------
sl@0	330	*/
sl@0	331	static int
sl@0	332	WinSymLinkDirectory(LinkDirectory, LinkTarget)
sl@0	333	CONST TCHAR* LinkDirectory;
sl@0	334	CONST TCHAR* LinkTarget;
sl@0	335	{
sl@0	336	DUMMY_REPARSE_BUFFER dummy;
sl@0	337	REPARSE_DATA_BUFFER reparseBuffer = (REPARSE_DATA_BUFFER)&dummy;
sl@0	338	int len;
sl@0	339	WCHAR nativeTarget[MAX_PATH];
sl@0	340	WCHAR *loop;
sl@0	341
sl@0	342	/* Make the native target name */
sl@0	343	memcpy((VOID)nativeTarget, (VOID)L"\\??\\", 4*sizeof(WCHAR));
sl@0	344	memcpy((VOID)(nativeTarget + 4), (VOID)LinkTarget,
sl@0	345	sizeof(WCHAR)(1+wcslen((WCHAR)LinkTarget)));
sl@0	346	len = wcslen(nativeTarget);
sl@0	347	/*
sl@0	348	* We must have backslashes only. This is VERY IMPORTANT.
sl@0	349	* If we have any forward slashes everything appears to work,
sl@0	350	* but the resulting symlink is useless!
sl@0	351	*/
sl@0	352	for (loop = nativeTarget; *loop != 0; loop++) {
sl@0	353	if (loop == L'/') loop = L'\\';
sl@0	354	}
sl@0	355	if ((nativeTarget[len-1] == L'\\') && (nativeTarget[len-2] != L':')) {
sl@0	356	nativeTarget[len-1] = 0;
sl@0	357	}
sl@0	358
sl@0	359	/* Build the reparse info */
sl@0	360	memset(reparseBuffer, 0, sizeof(DUMMY_REPARSE_BUFFER));
sl@0	361	reparseBuffer->ReparseTag = IO_REPARSE_TAG_MOUNT_POINT;
sl@0	362	reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength =
sl@0	363	wcslen(nativeTarget) * sizeof(WCHAR);
sl@0	364	reparseBuffer->Reserved = 0;
sl@0	365	reparseBuffer->SymbolicLinkReparseBuffer.PrintNameLength = 0;
sl@0	366	reparseBuffer->SymbolicLinkReparseBuffer.PrintNameOffset =
sl@0	367	reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength
sl@0	368	+ sizeof(WCHAR);
sl@0	369	memcpy(reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer, nativeTarget,
sl@0	370	sizeof(WCHAR)
sl@0	371	+ reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength);
sl@0	372	reparseBuffer->ReparseDataLength =
sl@0	373	reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength + 12;
sl@0	374
sl@0	375	return NativeWriteReparse(LinkDirectory, reparseBuffer);
sl@0	376	}
sl@0	377
sl@0	378	/*
sl@0	379	*--------------------------------------------------------------------
sl@0	380	*
sl@0	381	* TclWinSymLinkCopyDirectory
sl@0	382	*
sl@0	383	* Copy a Windows NTFS junction. This function assumes that
sl@0	384	* LinkOriginal exists and is a valid junction point, and that
sl@0	385	* LinkCopy does not exist.
sl@0	386	*
sl@0	387	* Returns zero on success.
sl@0	388	*--------------------------------------------------------------------
sl@0	389	*/
sl@0	390	int
sl@0	391	TclWinSymLinkCopyDirectory(LinkOriginal, LinkCopy)
sl@0	392	CONST TCHAR* LinkOriginal; /* Existing junction - reparse point */
sl@0	393	CONST TCHAR* LinkCopy; /* Will become a duplicate junction */
sl@0	394	{
sl@0	395	DUMMY_REPARSE_BUFFER dummy;
sl@0	396	REPARSE_DATA_BUFFER reparseBuffer = (REPARSE_DATA_BUFFER)&dummy;
sl@0	397
sl@0	398	if (NativeReadReparse(LinkOriginal, reparseBuffer)) {
sl@0	399	return -1;
sl@0	400	}
sl@0	401	return NativeWriteReparse(LinkCopy, reparseBuffer);
sl@0	402	}
sl@0	403
sl@0	404	/*
sl@0	405	*--------------------------------------------------------------------
sl@0	406	*
sl@0	407	* TclWinSymLinkDelete
sl@0	408	*
sl@0	409	* Delete a Windows NTFS junction. Once the junction information
sl@0	410	* is deleted, the filesystem object becomes an ordinary directory.
sl@0	411	* Unless 'linkOnly' is given, that directory is also removed.
sl@0	412	*
sl@0	413	* Assumption that LinkOriginal is a valid, existing junction.
sl@0	414	*
sl@0	415	* Returns zero on success.
sl@0	416	*--------------------------------------------------------------------
sl@0	417	*/
sl@0	418	int
sl@0	419	TclWinSymLinkDelete(LinkOriginal, linkOnly)
sl@0	420	CONST TCHAR* LinkOriginal;
sl@0	421	int linkOnly;
sl@0	422	{
sl@0	423	/* It is a symbolic link -- remove it */
sl@0	424	DUMMY_REPARSE_BUFFER dummy;
sl@0	425	REPARSE_DATA_BUFFER reparseBuffer = (REPARSE_DATA_BUFFER)&dummy;
sl@0	426	HANDLE hFile;
sl@0	427	DWORD returnedLength;
sl@0	428	memset(reparseBuffer, 0, sizeof(DUMMY_REPARSE_BUFFER));
sl@0	429	reparseBuffer->ReparseTag = IO_REPARSE_TAG_MOUNT_POINT;
sl@0	430	hFile = (*tclWinProcs->createFileProc)(LinkOriginal, GENERIC_WRITE, 0,
sl@0	431	NULL, OPEN_EXISTING,
sl@0	432	FILE_FLAG_OPEN_REPARSE_POINT\|FILE_FLAG_BACKUP_SEMANTICS, NULL);
sl@0	433	if (hFile != INVALID_HANDLE_VALUE) {
sl@0	434	if (!DeviceIoControl(hFile, FSCTL_DELETE_REPARSE_POINT, reparseBuffer,
sl@0	435	REPARSE_MOUNTPOINT_HEADER_SIZE,
sl@0	436	NULL, 0, &returnedLength, NULL)) {
sl@0	437	/* Error setting junction */
sl@0	438	TclWinConvertError(GetLastError());
sl@0	439	CloseHandle(hFile);
sl@0	440	} else {
sl@0	441	CloseHandle(hFile);
sl@0	442	if (!linkOnly) {
sl@0	443	(*tclWinProcs->removeDirectoryProc)(LinkOriginal);
sl@0	444	}
sl@0	445	return 0;
sl@0	446	}
sl@0	447	}
sl@0	448	return -1;
sl@0	449	}
sl@0	450
sl@0	451	/*
sl@0	452	*--------------------------------------------------------------------
sl@0	453	*
sl@0	454	* WinReadLinkDirectory
sl@0	455	*
sl@0	456	* This routine reads a NTFS junction, using the undocumented
sl@0	457	* FSCTL_GET_REPARSE_POINT structure Win2K uses for mount points
sl@0	458	* and junctions.
sl@0	459	*
sl@0	460	* Assumption that LinkDirectory is a valid, existing directory.
sl@0	461	*
sl@0	462	* Returns a Tcl_Obj with refCount of 1 (i.e. owned by the caller),
sl@0	463	* or NULL if anything went wrong.
sl@0	464	*
sl@0	465	* In the future we should enhance this to return a path object
sl@0	466	* rather than a string.
sl@0	467	*--------------------------------------------------------------------
sl@0	468	*/
sl@0	469	static Tcl_Obj*
sl@0	470	WinReadLinkDirectory(LinkDirectory)
sl@0	471	CONST TCHAR* LinkDirectory;
sl@0	472	{
sl@0	473	int attr;
sl@0	474	DUMMY_REPARSE_BUFFER dummy;
sl@0	475	REPARSE_DATA_BUFFER reparseBuffer = (REPARSE_DATA_BUFFER)&dummy;
sl@0	476
sl@0	477	attr = (*tclWinProcs->getFileAttributesProc)(LinkDirectory);
sl@0	478	if (!(attr & FILE_ATTRIBUTE_REPARSE_POINT)) {
sl@0	479	Tcl_SetErrno(EINVAL);
sl@0	480	return NULL;
sl@0	481	}
sl@0	482	if (NativeReadReparse(LinkDirectory, reparseBuffer)) {
sl@0	483	return NULL;
sl@0	484	}
sl@0	485
sl@0	486	switch (reparseBuffer->ReparseTag) {
sl@0	487	case 0x80000000\|IO_REPARSE_TAG_SYMBOLIC_LINK:
sl@0	488	case IO_REPARSE_TAG_SYMBOLIC_LINK:
sl@0	489	case IO_REPARSE_TAG_MOUNT_POINT: {
sl@0	490	Tcl_Obj *retVal;
sl@0	491	Tcl_DString ds;
sl@0	492	CONST char *copy;
sl@0	493	int len;
sl@0	494	int offset = 0;
sl@0	495
sl@0	496	/*
sl@0	497	* Certain native path representations on Windows have a
sl@0	498	* special prefix to indicate that they are to be treated
sl@0	499	* specially. For example extremely long paths, or symlinks,
sl@0	500	* or volumes mounted inside directories.
sl@0	501	*
sl@0	502	* There is an assumption in this code that 'wide' interfaces
sl@0	503	* are being used (see tclWin32Dll.c), which is true for the
sl@0	504	* only systems which support reparse tags at present. If
sl@0	505	* that changes in the future, this code will have to be
sl@0	506	* generalised.
sl@0	507	*/
sl@0	508	if (reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer[0]
sl@0	509	== L'\\') {
sl@0	510	/* Check whether this is a mounted volume */
sl@0	511	if (wcsncmp(reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer,
sl@0	512	L"\\??\\Volume{",11) == 0) {
sl@0	513	char drive;
sl@0	514	/*
sl@0	515	* There is some confusion between \??\ and \\?\ which
sl@0	516	* we have to fix here. It doesn't seem very well
sl@0	517	* documented.
sl@0	518	*/
sl@0	519	reparseBuffer->SymbolicLinkReparseBuffer
sl@0	520	.PathBuffer[1] = L'\\';
sl@0	521	/*
sl@0	522	* Check if a corresponding drive letter exists, and
sl@0	523	* use that if it is found
sl@0	524	*/
sl@0	525	drive = TclWinDriveLetterForVolMountPoint(reparseBuffer
sl@0	526	->SymbolicLinkReparseBuffer.PathBuffer);
sl@0	527	if (drive != -1) {
sl@0	528	char driveSpec[3] = {
sl@0	529	drive, ':', '\0'
sl@0	530	};
sl@0	531	retVal = Tcl_NewStringObj(driveSpec,2);
sl@0	532	Tcl_IncrRefCount(retVal);
sl@0	533	return retVal;
sl@0	534	}
sl@0	535	/*
sl@0	536	* This is actually a mounted drive, which doesn't
sl@0	537	* exists as a DOS drive letter. This means the path
sl@0	538	* isn't actually a link, although we partially treat
sl@0	539	* it like one ('file type' will return 'link'), but
sl@0	540	* then the link will actually just be treated like
sl@0	541	* an ordinary directory. I don't believe any
sl@0	542	* serious inconsistency will arise from this, but it
sl@0	543	* is something to be aware of.
sl@0	544	*/
sl@0	545	Tcl_SetErrno(EINVAL);
sl@0	546	return NULL;
sl@0	547	} else if (wcsncmp(reparseBuffer->SymbolicLinkReparseBuffer
sl@0	548	.PathBuffer, L"\\\\?\\",4) == 0) {
sl@0	549	/* Strip off the prefix */
sl@0	550	offset = 4;
sl@0	551	} else if (wcsncmp(reparseBuffer->SymbolicLinkReparseBuffer
sl@0	552	.PathBuffer, L"\\??\\",4) == 0) {
sl@0	553	/* Strip off the prefix */
sl@0	554	offset = 4;
sl@0	555	}
sl@0	556	}
sl@0	557
sl@0	558	Tcl_WinTCharToUtf(
sl@0	559	(CONST char*)reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer,
sl@0	560	(int)reparseBuffer->SymbolicLinkReparseBuffer
sl@0	561	.SubstituteNameLength, &ds);
sl@0	562
sl@0	563	copy = Tcl_DStringValue(&ds)+offset;
sl@0	564	len = Tcl_DStringLength(&ds)-offset;
sl@0	565	retVal = Tcl_NewStringObj(copy,len);
sl@0	566	Tcl_IncrRefCount(retVal);
sl@0	567	Tcl_DStringFree(&ds);
sl@0	568	return retVal;
sl@0	569	}
sl@0	570	}
sl@0	571	Tcl_SetErrno(EINVAL);
sl@0	572	return NULL;
sl@0	573	}
sl@0	574
sl@0	575	/*
sl@0	576	*--------------------------------------------------------------------
sl@0	577	*
sl@0	578	* NativeReadReparse
sl@0	579	*
sl@0	580	* Read the junction/reparse information from a given NTFS directory.
sl@0	581	*
sl@0	582	* Assumption that LinkDirectory is a valid, existing directory.
sl@0	583	*
sl@0	584	* Returns zero on success.
sl@0	585	*--------------------------------------------------------------------
sl@0	586	*/
sl@0	587	static int
sl@0	588	NativeReadReparse(LinkDirectory, buffer)
sl@0	589	CONST TCHAR* LinkDirectory; /* The junction to read */
sl@0	590	REPARSE_DATA_BUFFER* buffer; /* Pointer to buffer. Cannot be NULL */
sl@0	591	{
sl@0	592	HANDLE hFile;
sl@0	593	DWORD returnedLength;
sl@0	594
sl@0	595	hFile = (*tclWinProcs->createFileProc)(LinkDirectory, GENERIC_READ, 0,
sl@0	596	NULL, OPEN_EXISTING,
sl@0	597	FILE_FLAG_OPEN_REPARSE_POINT\|FILE_FLAG_BACKUP_SEMANTICS, NULL);
sl@0	598	if (hFile == INVALID_HANDLE_VALUE) {
sl@0	599	/* Error creating directory */
sl@0	600	TclWinConvertError(GetLastError());
sl@0	601	return -1;
sl@0	602	}
sl@0	603	/* Get the link */
sl@0	604	if (!DeviceIoControl(hFile, FSCTL_GET_REPARSE_POINT, NULL,
sl@0	605	0, buffer, sizeof(DUMMY_REPARSE_BUFFER),
sl@0	606	&returnedLength, NULL)) {
sl@0	607	/* Error setting junction */
sl@0	608	TclWinConvertError(GetLastError());
sl@0	609	CloseHandle(hFile);
sl@0	610	return -1;
sl@0	611	}
sl@0	612	CloseHandle(hFile);
sl@0	613
sl@0	614	if (!IsReparseTagValid(buffer->ReparseTag)) {
sl@0	615	Tcl_SetErrno(EINVAL);
sl@0	616	return -1;
sl@0	617	}
sl@0	618	return 0;
sl@0	619	}
sl@0	620
sl@0	621	/*
sl@0	622	*--------------------------------------------------------------------
sl@0	623	*
sl@0	624	* NativeWriteReparse
sl@0	625	*
sl@0	626	* Write the reparse information for a given directory.
sl@0	627	*
sl@0	628	* Assumption that LinkDirectory does not exist.
sl@0	629	*--------------------------------------------------------------------
sl@0	630	*/
sl@0	631	static int
sl@0	632	NativeWriteReparse(LinkDirectory, buffer)
sl@0	633	CONST TCHAR* LinkDirectory;
sl@0	634	REPARSE_DATA_BUFFER* buffer;
sl@0	635	{
sl@0	636	HANDLE hFile;
sl@0	637	DWORD returnedLength;
sl@0	638
sl@0	639	/* Create the directory - it must not already exist */
sl@0	640	if ((*tclWinProcs->createDirectoryProc)(LinkDirectory, NULL) == 0) {
sl@0	641	/* Error creating directory */
sl@0	642	TclWinConvertError(GetLastError());
sl@0	643	return -1;
sl@0	644	}
sl@0	645	hFile = (*tclWinProcs->createFileProc)(LinkDirectory, GENERIC_WRITE, 0,
sl@0	646	NULL, OPEN_EXISTING,
sl@0	647	FILE_FLAG_OPEN_REPARSE_POINT\|FILE_FLAG_BACKUP_SEMANTICS, NULL);
sl@0	648	if (hFile == INVALID_HANDLE_VALUE) {
sl@0	649	/* Error creating directory */
sl@0	650	TclWinConvertError(GetLastError());
sl@0	651	return -1;
sl@0	652	}
sl@0	653	/* Set the link */
sl@0	654	if (!DeviceIoControl(hFile, FSCTL_SET_REPARSE_POINT, buffer,
sl@0	655	(DWORD) buffer->ReparseDataLength
sl@0	656	+ REPARSE_MOUNTPOINT_HEADER_SIZE,
sl@0	657	NULL, 0, &returnedLength, NULL)) {
sl@0	658	/* Error setting junction */
sl@0	659	TclWinConvertError(GetLastError());
sl@0	660	CloseHandle(hFile);
sl@0	661	(*tclWinProcs->removeDirectoryProc)(LinkDirectory);
sl@0	662	return -1;
sl@0	663	}
sl@0	664	CloseHandle(hFile);
sl@0	665	/* We succeeded */
sl@0	666	return 0;
sl@0	667	}
sl@0	668
sl@0	669	/*
sl@0	670	*---------------------------------------------------------------------------
sl@0	671	*
sl@0	672	* TclpFindExecutable --
sl@0	673	*
sl@0	674	* This procedure computes the absolute path name of the current
sl@0	675	* application, given its argv[0] value.
sl@0	676	*
sl@0	677	* Results:
sl@0	678	* A clean UTF string that is the path to the executable. At this
sl@0	679	* point we may not know the system encoding, but we convert the
sl@0	680	* string value to UTF-8 using core Windows functions. The path name
sl@0	681	* contains ASCII string and '/' chars do not conflict with other UTF
sl@0	682	* chars.
sl@0	683	*
sl@0	684	* Side effects:
sl@0	685	* The variable tclNativeExecutableName gets filled in with the file
sl@0	686	* name for the application, if we figured it out. If we couldn't
sl@0	687	* figure it out, tclNativeExecutableName is set to NULL.
sl@0	688	*
sl@0	689	*---------------------------------------------------------------------------
sl@0	690	*/
sl@0	691
sl@0	692	char *
sl@0	693	TclpFindExecutable(argv0)
sl@0	694	CONST char argv0; / The value of the application's argv[0]
sl@0	695	* (native). */
sl@0	696	{
sl@0	697	WCHAR wName[MAX_PATH];
sl@0	698	char name[MAX_PATH * TCL_UTF_MAX];
sl@0	699
sl@0	700	if (argv0 == NULL) {
sl@0	701	return NULL;
sl@0	702	}
sl@0	703	if (tclNativeExecutableName != NULL) {
sl@0	704	return tclNativeExecutableName;
sl@0	705	}
sl@0	706
sl@0	707	/*
sl@0	708	* Under Windows we ignore argv0, and return the path for the file used to
sl@0	709	* create this process.
sl@0	710	*/
sl@0	711
sl@0	712	if (GetModuleFileNameW(NULL, wName, MAX_PATH) == 0) {
sl@0	713	GetModuleFileNameA(NULL, name, sizeof(name));
sl@0	714	} else {
sl@0	715	WideCharToMultiByte(CP_UTF8, 0, wName, -1,
sl@0	716	name, sizeof(name), NULL, NULL);
sl@0	717	}
sl@0	718
sl@0	719	tclNativeExecutableName = ckalloc((unsigned) (strlen(name) + 1));
sl@0	720	strcpy(tclNativeExecutableName, name);
sl@0	721
sl@0	722	TclWinNoBackslash(tclNativeExecutableName);
sl@0	723	return tclNativeExecutableName;
sl@0	724	}
sl@0	725
sl@0	726	/*
sl@0	727	*----------------------------------------------------------------------
sl@0	728	*
sl@0	729	* TclpMatchInDirectory --
sl@0	730	*
sl@0	731	* This routine is used by the globbing code to search a
sl@0	732	* directory for all files which match a given pattern.
sl@0	733	*
sl@0	734	* Results:
sl@0	735	*
sl@0	736	* The return value is a standard Tcl result indicating whether an
sl@0	737	* error occurred in globbing. Errors are left in interp, good
sl@0	738	* results are lappended to resultPtr (which must be a valid object)
sl@0	739	*
sl@0	740	* Side effects:
sl@0	741	* None.
sl@0	742	*
sl@0	743	---------------------------------------------------------------------- /
sl@0	744
sl@0	745	int
sl@0	746	TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
sl@0	747	Tcl_Interp interp; / Interpreter to receive errors. */
sl@0	748	Tcl_Obj resultPtr; / List object to lappend results. */
sl@0	749	Tcl_Obj pathPtr; / Contains path to directory to search. */
sl@0	750	CONST char pattern; / Pattern to match against. */
sl@0	751	Tcl_GlobTypeData types; / Object containing list of acceptable types.
sl@0	752	* May be NULL. In particular the directory
sl@0	753	* flag is very important. */
sl@0	754	{
sl@0	755	CONST TCHAR *native;
sl@0	756
sl@0	757	if (pattern == NULL \|\| (*pattern == '\0')) {
sl@0	758	Tcl_Obj *norm = Tcl_FSGetNormalizedPath(NULL, pathPtr);
sl@0	759	if (norm != NULL) {
sl@0	760	/* Match a single file directly */
sl@0	761	int len;
sl@0	762	DWORD attr;
sl@0	763	CONST char *str = Tcl_GetStringFromObj(norm,&len);
sl@0	764
sl@0	765	native = (CONST TCHAR*) Tcl_FSGetNativePath(pathPtr);
sl@0	766
sl@0	767	if (tclWinProcs->getFileAttributesExProc == NULL) {
sl@0	768	attr = (*tclWinProcs->getFileAttributesProc)(native);
sl@0	769	if (attr == 0xffffffff) {
sl@0	770	return TCL_OK;
sl@0	771	}
sl@0	772	} else {
sl@0	773	WIN32_FILE_ATTRIBUTE_DATA data;
sl@0	774	if ((*tclWinProcs->getFileAttributesExProc)(native,
sl@0	775	GetFileExInfoStandard, &data) != TRUE) {
sl@0	776	return TCL_OK;
sl@0	777	}
sl@0	778	attr = data.dwFileAttributes;
sl@0	779	}
sl@0	780	if (NativeMatchType(WinIsDrive(str,len), attr,
sl@0	781	native, types)) {
sl@0	782	Tcl_ListObjAppendElement(interp, resultPtr, pathPtr);
sl@0	783	}
sl@0	784	}
sl@0	785	return TCL_OK;
sl@0	786	} else {
sl@0	787	DWORD attr;
sl@0	788	HANDLE handle;
sl@0	789	WIN32_FIND_DATAT data;
sl@0	790	CONST char *dirName;
sl@0	791	int dirLength;
sl@0	792	int matchSpecialDots;
sl@0	793	Tcl_DString ds; /* native encoding of dir */
sl@0	794	Tcl_DString dsOrig; /* utf-8 encoding of dir */
sl@0	795	Tcl_DString dirString; /* utf-8 encoding of dir with \'s */
sl@0	796	Tcl_Obj *fileNamePtr;
sl@0	797
sl@0	798	/*
sl@0	799	* Convert the path to normalized form since some interfaces only
sl@0	800	* accept backslashes. Also, ensure that the directory ends with a
sl@0	801	* separator character.
sl@0	802	*/
sl@0	803
sl@0	804	fileNamePtr = Tcl_FSGetTranslatedPath(interp, pathPtr);
sl@0	805	if (fileNamePtr == NULL) {
sl@0	806	return TCL_ERROR;
sl@0	807	}
sl@0	808	Tcl_DStringInit(&dsOrig);
sl@0	809	dirName = Tcl_GetStringFromObj(fileNamePtr, &dirLength);
sl@0	810	Tcl_DStringAppend(&dsOrig, dirName, dirLength);
sl@0	811
sl@0	812	Tcl_DStringInit(&dirString);
sl@0	813	if (dirLength == 0) {
sl@0	814	Tcl_DStringAppend(&dirString, ".\\", 2);
sl@0	815	} else {
sl@0	816	char *p;
sl@0	817
sl@0	818	Tcl_DStringAppend(&dirString, dirName, dirLength);
sl@0	819	for (p = Tcl_DStringValue(&dirString); *p != '\0'; p++) {
sl@0	820	if (*p == '/') {
sl@0	821	*p = '\\';
sl@0	822	}
sl@0	823	}
sl@0	824	p--;
sl@0	825	/* Make sure we have a trailing directory delimiter */
sl@0	826	if ((p != '\\') && (p != ':')) {
sl@0	827	Tcl_DStringAppend(&dirString, "\\", 1);
sl@0	828	Tcl_DStringAppend(&dsOrig, "/", 1);
sl@0	829	dirLength++;
sl@0	830	}
sl@0	831	}
sl@0	832	dirName = Tcl_DStringValue(&dirString);
sl@0	833	Tcl_DecrRefCount(fileNamePtr);
sl@0	834
sl@0	835	/*
sl@0	836	* First verify that the specified path is actually a directory.
sl@0	837	*/
sl@0	838
sl@0	839	native = Tcl_WinUtfToTChar(dirName, Tcl_DStringLength(&dirString),
sl@0	840	&ds);
sl@0	841	attr = (*tclWinProcs->getFileAttributesProc)(native);
sl@0	842	Tcl_DStringFree(&ds);
sl@0	843
sl@0	844	if ((attr == 0xffffffff) \|\| ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0)) {
sl@0	845	Tcl_DStringFree(&dirString);
sl@0	846	return TCL_OK;
sl@0	847	}
sl@0	848
sl@0	849	/*
sl@0	850	* We need to check all files in the directory, so append a .
sl@0	851	* to the path.
sl@0	852	*/
sl@0	853
sl@0	854	dirName = Tcl_DStringAppend(&dirString, ".", 3);
sl@0	855	native = Tcl_WinUtfToTChar(dirName, -1, &ds);
sl@0	856	handle = (*tclWinProcs->findFirstFileProc)(native, &data);
sl@0	857
sl@0	858	if (handle == INVALID_HANDLE_VALUE) {
sl@0	859	TclWinConvertError(GetLastError());
sl@0	860	Tcl_DStringFree(&ds);
sl@0	861	Tcl_DStringFree(&dirString);
sl@0	862	Tcl_ResetResult(interp);
sl@0	863	Tcl_AppendResult(interp, "couldn't read directory \"",
sl@0	864	Tcl_DStringValue(&dsOrig), "\": ",
sl@0	865	Tcl_PosixError(interp), (char *) NULL);
sl@0	866	Tcl_DStringFree(&dsOrig);
sl@0	867	return TCL_ERROR;
sl@0	868	}
sl@0	869	Tcl_DStringFree(&ds);
sl@0	870
sl@0	871	/*
sl@0	872	* Check to see if the pattern should match the special
sl@0	873	* . and .. names, referring to the current directory,
sl@0	874	* or the directory above. We need a special check for
sl@0	875	* this because paths beginning with a dot are not considered
sl@0	876	* hidden on Windows, and so otherwise a relative glob like
sl@0	877	* 'glob -join * *' will actually return './. ../..' etc.
sl@0	878	*/
sl@0	879
sl@0	880	if ((pattern[0] == '.')
sl@0	881	\|\| ((pattern[0] == '\\') && (pattern[1] == '.'))) {
sl@0	882	matchSpecialDots = 1;
sl@0	883	} else {
sl@0	884	matchSpecialDots = 0;
sl@0	885	}
sl@0	886
sl@0	887	/*
sl@0	888	* Now iterate over all of the files in the directory, starting
sl@0	889	* with the first one we found.
sl@0	890	*/
sl@0	891
sl@0	892	do {
sl@0	893	CONST char *utfname;
sl@0	894	int checkDrive = 0;
sl@0	895	int isDrive;
sl@0	896	DWORD attr;
sl@0	897
sl@0	898	if (tclWinProcs->useWide) {
sl@0	899	native = (CONST TCHAR *) data.w.cFileName;
sl@0	900	attr = data.w.dwFileAttributes;
sl@0	901	} else {
sl@0	902	native = (CONST TCHAR *) data.a.cFileName;
sl@0	903	attr = data.a.dwFileAttributes;
sl@0	904	}
sl@0	905
sl@0	906	utfname = Tcl_WinTCharToUtf(native, -1, &ds);
sl@0	907
sl@0	908	if (!matchSpecialDots) {
sl@0	909	/* If it is exactly '.' or '..' then we ignore it */
sl@0	910	if ((utfname[0] == '.') && (utfname[1] == '\0'
sl@0	911	\|\| (utfname[1] == '.' && utfname[2] == '\0'))) {
sl@0	912	Tcl_DStringFree(&ds);
sl@0	913	continue;
sl@0	914	}
sl@0	915	} else if (utfname[0] == '.' && utfname[1] == '.'
sl@0	916	&& utfname[2] == '\0') {
sl@0	917	/*
sl@0	918	* Have to check if this is a drive below, so we can
sl@0	919	* correctly match 'hidden' and not hidden files.
sl@0	920	*/
sl@0	921	checkDrive = 1;
sl@0	922	}
sl@0	923
sl@0	924	/*
sl@0	925	* Check to see if the file matches the pattern. Note that
sl@0	926	* we are ignoring the case sensitivity flag because Windows
sl@0	927	* doesn't honor case even if the volume is case sensitive.
sl@0	928	* If the volume also doesn't preserve case, then we
sl@0	929	* previously returned the lower case form of the name. This
sl@0	930	* didn't seem quite right since there are
sl@0	931	* non-case-preserving volumes that actually return mixed
sl@0	932	* case. So now we are returning exactly what we get from
sl@0	933	* the system.
sl@0	934	*/
sl@0	935
sl@0	936	if (Tcl_StringCaseMatch(utfname, pattern, 1)) {
sl@0	937	/*
sl@0	938	* If the file matches, then we need to process the remainder
sl@0	939	* of the path.
sl@0	940	*/
sl@0	941
sl@0	942	if (checkDrive) {
sl@0	943	CONST char *fullname = Tcl_DStringAppend(&dsOrig, utfname,
sl@0	944	Tcl_DStringLength(&ds));
sl@0	945	isDrive = WinIsDrive(fullname, Tcl_DStringLength(&dsOrig));
sl@0	946	Tcl_DStringSetLength(&dsOrig, dirLength);
sl@0	947	} else {
sl@0	948	isDrive = 0;
sl@0	949	}
sl@0	950	if (NativeMatchType(isDrive, attr, native, types)) {
sl@0	951	Tcl_ListObjAppendElement(interp, resultPtr,
sl@0	952	TclNewFSPathObj(pathPtr, utfname,
sl@0	953	Tcl_DStringLength(&ds)));
sl@0	954	}
sl@0	955	}
sl@0	956
sl@0	957	/*
sl@0	958	* Free ds here to ensure that native is valid above.
sl@0	959	*/
sl@0	960	Tcl_DStringFree(&ds);
sl@0	961	} while ((*tclWinProcs->findNextFileProc)(handle, &data) == TRUE);
sl@0	962
sl@0	963	FindClose(handle);
sl@0	964	Tcl_DStringFree(&dirString);
sl@0	965	Tcl_DStringFree(&dsOrig);
sl@0	966	return TCL_OK;
sl@0	967	}
sl@0	968	}
sl@0	969
sl@0	970	/*
sl@0	971	* Does the given path represent a root volume? We need this special
sl@0	972	* case because for NTFS root volumes, the getFileAttributesProc returns
sl@0	973	* a 'hidden' attribute when it should not.
sl@0	974	*/
sl@0	975	static int
sl@0	976	WinIsDrive(
sl@0	977	CONST char name, / Name (UTF-8) */
sl@0	978	int len) /* Length of name */
sl@0	979	{
sl@0	980	int remove = 0;
sl@0	981	while (len > 4) {
sl@0	982	if ((name[len-1] != '.' \|\| name[len-2] != '.')
sl@0	983	\|\| (name[len-3] != '/' && name[len-3] != '\\')) {
sl@0	984	/* We don't have '/..' at the end */
sl@0	985	if (remove == 0) {
sl@0	986	break;
sl@0	987	}
sl@0	988	remove--;
sl@0	989	while (len > 0) {
sl@0	990	len--;
sl@0	991	if (name[len] == '/' \|\| name[len] == '\\') {
sl@0	992	break;
sl@0	993	}
sl@0	994	}
sl@0	995	if (len < 4) {
sl@0	996	len++;
sl@0	997	break;
sl@0	998	}
sl@0	999	} else {
sl@0	1000	/* We do have '/..' */
sl@0	1001	len -= 3;
sl@0	1002	remove++;
sl@0	1003	}
sl@0	1004	}
sl@0	1005	if (len < 4) {
sl@0	1006	if (len == 0) {
sl@0	1007	/*
sl@0	1008	* Not sure if this is possible, but we pass it on
sl@0	1009	* anyway
sl@0	1010	*/
sl@0	1011	} else if (len == 1 && (name[0] == '/' \|\| name[0] == '\\')) {
sl@0	1012	/* Path is pointing to the root volume */
sl@0	1013	return 1;
sl@0	1014	} else if ((name[1] == ':')
sl@0	1015	&& (len == 2 \|\| (name[2] == '/' \|\| name[2] == '\\'))) {
sl@0	1016	/* Path is of the form 'x:' or 'x:/' or 'x:\' */
sl@0	1017	return 1;
sl@0	1018	}
sl@0	1019	}
sl@0	1020	return 0;
sl@0	1021	}
sl@0	1022
sl@0	1023	/*
sl@0	1024	* Does the given path represent a reserved window path name? If not
sl@0	1025	* return 0, if true, return the number of characters of the path that
sl@0	1026	* we actually want (not any trailing :).
sl@0	1027	*/
sl@0	1028	static int WinIsReserved(
sl@0	1029	CONST char path) / Path in UTF-8 */
sl@0	1030	{
sl@0	1031	if ((path[0] == 'c' \|\| path[0] == 'C')
sl@0	1032	&& (path[1] == 'o' \|\| path[1] == 'O')) {
sl@0	1033	if ((path[2] == 'm' \|\| path[2] == 'M')
sl@0	1034	&& path[3] >= '1' && path[3] <= '4') {
sl@0	1035	/* May have match for 'com[1-4]:?', which is a serial port */
sl@0	1036	if (path[4] == '\0') {
sl@0	1037	return 4;
sl@0	1038	} else if (path [4] == ':' && path[5] == '\0') {
sl@0	1039	return 4;
sl@0	1040	}
sl@0	1041	} else if ((path[2] == 'n' \|\| path[2] == 'N') && path[3] == '\0') {
sl@0	1042	/* Have match for 'con' */
sl@0	1043	return 3;
sl@0	1044	}
sl@0	1045	} else if ((path[0] == 'l' \|\| path[0] == 'L')
sl@0	1046	&& (path[1] == 'p' \|\| path[1] == 'P')
sl@0	1047	&& (path[2] == 't' \|\| path[2] == 'T')) {
sl@0	1048	if (path[3] >= '1' && path[3] <= '3') {
sl@0	1049	/* May have match for 'lpt[1-3]:?' */
sl@0	1050	if (path[4] == '\0') {
sl@0	1051	return 4;
sl@0	1052	} else if (path [4] == ':' && path[5] == '\0') {
sl@0	1053	return 4;
sl@0	1054	}
sl@0	1055	}
sl@0	1056	} else if (stricmp(path, "prn") == 0) {
sl@0	1057	/* Have match for 'prn' */
sl@0	1058	return 3;
sl@0	1059	} else if (stricmp(path, "nul") == 0) {
sl@0	1060	/* Have match for 'nul' */
sl@0	1061	return 3;
sl@0	1062	} else if (stricmp(path, "aux") == 0) {
sl@0	1063	/* Have match for 'aux' */
sl@0	1064	return 3;
sl@0	1065	}
sl@0	1066	return 0;
sl@0	1067	}
sl@0	1068
sl@0	1069	/*
sl@0	1070	*----------------------------------------------------------------------
sl@0	1071	*
sl@0	1072	* NativeMatchType --
sl@0	1073	*
sl@0	1074	* This function needs a special case for a path which is a root
sl@0	1075	* volume, because for NTFS root volumes, the getFileAttributesProc
sl@0	1076	* returns a 'hidden' attribute when it should not.
sl@0	1077	*
sl@0	1078	* We never make any calss to a 'get attributes' routine here,
sl@0	1079	* since we have arranged things so that our caller already knows
sl@0	1080	* such information.
sl@0	1081	*
sl@0	1082	* Results:
sl@0	1083	* 0 = file doesn't match
sl@0	1084	* 1 = file matches
sl@0	1085	*
sl@0	1086	*----------------------------------------------------------------------
sl@0	1087	*/
sl@0	1088	static int
sl@0	1089	NativeMatchType(
sl@0	1090	int isDrive, /* Is this a drive */
sl@0	1091	DWORD attr, /* We already know the attributes
sl@0	1092	* for the file */
sl@0	1093	CONST TCHAR* nativeName, /* Native path to check */
sl@0	1094	Tcl_GlobTypeData types) / Type description to match against */
sl@0	1095	{
sl@0	1096	/*
sl@0	1097	* 'attr' represents the attributes of the file, but we only
sl@0	1098	* want to retrieve this info if it is absolutely necessary
sl@0	1099	* because it is an expensive call. Unfortunately, to deal
sl@0	1100	* with hidden files properly, we must always retrieve it.
sl@0	1101	*/
sl@0	1102
sl@0	1103	if (types == NULL) {
sl@0	1104	/* If invisible, don't return the file */
sl@0	1105	if (attr & FILE_ATTRIBUTE_HIDDEN && !isDrive) {
sl@0	1106	return 0;
sl@0	1107	}
sl@0	1108	} else {
sl@0	1109	if (attr & FILE_ATTRIBUTE_HIDDEN && !isDrive) {
sl@0	1110	/* If invisible */
sl@0	1111	if ((types->perm == 0) \|\|
sl@0	1112	!(types->perm & TCL_GLOB_PERM_HIDDEN)) {
sl@0	1113	return 0;
sl@0	1114	}
sl@0	1115	} else {
sl@0	1116	/* Visible */
sl@0	1117	if (types->perm & TCL_GLOB_PERM_HIDDEN) {
sl@0	1118	return 0;
sl@0	1119	}
sl@0	1120	}
sl@0	1121
sl@0	1122	if (types->perm != 0) {
sl@0	1123	if (
sl@0	1124	((types->perm & TCL_GLOB_PERM_RONLY) &&
sl@0	1125	!(attr & FILE_ATTRIBUTE_READONLY)) \|\|
sl@0	1126	((types->perm & TCL_GLOB_PERM_R) &&
sl@0	1127	(0 /* File exists => R_OK on Windows */)) \|\|
sl@0	1128	((types->perm & TCL_GLOB_PERM_W) &&
sl@0	1129	(attr & FILE_ATTRIBUTE_READONLY)) \|\|
sl@0	1130	((types->perm & TCL_GLOB_PERM_X) &&
sl@0	1131	(!(attr & FILE_ATTRIBUTE_DIRECTORY)
sl@0	1132	&& !NativeIsExec(nativeName)))
sl@0	1133	) {
sl@0	1134	return 0;
sl@0	1135	}
sl@0	1136	}
sl@0	1137	if ((types->type & TCL_GLOB_TYPE_DIR)
sl@0	1138	&& (attr & FILE_ATTRIBUTE_DIRECTORY)) {
sl@0	1139	/* Quicker test for directory, which is a common case */
sl@0	1140	return 1;
sl@0	1141	} else if (types->type != 0) {
sl@0	1142	unsigned short st_mode;
sl@0	1143	int isExec = NativeIsExec(nativeName);
sl@0	1144
sl@0	1145	st_mode = NativeStatMode(attr, 0, isExec);
sl@0	1146
sl@0	1147	/*
sl@0	1148	* In order bcdpfls as in 'find -t'
sl@0	1149	*/
sl@0	1150	if (
sl@0	1151	((types->type & TCL_GLOB_TYPE_BLOCK) &&
sl@0	1152	S_ISBLK(st_mode)) \|\|
sl@0	1153	((types->type & TCL_GLOB_TYPE_CHAR) &&
sl@0	1154	S_ISCHR(st_mode)) \|\|
sl@0	1155	((types->type & TCL_GLOB_TYPE_DIR) &&
sl@0	1156	S_ISDIR(st_mode)) \|\|
sl@0	1157	((types->type & TCL_GLOB_TYPE_PIPE) &&
sl@0	1158	S_ISFIFO(st_mode)) \|\|
sl@0	1159	((types->type & TCL_GLOB_TYPE_FILE) &&
sl@0	1160	S_ISREG(st_mode))
sl@0	1161	#ifdef S_ISSOCK
sl@0	1162	\|\| ((types->type & TCL_GLOB_TYPE_SOCK) &&
sl@0	1163	S_ISSOCK(st_mode))
sl@0	1164	#endif
sl@0	1165	) {
sl@0	1166	/* Do nothing -- this file is ok */
sl@0	1167	} else {
sl@0	1168	#ifdef S_ISLNK
sl@0	1169	if (types->type & TCL_GLOB_TYPE_LINK) {
sl@0	1170	st_mode = NativeStatMode(attr, 1, isExec);
sl@0	1171	if (S_ISLNK(st_mode)) {
sl@0	1172	return 1;
sl@0	1173	}
sl@0	1174	}
sl@0	1175	#endif
sl@0	1176	return 0;
sl@0	1177	}
sl@0	1178	}
sl@0	1179	}
sl@0	1180	return 1;
sl@0	1181	}
sl@0	1182
sl@0	1183	/*
sl@0	1184	*----------------------------------------------------------------------
sl@0	1185	*
sl@0	1186	* TclpGetUserHome --
sl@0	1187	*
sl@0	1188	* This function takes the passed in user name and finds the
sl@0	1189	* corresponding home directory specified in the password file.
sl@0	1190	*
sl@0	1191	* Results:
sl@0	1192	* The result is a pointer to a string specifying the user's home
sl@0	1193	* directory, or NULL if the user's home directory could not be
sl@0	1194	* determined. Storage for the result string is allocated in
sl@0	1195	* bufferPtr; the caller must call Tcl_DStringFree() when the result
sl@0	1196	* is no longer needed.
sl@0	1197	*
sl@0	1198	* Side effects:
sl@0	1199	* None.
sl@0	1200	*
sl@0	1201	*----------------------------------------------------------------------
sl@0	1202	*/
sl@0	1203
sl@0	1204	char *
sl@0	1205	TclpGetUserHome(name, bufferPtr)
sl@0	1206	CONST char name; / User name for desired home directory. */
sl@0	1207	Tcl_DString bufferPtr; / Uninitialized or free DString filled
sl@0	1208	* with name of user's home directory. */
sl@0	1209	{
sl@0	1210	char *result;
sl@0	1211	HINSTANCE netapiInst;
sl@0	1212
sl@0	1213	result = NULL;
sl@0	1214
sl@0	1215	Tcl_DStringInit(bufferPtr);
sl@0	1216
sl@0	1217	netapiInst = LoadLibraryA("netapi32.dll");
sl@0	1218	if (netapiInst != NULL) {
sl@0	1219	NETAPIBUFFERFREEPROC *netApiBufferFreeProc;
sl@0	1220	NETGETDCNAMEPROC *netGetDCNameProc;
sl@0	1221	NETUSERGETINFOPROC *netUserGetInfoProc;
sl@0	1222
sl@0	1223	netApiBufferFreeProc = (NETAPIBUFFERFREEPROC *)
sl@0	1224	GetProcAddress(netapiInst, "NetApiBufferFree");
sl@0	1225	netGetDCNameProc = (NETGETDCNAMEPROC *)
sl@0	1226	GetProcAddress(netapiInst, "NetGetDCName");
sl@0	1227	netUserGetInfoProc = (NETUSERGETINFOPROC *)
sl@0	1228	GetProcAddress(netapiInst, "NetUserGetInfo");
sl@0	1229	if ((netUserGetInfoProc != NULL) && (netGetDCNameProc != NULL)
sl@0	1230	&& (netApiBufferFreeProc != NULL)) {
sl@0	1231	USER_INFO_1 *uiPtr;
sl@0	1232	Tcl_DString ds;
sl@0	1233	int nameLen, badDomain;
sl@0	1234	char *domain;
sl@0	1235	WCHAR wName, wHomeDir, *wDomain;
sl@0	1236	WCHAR buf[MAX_PATH];
sl@0	1237
sl@0	1238	badDomain = 0;
sl@0	1239	nameLen = -1;
sl@0	1240	wDomain = NULL;
sl@0	1241	domain = strchr(name, '@');
sl@0	1242	if (domain != NULL) {
sl@0	1243	Tcl_DStringInit(&ds);
sl@0	1244	wName = Tcl_UtfToUniCharDString(domain + 1, -1, &ds);
sl@0	1245	badDomain = (*netGetDCNameProc)(NULL, wName,
sl@0	1246	(LPBYTE *) &wDomain);
sl@0	1247	Tcl_DStringFree(&ds);
sl@0	1248	nameLen = domain - name;
sl@0	1249	}
sl@0	1250	if (badDomain == 0) {
sl@0	1251	Tcl_DStringInit(&ds);
sl@0	1252	wName = Tcl_UtfToUniCharDString(name, nameLen, &ds);
sl@0	1253	if ((*netUserGetInfoProc)(wDomain, wName, 1,
sl@0	1254	(LPBYTE *) &uiPtr) == 0) {
sl@0	1255	wHomeDir = uiPtr->usri1_home_dir;
sl@0	1256	if ((wHomeDir != NULL) && (wHomeDir[0] != L'\0')) {
sl@0	1257	Tcl_UniCharToUtfDString(wHomeDir, lstrlenW(wHomeDir),
sl@0	1258	bufferPtr);
sl@0	1259	} else {
sl@0	1260	/*
sl@0	1261	* User exists but has no home dir. Return
sl@0	1262	* "{Windows Drive}:/users/default".
sl@0	1263	*/
sl@0	1264
sl@0	1265	GetWindowsDirectoryW(buf, MAX_PATH);
sl@0	1266	Tcl_UniCharToUtfDString(buf, 2, bufferPtr);
sl@0	1267	Tcl_DStringAppend(bufferPtr, "/users/default", -1);
sl@0	1268	}
sl@0	1269	result = Tcl_DStringValue(bufferPtr);
sl@0	1270	(netApiBufferFreeProc)((void ) uiPtr);
sl@0	1271	}
sl@0	1272	Tcl_DStringFree(&ds);
sl@0	1273	}
sl@0	1274	if (wDomain != NULL) {
sl@0	1275	(netApiBufferFreeProc)((void ) wDomain);
sl@0	1276	}
sl@0	1277	}
sl@0	1278	FreeLibrary(netapiInst);
sl@0	1279	}
sl@0	1280	if (result == NULL) {
sl@0	1281	/*
sl@0	1282	* Look in the "Password Lists" section of system.ini for the
sl@0	1283	* local user. There are also entries in that section that begin
sl@0	1284	* with a "*" character that are used by Windows for other
sl@0	1285	* purposes; ignore user names beginning with a "*".
sl@0	1286	*/
sl@0	1287
sl@0	1288	char buf[MAX_PATH];
sl@0	1289
sl@0	1290	if (name[0] != '*') {
sl@0	1291	if (GetPrivateProfileStringA("Password Lists", name, "", buf,
sl@0	1292	MAX_PATH, "system.ini") > 0) {
sl@0	1293	/*
sl@0	1294	* User exists, but there is no such thing as a home
sl@0	1295	* directory in system.ini. Return "{Windows drive}:/".
sl@0	1296	*/
sl@0	1297
sl@0	1298	GetWindowsDirectoryA(buf, MAX_PATH);
sl@0	1299	Tcl_DStringAppend(bufferPtr, buf, 3);
sl@0	1300	result = Tcl_DStringValue(bufferPtr);
sl@0	1301	}
sl@0	1302	}
sl@0	1303	}
sl@0	1304
sl@0	1305	return result;
sl@0	1306	}
sl@0	1307
sl@0	1308	/*
sl@0	1309	*---------------------------------------------------------------------------
sl@0	1310	*
sl@0	1311	* NativeAccess --
sl@0	1312	*
sl@0	1313	* This function replaces the library version of access(), fixing the
sl@0	1314	* following bugs:
sl@0	1315	*
sl@0	1316	* 1. access() returns that all files have execute permission.
sl@0	1317	*
sl@0	1318	* Results:
sl@0	1319	* See access documentation.
sl@0	1320	*
sl@0	1321	* Side effects:
sl@0	1322	* See access documentation.
sl@0	1323	*
sl@0	1324	*---------------------------------------------------------------------------
sl@0	1325	*/
sl@0	1326
sl@0	1327	static int
sl@0	1328	NativeAccess(
sl@0	1329	CONST TCHAR nativePath, / Path of file to access (UTF-8). */
sl@0	1330	int mode) /* Permission setting. */
sl@0	1331	{
sl@0	1332	DWORD attr;
sl@0	1333
sl@0	1334	attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
sl@0	1335
sl@0	1336	if (attr == 0xffffffff) {
sl@0	1337	/*
sl@0	1338	* File doesn't exist.
sl@0	1339	*/
sl@0	1340
sl@0	1341	TclWinConvertError(GetLastError());
sl@0	1342	return -1;
sl@0	1343	}
sl@0	1344
sl@0	1345	if ((mode & W_OK)
sl@0	1346	&& (tclWinProcs->getFileSecurityProc == NULL)
sl@0	1347	&& (attr & FILE_ATTRIBUTE_READONLY)) {
sl@0	1348	/*
sl@0	1349	* We don't have the advanced 'getFileSecurityProc', and
sl@0	1350	* our attributes say the file is not writable. If we
sl@0	1351	* do have 'getFileSecurityProc', we'll do a more
sl@0	1352	* robust XP-related check below.
sl@0	1353	*/
sl@0	1354
sl@0	1355	Tcl_SetErrno(EACCES);
sl@0	1356	return -1;
sl@0	1357	}
sl@0	1358
sl@0	1359	if (mode & X_OK) {
sl@0	1360	if (!(attr & FILE_ATTRIBUTE_DIRECTORY) && !NativeIsExec(nativePath)) {
sl@0	1361	/*
sl@0	1362	* It's not a directory and doesn't have the correct extension.
sl@0	1363	* Therefore it can't be executable
sl@0	1364	*/
sl@0	1365
sl@0	1366	Tcl_SetErrno(EACCES);
sl@0	1367	return -1;
sl@0	1368	}
sl@0	1369	}
sl@0	1370
sl@0	1371	/*
sl@0	1372	* It looks as if the permissions are ok, but if we are on NT, 2000 or XP,
sl@0	1373	* we have a more complex permissions structure so we try to check that.
sl@0	1374	* The code below is remarkably complex for such a simple thing as finding
sl@0	1375	* what permissions the OS has set for a file.
sl@0	1376	*
sl@0	1377	* If we are simply checking for file existence, then we don't need all
sl@0	1378	* these complications (which are really quite slow: with this code 'file
sl@0	1379	* readable' is 5-6 times slower than 'file exists').
sl@0	1380	*/
sl@0	1381
sl@0	1382	if ((mode != F_OK) && (tclWinProcs->getFileSecurityProc != NULL)) {
sl@0	1383	SECURITY_DESCRIPTOR *sdPtr = NULL;
sl@0	1384	unsigned long size;
sl@0	1385	GENERIC_MAPPING genMap;
sl@0	1386	HANDLE hToken = NULL;
sl@0	1387	DWORD desiredAccess = 0;
sl@0	1388	DWORD grantedAccess = 0;
sl@0	1389	BOOL accessYesNo = FALSE;
sl@0	1390	PRIVILEGE_SET privSet;
sl@0	1391	DWORD privSetSize = sizeof(PRIVILEGE_SET);
sl@0	1392	int error;
sl@0	1393
sl@0	1394	/*
sl@0	1395	* First find out how big the buffer needs to be
sl@0	1396	*/
sl@0	1397
sl@0	1398	size = 0;
sl@0	1399	(*tclWinProcs->getFileSecurityProc)(nativePath,
sl@0	1400	OWNER_SECURITY_INFORMATION \| GROUP_SECURITY_INFORMATION
sl@0	1401	\| DACL_SECURITY_INFORMATION, 0, 0, &size);
sl@0	1402
sl@0	1403	/*
sl@0	1404	* Should have failed with ERROR_INSUFFICIENT_BUFFER
sl@0	1405	*/
sl@0	1406
sl@0	1407	error = GetLastError();
sl@0	1408	if (error != ERROR_INSUFFICIENT_BUFFER) {
sl@0	1409	/*
sl@0	1410	* Most likely case is ERROR_ACCESS_DENIED, which we will convert
sl@0	1411	* to EACCES - just what we want!
sl@0	1412	*/
sl@0	1413
sl@0	1414	TclWinConvertError((DWORD)error);
sl@0	1415	return -1;
sl@0	1416	}
sl@0	1417
sl@0	1418	/*
sl@0	1419	* Now size contains the size of buffer needed
sl@0	1420	*/
sl@0	1421
sl@0	1422	sdPtr = (SECURITY_DESCRIPTOR *) HeapAlloc(GetProcessHeap(), 0, size);
sl@0	1423
sl@0	1424	if (sdPtr == NULL) {
sl@0	1425	goto accessError;
sl@0	1426	}
sl@0	1427
sl@0	1428	/*
sl@0	1429	* Call GetFileSecurity() for real
sl@0	1430	*/
sl@0	1431
sl@0	1432	if (!(*tclWinProcs->getFileSecurityProc)(nativePath,
sl@0	1433	OWNER_SECURITY_INFORMATION \| GROUP_SECURITY_INFORMATION
sl@0	1434	\| DACL_SECURITY_INFORMATION, sdPtr, size, &size)) {
sl@0	1435	/*
sl@0	1436	* Error getting owner SD
sl@0	1437	*/
sl@0	1438
sl@0	1439	goto accessError;
sl@0	1440	}
sl@0	1441
sl@0	1442	/*
sl@0	1443	* Perform security impersonation of the user and open the
sl@0	1444	* resulting thread token.
sl@0	1445	*/
sl@0	1446
sl@0	1447	if (!(*tclWinProcs->impersonateSelfProc)(SecurityImpersonation)) {
sl@0	1448	/*
sl@0	1449	* Unable to perform security impersonation.
sl@0	1450	*/
sl@0	1451
sl@0	1452	goto accessError;
sl@0	1453	}
sl@0	1454	if (!(*tclWinProcs->openThreadTokenProc)(GetCurrentThread (),
sl@0	1455	TOKEN_DUPLICATE \| TOKEN_QUERY, FALSE, &hToken)) {
sl@0	1456	/*
sl@0	1457	* Unable to get current thread's token.
sl@0	1458	*/
sl@0	1459
sl@0	1460	goto accessError;
sl@0	1461	}
sl@0	1462
sl@0	1463	(*tclWinProcs->revertToSelfProc)();
sl@0	1464
sl@0	1465	/*
sl@0	1466	* Setup desiredAccess according to the access priveleges we are
sl@0	1467	* checking.
sl@0	1468	*/
sl@0	1469
sl@0	1470	if (mode & R_OK) {
sl@0	1471	desiredAccess \|= FILE_GENERIC_READ;
sl@0	1472	}
sl@0	1473	if (mode & W_OK) {
sl@0	1474	desiredAccess \|= FILE_GENERIC_WRITE;
sl@0	1475	}
sl@0	1476	if (mode & X_OK) {
sl@0	1477	desiredAccess \|= FILE_GENERIC_EXECUTE;
sl@0	1478	}
sl@0	1479
sl@0	1480	memset (&genMap, 0x0, sizeof (GENERIC_MAPPING));
sl@0	1481	genMap.GenericRead = FILE_GENERIC_READ;
sl@0	1482	genMap.GenericWrite = FILE_GENERIC_WRITE;
sl@0	1483	genMap.GenericExecute = FILE_GENERIC_EXECUTE;
sl@0	1484	genMap.GenericAll = FILE_ALL_ACCESS;
sl@0	1485
sl@0	1486	/*
sl@0	1487	* Perform access check using the token.
sl@0	1488	*/
sl@0	1489
sl@0	1490	if (!(*tclWinProcs->accessCheckProc)(sdPtr, hToken, desiredAccess,
sl@0	1491	&genMap, &privSet, &privSetSize, &grantedAccess,
sl@0	1492	&accessYesNo)) {
sl@0	1493	/*
sl@0	1494	* Unable to perform access check.
sl@0	1495	*/
sl@0	1496
sl@0	1497	accessError:
sl@0	1498	TclWinConvertError(GetLastError());
sl@0	1499	if (sdPtr != NULL) {
sl@0	1500	HeapFree(GetProcessHeap(), 0, sdPtr);
sl@0	1501	}
sl@0	1502	if (hToken != NULL) {
sl@0	1503	CloseHandle(hToken);
sl@0	1504	}
sl@0	1505	return -1;
sl@0	1506	}
sl@0	1507
sl@0	1508	/*
sl@0	1509	* Clean up.
sl@0	1510	*/
sl@0	1511
sl@0	1512	HeapFree(GetProcessHeap (), 0, sdPtr);
sl@0	1513	CloseHandle(hToken);
sl@0	1514	if (!accessYesNo) {
sl@0	1515	Tcl_SetErrno(EACCES);
sl@0	1516	return -1;
sl@0	1517	}
sl@0	1518	/*
sl@0	1519	* For directories the above checks are ok. For files, though,
sl@0	1520	* we must still check the 'attr' value.
sl@0	1521	*/
sl@0	1522	if ((mode & W_OK)
sl@0	1523	&& !(attr & FILE_ATTRIBUTE_DIRECTORY)
sl@0	1524	&& (attr & FILE_ATTRIBUTE_READONLY)) {
sl@0	1525	Tcl_SetErrno(EACCES);
sl@0	1526	return -1;
sl@0	1527	}
sl@0	1528	}
sl@0	1529	return 0;
sl@0	1530	}
sl@0	1531
sl@0	1532	/*
sl@0	1533	*----------------------------------------------------------------------
sl@0	1534	*
sl@0	1535	* NativeIsExec --
sl@0	1536	*
sl@0	1537	* Determines if a path is executable. On windows this is
sl@0	1538	* simply defined by whether the path ends in any of ".exe",
sl@0	1539	* ".com", or ".bat"
sl@0	1540	*
sl@0	1541	* Results:
sl@0	1542	* 1 = executable, 0 = not.
sl@0	1543	*
sl@0	1544	*----------------------------------------------------------------------
sl@0	1545	*/
sl@0	1546	static int
sl@0	1547	NativeIsExec(nativePath)
sl@0	1548	CONST TCHAR *nativePath;
sl@0	1549	{
sl@0	1550	if (tclWinProcs->useWide) {
sl@0	1551	CONST WCHAR *path;
sl@0	1552	int len;
sl@0	1553
sl@0	1554	path = (CONST WCHAR*)nativePath;
sl@0	1555	len = wcslen(path);
sl@0	1556
sl@0	1557	if (len < 5) {
sl@0	1558	return 0;
sl@0	1559	}
sl@0	1560
sl@0	1561	if (path[len-4] != L'.') {
sl@0	1562	return 0;
sl@0	1563	}
sl@0	1564
sl@0	1565	/*
sl@0	1566	* Use wide-char case-insensitive comparison
sl@0	1567	*/
sl@0	1568	if ((_wcsicmp(path+len-3,L"exe") == 0)
sl@0	1569	\|\| (_wcsicmp(path+len-3,L"com") == 0)
sl@0	1570	\|\| (_wcsicmp(path+len-3,L"bat") == 0)) {
sl@0	1571	return 1;
sl@0	1572	}
sl@0	1573	} else {
sl@0	1574	CONST char *p;
sl@0	1575
sl@0	1576	/* We are only looking for pure ascii */
sl@0	1577
sl@0	1578	p = strrchr((CONST char*)nativePath, '.');
sl@0	1579	if (p != NULL) {
sl@0	1580	p++;
sl@0	1581	/*
sl@0	1582	* Note: in the old code, stat considered '.pif' files as
sl@0	1583	* executable, whereas access did not.
sl@0	1584	*/
sl@0	1585	if ((stricmp(p, "exe") == 0)
sl@0	1586	\|\| (stricmp(p, "com") == 0)
sl@0	1587	\|\| (stricmp(p, "bat") == 0)) {
sl@0	1588	/*
sl@0	1589	* File that ends with .exe, .com, or .bat is executable.
sl@0	1590	*/
sl@0	1591
sl@0	1592	return 1;
sl@0	1593	}
sl@0	1594	}
sl@0	1595	}
sl@0	1596	return 0;
sl@0	1597	}
sl@0	1598
sl@0	1599	/*
sl@0	1600	*----------------------------------------------------------------------
sl@0	1601	*
sl@0	1602	* TclpObjChdir --
sl@0	1603	*
sl@0	1604	* This function replaces the library version of chdir().
sl@0	1605	*
sl@0	1606	* Results:
sl@0	1607	* See chdir() documentation.
sl@0	1608	*
sl@0	1609	* Side effects:
sl@0	1610	* See chdir() documentation.
sl@0	1611	*
sl@0	1612	*----------------------------------------------------------------------
sl@0	1613	*/
sl@0	1614
sl@0	1615	int
sl@0	1616	TclpObjChdir(pathPtr)
sl@0	1617	Tcl_Obj pathPtr; / Path to new working directory. */
sl@0	1618	{
sl@0	1619	int result;
sl@0	1620	CONST TCHAR *nativePath;
sl@0	1621	#ifdef __CYGWIN__
sl@0	1622	extern int cygwin_conv_to_posix_path
sl@0	1623	_ANSI_ARGS_((CONST char , char ));
sl@0	1624	char posixPath[MAX_PATH+1];
sl@0	1625	CONST char *path;
sl@0	1626	Tcl_DString ds;
sl@0	1627	#endif /* __CYGWIN__ */
sl@0	1628
sl@0	1629	nativePath = (CONST TCHAR *) Tcl_FSGetNativePath(pathPtr);
sl@0	1630	#ifdef __CYGWIN__
sl@0	1631	/* Cygwin chdir only groks POSIX path. */
sl@0	1632	path = Tcl_WinTCharToUtf(nativePath, -1, &ds);
sl@0	1633	cygwin_conv_to_posix_path(path, posixPath);
sl@0	1634	result = (chdir(posixPath) == 0 ? 1 : 0);
sl@0	1635	Tcl_DStringFree(&ds);
sl@0	1636	#else /* __CYGWIN__ */
sl@0	1637	result = (*tclWinProcs->setCurrentDirectoryProc)(nativePath);
sl@0	1638	#endif /* __CYGWIN__ */
sl@0	1639
sl@0	1640	if (result == 0) {
sl@0	1641	TclWinConvertError(GetLastError());
sl@0	1642	return -1;
sl@0	1643	}
sl@0	1644	return 0;
sl@0	1645	}
sl@0	1646
sl@0	1647	#ifdef __CYGWIN__
sl@0	1648	/*
sl@0	1649	*---------------------------------------------------------------------------
sl@0	1650	*
sl@0	1651	* TclpReadlink --
sl@0	1652	*
sl@0	1653	* This function replaces the library version of readlink().
sl@0	1654	*
sl@0	1655	* Results:
sl@0	1656	* The result is a pointer to a string specifying the contents
sl@0	1657	* of the symbolic link given by 'path', or NULL if the symbolic
sl@0	1658	* link could not be read. Storage for the result string is
sl@0	1659	* allocated in bufferPtr; the caller must call Tcl_DStringFree()
sl@0	1660	* when the result is no longer needed.
sl@0	1661	*
sl@0	1662	* Side effects:
sl@0	1663	* See readlink() documentation.
sl@0	1664	*
sl@0	1665	*---------------------------------------------------------------------------
sl@0	1666	*/
sl@0	1667
sl@0	1668	char *
sl@0	1669	TclpReadlink(path, linkPtr)
sl@0	1670	CONST char path; / Path of file to readlink (UTF-8). */
sl@0	1671	Tcl_DString linkPtr; / Uninitialized or free DString filled
sl@0	1672	* with contents of link (UTF-8). */
sl@0	1673	{
sl@0	1674	char link[MAXPATHLEN];
sl@0	1675	int length;
sl@0	1676	char *native;
sl@0	1677	Tcl_DString ds;
sl@0	1678
sl@0	1679	native = Tcl_UtfToExternalDString(NULL, path, -1, &ds);
sl@0	1680	length = readlink(native, link, sizeof(link)); /* INTL: Native. */
sl@0	1681	Tcl_DStringFree(&ds);
sl@0	1682
sl@0	1683	if (length < 0) {
sl@0	1684	return NULL;
sl@0	1685	}
sl@0	1686
sl@0	1687	Tcl_ExternalToUtfDString(NULL, link, length, linkPtr);
sl@0	1688	return Tcl_DStringValue(linkPtr);
sl@0	1689	}
sl@0	1690	#endif /* __CYGWIN__ */
sl@0	1691
sl@0	1692	/*
sl@0	1693	*----------------------------------------------------------------------
sl@0	1694	*
sl@0	1695	* TclpGetCwd --
sl@0	1696	*
sl@0	1697	* This function replaces the library version of getcwd().
sl@0	1698	*
sl@0	1699	* Results:
sl@0	1700	* The result is a pointer to a string specifying the current
sl@0	1701	* directory, or NULL if the current directory could not be
sl@0	1702	* determined. If NULL is returned, an error message is left in the
sl@0	1703	* interp's result. Storage for the result string is allocated in
sl@0	1704	* bufferPtr; the caller must call Tcl_DStringFree() when the result
sl@0	1705	* is no longer needed.
sl@0	1706	*
sl@0	1707	* Side effects:
sl@0	1708	* None.
sl@0	1709	*
sl@0	1710	*----------------------------------------------------------------------
sl@0	1711	*/
sl@0	1712
sl@0	1713	CONST char *
sl@0	1714	TclpGetCwd(interp, bufferPtr)
sl@0	1715	Tcl_Interp interp; / If non-NULL, used for error reporting. */
sl@0	1716	Tcl_DString bufferPtr; / Uninitialized or free DString filled
sl@0	1717	* with name of current directory. */
sl@0	1718	{
sl@0	1719	WCHAR buffer[MAX_PATH];
sl@0	1720	char *p;
sl@0	1721
sl@0	1722	if ((*tclWinProcs->getCurrentDirectoryProc)(MAX_PATH, buffer) == 0) {
sl@0	1723	TclWinConvertError(GetLastError());
sl@0	1724	if (interp != NULL) {
sl@0	1725	Tcl_AppendResult(interp,
sl@0	1726	"error getting working directory name: ",
sl@0	1727	Tcl_PosixError(interp), (char *) NULL);
sl@0	1728	}
sl@0	1729	return NULL;
sl@0	1730	}
sl@0	1731
sl@0	1732	/*
sl@0	1733	* Watch for the weird Windows c:\\UNC syntax.
sl@0	1734	*/
sl@0	1735
sl@0	1736	if (tclWinProcs->useWide) {
sl@0	1737	WCHAR *native;
sl@0	1738
sl@0	1739	native = (WCHAR *) buffer;
sl@0	1740	if ((native[0] != '\0') && (native[1] == ':')
sl@0	1741	&& (native[2] == '\\') && (native[3] == '\\')) {
sl@0	1742	native += 2;
sl@0	1743	}
sl@0	1744	Tcl_WinTCharToUtf((TCHAR *) native, -1, bufferPtr);
sl@0	1745	} else {
sl@0	1746	char *native;
sl@0	1747
sl@0	1748	native = (char *) buffer;
sl@0	1749	if ((native[0] != '\0') && (native[1] == ':')
sl@0	1750	&& (native[2] == '\\') && (native[3] == '\\')) {
sl@0	1751	native += 2;
sl@0	1752	}
sl@0	1753	Tcl_WinTCharToUtf((TCHAR *) native, -1, bufferPtr);
sl@0	1754	}
sl@0	1755
sl@0	1756	/*
sl@0	1757	* Convert to forward slashes for easier use in scripts.
sl@0	1758	*/
sl@0	1759
sl@0	1760	for (p = Tcl_DStringValue(bufferPtr); *p != '\0'; p++) {
sl@0	1761	if (*p == '\\') {
sl@0	1762	*p = '/';
sl@0	1763	}
sl@0	1764	}
sl@0	1765	return Tcl_DStringValue(bufferPtr);
sl@0	1766	}
sl@0	1767
sl@0	1768	int
sl@0	1769	TclpObjStat(pathPtr, statPtr)
sl@0	1770	Tcl_Obj pathPtr; / Path of file to stat */
sl@0	1771	Tcl_StatBuf statPtr; / Filled with results of stat call. */
sl@0	1772	{
sl@0	1773	#ifdef OLD_API
sl@0	1774	Tcl_Obj *transPtr;
sl@0	1775	/*
sl@0	1776	* Eliminate file names containing wildcard characters, or subsequent
sl@0	1777	* call to FindFirstFile() will expand them, matching some other file.
sl@0	1778	*/
sl@0	1779
sl@0	1780	transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
sl@0	1781	if (transPtr == NULL \|\| (strpbrk(Tcl_GetString(transPtr), "?*") != NULL)) {
sl@0	1782	if (transPtr != NULL) {
sl@0	1783	Tcl_DecrRefCount(transPtr);
sl@0	1784	}
sl@0	1785	Tcl_SetErrno(ENOENT);
sl@0	1786	return -1;
sl@0	1787	}
sl@0	1788	Tcl_DecrRefCount(transPtr);
sl@0	1789	#endif
sl@0	1790
sl@0	1791	/*
sl@0	1792	* Ensure correct file sizes by forcing the OS to write any
sl@0	1793	* pending data to disk. This is done only for channels which are
sl@0	1794	* dirty, i.e. have been written to since the last flush here.
sl@0	1795	*/
sl@0	1796
sl@0	1797	TclWinFlushDirtyChannels ();
sl@0	1798
sl@0	1799	return NativeStat((CONST TCHAR*) Tcl_FSGetNativePath(pathPtr), statPtr, 0);
sl@0	1800	}
sl@0	1801
sl@0	1802	/*
sl@0	1803	*----------------------------------------------------------------------
sl@0	1804	*
sl@0	1805	* NativeStat --
sl@0	1806	*
sl@0	1807	* This function replaces the library version of stat(), fixing
sl@0	1808	* the following bugs:
sl@0	1809	*
sl@0	1810	* 1. stat("c:") returns an error.
sl@0	1811	* 2. Borland stat() return time in GMT instead of localtime.
sl@0	1812	* 3. stat("\\server\mount") would return error.
sl@0	1813	* 4. Accepts slashes or backslashes.
sl@0	1814	* 5. st_dev and st_rdev were wrong for UNC paths.
sl@0	1815	*
sl@0	1816	* Results:
sl@0	1817	* See stat documentation.
sl@0	1818	*
sl@0	1819	* Side effects:
sl@0	1820	* See stat documentation.
sl@0	1821	*
sl@0	1822	*----------------------------------------------------------------------
sl@0	1823	*/
sl@0	1824
sl@0	1825	static int
sl@0	1826	NativeStat(nativePath, statPtr, checkLinks)
sl@0	1827	CONST TCHAR nativePath; / Path of file to stat */
sl@0	1828	Tcl_StatBuf statPtr; / Filled with results of stat call. */
sl@0	1829	int checkLinks; /* If non-zero, behave like 'lstat' */
sl@0	1830	{
sl@0	1831	Tcl_DString ds;
sl@0	1832	DWORD attr;
sl@0	1833	WCHAR nativeFullPath[MAX_PATH];
sl@0	1834	TCHAR *nativePart;
sl@0	1835	CONST char *fullPath;
sl@0	1836	int dev;
sl@0	1837	unsigned short mode;
sl@0	1838
sl@0	1839	if (tclWinProcs->getFileAttributesExProc == NULL) {
sl@0	1840	/*
sl@0	1841	* We don't have the faster attributes proc, so we're
sl@0	1842	* probably running on Win95
sl@0	1843	*/
sl@0	1844	WIN32_FIND_DATAT data;
sl@0	1845	HANDLE handle;
sl@0	1846
sl@0	1847	handle = (*tclWinProcs->findFirstFileProc)(nativePath, &data);
sl@0	1848	if (handle == INVALID_HANDLE_VALUE) {
sl@0	1849	/*
sl@0	1850	* FindFirstFile() doesn't work on root directories, so call
sl@0	1851	* GetFileAttributes() to see if the specified file exists.
sl@0	1852	*/
sl@0	1853
sl@0	1854	attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
sl@0	1855	if (attr == INVALID_FILE_ATTRIBUTES) {
sl@0	1856	Tcl_SetErrno(ENOENT);
sl@0	1857	return -1;
sl@0	1858	}
sl@0	1859
sl@0	1860	/*
sl@0	1861	* Make up some fake information for this file. It has the
sl@0	1862	* correct file attributes and a time of 0.
sl@0	1863	*/
sl@0	1864
sl@0	1865	memset(&data, 0, sizeof(data));
sl@0	1866	data.a.dwFileAttributes = attr;
sl@0	1867	} else {
sl@0	1868	FindClose(handle);
sl@0	1869	}
sl@0	1870
sl@0	1871
sl@0	1872	(*tclWinProcs->getFullPathNameProc)(nativePath, MAX_PATH, nativeFullPath,
sl@0	1873	&nativePart);
sl@0	1874
sl@0	1875	fullPath = Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds);
sl@0	1876
sl@0	1877	dev = -1;
sl@0	1878	if ((fullPath[0] == '\\') && (fullPath[1] == '\\')) {
sl@0	1879	CONST char *p;
sl@0	1880	DWORD dw;
sl@0	1881	CONST TCHAR *nativeVol;
sl@0	1882	Tcl_DString volString;
sl@0	1883
sl@0	1884	p = strchr(fullPath + 2, '\\');
sl@0	1885	p = strchr(p + 1, '\\');
sl@0	1886	if (p == NULL) {
sl@0	1887	/*
sl@0	1888	* Add terminating backslash to fullpath or
sl@0	1889	* GetVolumeInformation() won't work.
sl@0	1890	*/
sl@0	1891
sl@0	1892	fullPath = Tcl_DStringAppend(&ds, "\\", 1);
sl@0	1893	p = fullPath + Tcl_DStringLength(&ds);
sl@0	1894	} else {
sl@0	1895	p++;
sl@0	1896	}
sl@0	1897	nativeVol = Tcl_WinUtfToTChar(fullPath, p - fullPath, &volString);
sl@0	1898	dw = (DWORD) -1;
sl@0	1899	(*tclWinProcs->getVolumeInformationProc)(nativeVol, NULL, 0, &dw,
sl@0	1900	NULL, NULL, NULL, 0);
sl@0	1901	/*
sl@0	1902	* GetFullPathName() turns special devices like "NUL" into
sl@0	1903	* "\\.\NUL", but GetVolumeInformation() returns failure for
sl@0	1904	* "\\.\NUL". This will cause "NUL" to get a drive number of
sl@0	1905	* -1, which makes about as much sense as anything since the
sl@0	1906	* special devices don't live on any drive.
sl@0	1907	*/
sl@0	1908
sl@0	1909	dev = dw;
sl@0	1910	Tcl_DStringFree(&volString);
sl@0	1911	} else if ((fullPath[0] != '\0') && (fullPath[1] == ':')) {
sl@0	1912	dev = Tcl_UniCharToLower(fullPath[0]) - 'a';
sl@0	1913	}
sl@0	1914	Tcl_DStringFree(&ds);
sl@0	1915
sl@0	1916	attr = data.a.dwFileAttributes;
sl@0	1917
sl@0	1918	statPtr->st_size = ((Tcl_WideInt)data.a.nFileSizeLow) \|
sl@0	1919	(((Tcl_WideInt)data.a.nFileSizeHigh) << 32);
sl@0	1920	statPtr->st_atime = ToCTime(data.a.ftLastAccessTime);
sl@0	1921	statPtr->st_mtime = ToCTime(data.a.ftLastWriteTime);
sl@0	1922	statPtr->st_ctime = ToCTime(data.a.ftCreationTime);
sl@0	1923	} else {
sl@0	1924	WIN32_FILE_ATTRIBUTE_DATA data;
sl@0	1925	if((*tclWinProcs->getFileAttributesExProc)(nativePath,
sl@0	1926	GetFileExInfoStandard,
sl@0	1927	&data) != TRUE) {
sl@0	1928	Tcl_SetErrno(ENOENT);
sl@0	1929	return -1;
sl@0	1930	}
sl@0	1931
sl@0	1932
sl@0	1933	(*tclWinProcs->getFullPathNameProc)(nativePath, MAX_PATH,
sl@0	1934	nativeFullPath, &nativePart);
sl@0	1935
sl@0	1936	fullPath = Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds);
sl@0	1937
sl@0	1938	dev = -1;
sl@0	1939	if ((fullPath[0] == '\\') && (fullPath[1] == '\\')) {
sl@0	1940	CONST char *p;
sl@0	1941	DWORD dw;
sl@0	1942	CONST TCHAR *nativeVol;
sl@0	1943	Tcl_DString volString;
sl@0	1944
sl@0	1945	p = strchr(fullPath + 2, '\\');
sl@0	1946	p = strchr(p + 1, '\\');
sl@0	1947	if (p == NULL) {
sl@0	1948	/*
sl@0	1949	* Add terminating backslash to fullpath or
sl@0	1950	* GetVolumeInformation() won't work.
sl@0	1951	*/
sl@0	1952
sl@0	1953	fullPath = Tcl_DStringAppend(&ds, "\\", 1);
sl@0	1954	p = fullPath + Tcl_DStringLength(&ds);
sl@0	1955	} else {
sl@0	1956	p++;
sl@0	1957	}
sl@0	1958	nativeVol = Tcl_WinUtfToTChar(fullPath, p - fullPath, &volString);
sl@0	1959	dw = (DWORD) -1;
sl@0	1960	(*tclWinProcs->getVolumeInformationProc)(nativeVol, NULL, 0, &dw,
sl@0	1961	NULL, NULL, NULL, 0);
sl@0	1962	/*
sl@0	1963	* GetFullPathName() turns special devices like "NUL" into
sl@0	1964	* "\\.\NUL", but GetVolumeInformation() returns failure for
sl@0	1965	* "\\.\NUL". This will cause "NUL" to get a drive number of
sl@0	1966	* -1, which makes about as much sense as anything since the
sl@0	1967	* special devices don't live on any drive.
sl@0	1968	*/
sl@0	1969
sl@0	1970	dev = dw;
sl@0	1971	Tcl_DStringFree(&volString);
sl@0	1972	} else if ((fullPath[0] != '\0') && (fullPath[1] == ':')) {
sl@0	1973	dev = Tcl_UniCharToLower(fullPath[0]) - 'a';
sl@0	1974	}
sl@0	1975	Tcl_DStringFree(&ds);
sl@0	1976
sl@0	1977	attr = data.dwFileAttributes;
sl@0	1978
sl@0	1979	statPtr->st_size = ((Tcl_WideInt)data.nFileSizeLow) \|
sl@0	1980	(((Tcl_WideInt)data.nFileSizeHigh) << 32);
sl@0	1981	statPtr->st_atime = ToCTime(data.ftLastAccessTime);
sl@0	1982	statPtr->st_mtime = ToCTime(data.ftLastWriteTime);
sl@0	1983	statPtr->st_ctime = ToCTime(data.ftCreationTime);
sl@0	1984	}
sl@0	1985
sl@0	1986	mode = NativeStatMode(attr, checkLinks, NativeIsExec(nativePath));
sl@0	1987
sl@0	1988	statPtr->st_dev = (dev_t) dev;
sl@0	1989	statPtr->st_ino = 0;
sl@0	1990	statPtr->st_mode = mode;
sl@0	1991	statPtr->st_nlink = 1;
sl@0	1992	statPtr->st_uid = 0;
sl@0	1993	statPtr->st_gid = 0;
sl@0	1994	statPtr->st_rdev = (dev_t) dev;
sl@0	1995	return 0;
sl@0	1996	}
sl@0	1997
sl@0	1998	/*
sl@0	1999	*----------------------------------------------------------------------
sl@0	2000	*
sl@0	2001	* NativeStatMode --
sl@0	2002	*
sl@0	2003	* Calculate just the 'st_mode' field of a 'stat' structure.
sl@0	2004	*
sl@0	2005	*----------------------------------------------------------------------
sl@0	2006	*/
sl@0	2007	static unsigned short
sl@0	2008	NativeStatMode(DWORD attr, int checkLinks, int isExec)
sl@0	2009	{
sl@0	2010	int mode;
sl@0	2011	if (checkLinks && (attr & FILE_ATTRIBUTE_REPARSE_POINT)) {
sl@0	2012	/* It is a link */
sl@0	2013	mode = S_IFLNK;
sl@0	2014	} else {
sl@0	2015	mode = (attr & FILE_ATTRIBUTE_DIRECTORY) ? S_IFDIR \| S_IEXEC : S_IFREG;
sl@0	2016	}
sl@0	2017	mode \|= (attr & FILE_ATTRIBUTE_READONLY) ? S_IREAD : S_IREAD \| S_IWRITE;
sl@0	2018	if (isExec) {
sl@0	2019	mode \|= S_IEXEC;
sl@0	2020	}
sl@0	2021
sl@0	2022	/*
sl@0	2023	* Propagate the S_IREAD, S_IWRITE, S_IEXEC bits to the group and
sl@0	2024	* other positions.
sl@0	2025	*/
sl@0	2026
sl@0	2027	mode \|= (mode & 0x0700) >> 3;
sl@0	2028	mode \|= (mode & 0x0700) >> 6;
sl@0	2029	return (unsigned short)mode;
sl@0	2030	}
sl@0	2031
sl@0	2032	/*
sl@0	2033	*------------------------------------------------------------------------
sl@0	2034	*
sl@0	2035	* ToCTime --
sl@0	2036	*
sl@0	2037	* Converts a Windows FILETIME to a time_t in UTC.
sl@0	2038	*
sl@0	2039	* Results:
sl@0	2040	* Returns the count of seconds from the Posix epoch.
sl@0	2041	*
sl@0	2042	*------------------------------------------------------------------------
sl@0	2043	*/
sl@0	2044
sl@0	2045	static time_t
sl@0	2046	ToCTime(
sl@0	2047	FILETIME fileTime) /* UTC time */
sl@0	2048	{
sl@0	2049	LARGE_INTEGER convertedTime;
sl@0	2050
sl@0	2051	convertedTime.LowPart = fileTime.dwLowDateTime;
sl@0	2052	convertedTime.HighPart = (LONG) fileTime.dwHighDateTime;
sl@0	2053
sl@0	2054	return (time_t) ((convertedTime.QuadPart
sl@0	2055	- (Tcl_WideInt) POSIX_EPOCH_AS_FILETIME) / (Tcl_WideInt) 10000000);
sl@0	2056	}
sl@0	2057
sl@0	2058	/*
sl@0	2059	*------------------------------------------------------------------------
sl@0	2060	*
sl@0	2061	* FromCTime --
sl@0	2062	*
sl@0	2063	* Converts a time_t to a Windows FILETIME
sl@0	2064	*
sl@0	2065	* Results:
sl@0	2066	* Returns the count of 100-ns ticks seconds from the Windows epoch.
sl@0	2067	*
sl@0	2068	*------------------------------------------------------------------------
sl@0	2069	*/
sl@0	2070
sl@0	2071	static void
sl@0	2072	FromCTime(
sl@0	2073	time_t posixTime,
sl@0	2074	FILETIME* fileTime) /* UTC Time */
sl@0	2075	{
sl@0	2076	LARGE_INTEGER convertedTime;
sl@0	2077	convertedTime.QuadPart = ((LONGLONG) posixTime) * 10000000
sl@0	2078	+ POSIX_EPOCH_AS_FILETIME;
sl@0	2079	fileTime->dwLowDateTime = convertedTime.LowPart;
sl@0	2080	fileTime->dwHighDateTime = convertedTime.HighPart;
sl@0	2081	}
sl@0	2082
sl@0	2083	#if 0
sl@0	2084	/*
sl@0	2085	*-------------------------------------------------------------------------
sl@0	2086	*
sl@0	2087	* TclWinResolveShortcut --
sl@0	2088	*
sl@0	2089	* Resolve a potential Windows shortcut to get the actual file or
sl@0	2090	* directory in question.
sl@0	2091	*
sl@0	2092	* Results:
sl@0	2093	* Returns 1 if the shortcut could be resolved, or 0 if there was
sl@0	2094	* an error or if the filename was not a shortcut.
sl@0	2095	* If bufferPtr did hold the name of a shortcut, it is modified to
sl@0	2096	* hold the resolved target of the shortcut instead.
sl@0	2097	*
sl@0	2098	* Side effects:
sl@0	2099	* Loads and unloads OLE package to determine if filename refers to
sl@0	2100	* a shortcut.
sl@0	2101	*
sl@0	2102	*-------------------------------------------------------------------------
sl@0	2103	*/
sl@0	2104
sl@0	2105	int
sl@0	2106	TclWinResolveShortcut(bufferPtr)
sl@0	2107	Tcl_DString bufferPtr; / Holds name of file to resolve. On
sl@0	2108	* return, holds resolved file name. */
sl@0	2109	{
sl@0	2110	HRESULT hres;
sl@0	2111	IShellLink *psl;
sl@0	2112	IPersistFile *ppf;
sl@0	2113	WIN32_FIND_DATA wfd;
sl@0	2114	WCHAR wpath[MAX_PATH];
sl@0	2115	char path, ext;
sl@0	2116	char realFileName[MAX_PATH];
sl@0	2117
sl@0	2118	/*
sl@0	2119	* Windows system calls do not automatically resolve
sl@0	2120	* shortcuts like UNIX automatically will with symbolic links.
sl@0	2121	*/
sl@0	2122
sl@0	2123	path = Tcl_DStringValue(bufferPtr);
sl@0	2124	ext = strrchr(path, '.');
sl@0	2125	if ((ext == NULL) \|\| (stricmp(ext, ".lnk") != 0)) {
sl@0	2126	return 0;
sl@0	2127	}
sl@0	2128
sl@0	2129	CoInitialize(NULL);
sl@0	2130	path = Tcl_DStringValue(bufferPtr);
sl@0	2131	realFileName[0] = '\0';
sl@0	2132	hres = CoCreateInstance(&CLSID_ShellLink, NULL, CLSCTX_INPROC_SERVER,
sl@0	2133	&IID_IShellLink, &psl);
sl@0	2134	if (SUCCEEDED(hres)) {
sl@0	2135	hres = psl->lpVtbl->QueryInterface(psl, &IID_IPersistFile, &ppf);
sl@0	2136	if (SUCCEEDED(hres)) {
sl@0	2137	MultiByteToWideChar(CP_ACP, 0, path, -1, wpath, sizeof(wpath));
sl@0	2138	hres = ppf->lpVtbl->Load(ppf, wpath, STGM_READ);
sl@0	2139	if (SUCCEEDED(hres)) {
sl@0	2140	hres = psl->lpVtbl->Resolve(psl, NULL,
sl@0	2141	SLR_ANY_MATCH \| SLR_NO_UI);
sl@0	2142	if (SUCCEEDED(hres)) {
sl@0	2143	hres = psl->lpVtbl->GetPath(psl, realFileName, MAX_PATH,
sl@0	2144	&wfd, 0);
sl@0	2145	}
sl@0	2146	}
sl@0	2147	ppf->lpVtbl->Release(ppf);
sl@0	2148	}
sl@0	2149	psl->lpVtbl->Release(psl);
sl@0	2150	}
sl@0	2151	CoUninitialize();
sl@0	2152
sl@0	2153	if (realFileName[0] != '\0') {
sl@0	2154	Tcl_DStringSetLength(bufferPtr, 0);
sl@0	2155	Tcl_DStringAppend(bufferPtr, realFileName, -1);
sl@0	2156	return 1;
sl@0	2157	}
sl@0	2158	return 0;
sl@0	2159	}
sl@0	2160	#endif
sl@0	2161
sl@0	2162	Tcl_Obj*
sl@0	2163	TclpObjGetCwd(interp)
sl@0	2164	Tcl_Interp *interp;
sl@0	2165	{
sl@0	2166	Tcl_DString ds;
sl@0	2167	if (TclpGetCwd(interp, &ds) != NULL) {
sl@0	2168	Tcl_Obj *cwdPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
sl@0	2169	Tcl_IncrRefCount(cwdPtr);
sl@0	2170	Tcl_DStringFree(&ds);
sl@0	2171	return cwdPtr;
sl@0	2172	} else {
sl@0	2173	return NULL;
sl@0	2174	}
sl@0	2175	}
sl@0	2176
sl@0	2177	int
sl@0	2178	TclpObjAccess(pathPtr, mode)
sl@0	2179	Tcl_Obj *pathPtr;
sl@0	2180	int mode;
sl@0	2181	{
sl@0	2182	return NativeAccess((CONST TCHAR*) Tcl_FSGetNativePath(pathPtr), mode);
sl@0	2183	}
sl@0	2184
sl@0	2185	int
sl@0	2186	TclpObjLstat(pathPtr, statPtr)
sl@0	2187	Tcl_Obj *pathPtr;
sl@0	2188	Tcl_StatBuf *statPtr;
sl@0	2189	{
sl@0	2190	/*
sl@0	2191	* Ensure correct file sizes by forcing the OS to write any
sl@0	2192	* pending data to disk. This is done only for channels which are
sl@0	2193	* dirty, i.e. have been written to since the last flush here.
sl@0	2194	*/
sl@0	2195
sl@0	2196	TclWinFlushDirtyChannels ();
sl@0	2197
sl@0	2198	return NativeStat((CONST TCHAR*) Tcl_FSGetNativePath(pathPtr), statPtr, 1);
sl@0	2199	}
sl@0	2200
sl@0	2201	#ifdef S_IFLNK
sl@0	2202
sl@0	2203	Tcl_Obj*
sl@0	2204	TclpObjLink(pathPtr, toPtr, linkAction)
sl@0	2205	Tcl_Obj *pathPtr;
sl@0	2206	Tcl_Obj *toPtr;
sl@0	2207	int linkAction;
sl@0	2208	{
sl@0	2209	if (toPtr != NULL) {
sl@0	2210	int res;
sl@0	2211	TCHAR* LinkTarget = (TCHAR*)Tcl_FSGetNativePath(toPtr);
sl@0	2212	TCHAR* LinkSource = (TCHAR*)Tcl_FSGetNativePath(pathPtr);
sl@0	2213	if (LinkSource == NULL \|\| LinkTarget == NULL) {
sl@0	2214	return NULL;
sl@0	2215	}
sl@0	2216	res = WinLink(LinkSource, LinkTarget, linkAction);
sl@0	2217	if (res == 0) {
sl@0	2218	return toPtr;
sl@0	2219	} else {
sl@0	2220	return NULL;
sl@0	2221	}
sl@0	2222	} else {
sl@0	2223	TCHAR* LinkSource = (TCHAR*)Tcl_FSGetNativePath(pathPtr);
sl@0	2224	if (LinkSource == NULL) {
sl@0	2225	return NULL;
sl@0	2226	}
sl@0	2227	return WinReadLink(LinkSource);
sl@0	2228	}
sl@0	2229	}
sl@0	2230
sl@0	2231	#endif
sl@0	2232
sl@0	2233
sl@0	2234	/*
sl@0	2235	*---------------------------------------------------------------------------
sl@0	2236	*
sl@0	2237	* TclpFilesystemPathType --
sl@0	2238	*
sl@0	2239	* This function is part of the native filesystem support, and
sl@0	2240	* returns the path type of the given path. Returns NTFS or FAT
sl@0	2241	* or whatever is returned by the 'volume information' proc.
sl@0	2242	*
sl@0	2243	* Results:
sl@0	2244	* NULL at present.
sl@0	2245	*
sl@0	2246	* Side effects:
sl@0	2247	* None.
sl@0	2248	*
sl@0	2249	*---------------------------------------------------------------------------
sl@0	2250	*/
sl@0	2251	Tcl_Obj*
sl@0	2252	TclpFilesystemPathType(pathObjPtr)
sl@0	2253	Tcl_Obj* pathObjPtr;
sl@0	2254	{
sl@0	2255	#define VOL_BUF_SIZE 32
sl@0	2256	int found;
sl@0	2257	WCHAR volType[VOL_BUF_SIZE];
sl@0	2258	char* firstSeparator;
sl@0	2259	CONST char *path;
sl@0	2260
sl@0	2261	Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathObjPtr);
sl@0	2262	if (normPath == NULL) return NULL;
sl@0	2263	path = Tcl_GetString(normPath);
sl@0	2264	if (path == NULL) return NULL;
sl@0	2265
sl@0	2266	firstSeparator = strchr(path, '/');
sl@0	2267	if (firstSeparator == NULL) {
sl@0	2268	found = tclWinProcs->getVolumeInformationProc(
sl@0	2269	Tcl_FSGetNativePath(pathObjPtr), NULL, 0, NULL, NULL,
sl@0	2270	NULL, (WCHAR *)volType, VOL_BUF_SIZE);
sl@0	2271	} else {
sl@0	2272	Tcl_Obj *driveName = Tcl_NewStringObj(path, firstSeparator - path+1);
sl@0	2273	Tcl_IncrRefCount(driveName);
sl@0	2274	found = tclWinProcs->getVolumeInformationProc(
sl@0	2275	Tcl_FSGetNativePath(driveName), NULL, 0, NULL, NULL,
sl@0	2276	NULL, (WCHAR *)volType, VOL_BUF_SIZE);
sl@0	2277	Tcl_DecrRefCount(driveName);
sl@0	2278	}
sl@0	2279
sl@0	2280	if (found == 0) {
sl@0	2281	return NULL;
sl@0	2282	} else {
sl@0	2283	Tcl_DString ds;
sl@0	2284	Tcl_Obj *objPtr;
sl@0	2285
sl@0	2286	Tcl_WinTCharToUtf((CONST char *)volType, -1, &ds);
sl@0	2287	objPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds),Tcl_DStringLength(&ds));
sl@0	2288	Tcl_DStringFree(&ds);
sl@0	2289	return objPtr;
sl@0	2290	}
sl@0	2291	#undef VOL_BUF_SIZE
sl@0	2292	}
sl@0	2293
sl@0	2294
sl@0	2295	/*
sl@0	2296	*---------------------------------------------------------------------------
sl@0	2297	*
sl@0	2298	* TclpObjNormalizePath --
sl@0	2299	*
sl@0	2300	* This function scans through a path specification and replaces it,
sl@0	2301	* in place, with a normalized version. This means using the
sl@0	2302	* 'longname', and expanding any symbolic links contained within the
sl@0	2303	* path.
sl@0	2304	*
sl@0	2305	* Results:
sl@0	2306	* The new 'nextCheckpoint' value, giving as far as we could
sl@0	2307	* understand in the path.
sl@0	2308	*
sl@0	2309	* Side effects:
sl@0	2310	* The pathPtr string, which must contain a valid path, is
sl@0	2311	* possibly modified in place.
sl@0	2312	*
sl@0	2313	*---------------------------------------------------------------------------
sl@0	2314	*/
sl@0	2315
sl@0	2316	int
sl@0	2317	TclpObjNormalizePath(interp, pathPtr, nextCheckpoint)
sl@0	2318	Tcl_Interp *interp;
sl@0	2319	Tcl_Obj *pathPtr;
sl@0	2320	int nextCheckpoint;
sl@0	2321	{
sl@0	2322	char *lastValidPathEnd = NULL;
sl@0	2323	/* This will hold the normalized string */
sl@0	2324	Tcl_DString dsNorm;
sl@0	2325	char *path;
sl@0	2326	char *currentPathEndPosition;
sl@0	2327
sl@0	2328	Tcl_DStringInit(&dsNorm);
sl@0	2329	path = Tcl_GetString(pathPtr);
sl@0	2330
sl@0	2331	if (TclWinGetPlatformId() == VER_PLATFORM_WIN32_WINDOWS) {
sl@0	2332	/*
sl@0	2333	* We're on Win95, 98 or ME. There are two assumptions
sl@0	2334	* in this block of code. First that the native (NULL)
sl@0	2335	* encoding is basically ascii, and second that symbolic
sl@0	2336	* links are not possible. Both of these assumptions
sl@0	2337	* appear to be true of these operating systems.
sl@0	2338	*/
sl@0	2339	int isDrive = 1;
sl@0	2340	Tcl_DString ds;
sl@0	2341
sl@0	2342	currentPathEndPosition = path + nextCheckpoint;
sl@0	2343	if (*currentPathEndPosition == '/') {
sl@0	2344	currentPathEndPosition++;
sl@0	2345	}
sl@0	2346	while (1) {
sl@0	2347	char cur = *currentPathEndPosition;
sl@0	2348	if ((cur == '/' \|\| cur == 0) && (path != currentPathEndPosition)) {
sl@0	2349	/* Reached directory separator, or end of string */
sl@0	2350	CONST char *nativePath = Tcl_UtfToExternalDString(NULL, path,
sl@0	2351	currentPathEndPosition - path, &ds);
sl@0	2352
sl@0	2353	/*
sl@0	2354	* Now we convert the tail of the current path to its
sl@0	2355	* 'long form', and append it to 'dsNorm' which holds
sl@0	2356	* the current normalized path, if the file exists.
sl@0	2357	*/
sl@0	2358	if (isDrive) {
sl@0	2359	if (GetFileAttributesA(nativePath) == INVALID_FILE_ATTRIBUTES) {
sl@0	2360	/* File doesn't exist */
sl@0	2361	if (isDrive) {
sl@0	2362	int len = WinIsReserved(path);
sl@0	2363	if (len > 0) {
sl@0	2364	/* Actually it does exist - COM1, etc */
sl@0	2365	int i;
sl@0	2366	for (i=0;i<len;i++) {
sl@0	2367	if (nativePath[i] >= 'a') {
sl@0	2368	((char*)nativePath)[i] -= ('a' - 'A');
sl@0	2369	}
sl@0	2370	}
sl@0	2371	Tcl_DStringAppend(&dsNorm, nativePath, len);
sl@0	2372	lastValidPathEnd = currentPathEndPosition;
sl@0	2373	}
sl@0	2374	}
sl@0	2375	Tcl_DStringFree(&ds);
sl@0	2376	break;
sl@0	2377	}
sl@0	2378	if (nativePath[0] >= 'a') {
sl@0	2379	((char*)nativePath)[0] -= ('a' - 'A');
sl@0	2380	}
sl@0	2381	Tcl_DStringAppend(&dsNorm,nativePath,Tcl_DStringLength(&ds));
sl@0	2382	} else {
sl@0	2383	WIN32_FIND_DATA fData;
sl@0	2384	HANDLE handle;
sl@0	2385
sl@0	2386	handle = FindFirstFileA(nativePath, &fData);
sl@0	2387	if (handle == INVALID_HANDLE_VALUE) {
sl@0	2388	if (GetFileAttributesA(nativePath)
sl@0	2389	== INVALID_FILE_ATTRIBUTES) {
sl@0	2390	/* File doesn't exist */
sl@0	2391	Tcl_DStringFree(&ds);
sl@0	2392	break;
sl@0	2393	}
sl@0	2394	/* This is usually the '/' in 'c:/' at end of string */
sl@0	2395	Tcl_DStringAppend(&dsNorm,"/", 1);
sl@0	2396	} else {
sl@0	2397	char *nativeName;
sl@0	2398	if (fData.cFileName[0] != '\0') {
sl@0	2399	nativeName = fData.cFileName;
sl@0	2400	} else {
sl@0	2401	nativeName = fData.cAlternateFileName;
sl@0	2402	}
sl@0	2403	FindClose(handle);
sl@0	2404	Tcl_DStringAppend(&dsNorm,"/", 1);
sl@0	2405	Tcl_DStringAppend(&dsNorm,nativeName,-1);
sl@0	2406	}
sl@0	2407	}
sl@0	2408	Tcl_DStringFree(&ds);
sl@0	2409	lastValidPathEnd = currentPathEndPosition;
sl@0	2410	if (cur == 0) {
sl@0	2411	break;
sl@0	2412	}
sl@0	2413	/*
sl@0	2414	* If we get here, we've got past one directory
sl@0	2415	* delimiter, so we know it is no longer a drive
sl@0	2416	*/
sl@0	2417	isDrive = 0;
sl@0	2418	}
sl@0	2419	currentPathEndPosition++;
sl@0	2420	}
sl@0	2421	} else {
sl@0	2422	/* We're on WinNT or 2000 or XP */
sl@0	2423	Tcl_Obj *temp = NULL;
sl@0	2424	int isDrive = 1;
sl@0	2425	Tcl_DString ds;
sl@0	2426
sl@0	2427	currentPathEndPosition = path + nextCheckpoint;
sl@0	2428	if (*currentPathEndPosition == '/') {
sl@0	2429	currentPathEndPosition++;
sl@0	2430	}
sl@0	2431	while (1) {
sl@0	2432	char cur = *currentPathEndPosition;
sl@0	2433	if ((cur == '/' \|\| cur == 0) && (path != currentPathEndPosition)) {
sl@0	2434	/* Reached directory separator, or end of string */
sl@0	2435	WIN32_FILE_ATTRIBUTE_DATA data;
sl@0	2436	CONST char *nativePath = Tcl_WinUtfToTChar(path,
sl@0	2437	currentPathEndPosition - path, &ds);
sl@0	2438	if ((*tclWinProcs->getFileAttributesExProc)(nativePath,
sl@0	2439	GetFileExInfoStandard, &data) != TRUE) {
sl@0	2440	/* File doesn't exist */
sl@0	2441	if (isDrive) {
sl@0	2442	int len = WinIsReserved(path);
sl@0	2443	if (len > 0) {
sl@0	2444	/* Actually it does exist - COM1, etc */
sl@0	2445	int i;
sl@0	2446	for (i=0;i<len;i++) {
sl@0	2447	WCHAR wc = ((WCHAR*)nativePath)[i];
sl@0	2448	if (wc >= L'a') {
sl@0	2449	wc -= (L'a' - L'A');
sl@0	2450	((WCHAR*)nativePath)[i] = wc;
sl@0	2451	}
sl@0	2452	}
sl@0	2453	Tcl_DStringAppend(&dsNorm, nativePath,
sl@0	2454	sizeof(WCHAR)*len);
sl@0	2455	lastValidPathEnd = currentPathEndPosition;
sl@0	2456	}
sl@0	2457	}
sl@0	2458	Tcl_DStringFree(&ds);
sl@0	2459	break;
sl@0	2460	}
sl@0	2461
sl@0	2462	/*
sl@0	2463	* File 'nativePath' does exist if we get here. We
sl@0	2464	* now want to check if it is a symlink and otherwise
sl@0	2465	* continue with the rest of the path.
sl@0	2466	*/
sl@0	2467
sl@0	2468	/*
sl@0	2469	* Check for symlinks, except at last component
sl@0	2470	* of path (we don't follow final symlinks). Also
sl@0	2471	* a drive (C:/) for example, may sometimes have
sl@0	2472	* the reparse flag set for some reason I don't
sl@0	2473	* understand. We therefore don't perform this
sl@0	2474	* check for drives.
sl@0	2475	*/
sl@0	2476	if (cur != 0 && !isDrive && (data.dwFileAttributes
sl@0	2477	& FILE_ATTRIBUTE_REPARSE_POINT)) {
sl@0	2478	Tcl_Obj *to = WinReadLinkDirectory(nativePath);
sl@0	2479	if (to != NULL) {
sl@0	2480	/* Read the reparse point ok */
sl@0	2481	/* Tcl_GetStringFromObj(to, &pathLen); */
sl@0	2482	nextCheckpoint = 0; /* pathLen */
sl@0	2483	Tcl_AppendToObj(to, currentPathEndPosition, -1);
sl@0	2484	/* Convert link to forward slashes */
sl@0	2485	for (path = Tcl_GetString(to); *path != 0; path++) {
sl@0	2486	if (path == '\\') path = '/';
sl@0	2487	}
sl@0	2488	path = Tcl_GetString(to);
sl@0	2489	currentPathEndPosition = path + nextCheckpoint;
sl@0	2490	if (temp != NULL) {
sl@0	2491	Tcl_DecrRefCount(temp);
sl@0	2492	}
sl@0	2493	temp = to;
sl@0	2494	/* Reset variables so we can restart normalization */
sl@0	2495	isDrive = 1;
sl@0	2496	Tcl_DStringFree(&dsNorm);
sl@0	2497	Tcl_DStringInit(&dsNorm);
sl@0	2498	Tcl_DStringFree(&ds);
sl@0	2499	continue;
sl@0	2500	}
sl@0	2501	}
sl@0	2502	/*
sl@0	2503	* Now we convert the tail of the current path to its
sl@0	2504	* 'long form', and append it to 'dsNorm' which holds
sl@0	2505	* the current normalized path
sl@0	2506	*/
sl@0	2507	if (isDrive) {
sl@0	2508	WCHAR drive = ((WCHAR*)nativePath)[0];
sl@0	2509	if (drive >= L'a') {
sl@0	2510	drive -= (L'a' - L'A');
sl@0	2511	((WCHAR*)nativePath)[0] = drive;
sl@0	2512	}
sl@0	2513	Tcl_DStringAppend(&dsNorm,nativePath,Tcl_DStringLength(&ds));
sl@0	2514	} else {
sl@0	2515	char *checkDots = NULL;
sl@0	2516
sl@0	2517	if (lastValidPathEnd[1] == '.') {
sl@0	2518	checkDots = lastValidPathEnd + 1;
sl@0	2519	while (checkDots < currentPathEndPosition) {
sl@0	2520	if (*checkDots != '.') {
sl@0	2521	checkDots = NULL;
sl@0	2522	break;
sl@0	2523	}
sl@0	2524	checkDots++;
sl@0	2525	}
sl@0	2526	}
sl@0	2527	if (checkDots != NULL) {
sl@0	2528	int dotLen = currentPathEndPosition - lastValidPathEnd;
sl@0	2529	/*
sl@0	2530	* Path is just dots. We shouldn't really
sl@0	2531	* ever see a path like that. However, to be
sl@0	2532	* nice we at least don't mangle the path --
sl@0	2533	* we just add the dots as a path segment and
sl@0	2534	* continue
sl@0	2535	*/
sl@0	2536	Tcl_DStringAppend(&dsNorm,
sl@0	2537	(TCHAR)((WCHAR)(nativePath
sl@0	2538	+ Tcl_DStringLength(&ds))
sl@0	2539	- dotLen),
sl@0	2540	(int)(dotLen * sizeof(WCHAR)));
sl@0	2541	} else {
sl@0	2542	/* Normal path */
sl@0	2543	WIN32_FIND_DATAW fData;
sl@0	2544	HANDLE handle;
sl@0	2545
sl@0	2546	handle = FindFirstFileW((WCHAR*)nativePath, &fData);
sl@0	2547	if (handle == INVALID_HANDLE_VALUE) {
sl@0	2548	/* This is usually the '/' in 'c:/' at end of string */
sl@0	2549	Tcl_DStringAppend(&dsNorm,(CONST char*)L"/",
sl@0	2550	sizeof(WCHAR));
sl@0	2551	} else {
sl@0	2552	WCHAR *nativeName;
sl@0	2553	if (fData.cFileName[0] != '\0') {
sl@0	2554	nativeName = fData.cFileName;
sl@0	2555	} else {
sl@0	2556	nativeName = fData.cAlternateFileName;
sl@0	2557	}
sl@0	2558	FindClose(handle);
sl@0	2559	Tcl_DStringAppend(&dsNorm,(CONST char*)L"/",
sl@0	2560	sizeof(WCHAR));
sl@0	2561	Tcl_DStringAppend(&dsNorm,(TCHAR*)nativeName,
sl@0	2562	(int) (wcslen(nativeName)*sizeof(WCHAR)));
sl@0	2563	}
sl@0	2564	}
sl@0	2565	}
sl@0	2566	Tcl_DStringFree(&ds);
sl@0	2567	lastValidPathEnd = currentPathEndPosition;
sl@0	2568	if (cur == 0) {
sl@0	2569	break;
sl@0	2570	}
sl@0	2571	/*
sl@0	2572	* If we get here, we've got past one directory
sl@0	2573	* delimiter, so we know it is no longer a drive
sl@0	2574	*/
sl@0	2575	isDrive = 0;
sl@0	2576	}
sl@0	2577	currentPathEndPosition++;
sl@0	2578	}
sl@0	2579	}
sl@0	2580	/* Common code path for all Windows platforms */
sl@0	2581	nextCheckpoint = currentPathEndPosition - path;
sl@0	2582	if (lastValidPathEnd != NULL) {
sl@0	2583	/*
sl@0	2584	* Concatenate the normalized string in dsNorm with the
sl@0	2585	* tail of the path which we didn't recognise. The
sl@0	2586	* string in dsNorm is in the native encoding, so we
sl@0	2587	* have to convert it to Utf.
sl@0	2588	*/
sl@0	2589	Tcl_DString dsTemp;
sl@0	2590	Tcl_WinTCharToUtf(Tcl_DStringValue(&dsNorm),
sl@0	2591	Tcl_DStringLength(&dsNorm), &dsTemp);
sl@0	2592	nextCheckpoint = Tcl_DStringLength(&dsTemp);
sl@0	2593	if (*lastValidPathEnd != 0) {
sl@0	2594	/* Not the end of the string */
sl@0	2595	int len;
sl@0	2596	char *path;
sl@0	2597	Tcl_Obj *tmpPathPtr;
sl@0	2598	tmpPathPtr = Tcl_NewStringObj(Tcl_DStringValue(&dsTemp),
sl@0	2599	nextCheckpoint);
sl@0	2600	Tcl_AppendToObj(tmpPathPtr, lastValidPathEnd, -1);
sl@0	2601	path = Tcl_GetStringFromObj(tmpPathPtr, &len);
sl@0	2602	Tcl_SetStringObj(pathPtr, path, len);
sl@0	2603	Tcl_DecrRefCount(tmpPathPtr);
sl@0	2604	} else {
sl@0	2605	/* End of string was reached above */
sl@0	2606	Tcl_SetStringObj(pathPtr, Tcl_DStringValue(&dsTemp),
sl@0	2607	nextCheckpoint);
sl@0	2608	}
sl@0	2609	Tcl_DStringFree(&dsTemp);
sl@0	2610	}
sl@0	2611	Tcl_DStringFree(&dsNorm);
sl@0	2612	return nextCheckpoint;
sl@0	2613	}
sl@0	2614
sl@0	2615	/*
sl@0	2616	*---------------------------------------------------------------------------
sl@0	2617	*
sl@0	2618	* TclpUtime --
sl@0	2619	*
sl@0	2620	* Set the modification date for a file.
sl@0	2621	*
sl@0	2622	* Results:
sl@0	2623	* 0 on success, -1 on error.
sl@0	2624	*
sl@0	2625	* Side effects:
sl@0	2626	* Sets errno to a representation of any Windows problem that's observed
sl@0	2627	* in the process.
sl@0	2628	*
sl@0	2629	*---------------------------------------------------------------------------
sl@0	2630	*/
sl@0	2631
sl@0	2632	int
sl@0	2633	TclpUtime(
sl@0	2634	Tcl_Obj pathPtr, / File to modify */
sl@0	2635	struct utimbuf tval) / New modification date structure */
sl@0	2636	{
sl@0	2637	int res = 0;
sl@0	2638	HANDLE fileHandle;
sl@0	2639	CONST TCHAR *native;
sl@0	2640	DWORD attr = 0;
sl@0	2641	DWORD flags = FILE_ATTRIBUTE_NORMAL;
sl@0	2642	FILETIME lastAccessTime, lastModTime;
sl@0	2643
sl@0	2644	FromCTime(tval->actime, &lastAccessTime);
sl@0	2645	FromCTime(tval->modtime, &lastModTime);
sl@0	2646
sl@0	2647	native = (CONST TCHAR *)Tcl_FSGetNativePath(pathPtr);
sl@0	2648
sl@0	2649	attr = (*tclWinProcs->getFileAttributesProc)(native);
sl@0	2650
sl@0	2651	if (attr != INVALID_FILE_ATTRIBUTES && attr & FILE_ATTRIBUTE_DIRECTORY) {
sl@0	2652	flags = FILE_FLAG_BACKUP_SEMANTICS;
sl@0	2653	}
sl@0	2654
sl@0	2655	/*
sl@0	2656	* We use the native APIs (not 'utime') because there are some daylight
sl@0	2657	* savings complications that utime gets wrong.
sl@0	2658	*/
sl@0	2659
sl@0	2660	fileHandle = (tclWinProcs->createFileProc) (
sl@0	2661	native, FILE_WRITE_ATTRIBUTES, 0, NULL,
sl@0	2662	OPEN_EXISTING, flags, NULL);
sl@0	2663
sl@0	2664	if (fileHandle == INVALID_HANDLE_VALUE \|\|
sl@0	2665	!SetFileTime(fileHandle, NULL, &lastAccessTime, &lastModTime)) {
sl@0	2666	TclWinConvertError(GetLastError());
sl@0	2667	res = -1;
sl@0	2668	}
sl@0	2669	if (fileHandle != INVALID_HANDLE_VALUE) {
sl@0	2670	CloseHandle(fileHandle);
sl@0	2671	}
sl@0	2672	return res;
sl@0	2673	}

author	sl
	Tue, 10 Jun 2014 14:32:02 +0200
changeset 1	260cb5ec6c19
permissions	-rw-r--r--