Planet

navi

home

PPS

about

screenshots

download

development

forum

Context Navigation

source: downloads/tcl8.5.2/win/tclWinFile.c @ 47

Last change on this file since 47 was 25, checked in by landauf, 17 years ago
added tcl to libs
File size: 82.2 KB

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

Note: See TracBrowser for help on using the repository browser.

Download in other formats: