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

     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

    12  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.

    13  *

    14  * RCS: @(#) $Id: tclWinFile.c,v 1.44.2.18 2006/10/17 04:36:45 dgp Exp $

    15  */

    17 //#define _WIN32_WINNT  0x0500

    19 #include "tclWinInt.h"

    20 #include <winioctl.h>

    21 #include <sys/stat.h>

    22 #include <shlobj.h>

    23 #include <lmaccess.h>		/* For TclpGetUserHome(). */

    25 /*

    26  * The number of 100-ns intervals between the Windows system epoch (1601-01-01

    27  * on the proleptic Gregorian calendar) and the Posix epoch (1970-01-01).

    28  */

    30 #define POSIX_EPOCH_AS_FILETIME		116444736000000000

    32 /*

    33  * Declarations for 'link' related information.  This information

    34  * should come with VC++ 6.0, but is not in some older SDKs.

    35  * In any case it is not well documented.

    36  */

    37 #ifndef IO_REPARSE_TAG_RESERVED_ONE

    38 #  define IO_REPARSE_TAG_RESERVED_ONE 0x000000001

    39 #endif

    40 #ifndef IO_REPARSE_TAG_RESERVED_RANGE

    41 #  define IO_REPARSE_TAG_RESERVED_RANGE 0x000000001

    42 #endif

    43 #ifndef IO_REPARSE_TAG_VALID_VALUES

    44 #  define IO_REPARSE_TAG_VALID_VALUES 0x0E000FFFF

    45 #endif

    46 #ifndef IO_REPARSE_TAG_HSM

    47 #  define IO_REPARSE_TAG_HSM 0x0C0000004

    48 #endif

    49 #ifndef IO_REPARSE_TAG_NSS

    50 #  define IO_REPARSE_TAG_NSS 0x080000005

    51 #endif

    52 #ifndef IO_REPARSE_TAG_NSSRECOVER

    53 #  define IO_REPARSE_TAG_NSSRECOVER 0x080000006

    54 #endif

    55 #ifndef IO_REPARSE_TAG_SIS

    56 #  define IO_REPARSE_TAG_SIS 0x080000007

    57 #endif

    58 #ifndef IO_REPARSE_TAG_DFS

    59 #  define IO_REPARSE_TAG_DFS 0x080000008

    60 #endif

    62 #ifndef IO_REPARSE_TAG_RESERVED_ZERO

    63 #  define IO_REPARSE_TAG_RESERVED_ZERO 0x00000000

    64 #endif

    65 #ifndef FILE_FLAG_OPEN_REPARSE_POINT

    66 #  define FILE_FLAG_OPEN_REPARSE_POINT 0x00200000

    67 #endif

    68 #ifndef IO_REPARSE_TAG_MOUNT_POINT

    69 #  define IO_REPARSE_TAG_MOUNT_POINT 0xA0000003

    70 #endif

    71 #ifndef IsReparseTagValid

    72 #  define IsReparseTagValid(x) (!((x)&~IO_REPARSE_TAG_VALID_VALUES)&&((x)>IO_REPARSE_TAG_RESERVED_RANGE))

    73 #endif

    74 #ifndef IO_REPARSE_TAG_SYMBOLIC_LINK

    75 #  define IO_REPARSE_TAG_SYMBOLIC_LINK IO_REPARSE_TAG_RESERVED_ZERO

    76 #endif

    77 #ifndef FILE_SPECIAL_ACCESS

    78 #  define FILE_SPECIAL_ACCESS         (FILE_ANY_ACCESS)

    79 #endif

    80 #ifndef FSCTL_SET_REPARSE_POINT

    81 #  define FSCTL_SET_REPARSE_POINT    CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 41, METHOD_BUFFERED, FILE_SPECIAL_ACCESS)

    82 #  define FSCTL_GET_REPARSE_POINT    CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 42, METHOD_BUFFERED, FILE_ANY_ACCESS)

    83 #  define FSCTL_DELETE_REPARSE_POINT CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 43, METHOD_BUFFERED, FILE_SPECIAL_ACCESS)

    84 #endif

    85 #ifndef INVALID_FILE_ATTRIBUTES

    86 #define INVALID_FILE_ATTRIBUTES ((DWORD)-1)

    87 #endif

    89 /*

    90  * Maximum reparse buffer info size. The max user defined reparse

    91  * data is 16KB, plus there's a header.

    92  */

    94 #define MAX_REPARSE_SIZE	17000

    96 /*

    97  * Undocumented REPARSE_MOUNTPOINT_HEADER_SIZE structure definition.

    98  * This is found in winnt.h.

    99  *

   100  * IMPORTANT: caution when using this structure, since the actual

   101  * structures used will want to store a full path in the 'PathBuffer'

   102  * field, but there isn't room (there's only a single WCHAR!).  Therefore

   103  * one must artificially create a larger space of memory and then cast it

   104  * to this type.  We use the 'DUMMY_REPARSE_BUFFER' struct just below to

   105  * deal with this problem.

   106  */

   108 #define REPARSE_MOUNTPOINT_HEADER_SIZE   8

   109 #ifndef REPARSE_DATA_BUFFER_HEADER_SIZE

   110 typedef struct _REPARSE_DATA_BUFFER {

   111     DWORD  ReparseTag;

   112     WORD   ReparseDataLength;

   113     WORD   Reserved;

   114     union {

   115         struct {

   116             WORD   SubstituteNameOffset;

   117             WORD   SubstituteNameLength;

   118             WORD   PrintNameOffset;

   119             WORD   PrintNameLength;

   120             WCHAR PathBuffer[1];

   121         } SymbolicLinkReparseBuffer;

   122         struct {

   123             WORD   SubstituteNameOffset;

   124             WORD   SubstituteNameLength;

   125             WORD   PrintNameOffset;

   126             WORD   PrintNameLength;

   127             WCHAR PathBuffer[1];

   128         } MountPointReparseBuffer;

   129         struct {

   130             BYTE   DataBuffer[1];

   131         } GenericReparseBuffer;

   132     };

   133 } REPARSE_DATA_BUFFER;

   134 #endif

   136 typedef struct {

   137     REPARSE_DATA_BUFFER dummy;

   138     WCHAR  dummyBuf[MAX_PATH*3];

   139 } DUMMY_REPARSE_BUFFER;

   141 #if defined(_MSC_VER) && ( _MSC_VER <= 1100 )

   142 #define HAVE_NO_FINDEX_ENUMS

   143 #elif !defined(_WIN32_WINNT) || (_WIN32_WINNT < 0x0400)

   144 #define HAVE_NO_FINDEX_ENUMS

   145 #endif

   147 #ifdef HAVE_NO_FINDEX_ENUMS

   148 /* These two aren't in VC++ 5.2 headers */

   149 typedef enum _FINDEX_INFO_LEVELS {

   150 	FindExInfoStandard,

   151 	FindExInfoMaxInfoLevel

   152 } FINDEX_INFO_LEVELS;

   153 typedef enum _FINDEX_SEARCH_OPS {

   154 	FindExSearchNameMatch,

   155 	FindExSearchLimitToDirectories,

   156 	FindExSearchLimitToDevices,

   157 	FindExSearchMaxSearchOp

   158 } FINDEX_SEARCH_OPS;

   159 #endif /* HAVE_NO_FINDEX_ENUMS */

   161 /* Other typedefs required by this code */

   163 static time_t		ToCTime(FILETIME fileTime);

   164 static void		FromCTime(time_t posixTime, FILETIME *fileTime);

   166 typedef NET_API_STATUS NET_API_FUNCTION NETUSERGETINFOPROC

   167 	(LPWSTR servername, LPWSTR username, DWORD level, LPBYTE *bufptr);

   169 typedef NET_API_STATUS NET_API_FUNCTION NETAPIBUFFERFREEPROC

   170 	(LPVOID Buffer);

   172 typedef NET_API_STATUS NET_API_FUNCTION NETGETDCNAMEPROC

   173 	(LPWSTR servername, LPWSTR domainname, LPBYTE *bufptr);

   175 /*

   176  * Declarations for local procedures defined in this file:

   177  */

   179 static int NativeAccess(CONST TCHAR *path, int mode);

   180 static int NativeStat(CONST TCHAR *path, Tcl_StatBuf *statPtr, int checkLinks);

   181 static unsigned short NativeStatMode(DWORD attr, int checkLinks, int isExec);

   182 static int NativeIsExec(CONST TCHAR *path);

   183 static int NativeReadReparse(CONST TCHAR* LinkDirectory,

   184 			     REPARSE_DATA_BUFFER* buffer);

   185 static int NativeWriteReparse(CONST TCHAR* LinkDirectory,

   186 			      REPARSE_DATA_BUFFER* buffer);

   187 static int NativeMatchType(int isDrive, DWORD attr, CONST TCHAR* nativeName,

   188 			   Tcl_GlobTypeData *types);

   189 static int WinIsDrive(CONST char *name, int nameLen);

   190 static int WinIsReserved(CONST char *path);

   191 static Tcl_Obj* WinReadLink(CONST TCHAR* LinkSource);

   192 static Tcl_Obj* WinReadLinkDirectory(CONST TCHAR* LinkDirectory);

   193 static int WinLink(CONST TCHAR* LinkSource, CONST TCHAR* LinkTarget,

   194 		   int linkAction);

   195 static int WinSymLinkDirectory(CONST TCHAR* LinkDirectory,

   196 			       CONST TCHAR* LinkTarget);

   198 /*

   199  *--------------------------------------------------------------------

   200  *

   201  * WinLink

   202  *

   203  * Make a link from source to target.

   204  *--------------------------------------------------------------------

   205  */

   206 static int

   207 WinLink(LinkSource, LinkTarget, linkAction)

   208     CONST TCHAR* LinkSource;

   209     CONST TCHAR* LinkTarget;

   210     int linkAction;

   211 {

   212     WCHAR	tempFileName[MAX_PATH];

   213     TCHAR*	tempFilePart;

   214     int         attr;

   216     /* Get the full path referenced by the target */

   217     if (!(*tclWinProcs->getFullPathNameProc)(LinkTarget,

   218 			  MAX_PATH, tempFileName, &tempFilePart)) {

   219 	/* Invalid file */

   220 	TclWinConvertError(GetLastError());

   221 	return -1;

   222     }

   224     /* Make sure source file doesn't exist */

   225     attr = (*tclWinProcs->getFileAttributesProc)(LinkSource);

   226     if (attr != 0xffffffff) {

   227 	Tcl_SetErrno(EEXIST);

   228 	return -1;

   229     }

   231     /* Get the full path referenced by the directory */

   232     if (!(*tclWinProcs->getFullPathNameProc)(LinkSource,

   233 			  MAX_PATH, tempFileName, &tempFilePart)) {

   234 	/* Invalid file */

   235 	TclWinConvertError(GetLastError());

   236 	return -1;

   237     }

   238     /* Check the target */

   239     attr = (*tclWinProcs->getFileAttributesProc)(LinkTarget);

   240     if (attr == 0xffffffff) {

   241 	/* The target doesn't exist */

   242 	TclWinConvertError(GetLastError());

   243 	return -1;

   244     } else if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) {

   245 	/* It is a file */

   246 	if (tclWinProcs->createHardLinkProc == NULL) {

   247 	    Tcl_SetErrno(ENOTDIR);

   248 	    return -1;

   249 	}

   250 	if (linkAction & TCL_CREATE_HARD_LINK) {

   251 	    if (!(*tclWinProcs->createHardLinkProc)(LinkSource, LinkTarget, NULL)) {

   252 		TclWinConvertError(GetLastError());

   253 		return -1;

   254 	    }

   255 	    return 0;

   256 	} else if (linkAction & TCL_CREATE_SYMBOLIC_LINK) {

   257 	    /* Can't symlink files */

   258 	    Tcl_SetErrno(ENOTDIR);

   259 	    return -1;

   260 	} else {

   261 	    Tcl_SetErrno(ENODEV);

   262 	    return -1;

   263 	}

   264     } else {

   265 	if (linkAction & TCL_CREATE_SYMBOLIC_LINK) {

   266 	    return WinSymLinkDirectory(LinkSource, LinkTarget);

   267 	} else if (linkAction & TCL_CREATE_HARD_LINK) {

   268 	    /* Can't hard link directories */

   269 	    Tcl_SetErrno(EISDIR);

   270 	    return -1;

   271 	} else {

   272 	    Tcl_SetErrno(ENODEV);

   273 	    return -1;

   274 	}

   275     }

   276 }

   278 /*

   279  *--------------------------------------------------------------------

   280  *

   281  * WinReadLink

   282  *

   283  * What does 'LinkSource' point to?

   284  *--------------------------------------------------------------------

   285  */

   286 static Tcl_Obj*

   287 WinReadLink(LinkSource)

   288     CONST TCHAR* LinkSource;

   289 {

   290     WCHAR	tempFileName[MAX_PATH];

   291     TCHAR*	tempFilePart;

   292     int         attr;

   294     /* Get the full path referenced by the target */

   295     if (!(*tclWinProcs->getFullPathNameProc)(LinkSource,

   296 			  MAX_PATH, tempFileName, &tempFilePart)) {

   297 	/* Invalid file */

   298 	TclWinConvertError(GetLastError());

   299 	return NULL;

   300     }

   302     /* Make sure source file does exist */

   303     attr = (*tclWinProcs->getFileAttributesProc)(LinkSource);

   304     if (attr == 0xffffffff) {

   305 	/* The source doesn't exist */

   306 	TclWinConvertError(GetLastError());

   307 	return NULL;

   308     } else if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) {

   309 	/* It is a file - this is not yet supported */

   310 	Tcl_SetErrno(ENOTDIR);

   311 	return NULL;

   312     } else {

   313 	return WinReadLinkDirectory(LinkSource);

   314     }

   315 }

   317 /*

   318  *--------------------------------------------------------------------

   319  *

   320  * WinSymLinkDirectory

   321  *

   322  * This routine creates a NTFS junction, using the undocumented

   323  * FSCTL_SET_REPARSE_POINT structure Win2K uses for mount points

   324  * and junctions.

   325  *

   326  * Assumption that LinkTarget is a valid, existing directory.

   327  *

   328  * Returns zero on success.

   329  *--------------------------------------------------------------------

   330  */

   331 static int

   332 WinSymLinkDirectory(LinkDirectory, LinkTarget)

   333     CONST TCHAR* LinkDirectory;

   334     CONST TCHAR* LinkTarget;

   335 {

   336     DUMMY_REPARSE_BUFFER dummy;

   337     REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER*)&dummy;

   338     int         len;

   339     WCHAR       nativeTarget[MAX_PATH];

   340     WCHAR       *loop;

   342     /* Make the native target name */

   343     memcpy((VOID*)nativeTarget, (VOID*)L"\\??\\", 4*sizeof(WCHAR));

   344     memcpy((VOID*)(nativeTarget + 4), (VOID*)LinkTarget,

   345 	   sizeof(WCHAR)*(1+wcslen((WCHAR*)LinkTarget)));

   346     len = wcslen(nativeTarget);

   347     /*

   348      * We must have backslashes only.  This is VERY IMPORTANT.

   349      * If we have any forward slashes everything appears to work,

   350      * but the resulting symlink is useless!

   351      */

   352     for (loop = nativeTarget; *loop != 0; loop++) {

   353 	if (*loop == L'/') *loop = L'\\';

   354     }

   355     if ((nativeTarget[len-1] == L'\\') && (nativeTarget[len-2] != L':')) {

   356 	nativeTarget[len-1] = 0;

   357     }

   359     /* Build the reparse info */

   360     memset(reparseBuffer, 0, sizeof(DUMMY_REPARSE_BUFFER));

   361     reparseBuffer->ReparseTag = IO_REPARSE_TAG_MOUNT_POINT;

   362     reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength =

   363       wcslen(nativeTarget) * sizeof(WCHAR);

   364     reparseBuffer->Reserved = 0;

   365     reparseBuffer->SymbolicLinkReparseBuffer.PrintNameLength = 0;

   366     reparseBuffer->SymbolicLinkReparseBuffer.PrintNameOffset =

   367       reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength

   368       + sizeof(WCHAR);

   369     memcpy(reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer, nativeTarget,

   370       sizeof(WCHAR)

   371       + reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength);

   372     reparseBuffer->ReparseDataLength =

   373       reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength + 12;

   375     return NativeWriteReparse(LinkDirectory, reparseBuffer);

   376 }

   378 /*

   379  *--------------------------------------------------------------------

   380  *

   381  * TclWinSymLinkCopyDirectory

   382  *

   383  * Copy a Windows NTFS junction.  This function assumes that

   384  * LinkOriginal exists and is a valid junction point, and that

   385  * LinkCopy does not exist.

   386  *

   387  * Returns zero on success.

   388  *--------------------------------------------------------------------

   389  */

   390 int

   391 TclWinSymLinkCopyDirectory(LinkOriginal, LinkCopy)

   392     CONST TCHAR* LinkOriginal;  /* Existing junction - reparse point */

   393     CONST TCHAR* LinkCopy;      /* Will become a duplicate junction */

   394 {

   395     DUMMY_REPARSE_BUFFER dummy;

   396     REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER*)&dummy;

   398     if (NativeReadReparse(LinkOriginal, reparseBuffer)) {

   399 	return -1;

   400     }

   401     return NativeWriteReparse(LinkCopy, reparseBuffer);

   402 }

   404 /*

   405  *--------------------------------------------------------------------

   406  *

   407  * TclWinSymLinkDelete

   408  *

   409  * Delete a Windows NTFS junction.  Once the junction information

   410  * is deleted, the filesystem object becomes an ordinary directory.

   411  * Unless 'linkOnly' is given, that directory is also removed.

   412  *

   413  * Assumption that LinkOriginal is a valid, existing junction.

   414  *

   415  * Returns zero on success.

   416  *--------------------------------------------------------------------

   417  */

   418 int

   419 TclWinSymLinkDelete(LinkOriginal, linkOnly)

   420     CONST TCHAR* LinkOriginal;

   421     int linkOnly;

   422 {

   423     /* It is a symbolic link -- remove it */

   424     DUMMY_REPARSE_BUFFER dummy;

   425     REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER*)&dummy;

   426     HANDLE hFile;

   427     DWORD returnedLength;

   428     memset(reparseBuffer, 0, sizeof(DUMMY_REPARSE_BUFFER));

   429     reparseBuffer->ReparseTag = IO_REPARSE_TAG_MOUNT_POINT;

   430     hFile = (*tclWinProcs->createFileProc)(LinkOriginal, GENERIC_WRITE, 0,

   431 	NULL, OPEN_EXISTING,

   432 	FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL);

   433     if (hFile != INVALID_HANDLE_VALUE) {

   434 	if (!DeviceIoControl(hFile, FSCTL_DELETE_REPARSE_POINT, reparseBuffer,

   435 			     REPARSE_MOUNTPOINT_HEADER_SIZE,

   436 			     NULL, 0, &returnedLength, NULL)) {

   437 	    /* Error setting junction */

   438 	    TclWinConvertError(GetLastError());

   439 	    CloseHandle(hFile);

   440 	} else {

   441 	    CloseHandle(hFile);

   442 	    if (!linkOnly) {

   443 	        (*tclWinProcs->removeDirectoryProc)(LinkOriginal);

   444 	    }

   445 	    return 0;

   446 	}

   447     }

   448     return -1;

   449 }

   451 /*

   452  *--------------------------------------------------------------------

   453  *

   454  * WinReadLinkDirectory

   455  *

   456  * This routine reads a NTFS junction, using the undocumented

   457  * FSCTL_GET_REPARSE_POINT structure Win2K uses for mount points

   458  * and junctions.

   459  *

   460  * Assumption that LinkDirectory is a valid, existing directory.

   461  *

   462  * Returns a Tcl_Obj with refCount of 1 (i.e. owned by the caller),

   463  * or NULL if anything went wrong.

   464  *

   465  * In the future we should enhance this to return a path object

   466  * rather than a string.

   467  *--------------------------------------------------------------------

   468  */

   469 static Tcl_Obj*

   470 WinReadLinkDirectory(LinkDirectory)

   471     CONST TCHAR* LinkDirectory;

   472 {

   473     int attr;

   474     DUMMY_REPARSE_BUFFER dummy;

   475     REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER*)&dummy;

   477     attr = (*tclWinProcs->getFileAttributesProc)(LinkDirectory);

   478     if (!(attr & FILE_ATTRIBUTE_REPARSE_POINT)) {

   479 	Tcl_SetErrno(EINVAL);

   480 	return NULL;

   481     }

   482     if (NativeReadReparse(LinkDirectory, reparseBuffer)) {

   483         return NULL;

   484     }

   486     switch (reparseBuffer->ReparseTag) {

   487 	case 0x80000000|IO_REPARSE_TAG_SYMBOLIC_LINK:

   488 	case IO_REPARSE_TAG_SYMBOLIC_LINK:

   489 	case IO_REPARSE_TAG_MOUNT_POINT: {

   490 	    Tcl_Obj *retVal;

   491 	    Tcl_DString ds;

   492 	    CONST char *copy;

   493 	    int len;

   494 	    int offset = 0;

   496 	    /*

   497 	     * Certain native path representations on Windows have a

   498 	     * special prefix to indicate that they are to be treated

   499 	     * specially.  For example extremely long paths, or symlinks,

   500 	     * or volumes mounted inside directories.

   501 	     *

   502 	     * There is an assumption in this code that 'wide' interfaces

   503 	     * are being used (see tclWin32Dll.c), which is true for the

   504 	     * only systems which support reparse tags at present.  If

   505 	     * that changes in the future, this code will have to be

   506 	     * generalised.

   507 	     */

   508 	    if (reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer[0]

   509 		                                                 == L'\\') {

   510 		/* Check whether this is a mounted volume */

   511 		if (wcsncmp(reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer,

   512 			    L"\\??\\Volume{",11) == 0) {

   513 		    char drive;

   514 		    /*

   515 		     * There is some confusion between \??\ and \\?\ which

   516 		     * we have to fix here.  It doesn't seem very well

   517 		     * documented.

   518 		     */

   519 		    reparseBuffer->SymbolicLinkReparseBuffer

   520 		                                      .PathBuffer[1] = L'\\';

   521 		    /*

   522 		     * Check if a corresponding drive letter exists, and

   523 		     * use that if it is found

   524 		     */

   525 		    drive = TclWinDriveLetterForVolMountPoint(reparseBuffer

   526 					->SymbolicLinkReparseBuffer.PathBuffer);

   527 		    if (drive != -1) {

   528 			char driveSpec[3] = {

   529 			    drive, ':', '\0'

   530 			};

   531 			retVal = Tcl_NewStringObj(driveSpec,2);

   532 			Tcl_IncrRefCount(retVal);

   533 			return retVal;

   534 		    }

   535 		    /*

   536 		     * This is actually a mounted drive, which doesn't

   537 		     * exists as a DOS drive letter.  This means the path

   538 		     * isn't actually a link, although we partially treat

   539 		     * it like one ('file type' will return 'link'), but

   540 		     * then the link will actually just be treated like

   541 		     * an ordinary directory.  I don't believe any

   542 		     * serious inconsistency will arise from this, but it

   543 		     * is something to be aware of.

   544 		     */

   545 		    Tcl_SetErrno(EINVAL);

   546 		    return NULL;

   547 		} else if (wcsncmp(reparseBuffer->SymbolicLinkReparseBuffer

   548 				   .PathBuffer, L"\\\\?\\",4) == 0) {

   549 		    /* Strip off the prefix */

   550 		    offset = 4;

   551 		} else if (wcsncmp(reparseBuffer->SymbolicLinkReparseBuffer

   552 				   .PathBuffer, L"\\??\\",4) == 0) {

   553 		    /* Strip off the prefix */

   554 		    offset = 4;

   555 		}

   556 	    }

   558 	    Tcl_WinTCharToUtf(

   559 		(CONST char*)reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer,

   560 		(int)reparseBuffer->SymbolicLinkReparseBuffer

   561 		.SubstituteNameLength, &ds);

   563 	    copy = Tcl_DStringValue(&ds)+offset;

   564 	    len = Tcl_DStringLength(&ds)-offset;

   565 	    retVal = Tcl_NewStringObj(copy,len);

   566 	    Tcl_IncrRefCount(retVal);

   567 	    Tcl_DStringFree(&ds);

   568 	    return retVal;

   569 	}

   570     }

   571     Tcl_SetErrno(EINVAL);

   572     return NULL;

   573 }

   575 /*

   576  *--------------------------------------------------------------------

   577  *

   578  * NativeReadReparse

   579  *

   580  * Read the junction/reparse information from a given NTFS directory.

   581  *

   582  * Assumption that LinkDirectory is a valid, existing directory.

   583  *

   584  * Returns zero on success.

   585  *--------------------------------------------------------------------

   586  */

   587 static int

   588 NativeReadReparse(LinkDirectory, buffer)

   589     CONST TCHAR* LinkDirectory;   /* The junction to read */

   590     REPARSE_DATA_BUFFER* buffer;  /* Pointer to buffer. Cannot be NULL */

   591 {

   592     HANDLE hFile;

   593     DWORD returnedLength;

   595     hFile = (*tclWinProcs->createFileProc)(LinkDirectory, GENERIC_READ, 0,

   596 	NULL, OPEN_EXISTING,

   597 	FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL);

   598     if (hFile == INVALID_HANDLE_VALUE) {

   599 	/* Error creating directory */

   600 	TclWinConvertError(GetLastError());

   601 	return -1;

   602     }

   603     /* Get the link */

   604     if (!DeviceIoControl(hFile, FSCTL_GET_REPARSE_POINT, NULL,

   605 			 0, buffer, sizeof(DUMMY_REPARSE_BUFFER),

   606 			 &returnedLength, NULL)) {

   607 	/* Error setting junction */

   608 	TclWinConvertError(GetLastError());

   609 	CloseHandle(hFile);

   610 	return -1;

   611     }

   612     CloseHandle(hFile);

   614     if (!IsReparseTagValid(buffer->ReparseTag)) {

   615 	Tcl_SetErrno(EINVAL);

   616 	return -1;

   617     }

   618     return 0;

   619 }

   621 /*

   622  *--------------------------------------------------------------------

   623  *

   624  * NativeWriteReparse

   625  *

   626  * Write the reparse information for a given directory.

   627  *

   628  * Assumption that LinkDirectory does not exist.

   629  *--------------------------------------------------------------------

   630  */

   631 static int

   632 NativeWriteReparse(LinkDirectory, buffer)

   633     CONST TCHAR* LinkDirectory;

   634     REPARSE_DATA_BUFFER* buffer;

   635 {

   636     HANDLE hFile;

   637     DWORD returnedLength;

   639     /* Create the directory - it must not already exist */

   640     if ((*tclWinProcs->createDirectoryProc)(LinkDirectory, NULL) == 0) {

   641 	/* Error creating directory */

   642 	TclWinConvertError(GetLastError());

   643 	return -1;

   644     }

   645     hFile = (*tclWinProcs->createFileProc)(LinkDirectory, GENERIC_WRITE, 0,

   646 	NULL, OPEN_EXISTING,

   647 	FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL);

   648     if (hFile == INVALID_HANDLE_VALUE) {

   649 	/* Error creating directory */

   650 	TclWinConvertError(GetLastError());

   651 	return -1;

   652     }

   653     /* Set the link */

   654     if (!DeviceIoControl(hFile, FSCTL_SET_REPARSE_POINT, buffer,

   655 			 (DWORD) buffer->ReparseDataLength

   656 			 + REPARSE_MOUNTPOINT_HEADER_SIZE,

   657 			 NULL, 0, &returnedLength, NULL)) {

   658 	/* Error setting junction */

   659 	TclWinConvertError(GetLastError());

   660 	CloseHandle(hFile);

   661 	(*tclWinProcs->removeDirectoryProc)(LinkDirectory);

   662 	return -1;

   663     }

   664     CloseHandle(hFile);

   665     /* We succeeded */

   666     return 0;

   667 }

   669 /*

   670  *---------------------------------------------------------------------------

   671  *

   672  * TclpFindExecutable --

   673  *

   674  *	This procedure computes the absolute path name of the current

   675  *	application, given its argv[0] value.

   676  *

   677  * Results:

   678  *	A clean UTF string that is the path to the executable.  At this

   679  *	point we may not know the system encoding, but we convert the

   680  *	string value to UTF-8 using core Windows functions.  The path name

   681  *	contains ASCII string and '/' chars do not conflict with other UTF

   682  *	chars.

   683  *

   684  * Side effects:

   685  *	The variable tclNativeExecutableName gets filled in with the file

   686  *	name for the application, if we figured it out.  If we couldn't

   687  *	figure it out, tclNativeExecutableName is set to NULL.

   688  *

   689  *---------------------------------------------------------------------------

   690  */

   692 char *

   693 TclpFindExecutable(argv0)

   694     CONST char *argv0;		/* The value of the application's argv[0]

   695 				 * (native). */

   696 {

   697     WCHAR wName[MAX_PATH];

   698     char name[MAX_PATH * TCL_UTF_MAX];

   700     if (argv0 == NULL) {

   701 	return NULL;

   702     }

   703     if (tclNativeExecutableName != NULL) {

   704 	return tclNativeExecutableName;

   705     }

   707     /*

   708      * Under Windows we ignore argv0, and return the path for the file used to

   709      * create this process.

   710      */

   712     if (GetModuleFileNameW(NULL, wName, MAX_PATH) == 0) {

   713 	GetModuleFileNameA(NULL, name, sizeof(name));

   714     } else {

   715 	WideCharToMultiByte(CP_UTF8, 0, wName, -1,

   716 		name, sizeof(name), NULL, NULL);

   717     }

   719     tclNativeExecutableName = ckalloc((unsigned) (strlen(name) + 1));

   720     strcpy(tclNativeExecutableName, name);

   722     TclWinNoBackslash(tclNativeExecutableName);

   723     return tclNativeExecutableName;

   724 }

   726 /*

   727  *----------------------------------------------------------------------

   728  *

   729  * TclpMatchInDirectory --

   730  *

   731  *	This routine is used by the globbing code to search a

   732  *	directory for all files which match a given pattern.

   733  *

   734  * Results:

   735  *

   736  *	The return value is a standard Tcl result indicating whether an

   737  *	error occurred in globbing.  Errors are left in interp, good

   738  *	results are lappended to resultPtr (which must be a valid object)

   739  *

   740  * Side effects:

   741  *	None.

   742  *

   743  *---------------------------------------------------------------------- */

   745 int

   746 TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)

   747     Tcl_Interp *interp;		/* Interpreter to receive errors. */

   748     Tcl_Obj *resultPtr;		/* List object to lappend results. */

   749     Tcl_Obj *pathPtr;	        /* Contains path to directory to search. */

   750     CONST char *pattern;	/* Pattern to match against. */

   751     Tcl_GlobTypeData *types;	/* Object containing list of acceptable types.

   752 				 * May be NULL. In particular the directory

   753 				 * flag is very important. */

   754 {

   755     CONST TCHAR *native;

   757     if (pattern == NULL || (*pattern == '\0')) {

   758 	Tcl_Obj *norm = Tcl_FSGetNormalizedPath(NULL, pathPtr);

   759 	if (norm != NULL) {

   760 	    /* Match a single file directly */

   761 	    int len;

   762 	    DWORD attr;

   763 	    CONST char *str = Tcl_GetStringFromObj(norm,&len);

   765 	    native = (CONST TCHAR*) Tcl_FSGetNativePath(pathPtr);

   767 	    if (tclWinProcs->getFileAttributesExProc == NULL) {

   768 		attr = (*tclWinProcs->getFileAttributesProc)(native);

   769 		if (attr == 0xffffffff) {

   770 		    return TCL_OK;

   771 		}

   772 	    } else {

   773 		WIN32_FILE_ATTRIBUTE_DATA data;

   774 		if ((*tclWinProcs->getFileAttributesExProc)(native,

   775 			GetFileExInfoStandard, &data) != TRUE) {

   776 		    return TCL_OK;

   777 		}

   778 		attr = data.dwFileAttributes;

   779 	    }

   780 	    if (NativeMatchType(WinIsDrive(str,len), attr,

   781 				native, types)) {

   782 		Tcl_ListObjAppendElement(interp, resultPtr, pathPtr);

   783 	    }

   784 	}

   785 	return TCL_OK;

   786     } else {

   787 	DWORD attr;

   788 	HANDLE handle;

   789 	WIN32_FIND_DATAT data;

   790 	CONST char *dirName;

   791 	int dirLength;

   792 	int matchSpecialDots;

   793 	Tcl_DString ds;        /* native encoding of dir */

   794 	Tcl_DString dsOrig;    /* utf-8 encoding of dir */

   795 	Tcl_DString dirString; /* utf-8 encoding of dir with \'s */

   796 	Tcl_Obj *fileNamePtr;

   798 	/*

   799 	 * Convert the path to normalized form since some interfaces only

   800 	 * accept backslashes.  Also, ensure that the directory ends with a

   801 	 * separator character.

   802 	 */

   804 	fileNamePtr = Tcl_FSGetTranslatedPath(interp, pathPtr);

   805 	if (fileNamePtr == NULL) {

   806 	    return TCL_ERROR;

   807 	}

   808 	Tcl_DStringInit(&dsOrig);

   809 	dirName = Tcl_GetStringFromObj(fileNamePtr, &dirLength);

   810 	Tcl_DStringAppend(&dsOrig, dirName, dirLength);

   812 	Tcl_DStringInit(&dirString);

   813 	if (dirLength == 0) {

   814 	    Tcl_DStringAppend(&dirString, ".\\", 2);

   815 	} else {

   816 	    char *p;

   818 	    Tcl_DStringAppend(&dirString, dirName, dirLength);

   819 	    for (p = Tcl_DStringValue(&dirString); *p != '\0'; p++) {

   820 		if (*p == '/') {

   821 		    *p = '\\';

   822 		}

   823 	    }

   824 	    p--;

   825 	    /* Make sure we have a trailing directory delimiter */

   826 	    if ((*p != '\\') && (*p != ':')) {

   827 		Tcl_DStringAppend(&dirString, "\\", 1);

   828 		Tcl_DStringAppend(&dsOrig, "/", 1);

   829 		dirLength++;

   830 	    }

   831 	}

   832 	dirName = Tcl_DStringValue(&dirString);

   833 	Tcl_DecrRefCount(fileNamePtr);

   835 	/*

   836 	 * First verify that the specified path is actually a directory.

   837 	 */

   839 	native = Tcl_WinUtfToTChar(dirName, Tcl_DStringLength(&dirString),

   840 		&ds);

   841 	attr = (*tclWinProcs->getFileAttributesProc)(native);

   842 	Tcl_DStringFree(&ds);

   844 	if ((attr == 0xffffffff) || ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0)) {

   845 	    Tcl_DStringFree(&dirString);

   846 	    return TCL_OK;

   847 	}

   849 	/*

   850 	 * We need to check all files in the directory, so append a *.*

   851 	 * to the path.

   852 	 */

   854 	dirName = Tcl_DStringAppend(&dirString, "*.*", 3);

   855 	native = Tcl_WinUtfToTChar(dirName, -1, &ds);

   856 	handle = (*tclWinProcs->findFirstFileProc)(native, &data);

   858 	if (handle == INVALID_HANDLE_VALUE) {

   859 	    TclWinConvertError(GetLastError());

   860 	    Tcl_DStringFree(&ds);

   861 	    Tcl_DStringFree(&dirString);

   862 	    Tcl_ResetResult(interp);

   863 	    Tcl_AppendResult(interp, "couldn't read directory \"",

   864 		    Tcl_DStringValue(&dsOrig), "\": ",

   865 		    Tcl_PosixError(interp), (char *) NULL);

   866 	    Tcl_DStringFree(&dsOrig);

   867 	    return TCL_ERROR;

   868 	}

   869 	Tcl_DStringFree(&ds);

   871 	/*

   872 	 * Check to see if the pattern should match the special

   873 	 * . and .. names, referring to the current directory,

   874 	 * or the directory above.  We need a special check for

   875 	 * this because paths beginning with a dot are not considered

   876 	 * hidden on Windows, and so otherwise a relative glob like

   877 	 * 'glob -join * *' will actually return './. ../..' etc.

   878 	 */

   880 	if ((pattern[0] == '.')

   881 		|| ((pattern[0] == '\\') && (pattern[1] == '.'))) {

   882 	    matchSpecialDots = 1;

   883 	} else {

   884 	    matchSpecialDots = 0;

   885 	}

   887 	/*

   888 	 * Now iterate over all of the files in the directory, starting

   889 	 * with the first one we found.

   890 	 */

   892 	do {

   893 	    CONST char *utfname;

   894 	    int checkDrive = 0;

   895 	    int isDrive;

   896 	    DWORD attr;

   898 	    if (tclWinProcs->useWide) {

   899 		native = (CONST TCHAR *) data.w.cFileName;

   900 		attr = data.w.dwFileAttributes;

   901 	    } else {

   902 		native = (CONST TCHAR *) data.a.cFileName;

   903 		attr = data.a.dwFileAttributes;

   904 	    }

   906 	    utfname = Tcl_WinTCharToUtf(native, -1, &ds);

   908 	    if (!matchSpecialDots) {

   909 		/* If it is exactly '.' or '..' then we ignore it */

   910 		if ((utfname[0] == '.') && (utfname[1] == '\0'

   911 			|| (utfname[1] == '.' && utfname[2] == '\0'))) {

   912 		    Tcl_DStringFree(&ds);

   913 		    continue;

   914 		}

   915 	    } else if (utfname[0] == '.' && utfname[1] == '.'

   916 		    && utfname[2] == '\0') {

   917 		/*

   918 		 * Have to check if this is a drive below, so we can

   919 		 * correctly match 'hidden' and not hidden files.

   920 		 */

   921 		checkDrive = 1;

   922 	    }

   924 	    /*

   925 	     * Check to see if the file matches the pattern.  Note that

   926 	     * we are ignoring the case sensitivity flag because Windows

   927 	     * doesn't honor case even if the volume is case sensitive.

   928 	     * If the volume also doesn't preserve case, then we

   929 	     * previously returned the lower case form of the name.  This

   930 	     * didn't seem quite right since there are

   931 	     * non-case-preserving volumes that actually return mixed

   932 	     * case.  So now we are returning exactly what we get from

   933 	     * the system.

   934 	     */

   936 	    if (Tcl_StringCaseMatch(utfname, pattern, 1)) {

   937 		/*

   938 		 * If the file matches, then we need to process the remainder

   939 		 * of the path.

   940 		 */

   942 		if (checkDrive) {

   943 		    CONST char *fullname = Tcl_DStringAppend(&dsOrig, utfname,

   944 			    Tcl_DStringLength(&ds));

   945 		    isDrive = WinIsDrive(fullname, Tcl_DStringLength(&dsOrig));

   946 		    Tcl_DStringSetLength(&dsOrig, dirLength);

   947 		} else {

   948 		    isDrive = 0;

   949 		}

   950 		if (NativeMatchType(isDrive, attr, native, types)) {

   951 		    Tcl_ListObjAppendElement(interp, resultPtr,

   952 			    TclNewFSPathObj(pathPtr, utfname,

   953 				    Tcl_DStringLength(&ds)));

   954 		}

   955 	    }

   957 	    /*

   958 	     * Free ds here to ensure that native is valid above.

   959 	     */

   960 	    Tcl_DStringFree(&ds);

   961 	} while ((*tclWinProcs->findNextFileProc)(handle, &data) == TRUE);

   963 	FindClose(handle);

   964 	Tcl_DStringFree(&dirString);

   965 	Tcl_DStringFree(&dsOrig);

   966 	return TCL_OK;

   967     }

   968 }

   970 /*

   971  * Does the given path represent a root volume?  We need this special

   972  * case because for NTFS root volumes, the getFileAttributesProc returns

   973  * a 'hidden' attribute when it should not.

   974  */

   975 static int

   976 WinIsDrive(

   977     CONST char *name,     /* Name (UTF-8) */

   978     int len)              /* Length of name */

   979 {

   980     int remove = 0;

   981     while (len > 4) {

   982         if ((name[len-1] != '.' || name[len-2] != '.')

   983 	    || (name[len-3] != '/' && name[len-3] != '\\')) {

   984             /* We don't have '/..' at the end */

   985 	    if (remove == 0) {

   986 	        break;

   987 	    }

   988 	    remove--;

   989 	    while (len > 0) {

   990 		len--;

   991 		if (name[len] == '/' || name[len] == '\\') {

   992 		    break;

   993 		}

   994 	    }

   995 	    if (len < 4) {

   996 	        len++;

   997 		break;

   998 	    }

   999         } else {

  1000 	    /* We do have '/..' */

  1001 	    len -= 3;

  1002 	    remove++;

  1003         }

  1004     }

  1005     if (len < 4) {

  1006 	if (len == 0) {

  1007 	    /*

  1008 	     * Not sure if this is possible, but we pass it on

  1009 	     * anyway

  1010 	     */

  1011 	} else if (len == 1 && (name[0] == '/' || name[0] == '\\')) {

  1012 	    /* Path is pointing to the root volume */

  1013 	    return 1;

  1014 	} else if ((name[1] == ':')

  1015 		   && (len == 2 || (name[2] == '/' || name[2] == '\\'))) {

  1016 	    /* Path is of the form 'x:' or 'x:/' or 'x:\' */

  1017 	    return 1;

  1018 	}

  1019     }

  1020     return 0;

  1021 }

  1023 /*

  1024  * Does the given path represent a reserved window path name?  If not

  1025  * return 0, if true, return the number of characters of the path that

  1026  * we actually want (not any trailing :).

  1027  */

  1028 static int WinIsReserved(

  1029    CONST char *path)    /* Path in UTF-8  */

  1030 {

  1031     if ((path[0] == 'c' || path[0] == 'C')

  1032 	&& (path[1] == 'o' || path[1] == 'O')) {

  1033 	if ((path[2] == 'm' || path[2] == 'M')

  1034 	    && path[3] >= '1' && path[3] <= '4') {

  1035 	    /* May have match for 'com[1-4]:?', which is a serial port */

  1036 	    if (path[4] == '\0') {

  1037 		return 4;

  1038 	    } else if (path [4] == ':' && path[5] == '\0') {

  1039 		return 4;

  1040 	    }

  1041 	} else if ((path[2] == 'n' || path[2] == 'N') && path[3] == '\0') {

  1042 	    /* Have match for 'con' */

  1043 	    return 3;

  1044 	}

  1045     } else if ((path[0] == 'l' || path[0] == 'L')

  1046 	       && (path[1] == 'p' || path[1] == 'P')

  1047 	       && (path[2] == 't' || path[2] == 'T')) {

  1048 	if (path[3] >= '1' && path[3] <= '3') {

  1049 	    /* May have match for 'lpt[1-3]:?' */

  1050 	    if (path[4] == '\0') {

  1051 		return 4;

  1052 	    } else if (path [4] == ':' && path[5] == '\0') {

  1053 		return 4;

  1054 	    }

  1055 	}

  1056     } else if (stricmp(path, "prn") == 0) {

  1057 	/* Have match for 'prn' */

  1058 	return 3;

  1059     } else if (stricmp(path, "nul") == 0) {

  1060 	/* Have match for 'nul' */

  1061 	return 3;

  1062     } else if (stricmp(path, "aux") == 0) {

  1063 	/* Have match for 'aux' */

  1064 	return 3;

  1065     }

  1066     return 0;

  1067 }

  1069 /*

  1070  *----------------------------------------------------------------------

  1071  *

  1072  * NativeMatchType --

  1073  *

  1074  * This function needs a special case for a path which is a root

  1075  * volume, because for NTFS root volumes, the getFileAttributesProc

  1076  * returns a 'hidden' attribute when it should not.

  1077  *

  1078  * We never make any calss to a 'get attributes' routine here,

  1079  * since we have arranged things so that our caller already knows

  1080  * such information.

  1081  *

  1082  * Results:

  1083  *  0 = file doesn't match

  1084  *  1 = file matches

  1085  *

  1086  *----------------------------------------------------------------------

  1087  */

  1088 static int

  1089 NativeMatchType(

  1090     int isDrive,              /* Is this a drive */

  1091     DWORD attr,               /* We already know the attributes

  1092                                * for the file */

  1093     CONST TCHAR* nativeName,  /* Native path to check */

  1094     Tcl_GlobTypeData *types)  /* Type description to match against */

  1095 {

  1096     /*

  1097      * 'attr' represents the attributes of the file, but we only

  1098      * want to retrieve this info if it is absolutely necessary

  1099      * because it is an expensive call.  Unfortunately, to deal

  1100      * with hidden files properly, we must always retrieve it.

  1101      */

  1103     if (types == NULL) {

  1104 	/* If invisible, don't return the file */

  1105 	if (attr & FILE_ATTRIBUTE_HIDDEN && !isDrive) {

  1106 	    return 0;

  1107 	}

  1108     } else {

  1109 	if (attr & FILE_ATTRIBUTE_HIDDEN && !isDrive) {

  1110 	    /* If invisible */

  1111 	    if ((types->perm == 0) ||

  1112 		    !(types->perm & TCL_GLOB_PERM_HIDDEN)) {

  1113 		return 0;

  1114 	    }

  1115 	} else {

  1116 	    /* Visible */

  1117 	    if (types->perm & TCL_GLOB_PERM_HIDDEN) {

  1118 		return 0;

  1119 	    }

  1120 	}

  1122 	if (types->perm != 0) {

  1123 	    if (

  1124 		((types->perm & TCL_GLOB_PERM_RONLY) &&

  1125 			!(attr & FILE_ATTRIBUTE_READONLY)) ||

  1126 		((types->perm & TCL_GLOB_PERM_R) &&

  1127 			(0 /* File exists => R_OK on Windows */)) ||

  1128 		((types->perm & TCL_GLOB_PERM_W) &&

  1129 			(attr & FILE_ATTRIBUTE_READONLY)) ||

  1130 		((types->perm & TCL_GLOB_PERM_X) &&

  1131 			(!(attr & FILE_ATTRIBUTE_DIRECTORY)

  1132 			 && !NativeIsExec(nativeName)))

  1133 		) {

  1134 		return 0;

  1135 	    }

  1136 	}

  1137 	if ((types->type & TCL_GLOB_TYPE_DIR)

  1138 	    && (attr & FILE_ATTRIBUTE_DIRECTORY)) {

  1139 	    /* Quicker test for directory, which is a common case */

  1140 	    return 1;

  1141 	} else if (types->type != 0) {

  1142 	    unsigned short st_mode;

  1143 	    int isExec = NativeIsExec(nativeName);

  1145 	    st_mode = NativeStatMode(attr, 0, isExec);

  1147 	    /*

  1148 	     * In order bcdpfls as in 'find -t'

  1149 	     */

  1150 	    if (

  1151 		((types->type & TCL_GLOB_TYPE_BLOCK) &&

  1152 			S_ISBLK(st_mode)) ||

  1153 		((types->type & TCL_GLOB_TYPE_CHAR) &&

  1154 			S_ISCHR(st_mode)) ||

  1155 		((types->type & TCL_GLOB_TYPE_DIR) &&

  1156 			S_ISDIR(st_mode)) ||

  1157 		((types->type & TCL_GLOB_TYPE_PIPE) &&

  1158 			S_ISFIFO(st_mode)) ||

  1159 		((types->type & TCL_GLOB_TYPE_FILE) &&

  1160 			S_ISREG(st_mode))

  1161 #ifdef S_ISSOCK

  1162 		|| ((types->type & TCL_GLOB_TYPE_SOCK) &&

  1163 			S_ISSOCK(st_mode))

  1164 #endif

  1165 		) {

  1166 		/* Do nothing -- this file is ok */

  1167 	    } else {

  1168 #ifdef S_ISLNK

  1169 		if (types->type & TCL_GLOB_TYPE_LINK) {

  1170 		    st_mode = NativeStatMode(attr, 1, isExec);

  1171 		    if (S_ISLNK(st_mode)) {

  1172 			return 1;

  1173 		    }

  1174 		}

  1175 #endif

  1176 		return 0;

  1177 	    }

  1178 	}

  1179     }

  1180     return 1;

  1181 }

  1183 /*

  1184  *----------------------------------------------------------------------

  1185  *

  1186  * TclpGetUserHome --

  1187  *

  1188  *	This function takes the passed in user name and finds the

  1189  *	corresponding home directory specified in the password file.

  1190  *

  1191  * Results:

  1192  *	The result is a pointer to a string specifying the user's home

  1193  *	directory, or NULL if the user's home directory could not be

  1194  *	determined.  Storage for the result string is allocated in

  1195  *	bufferPtr; the caller must call Tcl_DStringFree() when the result

  1196  *	is no longer needed.

  1197  *

  1198  * Side effects:

  1199  *	None.

  1200  *

  1201  *----------------------------------------------------------------------

  1202  */

  1204 char *

  1205 TclpGetUserHome(name, bufferPtr)

  1206     CONST char *name;		/* User name for desired home directory. */

  1207     Tcl_DString *bufferPtr;	/* Uninitialized or free DString filled

  1208 				 * with name of user's home directory. */

  1209 {

  1210     char *result;

  1211     HINSTANCE netapiInst;

  1213     result = NULL;

  1215     Tcl_DStringInit(bufferPtr);

  1217     netapiInst = LoadLibraryA("netapi32.dll");

  1218     if (netapiInst != NULL) {

  1219 	NETAPIBUFFERFREEPROC *netApiBufferFreeProc;

  1220 	NETGETDCNAMEPROC *netGetDCNameProc;

  1221 	NETUSERGETINFOPROC *netUserGetInfoProc;

  1223 	netApiBufferFreeProc = (NETAPIBUFFERFREEPROC *)

  1224 		GetProcAddress(netapiInst, "NetApiBufferFree");

  1225 	netGetDCNameProc = (NETGETDCNAMEPROC *)

  1226 		GetProcAddress(netapiInst, "NetGetDCName");

  1227 	netUserGetInfoProc = (NETUSERGETINFOPROC *)

  1228 		GetProcAddress(netapiInst, "NetUserGetInfo");

  1229 	if ((netUserGetInfoProc != NULL) && (netGetDCNameProc != NULL)

  1230 		&& (netApiBufferFreeProc != NULL)) {

  1231 	    USER_INFO_1 *uiPtr;

  1232 	    Tcl_DString ds;

  1233 	    int nameLen, badDomain;

  1234 	    char *domain;

  1235 	    WCHAR *wName, *wHomeDir, *wDomain;

  1236 	    WCHAR buf[MAX_PATH];

  1238 	    badDomain = 0;

  1239 	    nameLen = -1;

  1240 	    wDomain = NULL;

  1241 	    domain = strchr(name, '@');

  1242 	    if (domain != NULL) {

  1243 		Tcl_DStringInit(&ds);

  1244 		wName = Tcl_UtfToUniCharDString(domain + 1, -1, &ds);

  1245 		badDomain = (*netGetDCNameProc)(NULL, wName,

  1246 			(LPBYTE *) &wDomain);

  1247 		Tcl_DStringFree(&ds);

  1248 		nameLen = domain - name;

  1249 	    }

  1250 	    if (badDomain == 0) {

  1251 		Tcl_DStringInit(&ds);

  1252 		wName = Tcl_UtfToUniCharDString(name, nameLen, &ds);

  1253 		if ((*netUserGetInfoProc)(wDomain, wName, 1,

  1254 			(LPBYTE *) &uiPtr) == 0) {

  1255 		    wHomeDir = uiPtr->usri1_home_dir;

  1256 		    if ((wHomeDir != NULL) && (wHomeDir[0] != L'\0')) {

  1257 			Tcl_UniCharToUtfDString(wHomeDir, lstrlenW(wHomeDir),

  1258 				bufferPtr);

  1259 		    } else {

  1260 			/*

  1261 			 * User exists but has no home dir.  Return

  1262 			 * "{Windows Drive}:/users/default".

  1263 			 */

  1265 			GetWindowsDirectoryW(buf, MAX_PATH);

  1266 			Tcl_UniCharToUtfDString(buf, 2, bufferPtr);

  1267 			Tcl_DStringAppend(bufferPtr, "/users/default", -1);

  1268 		    }

  1269 		    result = Tcl_DStringValue(bufferPtr);

  1270 		    (*netApiBufferFreeProc)((void *) uiPtr);

  1271 		}

  1272 		Tcl_DStringFree(&ds);

  1273 	    }

  1274 	    if (wDomain != NULL) {

  1275 		(*netApiBufferFreeProc)((void *) wDomain);

  1276 	    }

  1277 	}

  1278 	FreeLibrary(netapiInst);

  1279     }

  1280     if (result == NULL) {

  1281 	/*

  1282 	 * Look in the "Password Lists" section of system.ini for the

  1283 	 * local user.  There are also entries in that section that begin

  1284 	 * with a "*" character that are used by Windows for other

  1285 	 * purposes; ignore user names beginning with a "*".

  1286 	 */

  1288 	char buf[MAX_PATH];

  1290 	if (name[0] != '*') {

  1291 	    if (GetPrivateProfileStringA("Password Lists", name, "", buf,

  1292 		    MAX_PATH, "system.ini") > 0) {

  1293 		/*

  1294 		 * User exists, but there is no such thing as a home

  1295 		 * directory in system.ini.  Return "{Windows drive}:/".

  1296 		 */

  1298 		GetWindowsDirectoryA(buf, MAX_PATH);

  1299 		Tcl_DStringAppend(bufferPtr, buf, 3);

  1300 		result = Tcl_DStringValue(bufferPtr);

  1301 	    }

  1302 	}

  1303     }

  1305     return result;

  1306 }

  1308 /*

  1309  *---------------------------------------------------------------------------

  1310  *

  1311  * NativeAccess --

  1312  *

  1313  *	This function replaces the library version of access(), fixing the

  1314  *	following bugs:

  1315  *

  1316  *	1. access() returns that all files have execute permission.

  1317  *

  1318  * Results:

  1319  *	See access documentation.

  1320  *

  1321  * Side effects:

  1322  *	See access documentation.

  1323  *

  1324  *---------------------------------------------------------------------------

  1325  */

  1327 static int

  1328 NativeAccess(

  1329     CONST TCHAR *nativePath,	/* Path of file to access (UTF-8). */

  1330     int mode)			/* Permission setting. */

  1331 {

  1332     DWORD attr;

  1334     attr = (*tclWinProcs->getFileAttributesProc)(nativePath);

  1336     if (attr == 0xffffffff) {

  1337 	/*

  1338 	 * File doesn't exist.

  1339 	 */

  1341 	TclWinConvertError(GetLastError());

  1342 	return -1;

  1343     }

  1345     if ((mode & W_OK)

  1346       && (tclWinProcs->getFileSecurityProc == NULL)

  1347       && (attr & FILE_ATTRIBUTE_READONLY)) {

  1348 	/*

  1349 	 * We don't have the advanced 'getFileSecurityProc', and

  1350 	 * our attributes say the file is not writable.  If we

  1351 	 * do have 'getFileSecurityProc', we'll do a more

  1352 	 * robust XP-related check below.

  1353 	 */

  1355 	Tcl_SetErrno(EACCES);

  1356 	return -1;

  1357     }

  1359     if (mode & X_OK) {

  1360 	if (!(attr & FILE_ATTRIBUTE_DIRECTORY) && !NativeIsExec(nativePath)) {

  1361 	    /*

  1362 	     * It's not a directory and doesn't have the correct extension.

  1363 	     * Therefore it can't be executable

  1364 	     */

  1366 	    Tcl_SetErrno(EACCES);

  1367 	    return -1;

  1368 	}

  1369     }

  1371     /*

  1372      * It looks as if the permissions are ok, but if we are on NT, 2000 or XP,

  1373      * we have a more complex permissions structure so we try to check that.

  1374      * The code below is remarkably complex for such a simple thing as finding

  1375      * what permissions the OS has set for a file.

  1376      *

  1377      * If we are simply checking for file existence, then we don't need all

  1378      * these complications (which are really quite slow: with this code 'file

  1379      * readable' is 5-6 times slower than 'file exists').

  1380      */

  1382     if ((mode != F_OK) && (tclWinProcs->getFileSecurityProc != NULL)) {

  1383 	SECURITY_DESCRIPTOR *sdPtr = NULL;

  1384 	unsigned long size;

  1385 	GENERIC_MAPPING genMap;

  1386 	HANDLE hToken = NULL;

  1387 	DWORD desiredAccess = 0;

  1388 	DWORD grantedAccess = 0;

  1389 	BOOL accessYesNo = FALSE;

  1390 	PRIVILEGE_SET privSet;

  1391 	DWORD privSetSize = sizeof(PRIVILEGE_SET);

  1392 	int error;

  1394 	/*

  1395 	 * First find out how big the buffer needs to be

  1396 	 */

  1398 	size = 0;

  1399 	(*tclWinProcs->getFileSecurityProc)(nativePath,

  1400 		OWNER_SECURITY_INFORMATION | GROUP_SECURITY_INFORMATION

  1401 		| DACL_SECURITY_INFORMATION, 0, 0, &size);

  1403 	/*

  1404 	 * Should have failed with ERROR_INSUFFICIENT_BUFFER

  1405 	 */

  1407 	error = GetLastError();

  1408 	if (error != ERROR_INSUFFICIENT_BUFFER) {

  1409 	    /*

  1410 	     * Most likely case is ERROR_ACCESS_DENIED, which we will convert

  1411 	     * to EACCES - just what we want!

  1412 	     */

  1414 	    TclWinConvertError((DWORD)error);

  1415 	    return -1;

  1416 	}

  1418 	/*

  1419 	 * Now size contains the size of buffer needed

  1420 	 */

  1422 	sdPtr = (SECURITY_DESCRIPTOR *) HeapAlloc(GetProcessHeap(), 0, size);

  1424 	if (sdPtr == NULL) {

  1425 	    goto accessError;

  1426 	}

  1428 	/*

  1429 	 * Call GetFileSecurity() for real

  1430 	 */

  1432 	if (!(*tclWinProcs->getFileSecurityProc)(nativePath,

  1433 		OWNER_SECURITY_INFORMATION | GROUP_SECURITY_INFORMATION

  1434 		| DACL_SECURITY_INFORMATION, sdPtr, size, &size)) {

  1435 	    /*

  1436 	     * Error getting owner SD

  1437 	     */

  1439 	    goto accessError;

  1440 	}

  1442 	/*

  1443 	 * Perform security impersonation of the user and open the

  1444 	 * resulting thread token.

  1445 	 */

  1447 	if (!(*tclWinProcs->impersonateSelfProc)(SecurityImpersonation)) {

  1448 	    /*

  1449 	     * Unable to perform security impersonation.

  1450 	     */

  1452 	    goto accessError;

  1453 	}

  1454 	if (!(*tclWinProcs->openThreadTokenProc)(GetCurrentThread (),

  1455 		TOKEN_DUPLICATE | TOKEN_QUERY, FALSE, &hToken)) {

  1456 	    /*

  1457 	     * Unable to get current thread's token.

  1458 	     */

  1460 	    goto accessError;

  1461 	}

  1463 	(*tclWinProcs->revertToSelfProc)();

  1465 	/*

  1466 	 * Setup desiredAccess according to the access priveleges we are

  1467 	 * checking.

  1468 	 */

  1470 	if (mode & R_OK) {

  1471 	    desiredAccess |= FILE_GENERIC_READ;

  1472 	}

  1473 	if (mode & W_OK) {

  1474 	    desiredAccess |= FILE_GENERIC_WRITE;

  1475 	}

  1476 	if (mode & X_OK) {

  1477 	    desiredAccess |= FILE_GENERIC_EXECUTE;

  1478 	}

  1480 	memset (&genMap, 0x0, sizeof (GENERIC_MAPPING));

  1481 	genMap.GenericRead = FILE_GENERIC_READ;

  1482 	genMap.GenericWrite = FILE_GENERIC_WRITE;

  1483 	genMap.GenericExecute = FILE_GENERIC_EXECUTE;

  1484 	genMap.GenericAll = FILE_ALL_ACCESS;

  1486 	/*

  1487 	 * Perform access check using the token.

  1488 	 */

  1490 	if (!(*tclWinProcs->accessCheckProc)(sdPtr, hToken, desiredAccess,

  1491 		&genMap, &privSet, &privSetSize, &grantedAccess,

  1492 		&accessYesNo)) {

  1493 	    /*

  1494 	     * Unable to perform access check.

  1495 	     */

  1497 	accessError:

  1498 	    TclWinConvertError(GetLastError());

  1499 	    if (sdPtr != NULL) {

  1500 		HeapFree(GetProcessHeap(), 0, sdPtr);

  1501 	    }

  1502 	    if (hToken != NULL) {

  1503 		CloseHandle(hToken);

  1504 	    }

  1505 	    return -1;

  1506 	}

  1508 	/*

  1509 	 * Clean up.

  1510 	 */

  1512 	HeapFree(GetProcessHeap (), 0, sdPtr);

  1513 	CloseHandle(hToken);

  1514 	if (!accessYesNo) {

  1515 	    Tcl_SetErrno(EACCES);

  1516 	    return -1;

  1517 	}

  1518 	/*

  1519 	 * For directories the above checks are ok.  For files, though,

  1520 	 * we must still check the 'attr' value.

  1521 	 */

  1522 	if ((mode & W_OK)

  1523 	  && !(attr & FILE_ATTRIBUTE_DIRECTORY)

  1524 	  && (attr & FILE_ATTRIBUTE_READONLY)) {

  1525 	    Tcl_SetErrno(EACCES);

  1526 	    return -1;

  1527 	}

  1528     }

  1529     return 0;

  1530 }

  1532 /*

  1533  *----------------------------------------------------------------------

  1534  *

  1535  * NativeIsExec --

  1536  *

  1537  *	Determines if a path is executable.  On windows this is

  1538  *	simply defined by whether the path ends in any of ".exe",

  1539  *	".com", or ".bat"

  1540  *

  1541  * Results:

  1542  *	1 = executable, 0 = not.

  1543  *

  1544  *----------------------------------------------------------------------

  1545  */

  1546 static int

  1547 NativeIsExec(nativePath)

  1548     CONST TCHAR *nativePath;

  1549 {

  1550     if (tclWinProcs->useWide) {

  1551 	CONST WCHAR *path;

  1552 	int len;

  1554 	path = (CONST WCHAR*)nativePath;

  1555 	len = wcslen(path);

  1557 	if (len < 5) {

  1558 	    return 0;

  1559 	}

  1561 	if (path[len-4] != L'.') {

  1562 	    return 0;

  1563 	}

  1565 	/*

  1566 	 * Use wide-char case-insensitive comparison

  1567 	 */

  1568 	if ((_wcsicmp(path+len-3,L"exe") == 0)

  1569 		|| (_wcsicmp(path+len-3,L"com") == 0)

  1570 		|| (_wcsicmp(path+len-3,L"bat") == 0)) {

  1571 	    return 1;

  1572 	}

  1573     } else {

  1574 	CONST char *p;

  1576 	/* We are only looking for pure ascii */

  1578 	p = strrchr((CONST char*)nativePath, '.');

  1579 	if (p != NULL) {

  1580 	    p++;

  1581 	    /*

  1582 	     * Note: in the old code, stat considered '.pif' files as

  1583 	     * executable, whereas access did not.

  1584 	     */

  1585 	    if ((stricmp(p, "exe") == 0)

  1586 		    || (stricmp(p, "com") == 0)

  1587 		    || (stricmp(p, "bat") == 0)) {

  1588 		/*

  1589 		 * File that ends with .exe, .com, or .bat is executable.

  1590 		 */

  1592 		return 1;

  1593 	    }

  1594 	}

  1595     }

  1596     return 0;

  1597 }

  1599 /*

  1600  *----------------------------------------------------------------------

  1601  *

  1602  * TclpObjChdir --

  1603  *

  1604  *	This function replaces the library version of chdir().

  1605  *

  1606  * Results:

  1607  *	See chdir() documentation.

  1608  *

  1609  * Side effects:

  1610  *	See chdir() documentation.

  1611  *

  1612  *----------------------------------------------------------------------

  1613  */

  1615 int

  1616 TclpObjChdir(pathPtr)

  1617     Tcl_Obj *pathPtr; 	/* Path to new working directory. */

  1618 {

  1619     int result;

  1620     CONST TCHAR *nativePath;

  1621 #ifdef __CYGWIN__

  1622     extern int cygwin_conv_to_posix_path

  1623 	_ANSI_ARGS_((CONST char *, char *));

  1624     char posixPath[MAX_PATH+1];

  1625     CONST char *path;

  1626     Tcl_DString ds;

  1627 #endif /* __CYGWIN__ */

  1629     nativePath = (CONST TCHAR *) Tcl_FSGetNativePath(pathPtr);

  1630 #ifdef __CYGWIN__

  1631     /* Cygwin chdir only groks POSIX path. */

  1632     path = Tcl_WinTCharToUtf(nativePath, -1, &ds);

  1633     cygwin_conv_to_posix_path(path, posixPath);

  1634     result = (chdir(posixPath) == 0 ? 1 : 0);

  1635     Tcl_DStringFree(&ds);

  1636 #else /* __CYGWIN__ */

  1637     result = (*tclWinProcs->setCurrentDirectoryProc)(nativePath);

  1638 #endif /* __CYGWIN__ */

  1640     if (result == 0) {

  1641 	TclWinConvertError(GetLastError());

  1642 	return -1;

  1643     }

  1644     return 0;

  1645 }

  1647 #ifdef __CYGWIN__

  1648 /*

  1649  *---------------------------------------------------------------------------

  1650  *

  1651  * TclpReadlink --

  1652  *

  1653  *     This function replaces the library version of readlink().

  1654  *

  1655  * Results:

  1656  *     The result is a pointer to a string specifying the contents

  1657  *     of the symbolic link given by 'path', or NULL if the symbolic

  1658  *     link could not be read.  Storage for the result string is

  1659  *     allocated in bufferPtr; the caller must call Tcl_DStringFree()

  1660  *     when the result is no longer needed.

  1661  *

  1662  * Side effects:

  1663  *     See readlink() documentation.

  1664  *

  1665  *---------------------------------------------------------------------------

  1666  */

  1668 char *

  1669 TclpReadlink(path, linkPtr)

  1670     CONST char *path;          /* Path of file to readlink (UTF-8). */

  1671     Tcl_DString *linkPtr;      /* Uninitialized or free DString filled

  1672                                 * with contents of link (UTF-8). */

  1673 {

  1674     char link[MAXPATHLEN];

  1675     int length;

  1676     char *native;

  1677     Tcl_DString ds;

  1679     native = Tcl_UtfToExternalDString(NULL, path, -1, &ds);

  1680     length = readlink(native, link, sizeof(link));     /* INTL: Native. */

  1681     Tcl_DStringFree(&ds);

  1683     if (length < 0) {

  1684 	return NULL;

  1685     }

  1687     Tcl_ExternalToUtfDString(NULL, link, length, linkPtr);

  1688     return Tcl_DStringValue(linkPtr);

  1689 }

  1690 #endif /* __CYGWIN__ */

  1692 /*

  1693  *----------------------------------------------------------------------

  1694  *

  1695  * TclpGetCwd --

  1696  *

  1697  *	This function replaces the library version of getcwd().

  1698  *

  1699  * Results:

  1700  *	The result is a pointer to a string specifying the current

  1701  *	directory, or NULL if the current directory could not be

  1702  *	determined.  If NULL is returned, an error message is left in the

  1703  *	interp's result.  Storage for the result string is allocated in

  1704  *	bufferPtr; the caller must call Tcl_DStringFree() when the result

  1705  *	is no longer needed.

  1706  *

  1707  * Side effects:

  1708  *	None.

  1709  *

  1710  *----------------------------------------------------------------------

  1711  */

  1713 CONST char *

  1714 TclpGetCwd(interp, bufferPtr)

  1715     Tcl_Interp *interp;		/* If non-NULL, used for error reporting. */

  1716     Tcl_DString *bufferPtr;	/* Uninitialized or free DString filled

  1717 				 * with name of current directory. */

  1718 {

  1719     WCHAR buffer[MAX_PATH];

  1720     char *p;

  1722     if ((*tclWinProcs->getCurrentDirectoryProc)(MAX_PATH, buffer) == 0) {

  1723 	TclWinConvertError(GetLastError());

  1724 	if (interp != NULL) {

  1725 	    Tcl_AppendResult(interp,

  1726 		    "error getting working directory name: ",

  1727 		    Tcl_PosixError(interp), (char *) NULL);

  1728 	}

  1729 	return NULL;

  1730     }

  1732     /*

  1733      * Watch for the weird Windows c:\\UNC syntax.

  1734      */

  1736     if (tclWinProcs->useWide) {

  1737 	WCHAR *native;

  1739 	native = (WCHAR *) buffer;

  1740 	if ((native[0] != '\0') && (native[1] == ':')

  1741 		&& (native[2] == '\\') && (native[3] == '\\')) {

  1742 	    native += 2;

  1743 	}

  1744 	Tcl_WinTCharToUtf((TCHAR *) native, -1, bufferPtr);

  1745     } else {

  1746 	char *native;

  1748 	native = (char *) buffer;

  1749 	if ((native[0] != '\0') && (native[1] == ':')

  1750 		&& (native[2] == '\\') && (native[3] == '\\')) {

  1751 	    native += 2;

  1752 	}

  1753 	Tcl_WinTCharToUtf((TCHAR *) native, -1, bufferPtr);

  1754     }

  1756     /*

  1757      * Convert to forward slashes for easier use in scripts.

  1758      */

  1760     for (p = Tcl_DStringValue(bufferPtr); *p != '\0'; p++) {

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

  1762 	    *p = '/';

  1763 	}

  1764     }

  1765     return Tcl_DStringValue(bufferPtr);

  1766 }

  1768 int

  1769 TclpObjStat(pathPtr, statPtr)

  1770     Tcl_Obj *pathPtr;          /* Path of file to stat */

  1771     Tcl_StatBuf *statPtr;      /* Filled with results of stat call. */

  1772 {

  1773 #ifdef OLD_API

  1774     Tcl_Obj *transPtr;

  1775     /*

  1776      * Eliminate file names containing wildcard characters, or subsequent

  1777      * call to FindFirstFile() will expand them, matching some other file.

  1778      */

  1780     transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);

  1781     if (transPtr == NULL || (strpbrk(Tcl_GetString(transPtr), "?*") != NULL)) {

  1782 	if (transPtr != NULL) {

  1783 	    Tcl_DecrRefCount(transPtr);

  1784 	}

  1785 	Tcl_SetErrno(ENOENT);

  1786 	return -1;

  1787     }

  1788     Tcl_DecrRefCount(transPtr);

  1789 #endif

  1791     /*

  1792      * Ensure correct file sizes by forcing the OS to write any

  1793      * pending data to disk. This is done only for channels which are

  1794      * dirty, i.e. have been written to since the last flush here.

  1795      */

  1797     TclWinFlushDirtyChannels ();

  1799     return NativeStat((CONST TCHAR*) Tcl_FSGetNativePath(pathPtr), statPtr, 0);

  1800 }

  1802 /*

  1803  *----------------------------------------------------------------------

  1804  *

  1805  * NativeStat --

  1806  *

  1807  *	This function replaces the library version of stat(), fixing

  1808  *	the following bugs:

  1809  *

  1810  *	1. stat("c:") returns an error.

  1811  *	2. Borland stat() return time in GMT instead of localtime.

  1812  *	3. stat("\\server\mount") would return error.

  1813  *	4. Accepts slashes or backslashes.

  1814  *	5. st_dev and st_rdev were wrong for UNC paths.

  1815  *

  1816  * Results:

  1817  *	See stat documentation.

  1818  *

  1819  * Side effects:

  1820  *	See stat documentation.

  1821  *

  1822  *----------------------------------------------------------------------

  1823  */

  1825 static int

  1826 NativeStat(nativePath, statPtr, checkLinks)

  1827     CONST TCHAR *nativePath;   /* Path of file to stat */

  1828     Tcl_StatBuf *statPtr;      /* Filled with results of stat call. */

  1829     int checkLinks;            /* If non-zero, behave like 'lstat' */

  1830 {

  1831     Tcl_DString ds;

  1832     DWORD attr;

  1833     WCHAR nativeFullPath[MAX_PATH];

  1834     TCHAR *nativePart;

  1835     CONST char *fullPath;

  1836     int dev;

  1837     unsigned short mode;

  1839     if (tclWinProcs->getFileAttributesExProc == NULL) {

  1840         /*

  1841          * We don't have the faster attributes proc, so we're

  1842          * probably running on Win95

  1843          */

  1844 	WIN32_FIND_DATAT data;

  1845 	HANDLE handle;

  1847 	handle = (*tclWinProcs->findFirstFileProc)(nativePath, &data);

  1848 	if (handle == INVALID_HANDLE_VALUE) {

  1849 	    /*

  1850 	     * FindFirstFile() doesn't work on root directories, so call

  1851 	     * GetFileAttributes() to see if the specified file exists.

  1852 	     */

  1854 	    attr = (*tclWinProcs->getFileAttributesProc)(nativePath);

  1855 	    if (attr == INVALID_FILE_ATTRIBUTES) {

  1856 		Tcl_SetErrno(ENOENT);

  1857 		return -1;

  1858 	    }

  1860 	    /*

  1861 	     * Make up some fake information for this file.  It has the

  1862 	     * correct file attributes and a time of 0.

  1863 	     */

  1865 	    memset(&data, 0, sizeof(data));

  1866 	    data.a.dwFileAttributes = attr;

  1867 	} else {

  1868 	    FindClose(handle);

  1869 	}

  1872 	(*tclWinProcs->getFullPathNameProc)(nativePath, MAX_PATH, nativeFullPath,

  1873 		&nativePart);

  1875 	fullPath = Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds);

  1877 	dev = -1;

  1878 	if ((fullPath[0] == '\\') && (fullPath[1] == '\\')) {

  1879 	    CONST char *p;

  1880 	    DWORD dw;

  1881 	    CONST TCHAR *nativeVol;

  1882 	    Tcl_DString volString;

  1884 	    p = strchr(fullPath + 2, '\\');

  1885 	    p = strchr(p + 1, '\\');

  1886 	    if (p == NULL) {

  1887 		/*

  1888 		 * Add terminating backslash to fullpath or

  1889 		 * GetVolumeInformation() won't work.

  1890 		 */

  1892 		fullPath = Tcl_DStringAppend(&ds, "\\", 1);

  1893 		p = fullPath + Tcl_DStringLength(&ds);

  1894 	    } else {

  1895 		p++;

  1896 	    }

  1897 	    nativeVol = Tcl_WinUtfToTChar(fullPath, p - fullPath, &volString);

  1898 	    dw = (DWORD) -1;

  1899 	    (*tclWinProcs->getVolumeInformationProc)(nativeVol, NULL, 0, &dw,

  1900 		    NULL, NULL, NULL, 0);

  1901 	    /*

  1902 	     * GetFullPathName() turns special devices like "NUL" into

  1903 	     * "\\.\NUL", but GetVolumeInformation() returns failure for

  1904 	     * "\\.\NUL".  This will cause "NUL" to get a drive number of

  1905 	     * -1, which makes about as much sense as anything since the

  1906 	     * special devices don't live on any drive.

  1907 	     */

  1909 	    dev = dw;

  1910 	    Tcl_DStringFree(&volString);

  1911 	} else if ((fullPath[0] != '\0') && (fullPath[1] == ':')) {

  1912 	    dev = Tcl_UniCharToLower(fullPath[0]) - 'a';

  1913 	}

  1914 	Tcl_DStringFree(&ds);

  1916 	attr = data.a.dwFileAttributes;

  1918 	statPtr->st_size  = ((Tcl_WideInt)data.a.nFileSizeLow) |

  1919 		(((Tcl_WideInt)data.a.nFileSizeHigh) << 32);

  1920 	statPtr->st_atime = ToCTime(data.a.ftLastAccessTime);

  1921 	statPtr->st_mtime = ToCTime(data.a.ftLastWriteTime);

  1922 	statPtr->st_ctime = ToCTime(data.a.ftCreationTime);

  1923     } else {

  1924 	WIN32_FILE_ATTRIBUTE_DATA data;

  1925 	if((*tclWinProcs->getFileAttributesExProc)(nativePath,

  1926 						   GetFileExInfoStandard,

  1927 						   &data) != TRUE) {

  1928 	    Tcl_SetErrno(ENOENT);

  1929 	    return -1;

  1930 	}

  1933 	(*tclWinProcs->getFullPathNameProc)(nativePath, MAX_PATH,

  1934 					    nativeFullPath, &nativePart);

  1936 	fullPath = Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds);

  1938 	dev = -1;

  1939 	if ((fullPath[0] == '\\') && (fullPath[1] == '\\')) {

  1940 	    CONST char *p;

  1941 	    DWORD dw;

  1942 	    CONST TCHAR *nativeVol;

  1943 	    Tcl_DString volString;

  1945 	    p = strchr(fullPath + 2, '\\');

  1946 	    p = strchr(p + 1, '\\');

  1947 	    if (p == NULL) {

  1948 		/*

  1949 		 * Add terminating backslash to fullpath or

  1950 		 * GetVolumeInformation() won't work.

  1951 		 */

  1953 		fullPath = Tcl_DStringAppend(&ds, "\\", 1);

  1954 		p = fullPath + Tcl_DStringLength(&ds);

  1955 	    } else {

  1956 		p++;

  1957 	    }

  1958 	    nativeVol = Tcl_WinUtfToTChar(fullPath, p - fullPath, &volString);

  1959 	    dw = (DWORD) -1;

  1960 	    (*tclWinProcs->getVolumeInformationProc)(nativeVol, NULL, 0, &dw,

  1961 		    NULL, NULL, NULL, 0);

  1962 	    /*

  1963 	     * GetFullPathName() turns special devices like "NUL" into

  1964 	     * "\\.\NUL", but GetVolumeInformation() returns failure for

  1965 	     * "\\.\NUL".  This will cause "NUL" to get a drive number of

  1966 	     * -1, which makes about as much sense as anything since the

  1967 	     * special devices don't live on any drive.

  1968 	     */

  1970 	    dev = dw;

  1971 	    Tcl_DStringFree(&volString);

  1972 	} else if ((fullPath[0] != '\0') && (fullPath[1] == ':')) {

  1973 	    dev = Tcl_UniCharToLower(fullPath[0]) - 'a';

  1974 	}

  1975 	Tcl_DStringFree(&ds);

  1977 	attr = data.dwFileAttributes;

  1979 	statPtr->st_size  = ((Tcl_WideInt)data.nFileSizeLow) |

  1980 		(((Tcl_WideInt)data.nFileSizeHigh) << 32);

  1981 	statPtr->st_atime = ToCTime(data.ftLastAccessTime);

  1982 	statPtr->st_mtime = ToCTime(data.ftLastWriteTime);

  1983 	statPtr->st_ctime = ToCTime(data.ftCreationTime);

  1984     }

  1986     mode = NativeStatMode(attr, checkLinks, NativeIsExec(nativePath));

  1988     statPtr->st_dev	= (dev_t) dev;

  1989     statPtr->st_ino	= 0;

  1990     statPtr->st_mode	= mode;

  1991     statPtr->st_nlink	= 1;

  1992     statPtr->st_uid	= 0;

  1993     statPtr->st_gid	= 0;

  1994     statPtr->st_rdev	= (dev_t) dev;

  1995     return 0;

  1996 }

  1998 /*

  1999  *----------------------------------------------------------------------

  2000  *

  2001  * NativeStatMode --

  2002  *

  2003  *	Calculate just the 'st_mode' field of a 'stat' structure.

  2004  *

  2005  *----------------------------------------------------------------------

  2006  */

  2007 static unsigned short

  2008 NativeStatMode(DWORD attr, int checkLinks, int isExec)

  2009 {

  2010     int mode;

  2011     if (checkLinks && (attr & FILE_ATTRIBUTE_REPARSE_POINT)) {

  2012 	/* It is a link */

  2013 	mode = S_IFLNK;

  2014     } else {

  2015 	mode  = (attr & FILE_ATTRIBUTE_DIRECTORY) ? S_IFDIR | S_IEXEC : S_IFREG;

  2016     }

  2017     mode |= (attr & FILE_ATTRIBUTE_READONLY) ? S_IREAD : S_IREAD | S_IWRITE;

  2018     if (isExec) {

  2019 	mode |= S_IEXEC;

  2020     }

  2022     /*

  2023      * Propagate the S_IREAD, S_IWRITE, S_IEXEC bits to the group and

  2024      * other positions.

  2025      */

  2027     mode |= (mode & 0x0700) >> 3;

  2028     mode |= (mode & 0x0700) >> 6;

  2029     return (unsigned short)mode;

  2030 }

  2032 /*

  2033  *------------------------------------------------------------------------

  2034  *

  2035  * ToCTime --

  2036  *

  2037  *	Converts a Windows FILETIME to a time_t in UTC.

  2038  *

  2039  * Results:

  2040  *	Returns the count of seconds from the Posix epoch.

  2041  *

  2042  *------------------------------------------------------------------------

  2043  */

  2045 static time_t

  2046 ToCTime(

  2047     FILETIME fileTime)		/* UTC time */

  2048 {

  2049     LARGE_INTEGER convertedTime;

  2051     convertedTime.LowPart = fileTime.dwLowDateTime;

  2052     convertedTime.HighPart = (LONG) fileTime.dwHighDateTime;

  2054     return (time_t) ((convertedTime.QuadPart

  2055 	    - (Tcl_WideInt) POSIX_EPOCH_AS_FILETIME) / (Tcl_WideInt) 10000000);

  2056 }

  2058 /*

  2059  *------------------------------------------------------------------------

  2060  *

  2061  * FromCTime --

  2062  *

  2063  *	Converts a time_t to a Windows FILETIME

  2064  *

  2065  * Results:

  2066  *	Returns the count of 100-ns ticks seconds from the Windows epoch.

  2067  *

  2068  *------------------------------------------------------------------------

  2069  */

  2071 static void

  2072 FromCTime(

  2073     time_t posixTime,

  2074     FILETIME* fileTime)		/* UTC Time */

  2075 {

  2076     LARGE_INTEGER convertedTime;

  2077     convertedTime.QuadPart = ((LONGLONG) posixTime) * 10000000

  2078 	+ POSIX_EPOCH_AS_FILETIME;

  2079     fileTime->dwLowDateTime = convertedTime.LowPart;

  2080     fileTime->dwHighDateTime = convertedTime.HighPart;

  2081 }

  2083 #if 0

  2084 /*

  2085  *-------------------------------------------------------------------------

  2086  *

  2087  * TclWinResolveShortcut --

  2088  *

  2089  *	Resolve a potential Windows shortcut to get the actual file or

  2090  *	directory in question.

  2091  *

  2092  * Results:

  2093  *	Returns 1 if the shortcut could be resolved, or 0 if there was

  2094  *	an error or if the filename was not a shortcut.

  2095  *	If bufferPtr did hold the name of a shortcut, it is modified to

  2096  *	hold the resolved target of the shortcut instead.

  2097  *

  2098  * Side effects:

  2099  *	Loads and unloads OLE package to determine if filename refers to

  2100  *	a shortcut.

  2101  *

  2102  *-------------------------------------------------------------------------

  2103  */

  2105 int

  2106 TclWinResolveShortcut(bufferPtr)

  2107     Tcl_DString *bufferPtr;	/* Holds name of file to resolve.  On

  2108 				 * return, holds resolved file name. */

  2109 {

  2110     HRESULT hres;

  2111     IShellLink *psl;

  2112     IPersistFile *ppf;

  2113     WIN32_FIND_DATA wfd;

  2114     WCHAR wpath[MAX_PATH];

  2115     char *path, *ext;

  2116     char realFileName[MAX_PATH];

  2118     /*

  2119      * Windows system calls do not automatically resolve

  2120      * shortcuts like UNIX automatically will with symbolic links.

  2121      */

  2123     path = Tcl_DStringValue(bufferPtr);

  2124     ext = strrchr(path, '.');

  2125     if ((ext == NULL) || (stricmp(ext, ".lnk") != 0)) {

  2126 	return 0;

  2127     }

  2129     CoInitialize(NULL);

  2130     path = Tcl_DStringValue(bufferPtr);

  2131     realFileName[0] = '\0';

  2132     hres = CoCreateInstance(&CLSID_ShellLink, NULL, CLSCTX_INPROC_SERVER,

  2133 	    &IID_IShellLink, &psl);

  2134     if (SUCCEEDED(hres)) {

  2135 	hres = psl->lpVtbl->QueryInterface(psl, &IID_IPersistFile, &ppf);

  2136 	if (SUCCEEDED(hres)) {

  2137 	    MultiByteToWideChar(CP_ACP, 0, path, -1, wpath, sizeof(wpath));

  2138 	    hres = ppf->lpVtbl->Load(ppf, wpath, STGM_READ);

  2139 	    if (SUCCEEDED(hres)) {

  2140 		hres = psl->lpVtbl->Resolve(psl, NULL,

  2141 			SLR_ANY_MATCH | SLR_NO_UI);

  2142 		if (SUCCEEDED(hres)) {

  2143 		    hres = psl->lpVtbl->GetPath(psl, realFileName, MAX_PATH,

  2144 			    &wfd, 0);

  2145 		}

  2146 	    }

  2147 	    ppf->lpVtbl->Release(ppf);

  2148 	}

  2149 	psl->lpVtbl->Release(psl);

  2150     }

  2151     CoUninitialize();

  2153     if (realFileName[0] != '\0') {

  2154 	Tcl_DStringSetLength(bufferPtr, 0);

  2155 	Tcl_DStringAppend(bufferPtr, realFileName, -1);

  2156 	return 1;

  2157     }

  2158     return 0;

  2159 }

  2160 #endif

  2162 Tcl_Obj*

  2163 TclpObjGetCwd(interp)

  2164     Tcl_Interp *interp;

  2165 {

  2166     Tcl_DString ds;

  2167     if (TclpGetCwd(interp, &ds) != NULL) {

  2168 	Tcl_Obj *cwdPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);

  2169 	Tcl_IncrRefCount(cwdPtr);

  2170 	Tcl_DStringFree(&ds);

  2171 	return cwdPtr;

  2172     } else {

  2173 	return NULL;

  2174     }

  2175 }

  2177 int

  2178 TclpObjAccess(pathPtr, mode)

  2179     Tcl_Obj *pathPtr;

  2180     int mode;

  2181 {

  2182     return NativeAccess((CONST TCHAR*) Tcl_FSGetNativePath(pathPtr), mode);

  2183 }

  2185 int

  2186 TclpObjLstat(pathPtr, statPtr)

  2187     Tcl_Obj *pathPtr;

  2188     Tcl_StatBuf *statPtr;

  2189 {

  2190     /*

  2191      * Ensure correct file sizes by forcing the OS to write any

  2192      * pending data to disk. This is done only for channels which are

  2193      * dirty, i.e. have been written to since the last flush here.

  2194      */

  2196     TclWinFlushDirtyChannels ();

  2198     return NativeStat((CONST TCHAR*) Tcl_FSGetNativePath(pathPtr), statPtr, 1);

  2199 }

  2201 #ifdef S_IFLNK

  2203 Tcl_Obj*

  2204 TclpObjLink(pathPtr, toPtr, linkAction)

  2205     Tcl_Obj *pathPtr;

  2206     Tcl_Obj *toPtr;

  2207     int linkAction;

  2208 {

  2209     if (toPtr != NULL) {

  2210 	int res;

  2211 	TCHAR* LinkTarget = (TCHAR*)Tcl_FSGetNativePath(toPtr);

  2212 	TCHAR* LinkSource = (TCHAR*)Tcl_FSGetNativePath(pathPtr);

  2213 	if (LinkSource == NULL || LinkTarget == NULL) {

  2214 	    return NULL;

  2215 	}

  2216 	res = WinLink(LinkSource, LinkTarget, linkAction);

  2217 	if (res == 0) {

  2218 	    return toPtr;

  2219 	} else {

  2220 	    return NULL;

  2221 	}

  2222     } else {

  2223 	TCHAR* LinkSource = (TCHAR*)Tcl_FSGetNativePath(pathPtr);

  2224 	if (LinkSource == NULL) {

  2225 	    return NULL;

  2226 	}

  2227 	return WinReadLink(LinkSource);

  2228     }

  2229 }

  2231 #endif

  2234 /*

  2235  *---------------------------------------------------------------------------

  2236  *

  2237  * TclpFilesystemPathType --

  2238  *

  2239  *      This function is part of the native filesystem support, and

  2240  *      returns the path type of the given path.  Returns NTFS or FAT

  2241  *      or whatever is returned by the 'volume information' proc.

  2242  *

  2243  * Results:

  2244  *      NULL at present.

  2245  *

  2246  * Side effects:

  2247  *	None.

  2248  *

  2249  *---------------------------------------------------------------------------

  2250  */

  2251 Tcl_Obj*

  2252 TclpFilesystemPathType(pathObjPtr)

  2253     Tcl_Obj* pathObjPtr;

  2254 {

  2255 #define VOL_BUF_SIZE 32

  2256     int found;

  2257     WCHAR volType[VOL_BUF_SIZE];

  2258     char* firstSeparator;

  2259     CONST char *path;

  2261     Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathObjPtr);

  2262     if (normPath == NULL) return NULL;

  2263     path = Tcl_GetString(normPath);

  2264     if (path == NULL) return NULL;

  2266     firstSeparator = strchr(path, '/');

  2267     if (firstSeparator == NULL) {

  2268 	found = tclWinProcs->getVolumeInformationProc(

  2269 		Tcl_FSGetNativePath(pathObjPtr), NULL, 0, NULL, NULL,

  2270 		NULL, (WCHAR *)volType, VOL_BUF_SIZE);

  2271     } else {

  2272 	Tcl_Obj *driveName = Tcl_NewStringObj(path, firstSeparator - path+1);

  2273 	Tcl_IncrRefCount(driveName);

  2274 	found = tclWinProcs->getVolumeInformationProc(

  2275 		Tcl_FSGetNativePath(driveName), NULL, 0, NULL, NULL,

  2276 		NULL, (WCHAR *)volType, VOL_BUF_SIZE);

  2277 	Tcl_DecrRefCount(driveName);

  2278     }

  2280     if (found == 0) {

  2281 	return NULL;

  2282     } else {

  2283 	Tcl_DString ds;

  2284 	Tcl_Obj *objPtr;

  2286 	Tcl_WinTCharToUtf((CONST char *)volType, -1, &ds);

  2287 	objPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds),Tcl_DStringLength(&ds));

  2288 	Tcl_DStringFree(&ds);

  2289 	return objPtr;

  2290     }

  2291 #undef VOL_BUF_SIZE

  2292 }

  2295 /*

  2296  *---------------------------------------------------------------------------

  2297  *

  2298  * TclpObjNormalizePath --

  2299  *

  2300  *	This function scans through a path specification and replaces it,

  2301  *	in place, with a normalized version.  This means using the

  2302  *	'longname', and expanding any symbolic links contained within the

  2303  *	path.

  2304  *

  2305  * Results:

  2306  *	The new 'nextCheckpoint' value, giving as far as we could

  2307  *	understand in the path.

  2308  *

  2309  * Side effects:

  2310  *	The pathPtr string, which must contain a valid path, is

  2311  *	possibly modified in place.

  2312  *

  2313  *---------------------------------------------------------------------------

  2314  */

  2316 int

  2317 TclpObjNormalizePath(interp, pathPtr, nextCheckpoint)

  2318     Tcl_Interp *interp;

  2319     Tcl_Obj *pathPtr;

  2320     int nextCheckpoint;

  2321 {

  2322     char *lastValidPathEnd = NULL;

  2323     /* This will hold the normalized string */

  2324     Tcl_DString dsNorm;

  2325     char *path;

  2326     char *currentPathEndPosition;

  2328     Tcl_DStringInit(&dsNorm);

  2329     path = Tcl_GetString(pathPtr);

  2331     if (TclWinGetPlatformId() == VER_PLATFORM_WIN32_WINDOWS) {

  2332 	/*

  2333 	 * We're on Win95, 98 or ME.  There are two assumptions

  2334 	 * in this block of code.  First that the native (NULL)

  2335 	 * encoding is basically ascii, and second that symbolic

  2336 	 * links are not possible.  Both of these assumptions

  2337 	 * appear to be true of these operating systems.

  2338 	 */

  2339 	int isDrive = 1;

  2340 	Tcl_DString ds;

  2342 	currentPathEndPosition = path + nextCheckpoint;

  2343         if (*currentPathEndPosition == '/') {

  2344 	    currentPathEndPosition++;

  2345         }

  2346 	while (1) {

  2347 	    char cur = *currentPathEndPosition;

  2348 	    if ((cur == '/' || cur == 0) && (path != currentPathEndPosition)) {

  2349 		/* Reached directory separator, or end of string */

  2350 		CONST char *nativePath = Tcl_UtfToExternalDString(NULL, path,

  2351 			    currentPathEndPosition - path, &ds);

  2353 		/*

  2354 		 * Now we convert the tail of the current path to its

  2355 		 * 'long form', and append it to 'dsNorm' which holds

  2356 		 * the current normalized path, if the file exists.

  2357 		 */

  2358 		if (isDrive) {

  2359 		    if (GetFileAttributesA(nativePath) == INVALID_FILE_ATTRIBUTES) {

  2360 			/* File doesn't exist */

  2361 			if (isDrive) {

  2362 			    int len = WinIsReserved(path);

  2363 			    if (len > 0) {

  2364 				/* Actually it does exist - COM1, etc */

  2365 				int i;

  2366 				for (i=0;i<len;i++) {

  2367 				    if (nativePath[i] >= 'a') {

  2368 					((char*)nativePath)[i] -= ('a' - 'A');

  2369 				    }

  2370 				}

  2371 				Tcl_DStringAppend(&dsNorm, nativePath, len);

  2372 				lastValidPathEnd = currentPathEndPosition;

  2373 			    }

  2374 			}

  2375 			Tcl_DStringFree(&ds);

  2376 			break;

  2377 		    }

  2378 		    if (nativePath[0] >= 'a') {

  2379 			((char*)nativePath)[0] -= ('a' - 'A');

  2380 		    }

  2381 		    Tcl_DStringAppend(&dsNorm,nativePath,Tcl_DStringLength(&ds));

  2382 		} else {

  2383 		    WIN32_FIND_DATA fData;

  2384 		    HANDLE handle;

  2386 		    handle = FindFirstFileA(nativePath, &fData);

  2387 		    if (handle == INVALID_HANDLE_VALUE) {

  2388 			if (GetFileAttributesA(nativePath)

  2389 			    == INVALID_FILE_ATTRIBUTES) {

  2390 			    /* File doesn't exist */

  2391 			    Tcl_DStringFree(&ds);

  2392 			    break;

  2393 			}

  2394 			/* This is usually the '/' in 'c:/' at end of string */

  2395 			Tcl_DStringAppend(&dsNorm,"/", 1);

  2396 		    } else {

  2397 			char *nativeName;

  2398 			if (fData.cFileName[0] != '\0') {

  2399 			    nativeName = fData.cFileName;

  2400 			} else {

  2401 			    nativeName = fData.cAlternateFileName;

  2402 			}

  2403 			FindClose(handle);

  2404 			Tcl_DStringAppend(&dsNorm,"/", 1);

  2405 			Tcl_DStringAppend(&dsNorm,nativeName,-1);

  2406 		    }

  2407 		}

  2408 		Tcl_DStringFree(&ds);

  2409 		lastValidPathEnd = currentPathEndPosition;

  2410 		if (cur == 0) {

  2411 		    break;

  2412 		}

  2413 		/*

  2414 		 * If we get here, we've got past one directory

  2415 		 * delimiter, so we know it is no longer a drive

  2416 		 */

  2417 		isDrive = 0;

  2418 	    }

  2419 	    currentPathEndPosition++;

  2420 	}

  2421     } else {

  2422 	/* We're on WinNT or 2000 or XP */

  2423 	Tcl_Obj *temp = NULL;

  2424 	int isDrive = 1;

  2425 	Tcl_DString ds;

  2427 	currentPathEndPosition = path + nextCheckpoint;

  2428 	if (*currentPathEndPosition == '/') {

  2429 	    currentPathEndPosition++;

  2430 	}

  2431 	while (1) {

  2432 	    char cur = *currentPathEndPosition;

  2433 	    if ((cur == '/' || cur == 0) && (path != currentPathEndPosition)) {

  2434 		/* Reached directory separator, or end of string */

  2435 		WIN32_FILE_ATTRIBUTE_DATA data;

  2436 		CONST char *nativePath = Tcl_WinUtfToTChar(path,

  2437 			    currentPathEndPosition - path, &ds);

  2438 		if ((*tclWinProcs->getFileAttributesExProc)(nativePath,

  2439 		    GetFileExInfoStandard, &data) != TRUE) {

  2440 		    /* File doesn't exist */

  2441 		    if (isDrive) {

  2442 			int len = WinIsReserved(path);

  2443 			if (len > 0) {

  2444 			    /* Actually it does exist - COM1, etc */

  2445 			    int i;

  2446 			    for (i=0;i<len;i++) {

  2447 				WCHAR wc = ((WCHAR*)nativePath)[i];

  2448 				if (wc >= L'a') {

  2449 				    wc -= (L'a' - L'A');

  2450 				    ((WCHAR*)nativePath)[i] = wc;

  2451 				}

  2452 			    }

  2453 			    Tcl_DStringAppend(&dsNorm, nativePath,

  2454 					      sizeof(WCHAR)*len);

  2455 			    lastValidPathEnd = currentPathEndPosition;

  2456 			}

  2457 		    }

  2458 		    Tcl_DStringFree(&ds);

  2459 		    break;

  2460 		}

  2462 		/*

  2463 		 * File 'nativePath' does exist if we get here.  We

  2464 		 * now want to check if it is a symlink and otherwise

  2465 		 * continue with the rest of the path.

  2466 		 */

  2468 		/*

  2469 		 * Check for symlinks, except at last component

  2470 		 * of path (we don't follow final symlinks). Also

  2471 		 * a drive (C:/) for example, may sometimes have

  2472 		 * the reparse flag set for some reason I don't

  2473 		 * understand.  We therefore don't perform this

  2474 		 * check for drives.

  2475 		 */

  2476 		if (cur != 0 && !isDrive && (data.dwFileAttributes

  2477 				 & FILE_ATTRIBUTE_REPARSE_POINT)) {

  2478 		    Tcl_Obj *to = WinReadLinkDirectory(nativePath);

  2479 		    if (to != NULL) {

  2480 			/* Read the reparse point ok */

  2481 			/* Tcl_GetStringFromObj(to, &pathLen); */

  2482 			nextCheckpoint = 0; /* pathLen */

  2483 			Tcl_AppendToObj(to, currentPathEndPosition, -1);

  2484 			/* Convert link to forward slashes */

  2485 			for (path = Tcl_GetString(to); *path != 0; path++) {

  2486 			    if (*path == '\\') *path = '/';

  2487 			}

  2488 			path = Tcl_GetString(to);

  2489 			currentPathEndPosition = path + nextCheckpoint;

  2490 			if (temp != NULL) {

  2491 			    Tcl_DecrRefCount(temp);

  2492 			}

  2493 			temp = to;

  2494 			/* Reset variables so we can restart normalization */

  2495 			isDrive = 1;

  2496 			Tcl_DStringFree(&dsNorm);

  2497 			Tcl_DStringInit(&dsNorm);

  2498 			Tcl_DStringFree(&ds);

  2499 			continue;

  2500 		    }

  2501 		}

  2502 		/*

  2503 		 * Now we convert the tail of the current path to its

  2504 		 * 'long form', and append it to 'dsNorm' which holds

  2505 		 * the current normalized path

  2506 		 */

  2507 		if (isDrive) {

  2508 		    WCHAR drive = ((WCHAR*)nativePath)[0];

  2509 		    if (drive >= L'a') {

  2510 		        drive -= (L'a' - L'A');

  2511 			((WCHAR*)nativePath)[0] = drive;

  2512 		    }

  2513 		    Tcl_DStringAppend(&dsNorm,nativePath,Tcl_DStringLength(&ds));

  2514 		} else {

  2515 		    char *checkDots = NULL;

  2517 		    if (lastValidPathEnd[1] == '.') {

  2518 			checkDots = lastValidPathEnd + 1;

  2519 			while (checkDots < currentPathEndPosition) {

  2520 			    if (*checkDots != '.') {

  2521 				checkDots = NULL;

  2522 				break;

  2523 			    }

  2524 			    checkDots++;

  2525 			}

  2526 		    }

  2527 		    if (checkDots != NULL) {

  2528 			int dotLen = currentPathEndPosition - lastValidPathEnd;

  2529 			/*

  2530 			 * Path is just dots.  We shouldn't really

  2531 			 * ever see a path like that.  However, to be

  2532 			 * nice we at least don't mangle the path --

  2533 			 * we just add the dots as a path segment and

  2534 			 * continue

  2535 			 */

  2536 			Tcl_DStringAppend(&dsNorm,

  2537 					  (TCHAR*)((WCHAR*)(nativePath

  2538 						+ Tcl_DStringLength(&ds))

  2539 						- dotLen),

  2540 					  (int)(dotLen * sizeof(WCHAR)));

  2541 		    } else {

  2542 			/* Normal path */

  2543 			WIN32_FIND_DATAW fData;

  2544 			HANDLE handle;

  2546 			handle = FindFirstFileW((WCHAR*)nativePath, &fData);

  2547 			if (handle == INVALID_HANDLE_VALUE) {

  2548 			    /* This is usually the '/' in 'c:/' at end of string */

  2549 			    Tcl_DStringAppend(&dsNorm,(CONST char*)L"/",

  2550 					      sizeof(WCHAR));

  2551 			} else {

  2552 			    WCHAR *nativeName;

  2553 			    if (fData.cFileName[0] != '\0') {

  2554 				nativeName = fData.cFileName;

  2555 			    } else {

  2556 				nativeName = fData.cAlternateFileName;

  2557 			    }

  2558 			    FindClose(handle);

  2559 			    Tcl_DStringAppend(&dsNorm,(CONST char*)L"/",

  2560 					      sizeof(WCHAR));

  2561 			    Tcl_DStringAppend(&dsNorm,(TCHAR*)nativeName,

  2562 					      (int) (wcslen(nativeName)*sizeof(WCHAR)));

  2563 			}

  2564 		    }

  2565 		}

  2566 		Tcl_DStringFree(&ds);

  2567 		lastValidPathEnd = currentPathEndPosition;

  2568 		if (cur == 0) {

  2569 		    break;

  2570 		}

  2571 		/*

  2572 		 * If we get here, we've got past one directory

  2573 		 * delimiter, so we know it is no longer a drive

  2574 		 */

  2575 		isDrive = 0;

  2576 	    }

  2577 	    currentPathEndPosition++;

  2578 	}

  2579     }

  2580     /* Common code path for all Windows platforms */

  2581     nextCheckpoint = currentPathEndPosition - path;

  2582     if (lastValidPathEnd != NULL) {

  2583 	/*

  2584 	 * Concatenate the normalized string in dsNorm with the

  2585 	 * tail of the path which we didn't recognise.  The

  2586 	 * string in dsNorm is in the native encoding, so we

  2587 	 * have to convert it to Utf.

  2588 	 */

  2589 	Tcl_DString dsTemp;

  2590 	Tcl_WinTCharToUtf(Tcl_DStringValue(&dsNorm),

  2591 			  Tcl_DStringLength(&dsNorm), &dsTemp);

  2592 	nextCheckpoint = Tcl_DStringLength(&dsTemp);

  2593 	if (*lastValidPathEnd != 0) {

  2594 	    /* Not the end of the string */

  2595 	    int len;

  2596 	    char *path;

  2597 	    Tcl_Obj *tmpPathPtr;

  2598 	    tmpPathPtr = Tcl_NewStringObj(Tcl_DStringValue(&dsTemp),

  2599 					  nextCheckpoint);

  2600 	    Tcl_AppendToObj(tmpPathPtr, lastValidPathEnd, -1);

  2601 	    path = Tcl_GetStringFromObj(tmpPathPtr, &len);

  2602 	    Tcl_SetStringObj(pathPtr, path, len);

  2603 	    Tcl_DecrRefCount(tmpPathPtr);

  2604 	} else {

  2605 	    /* End of string was reached above */

  2606 	    Tcl_SetStringObj(pathPtr, Tcl_DStringValue(&dsTemp),

  2607 			     nextCheckpoint);

  2608 	}

  2609 	Tcl_DStringFree(&dsTemp);

  2610     }

  2611     Tcl_DStringFree(&dsNorm);

  2612     return nextCheckpoint;

  2613 }

  2615 /*

  2616  *---------------------------------------------------------------------------

  2617  *

  2618  * TclpUtime --

  2619  *

  2620  *	Set the modification date for a file.

  2621  *

  2622  * Results:

  2623  *	0 on success, -1 on error.

  2624  *

  2625  * Side effects:

  2626  *	Sets errno to a representation of any Windows problem that's observed

  2627  *	in the process.

  2628  *

  2629  *---------------------------------------------------------------------------

  2630  */

  2632 int

  2633 TclpUtime(

  2634     Tcl_Obj *pathPtr,		/* File to modify */

  2635     struct utimbuf *tval)	/* New modification date structure */

  2636 {

  2637     int res = 0;

  2638     HANDLE fileHandle;

  2639     CONST TCHAR *native;

  2640     DWORD attr = 0;

  2641     DWORD flags = FILE_ATTRIBUTE_NORMAL;

  2642     FILETIME lastAccessTime, lastModTime;

  2644     FromCTime(tval->actime, &lastAccessTime);

  2645     FromCTime(tval->modtime, &lastModTime);

  2647     native = (CONST TCHAR *)Tcl_FSGetNativePath(pathPtr);

  2649     attr = (*tclWinProcs->getFileAttributesProc)(native);

  2651     if (attr != INVALID_FILE_ATTRIBUTES && attr & FILE_ATTRIBUTE_DIRECTORY) {

  2652 	flags = FILE_FLAG_BACKUP_SEMANTICS;

  2653     }

  2655     /*

  2656      * We use the native APIs (not 'utime') because there are some daylight

  2657      * savings complications that utime gets wrong.

  2658      */

  2660     fileHandle = (tclWinProcs->createFileProc) (

  2661 	    native, FILE_WRITE_ATTRIBUTES, 0, NULL,

  2662 	    OPEN_EXISTING, flags, NULL);

  2664     if (fileHandle == INVALID_HANDLE_VALUE ||

  2665 	    !SetFileTime(fileHandle, NULL, &lastAccessTime, &lastModTime)) {

  2666 	TclWinConvertError(GetLastError());

  2667 	res = -1;

  2668     }

  2669     if (fileHandle != INVALID_HANDLE_VALUE) {

  2670 	CloseHandle(fileHandle);

  2671     }

  2672     return res;

  2673 }

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