os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/win/tclWinFile.c
changeset 0 bde4ae8d615e
     1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/win/tclWinFile.c	Fri Jun 15 03:10:57 2012 +0200
     1.3 @@ -0,0 +1,2673 @@
     1.4 +/* 
     1.5 + * tclWinFile.c --
     1.6 + *
     1.7 + *      This file contains temporary wrappers around UNIX file handling
     1.8 + *      functions. These wrappers map the UNIX functions to Win32 HANDLE-style
     1.9 + *      files, which can be manipulated through the Win32 console redirection
    1.10 + *      interfaces.
    1.11 + *
    1.12 + * Copyright (c) 1995-1998 Sun Microsystems, Inc.
    1.13 + *
    1.14 + * See the file "license.terms" for information on usage and redistribution
    1.15 + * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    1.16 + *
    1.17 + * RCS: @(#) $Id: tclWinFile.c,v 1.44.2.18 2006/10/17 04:36:45 dgp Exp $
    1.18 + */
    1.19 +
    1.20 +//#define _WIN32_WINNT  0x0500
    1.21 +
    1.22 +#include "tclWinInt.h"
    1.23 +#include <winioctl.h>
    1.24 +#include <sys/stat.h>
    1.25 +#include <shlobj.h>
    1.26 +#include <lmaccess.h>		/* For TclpGetUserHome(). */
    1.27 +
    1.28 +/*
    1.29 + * The number of 100-ns intervals between the Windows system epoch (1601-01-01
    1.30 + * on the proleptic Gregorian calendar) and the Posix epoch (1970-01-01).
    1.31 + */
    1.32 +
    1.33 +#define POSIX_EPOCH_AS_FILETIME		116444736000000000
    1.34 +
    1.35 +/*
    1.36 + * Declarations for 'link' related information.  This information
    1.37 + * should come with VC++ 6.0, but is not in some older SDKs.
    1.38 + * In any case it is not well documented.
    1.39 + */
    1.40 +#ifndef IO_REPARSE_TAG_RESERVED_ONE
    1.41 +#  define IO_REPARSE_TAG_RESERVED_ONE 0x000000001
    1.42 +#endif
    1.43 +#ifndef IO_REPARSE_TAG_RESERVED_RANGE
    1.44 +#  define IO_REPARSE_TAG_RESERVED_RANGE 0x000000001
    1.45 +#endif
    1.46 +#ifndef IO_REPARSE_TAG_VALID_VALUES
    1.47 +#  define IO_REPARSE_TAG_VALID_VALUES 0x0E000FFFF
    1.48 +#endif
    1.49 +#ifndef IO_REPARSE_TAG_HSM
    1.50 +#  define IO_REPARSE_TAG_HSM 0x0C0000004
    1.51 +#endif
    1.52 +#ifndef IO_REPARSE_TAG_NSS
    1.53 +#  define IO_REPARSE_TAG_NSS 0x080000005
    1.54 +#endif
    1.55 +#ifndef IO_REPARSE_TAG_NSSRECOVER
    1.56 +#  define IO_REPARSE_TAG_NSSRECOVER 0x080000006
    1.57 +#endif
    1.58 +#ifndef IO_REPARSE_TAG_SIS
    1.59 +#  define IO_REPARSE_TAG_SIS 0x080000007
    1.60 +#endif
    1.61 +#ifndef IO_REPARSE_TAG_DFS
    1.62 +#  define IO_REPARSE_TAG_DFS 0x080000008
    1.63 +#endif
    1.64 +
    1.65 +#ifndef IO_REPARSE_TAG_RESERVED_ZERO
    1.66 +#  define IO_REPARSE_TAG_RESERVED_ZERO 0x00000000
    1.67 +#endif
    1.68 +#ifndef FILE_FLAG_OPEN_REPARSE_POINT
    1.69 +#  define FILE_FLAG_OPEN_REPARSE_POINT 0x00200000
    1.70 +#endif
    1.71 +#ifndef IO_REPARSE_TAG_MOUNT_POINT
    1.72 +#  define IO_REPARSE_TAG_MOUNT_POINT 0xA0000003
    1.73 +#endif
    1.74 +#ifndef IsReparseTagValid
    1.75 +#  define IsReparseTagValid(x) (!((x)&~IO_REPARSE_TAG_VALID_VALUES)&&((x)>IO_REPARSE_TAG_RESERVED_RANGE))
    1.76 +#endif
    1.77 +#ifndef IO_REPARSE_TAG_SYMBOLIC_LINK
    1.78 +#  define IO_REPARSE_TAG_SYMBOLIC_LINK IO_REPARSE_TAG_RESERVED_ZERO
    1.79 +#endif
    1.80 +#ifndef FILE_SPECIAL_ACCESS
    1.81 +#  define FILE_SPECIAL_ACCESS         (FILE_ANY_ACCESS)
    1.82 +#endif
    1.83 +#ifndef FSCTL_SET_REPARSE_POINT
    1.84 +#  define FSCTL_SET_REPARSE_POINT    CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 41, METHOD_BUFFERED, FILE_SPECIAL_ACCESS)
    1.85 +#  define FSCTL_GET_REPARSE_POINT    CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 42, METHOD_BUFFERED, FILE_ANY_ACCESS) 
    1.86 +#  define FSCTL_DELETE_REPARSE_POINT CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 43, METHOD_BUFFERED, FILE_SPECIAL_ACCESS) 
    1.87 +#endif
    1.88 +#ifndef INVALID_FILE_ATTRIBUTES
    1.89 +#define INVALID_FILE_ATTRIBUTES ((DWORD)-1)
    1.90 +#endif
    1.91 +
    1.92 +/* 
    1.93 + * Maximum reparse buffer info size. The max user defined reparse
    1.94 + * data is 16KB, plus there's a header.
    1.95 + */
    1.96 +
    1.97 +#define MAX_REPARSE_SIZE	17000
    1.98 +
    1.99 +/*
   1.100 + * Undocumented REPARSE_MOUNTPOINT_HEADER_SIZE structure definition.
   1.101 + * This is found in winnt.h.
   1.102 + * 
   1.103 + * IMPORTANT: caution when using this structure, since the actual
   1.104 + * structures used will want to store a full path in the 'PathBuffer'
   1.105 + * field, but there isn't room (there's only a single WCHAR!).  Therefore
   1.106 + * one must artificially create a larger space of memory and then cast it
   1.107 + * to this type.  We use the 'DUMMY_REPARSE_BUFFER' struct just below to
   1.108 + * deal with this problem.
   1.109 + */
   1.110 +
   1.111 +#define REPARSE_MOUNTPOINT_HEADER_SIZE   8
   1.112 +#ifndef REPARSE_DATA_BUFFER_HEADER_SIZE
   1.113 +typedef struct _REPARSE_DATA_BUFFER {
   1.114 +    DWORD  ReparseTag;
   1.115 +    WORD   ReparseDataLength;
   1.116 +    WORD   Reserved;
   1.117 +    union {
   1.118 +        struct {
   1.119 +            WORD   SubstituteNameOffset;
   1.120 +            WORD   SubstituteNameLength;
   1.121 +            WORD   PrintNameOffset;
   1.122 +            WORD   PrintNameLength;
   1.123 +            WCHAR PathBuffer[1];
   1.124 +        } SymbolicLinkReparseBuffer;
   1.125 +        struct {
   1.126 +            WORD   SubstituteNameOffset;
   1.127 +            WORD   SubstituteNameLength;
   1.128 +            WORD   PrintNameOffset;
   1.129 +            WORD   PrintNameLength;
   1.130 +            WCHAR PathBuffer[1];
   1.131 +        } MountPointReparseBuffer;
   1.132 +        struct {
   1.133 +            BYTE   DataBuffer[1];
   1.134 +        } GenericReparseBuffer;
   1.135 +    };
   1.136 +} REPARSE_DATA_BUFFER;
   1.137 +#endif
   1.138 +
   1.139 +typedef struct {
   1.140 +    REPARSE_DATA_BUFFER dummy;
   1.141 +    WCHAR  dummyBuf[MAX_PATH*3];
   1.142 +} DUMMY_REPARSE_BUFFER;
   1.143 +
   1.144 +#if defined(_MSC_VER) && ( _MSC_VER <= 1100 )
   1.145 +#define HAVE_NO_FINDEX_ENUMS
   1.146 +#elif !defined(_WIN32_WINNT) || (_WIN32_WINNT < 0x0400)
   1.147 +#define HAVE_NO_FINDEX_ENUMS
   1.148 +#endif
   1.149 +
   1.150 +#ifdef HAVE_NO_FINDEX_ENUMS
   1.151 +/* These two aren't in VC++ 5.2 headers */
   1.152 +typedef enum _FINDEX_INFO_LEVELS {
   1.153 +	FindExInfoStandard,
   1.154 +	FindExInfoMaxInfoLevel
   1.155 +} FINDEX_INFO_LEVELS;
   1.156 +typedef enum _FINDEX_SEARCH_OPS {
   1.157 +	FindExSearchNameMatch,
   1.158 +	FindExSearchLimitToDirectories,
   1.159 +	FindExSearchLimitToDevices,
   1.160 +	FindExSearchMaxSearchOp
   1.161 +} FINDEX_SEARCH_OPS;
   1.162 +#endif /* HAVE_NO_FINDEX_ENUMS */
   1.163 +
   1.164 +/* Other typedefs required by this code */
   1.165 +
   1.166 +static time_t		ToCTime(FILETIME fileTime);
   1.167 +static void		FromCTime(time_t posixTime, FILETIME *fileTime);
   1.168 +
   1.169 +typedef NET_API_STATUS NET_API_FUNCTION NETUSERGETINFOPROC
   1.170 +	(LPWSTR servername, LPWSTR username, DWORD level, LPBYTE *bufptr);
   1.171 +
   1.172 +typedef NET_API_STATUS NET_API_FUNCTION NETAPIBUFFERFREEPROC
   1.173 +	(LPVOID Buffer);
   1.174 +
   1.175 +typedef NET_API_STATUS NET_API_FUNCTION NETGETDCNAMEPROC
   1.176 +	(LPWSTR servername, LPWSTR domainname, LPBYTE *bufptr);
   1.177 +
   1.178 +/*
   1.179 + * Declarations for local procedures defined in this file:
   1.180 + */
   1.181 +
   1.182 +static int NativeAccess(CONST TCHAR *path, int mode);
   1.183 +static int NativeStat(CONST TCHAR *path, Tcl_StatBuf *statPtr, int checkLinks);
   1.184 +static unsigned short NativeStatMode(DWORD attr, int checkLinks, int isExec);
   1.185 +static int NativeIsExec(CONST TCHAR *path);
   1.186 +static int NativeReadReparse(CONST TCHAR* LinkDirectory, 
   1.187 +			     REPARSE_DATA_BUFFER* buffer);
   1.188 +static int NativeWriteReparse(CONST TCHAR* LinkDirectory, 
   1.189 +			      REPARSE_DATA_BUFFER* buffer);
   1.190 +static int NativeMatchType(int isDrive, DWORD attr, CONST TCHAR* nativeName, 
   1.191 +			   Tcl_GlobTypeData *types);
   1.192 +static int WinIsDrive(CONST char *name, int nameLen);
   1.193 +static int WinIsReserved(CONST char *path);
   1.194 +static Tcl_Obj* WinReadLink(CONST TCHAR* LinkSource);
   1.195 +static Tcl_Obj* WinReadLinkDirectory(CONST TCHAR* LinkDirectory);
   1.196 +static int WinLink(CONST TCHAR* LinkSource, CONST TCHAR* LinkTarget, 
   1.197 +		   int linkAction);
   1.198 +static int WinSymLinkDirectory(CONST TCHAR* LinkDirectory, 
   1.199 +			       CONST TCHAR* LinkTarget);
   1.200 +
   1.201 +/*
   1.202 + *--------------------------------------------------------------------
   1.203 + *
   1.204 + * WinLink
   1.205 + *
   1.206 + * Make a link from source to target. 
   1.207 + *--------------------------------------------------------------------
   1.208 + */
   1.209 +static int 
   1.210 +WinLink(LinkSource, LinkTarget, linkAction)
   1.211 +    CONST TCHAR* LinkSource;
   1.212 +    CONST TCHAR* LinkTarget;
   1.213 +    int linkAction;
   1.214 +{
   1.215 +    WCHAR	tempFileName[MAX_PATH];
   1.216 +    TCHAR*	tempFilePart;
   1.217 +    int         attr;
   1.218 +    
   1.219 +    /* Get the full path referenced by the target */
   1.220 +    if (!(*tclWinProcs->getFullPathNameProc)(LinkTarget, 
   1.221 +			  MAX_PATH, tempFileName, &tempFilePart)) {
   1.222 +	/* Invalid file */
   1.223 +	TclWinConvertError(GetLastError());
   1.224 +	return -1;
   1.225 +    }
   1.226 +
   1.227 +    /* Make sure source file doesn't exist */
   1.228 +    attr = (*tclWinProcs->getFileAttributesProc)(LinkSource);
   1.229 +    if (attr != 0xffffffff) {
   1.230 +	Tcl_SetErrno(EEXIST);
   1.231 +	return -1;
   1.232 +    }
   1.233 +
   1.234 +    /* Get the full path referenced by the directory */
   1.235 +    if (!(*tclWinProcs->getFullPathNameProc)(LinkSource, 
   1.236 +			  MAX_PATH, tempFileName, &tempFilePart)) {
   1.237 +	/* Invalid file */
   1.238 +	TclWinConvertError(GetLastError());
   1.239 +	return -1;
   1.240 +    }
   1.241 +    /* Check the target */
   1.242 +    attr = (*tclWinProcs->getFileAttributesProc)(LinkTarget);
   1.243 +    if (attr == 0xffffffff) {
   1.244 +	/* The target doesn't exist */
   1.245 +	TclWinConvertError(GetLastError());
   1.246 +	return -1;
   1.247 +    } else if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
   1.248 +	/* It is a file */
   1.249 +	if (tclWinProcs->createHardLinkProc == NULL) {
   1.250 +	    Tcl_SetErrno(ENOTDIR);
   1.251 +	    return -1;
   1.252 +	}
   1.253 +	if (linkAction & TCL_CREATE_HARD_LINK) {
   1.254 +	    if (!(*tclWinProcs->createHardLinkProc)(LinkSource, LinkTarget, NULL)) {
   1.255 +		TclWinConvertError(GetLastError());
   1.256 +		return -1;
   1.257 +	    }
   1.258 +	    return 0;
   1.259 +	} else if (linkAction & TCL_CREATE_SYMBOLIC_LINK) {
   1.260 +	    /* Can't symlink files */
   1.261 +	    Tcl_SetErrno(ENOTDIR);
   1.262 +	    return -1;
   1.263 +	} else {
   1.264 +	    Tcl_SetErrno(ENODEV);
   1.265 +	    return -1;
   1.266 +	}
   1.267 +    } else {
   1.268 +	if (linkAction & TCL_CREATE_SYMBOLIC_LINK) {
   1.269 +	    return WinSymLinkDirectory(LinkSource, LinkTarget);
   1.270 +	} else if (linkAction & TCL_CREATE_HARD_LINK) {
   1.271 +	    /* Can't hard link directories */
   1.272 +	    Tcl_SetErrno(EISDIR);
   1.273 +	    return -1;
   1.274 +	} else {
   1.275 +	    Tcl_SetErrno(ENODEV);
   1.276 +	    return -1;
   1.277 +	}
   1.278 +    }
   1.279 +}
   1.280 +
   1.281 +/*
   1.282 + *--------------------------------------------------------------------
   1.283 + *
   1.284 + * WinReadLink
   1.285 + *
   1.286 + * What does 'LinkSource' point to? 
   1.287 + *--------------------------------------------------------------------
   1.288 + */
   1.289 +static Tcl_Obj* 
   1.290 +WinReadLink(LinkSource)
   1.291 +    CONST TCHAR* LinkSource;
   1.292 +{
   1.293 +    WCHAR	tempFileName[MAX_PATH];
   1.294 +    TCHAR*	tempFilePart;
   1.295 +    int         attr;
   1.296 +    
   1.297 +    /* Get the full path referenced by the target */
   1.298 +    if (!(*tclWinProcs->getFullPathNameProc)(LinkSource, 
   1.299 +			  MAX_PATH, tempFileName, &tempFilePart)) {
   1.300 +	/* Invalid file */
   1.301 +	TclWinConvertError(GetLastError());
   1.302 +	return NULL;
   1.303 +    }
   1.304 +
   1.305 +    /* Make sure source file does exist */
   1.306 +    attr = (*tclWinProcs->getFileAttributesProc)(LinkSource);
   1.307 +    if (attr == 0xffffffff) {
   1.308 +	/* The source doesn't exist */
   1.309 +	TclWinConvertError(GetLastError());
   1.310 +	return NULL;
   1.311 +    } else if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
   1.312 +	/* It is a file - this is not yet supported */
   1.313 +	Tcl_SetErrno(ENOTDIR);
   1.314 +	return NULL;
   1.315 +    } else {
   1.316 +	return WinReadLinkDirectory(LinkSource);
   1.317 +    }
   1.318 +}
   1.319 +
   1.320 +/*
   1.321 + *--------------------------------------------------------------------
   1.322 + *
   1.323 + * WinSymLinkDirectory
   1.324 + *
   1.325 + * This routine creates a NTFS junction, using the undocumented
   1.326 + * FSCTL_SET_REPARSE_POINT structure Win2K uses for mount points
   1.327 + * and junctions.
   1.328 + *
   1.329 + * Assumption that LinkTarget is a valid, existing directory.
   1.330 + * 
   1.331 + * Returns zero on success.
   1.332 + *--------------------------------------------------------------------
   1.333 + */
   1.334 +static int 
   1.335 +WinSymLinkDirectory(LinkDirectory, LinkTarget)
   1.336 +    CONST TCHAR* LinkDirectory;
   1.337 +    CONST TCHAR* LinkTarget;
   1.338 +{
   1.339 +    DUMMY_REPARSE_BUFFER dummy;
   1.340 +    REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER*)&dummy;
   1.341 +    int         len;
   1.342 +    WCHAR       nativeTarget[MAX_PATH];
   1.343 +    WCHAR       *loop;
   1.344 +    
   1.345 +    /* Make the native target name */
   1.346 +    memcpy((VOID*)nativeTarget, (VOID*)L"\\??\\", 4*sizeof(WCHAR));
   1.347 +    memcpy((VOID*)(nativeTarget + 4), (VOID*)LinkTarget, 
   1.348 +	   sizeof(WCHAR)*(1+wcslen((WCHAR*)LinkTarget)));
   1.349 +    len = wcslen(nativeTarget);
   1.350 +    /* 
   1.351 +     * We must have backslashes only.  This is VERY IMPORTANT.
   1.352 +     * If we have any forward slashes everything appears to work,
   1.353 +     * but the resulting symlink is useless!
   1.354 +     */
   1.355 +    for (loop = nativeTarget; *loop != 0; loop++) {
   1.356 +	if (*loop == L'/') *loop = L'\\';
   1.357 +    }
   1.358 +    if ((nativeTarget[len-1] == L'\\') && (nativeTarget[len-2] != L':')) {
   1.359 +	nativeTarget[len-1] = 0;
   1.360 +    }
   1.361 +    
   1.362 +    /* Build the reparse info */
   1.363 +    memset(reparseBuffer, 0, sizeof(DUMMY_REPARSE_BUFFER));
   1.364 +    reparseBuffer->ReparseTag = IO_REPARSE_TAG_MOUNT_POINT;
   1.365 +    reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength = 
   1.366 +      wcslen(nativeTarget) * sizeof(WCHAR);
   1.367 +    reparseBuffer->Reserved = 0;
   1.368 +    reparseBuffer->SymbolicLinkReparseBuffer.PrintNameLength = 0;
   1.369 +    reparseBuffer->SymbolicLinkReparseBuffer.PrintNameOffset = 
   1.370 +      reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength 
   1.371 +      + sizeof(WCHAR);
   1.372 +    memcpy(reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer, nativeTarget, 
   1.373 +      sizeof(WCHAR) 
   1.374 +      + reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength);
   1.375 +    reparseBuffer->ReparseDataLength = 
   1.376 +      reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength + 12;
   1.377 +	
   1.378 +    return NativeWriteReparse(LinkDirectory, reparseBuffer);
   1.379 +}
   1.380 +
   1.381 +/*
   1.382 + *--------------------------------------------------------------------
   1.383 + *
   1.384 + * TclWinSymLinkCopyDirectory
   1.385 + *
   1.386 + * Copy a Windows NTFS junction.  This function assumes that
   1.387 + * LinkOriginal exists and is a valid junction point, and that
   1.388 + * LinkCopy does not exist.
   1.389 + * 
   1.390 + * Returns zero on success.
   1.391 + *--------------------------------------------------------------------
   1.392 + */
   1.393 +int 
   1.394 +TclWinSymLinkCopyDirectory(LinkOriginal, LinkCopy)
   1.395 +    CONST TCHAR* LinkOriginal;  /* Existing junction - reparse point */
   1.396 +    CONST TCHAR* LinkCopy;      /* Will become a duplicate junction */
   1.397 +{
   1.398 +    DUMMY_REPARSE_BUFFER dummy;
   1.399 +    REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER*)&dummy;
   1.400 +    
   1.401 +    if (NativeReadReparse(LinkOriginal, reparseBuffer)) {
   1.402 +	return -1;
   1.403 +    }
   1.404 +    return NativeWriteReparse(LinkCopy, reparseBuffer);
   1.405 +}
   1.406 +
   1.407 +/*
   1.408 + *--------------------------------------------------------------------
   1.409 + *
   1.410 + * TclWinSymLinkDelete
   1.411 + *
   1.412 + * Delete a Windows NTFS junction.  Once the junction information
   1.413 + * is deleted, the filesystem object becomes an ordinary directory.
   1.414 + * Unless 'linkOnly' is given, that directory is also removed.
   1.415 + * 
   1.416 + * Assumption that LinkOriginal is a valid, existing junction.
   1.417 + * 
   1.418 + * Returns zero on success.
   1.419 + *--------------------------------------------------------------------
   1.420 + */
   1.421 +int 
   1.422 +TclWinSymLinkDelete(LinkOriginal, linkOnly)
   1.423 +    CONST TCHAR* LinkOriginal;
   1.424 +    int linkOnly;
   1.425 +{
   1.426 +    /* It is a symbolic link -- remove it */
   1.427 +    DUMMY_REPARSE_BUFFER dummy;
   1.428 +    REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER*)&dummy;
   1.429 +    HANDLE hFile;
   1.430 +    DWORD returnedLength;
   1.431 +    memset(reparseBuffer, 0, sizeof(DUMMY_REPARSE_BUFFER));
   1.432 +    reparseBuffer->ReparseTag = IO_REPARSE_TAG_MOUNT_POINT;
   1.433 +    hFile = (*tclWinProcs->createFileProc)(LinkOriginal, GENERIC_WRITE, 0,
   1.434 +	NULL, OPEN_EXISTING, 
   1.435 +	FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL);
   1.436 +    if (hFile != INVALID_HANDLE_VALUE) {
   1.437 +	if (!DeviceIoControl(hFile, FSCTL_DELETE_REPARSE_POINT, reparseBuffer, 
   1.438 +			     REPARSE_MOUNTPOINT_HEADER_SIZE,
   1.439 +			     NULL, 0, &returnedLength, NULL)) {	
   1.440 +	    /* Error setting junction */
   1.441 +	    TclWinConvertError(GetLastError());
   1.442 +	    CloseHandle(hFile);
   1.443 +	} else {
   1.444 +	    CloseHandle(hFile);
   1.445 +	    if (!linkOnly) {
   1.446 +	        (*tclWinProcs->removeDirectoryProc)(LinkOriginal);
   1.447 +	    }
   1.448 +	    return 0;
   1.449 +	}
   1.450 +    }
   1.451 +    return -1;
   1.452 +}
   1.453 +
   1.454 +/*
   1.455 + *--------------------------------------------------------------------
   1.456 + *
   1.457 + * WinReadLinkDirectory
   1.458 + *
   1.459 + * This routine reads a NTFS junction, using the undocumented
   1.460 + * FSCTL_GET_REPARSE_POINT structure Win2K uses for mount points
   1.461 + * and junctions.
   1.462 + *
   1.463 + * Assumption that LinkDirectory is a valid, existing directory.
   1.464 + * 
   1.465 + * Returns a Tcl_Obj with refCount of 1 (i.e. owned by the caller),
   1.466 + * or NULL if anything went wrong.
   1.467 + * 
   1.468 + * In the future we should enhance this to return a path object
   1.469 + * rather than a string.
   1.470 + *--------------------------------------------------------------------
   1.471 + */
   1.472 +static Tcl_Obj* 
   1.473 +WinReadLinkDirectory(LinkDirectory)
   1.474 +    CONST TCHAR* LinkDirectory;
   1.475 +{
   1.476 +    int attr;
   1.477 +    DUMMY_REPARSE_BUFFER dummy;
   1.478 +    REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER*)&dummy;
   1.479 +    
   1.480 +    attr = (*tclWinProcs->getFileAttributesProc)(LinkDirectory);
   1.481 +    if (!(attr & FILE_ATTRIBUTE_REPARSE_POINT)) {
   1.482 +	Tcl_SetErrno(EINVAL);
   1.483 +	return NULL;
   1.484 +    }
   1.485 +    if (NativeReadReparse(LinkDirectory, reparseBuffer)) {
   1.486 +        return NULL;
   1.487 +    }
   1.488 +    
   1.489 +    switch (reparseBuffer->ReparseTag) {
   1.490 +	case 0x80000000|IO_REPARSE_TAG_SYMBOLIC_LINK: 
   1.491 +	case IO_REPARSE_TAG_SYMBOLIC_LINK: 
   1.492 +	case IO_REPARSE_TAG_MOUNT_POINT: {
   1.493 +	    Tcl_Obj *retVal;
   1.494 +	    Tcl_DString ds;
   1.495 +	    CONST char *copy;
   1.496 +	    int len;
   1.497 +	    int offset = 0;
   1.498 +	    
   1.499 +	    /* 
   1.500 +	     * Certain native path representations on Windows have a
   1.501 +	     * special prefix to indicate that they are to be treated
   1.502 +	     * specially.  For example extremely long paths, or symlinks,
   1.503 +	     * or volumes mounted inside directories.
   1.504 +	     * 
   1.505 +	     * There is an assumption in this code that 'wide' interfaces
   1.506 +	     * are being used (see tclWin32Dll.c), which is true for the
   1.507 +	     * only systems which support reparse tags at present.  If
   1.508 +	     * that changes in the future, this code will have to be
   1.509 +	     * generalised.
   1.510 +	     */
   1.511 +	    if (reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer[0] 
   1.512 +		                                                 == L'\\') {
   1.513 +		/* Check whether this is a mounted volume */
   1.514 +		if (wcsncmp(reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer, 
   1.515 +			    L"\\??\\Volume{",11) == 0) {
   1.516 +		    char drive;
   1.517 +		    /* 
   1.518 +		     * There is some confusion between \??\ and \\?\ which
   1.519 +		     * we have to fix here.  It doesn't seem very well
   1.520 +		     * documented.
   1.521 +		     */
   1.522 +		    reparseBuffer->SymbolicLinkReparseBuffer
   1.523 +		                                      .PathBuffer[1] = L'\\';
   1.524 +		    /* 
   1.525 +		     * Check if a corresponding drive letter exists, and
   1.526 +		     * use that if it is found
   1.527 +		     */
   1.528 +		    drive = TclWinDriveLetterForVolMountPoint(reparseBuffer
   1.529 +					->SymbolicLinkReparseBuffer.PathBuffer);
   1.530 +		    if (drive != -1) {
   1.531 +			char driveSpec[3] = {
   1.532 +			    drive, ':', '\0'
   1.533 +			};
   1.534 +			retVal = Tcl_NewStringObj(driveSpec,2);
   1.535 +			Tcl_IncrRefCount(retVal);
   1.536 +			return retVal;
   1.537 +		    }
   1.538 +		    /* 
   1.539 +		     * This is actually a mounted drive, which doesn't
   1.540 +		     * exists as a DOS drive letter.  This means the path
   1.541 +		     * isn't actually a link, although we partially treat
   1.542 +		     * it like one ('file type' will return 'link'), but
   1.543 +		     * then the link will actually just be treated like
   1.544 +		     * an ordinary directory.  I don't believe any
   1.545 +		     * serious inconsistency will arise from this, but it
   1.546 +		     * is something to be aware of.
   1.547 +		     */
   1.548 +		    Tcl_SetErrno(EINVAL);
   1.549 +		    return NULL;
   1.550 +		} else if (wcsncmp(reparseBuffer->SymbolicLinkReparseBuffer
   1.551 +				   .PathBuffer, L"\\\\?\\",4) == 0) {
   1.552 +		    /* Strip off the prefix */
   1.553 +		    offset = 4;
   1.554 +		} else if (wcsncmp(reparseBuffer->SymbolicLinkReparseBuffer
   1.555 +				   .PathBuffer, L"\\??\\",4) == 0) {
   1.556 +		    /* Strip off the prefix */
   1.557 +		    offset = 4;
   1.558 +		}
   1.559 +	    }
   1.560 +	    
   1.561 +	    Tcl_WinTCharToUtf(
   1.562 +		(CONST char*)reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer, 
   1.563 +		(int)reparseBuffer->SymbolicLinkReparseBuffer
   1.564 +		.SubstituteNameLength, &ds);
   1.565 +	
   1.566 +	    copy = Tcl_DStringValue(&ds)+offset;
   1.567 +	    len = Tcl_DStringLength(&ds)-offset;
   1.568 +	    retVal = Tcl_NewStringObj(copy,len);
   1.569 +	    Tcl_IncrRefCount(retVal);
   1.570 +	    Tcl_DStringFree(&ds);
   1.571 +	    return retVal;
   1.572 +	}
   1.573 +    }
   1.574 +    Tcl_SetErrno(EINVAL);
   1.575 +    return NULL;
   1.576 +}
   1.577 +
   1.578 +/*
   1.579 + *--------------------------------------------------------------------
   1.580 + *
   1.581 + * NativeReadReparse
   1.582 + *
   1.583 + * Read the junction/reparse information from a given NTFS directory.
   1.584 + *
   1.585 + * Assumption that LinkDirectory is a valid, existing directory.
   1.586 + * 
   1.587 + * Returns zero on success.
   1.588 + *--------------------------------------------------------------------
   1.589 + */
   1.590 +static int 
   1.591 +NativeReadReparse(LinkDirectory, buffer)
   1.592 +    CONST TCHAR* LinkDirectory;   /* The junction to read */
   1.593 +    REPARSE_DATA_BUFFER* buffer;  /* Pointer to buffer. Cannot be NULL */
   1.594 +{
   1.595 +    HANDLE hFile;
   1.596 +    DWORD returnedLength;
   1.597 +   
   1.598 +    hFile = (*tclWinProcs->createFileProc)(LinkDirectory, GENERIC_READ, 0,
   1.599 +	NULL, OPEN_EXISTING, 
   1.600 +	FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL);
   1.601 +    if (hFile == INVALID_HANDLE_VALUE) {
   1.602 +	/* Error creating directory */
   1.603 +	TclWinConvertError(GetLastError());
   1.604 +	return -1;
   1.605 +    }
   1.606 +    /* Get the link */
   1.607 +    if (!DeviceIoControl(hFile, FSCTL_GET_REPARSE_POINT, NULL, 
   1.608 +			 0, buffer, sizeof(DUMMY_REPARSE_BUFFER), 
   1.609 +			 &returnedLength, NULL)) {	
   1.610 +	/* Error setting junction */
   1.611 +	TclWinConvertError(GetLastError());
   1.612 +	CloseHandle(hFile);
   1.613 +	return -1;
   1.614 +    }
   1.615 +    CloseHandle(hFile);
   1.616 +    
   1.617 +    if (!IsReparseTagValid(buffer->ReparseTag)) {
   1.618 +	Tcl_SetErrno(EINVAL);
   1.619 +	return -1;
   1.620 +    }
   1.621 +    return 0;
   1.622 +}
   1.623 +
   1.624 +/*
   1.625 + *--------------------------------------------------------------------
   1.626 + *
   1.627 + * NativeWriteReparse
   1.628 + *
   1.629 + * Write the reparse information for a given directory.
   1.630 + * 
   1.631 + * Assumption that LinkDirectory does not exist.
   1.632 + *--------------------------------------------------------------------
   1.633 + */
   1.634 +static int 
   1.635 +NativeWriteReparse(LinkDirectory, buffer)
   1.636 +    CONST TCHAR* LinkDirectory;
   1.637 +    REPARSE_DATA_BUFFER* buffer;
   1.638 +{
   1.639 +    HANDLE hFile;
   1.640 +    DWORD returnedLength;
   1.641 +    
   1.642 +    /* Create the directory - it must not already exist */
   1.643 +    if ((*tclWinProcs->createDirectoryProc)(LinkDirectory, NULL) == 0) {
   1.644 +	/* Error creating directory */
   1.645 +	TclWinConvertError(GetLastError());
   1.646 +	return -1;
   1.647 +    }
   1.648 +    hFile = (*tclWinProcs->createFileProc)(LinkDirectory, GENERIC_WRITE, 0,
   1.649 +	NULL, OPEN_EXISTING, 
   1.650 +	FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL);
   1.651 +    if (hFile == INVALID_HANDLE_VALUE) {
   1.652 +	/* Error creating directory */
   1.653 +	TclWinConvertError(GetLastError());
   1.654 +	return -1;
   1.655 +    }
   1.656 +    /* Set the link */
   1.657 +    if (!DeviceIoControl(hFile, FSCTL_SET_REPARSE_POINT, buffer, 
   1.658 +			 (DWORD) buffer->ReparseDataLength 
   1.659 +			 + REPARSE_MOUNTPOINT_HEADER_SIZE,
   1.660 +			 NULL, 0, &returnedLength, NULL)) {	
   1.661 +	/* Error setting junction */
   1.662 +	TclWinConvertError(GetLastError());
   1.663 +	CloseHandle(hFile);
   1.664 +	(*tclWinProcs->removeDirectoryProc)(LinkDirectory);
   1.665 +	return -1;
   1.666 +    }
   1.667 +    CloseHandle(hFile);
   1.668 +    /* We succeeded */
   1.669 +    return 0;
   1.670 +}
   1.671 +
   1.672 +/*
   1.673 + *---------------------------------------------------------------------------
   1.674 + *
   1.675 + * TclpFindExecutable --
   1.676 + *
   1.677 + *	This procedure computes the absolute path name of the current
   1.678 + *	application, given its argv[0] value.
   1.679 + *
   1.680 + * Results:
   1.681 + *	A clean UTF string that is the path to the executable.  At this
   1.682 + *	point we may not know the system encoding, but we convert the
   1.683 + *	string value to UTF-8 using core Windows functions.  The path name
   1.684 + *	contains ASCII string and '/' chars do not conflict with other UTF
   1.685 + *	chars.
   1.686 + *
   1.687 + * Side effects:
   1.688 + *	The variable tclNativeExecutableName gets filled in with the file
   1.689 + *	name for the application, if we figured it out.  If we couldn't
   1.690 + *	figure it out, tclNativeExecutableName is set to NULL.
   1.691 + *
   1.692 + *---------------------------------------------------------------------------
   1.693 + */
   1.694 +
   1.695 +char *
   1.696 +TclpFindExecutable(argv0)
   1.697 +    CONST char *argv0;		/* The value of the application's argv[0]
   1.698 +				 * (native). */
   1.699 +{
   1.700 +    WCHAR wName[MAX_PATH];
   1.701 +    char name[MAX_PATH * TCL_UTF_MAX];
   1.702 +
   1.703 +    if (argv0 == NULL) {
   1.704 +	return NULL;
   1.705 +    }
   1.706 +    if (tclNativeExecutableName != NULL) {
   1.707 +	return tclNativeExecutableName;
   1.708 +    }
   1.709 +
   1.710 +    /*
   1.711 +     * Under Windows we ignore argv0, and return the path for the file used to
   1.712 +     * create this process.
   1.713 +     */
   1.714 +
   1.715 +    if (GetModuleFileNameW(NULL, wName, MAX_PATH) == 0) {
   1.716 +	GetModuleFileNameA(NULL, name, sizeof(name));
   1.717 +    } else {
   1.718 +	WideCharToMultiByte(CP_UTF8, 0, wName, -1, 
   1.719 +		name, sizeof(name), NULL, NULL);
   1.720 +    }
   1.721 +
   1.722 +    tclNativeExecutableName = ckalloc((unsigned) (strlen(name) + 1));
   1.723 +    strcpy(tclNativeExecutableName, name);
   1.724 +
   1.725 +    TclWinNoBackslash(tclNativeExecutableName);
   1.726 +    return tclNativeExecutableName;
   1.727 +}
   1.728 +
   1.729 +/*
   1.730 + *----------------------------------------------------------------------
   1.731 + *
   1.732 + * TclpMatchInDirectory --
   1.733 + *
   1.734 + *	This routine is used by the globbing code to search a
   1.735 + *	directory for all files which match a given pattern.
   1.736 + *
   1.737 + * Results: 
   1.738 + *	
   1.739 + *	The return value is a standard Tcl result indicating whether an
   1.740 + *	error occurred in globbing.  Errors are left in interp, good
   1.741 + *	results are lappended to resultPtr (which must be a valid object)
   1.742 + *
   1.743 + * Side effects:
   1.744 + *	None.
   1.745 + *
   1.746 + *---------------------------------------------------------------------- */
   1.747 +
   1.748 +int
   1.749 +TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
   1.750 +    Tcl_Interp *interp;		/* Interpreter to receive errors. */
   1.751 +    Tcl_Obj *resultPtr;		/* List object to lappend results. */
   1.752 +    Tcl_Obj *pathPtr;	        /* Contains path to directory to search. */
   1.753 +    CONST char *pattern;	/* Pattern to match against. */
   1.754 +    Tcl_GlobTypeData *types;	/* Object containing list of acceptable types.
   1.755 +				 * May be NULL. In particular the directory
   1.756 +				 * flag is very important. */
   1.757 +{
   1.758 +    CONST TCHAR *native;
   1.759 +
   1.760 +    if (pattern == NULL || (*pattern == '\0')) {
   1.761 +	Tcl_Obj *norm = Tcl_FSGetNormalizedPath(NULL, pathPtr);
   1.762 +	if (norm != NULL) {
   1.763 +	    /* Match a single file directly */
   1.764 +	    int len;
   1.765 +	    DWORD attr;
   1.766 +	    CONST char *str = Tcl_GetStringFromObj(norm,&len);
   1.767 +
   1.768 +	    native = (CONST TCHAR*) Tcl_FSGetNativePath(pathPtr);
   1.769 +	    
   1.770 +	    if (tclWinProcs->getFileAttributesExProc == NULL) {
   1.771 +		attr = (*tclWinProcs->getFileAttributesProc)(native);
   1.772 +		if (attr == 0xffffffff) {
   1.773 +		    return TCL_OK;
   1.774 +		}
   1.775 +	    } else {
   1.776 +		WIN32_FILE_ATTRIBUTE_DATA data;
   1.777 +		if ((*tclWinProcs->getFileAttributesExProc)(native,
   1.778 +			GetFileExInfoStandard, &data) != TRUE) {
   1.779 +		    return TCL_OK;
   1.780 +		}
   1.781 +		attr = data.dwFileAttributes;
   1.782 +	    }
   1.783 +	    if (NativeMatchType(WinIsDrive(str,len), attr, 
   1.784 +				native, types)) {
   1.785 +		Tcl_ListObjAppendElement(interp, resultPtr, pathPtr);
   1.786 +	    }
   1.787 +	}
   1.788 +	return TCL_OK;
   1.789 +    } else {
   1.790 +	DWORD attr;
   1.791 +	HANDLE handle;
   1.792 +	WIN32_FIND_DATAT data;
   1.793 +	CONST char *dirName;
   1.794 +	int dirLength;
   1.795 +	int matchSpecialDots;
   1.796 +	Tcl_DString ds;        /* native encoding of dir */
   1.797 +	Tcl_DString dsOrig;    /* utf-8 encoding of dir */
   1.798 +	Tcl_DString dirString; /* utf-8 encoding of dir with \'s */
   1.799 +	Tcl_Obj *fileNamePtr;
   1.800 +
   1.801 +	/*
   1.802 +	 * Convert the path to normalized form since some interfaces only
   1.803 +	 * accept backslashes.  Also, ensure that the directory ends with a
   1.804 +	 * separator character.
   1.805 +	 */
   1.806 +
   1.807 +	fileNamePtr = Tcl_FSGetTranslatedPath(interp, pathPtr);
   1.808 +	if (fileNamePtr == NULL) {
   1.809 +	    return TCL_ERROR;
   1.810 +	}
   1.811 +	Tcl_DStringInit(&dsOrig);
   1.812 +	dirName = Tcl_GetStringFromObj(fileNamePtr, &dirLength);
   1.813 +	Tcl_DStringAppend(&dsOrig, dirName, dirLength);
   1.814 +	
   1.815 +	Tcl_DStringInit(&dirString);
   1.816 +	if (dirLength == 0) {
   1.817 +	    Tcl_DStringAppend(&dirString, ".\\", 2);
   1.818 +	} else {
   1.819 +	    char *p;
   1.820 +
   1.821 +	    Tcl_DStringAppend(&dirString, dirName, dirLength);
   1.822 +	    for (p = Tcl_DStringValue(&dirString); *p != '\0'; p++) {
   1.823 +		if (*p == '/') {
   1.824 +		    *p = '\\';
   1.825 +		}
   1.826 +	    }
   1.827 +	    p--;
   1.828 +	    /* Make sure we have a trailing directory delimiter */
   1.829 +	    if ((*p != '\\') && (*p != ':')) {
   1.830 +		Tcl_DStringAppend(&dirString, "\\", 1);
   1.831 +		Tcl_DStringAppend(&dsOrig, "/", 1);
   1.832 +		dirLength++;
   1.833 +	    }
   1.834 +	}
   1.835 +	dirName = Tcl_DStringValue(&dirString);
   1.836 +	Tcl_DecrRefCount(fileNamePtr);
   1.837 +	
   1.838 +	/*
   1.839 +	 * First verify that the specified path is actually a directory.
   1.840 +	 */
   1.841 +
   1.842 +	native = Tcl_WinUtfToTChar(dirName, Tcl_DStringLength(&dirString),
   1.843 +		&ds);
   1.844 +	attr = (*tclWinProcs->getFileAttributesProc)(native);
   1.845 +	Tcl_DStringFree(&ds);
   1.846 +
   1.847 +	if ((attr == 0xffffffff) || ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0)) {
   1.848 +	    Tcl_DStringFree(&dirString);
   1.849 +	    return TCL_OK;
   1.850 +	}
   1.851 +
   1.852 +	/*
   1.853 +	 * We need to check all files in the directory, so append a *.*
   1.854 +	 * to the path. 
   1.855 +	 */
   1.856 +
   1.857 +	dirName = Tcl_DStringAppend(&dirString, "*.*", 3);
   1.858 +	native = Tcl_WinUtfToTChar(dirName, -1, &ds);
   1.859 +	handle = (*tclWinProcs->findFirstFileProc)(native, &data);
   1.860 +
   1.861 +	if (handle == INVALID_HANDLE_VALUE) {
   1.862 +	    TclWinConvertError(GetLastError());
   1.863 +	    Tcl_DStringFree(&ds);
   1.864 +	    Tcl_DStringFree(&dirString);
   1.865 +	    Tcl_ResetResult(interp);
   1.866 +	    Tcl_AppendResult(interp, "couldn't read directory \"",
   1.867 +		    Tcl_DStringValue(&dsOrig), "\": ", 
   1.868 +		    Tcl_PosixError(interp), (char *) NULL);
   1.869 +	    Tcl_DStringFree(&dsOrig);
   1.870 +	    return TCL_ERROR;
   1.871 +	}
   1.872 +	Tcl_DStringFree(&ds);
   1.873 +
   1.874 +	/*
   1.875 +	 * Check to see if the pattern should match the special
   1.876 +	 * . and .. names, referring to the current directory,
   1.877 +	 * or the directory above.  We need a special check for
   1.878 +	 * this because paths beginning with a dot are not considered
   1.879 +	 * hidden on Windows, and so otherwise a relative glob like
   1.880 +	 * 'glob -join * *' will actually return './. ../..' etc.
   1.881 +	 */
   1.882 +
   1.883 +	if ((pattern[0] == '.')
   1.884 +		|| ((pattern[0] == '\\') && (pattern[1] == '.'))) {
   1.885 +	    matchSpecialDots = 1;
   1.886 +	} else {
   1.887 +	    matchSpecialDots = 0;
   1.888 +	}
   1.889 +
   1.890 +	/*
   1.891 +	 * Now iterate over all of the files in the directory, starting
   1.892 +	 * with the first one we found.
   1.893 +	 */
   1.894 +
   1.895 +	do {
   1.896 +	    CONST char *utfname;
   1.897 +	    int checkDrive = 0;
   1.898 +	    int isDrive;
   1.899 +	    DWORD attr;
   1.900 +	    
   1.901 +	    if (tclWinProcs->useWide) {
   1.902 +		native = (CONST TCHAR *) data.w.cFileName;
   1.903 +		attr = data.w.dwFileAttributes;
   1.904 +	    } else {
   1.905 +		native = (CONST TCHAR *) data.a.cFileName;
   1.906 +		attr = data.a.dwFileAttributes;
   1.907 +	    }
   1.908 +	    
   1.909 +	    utfname = Tcl_WinTCharToUtf(native, -1, &ds);
   1.910 +
   1.911 +	    if (!matchSpecialDots) {
   1.912 +		/* If it is exactly '.' or '..' then we ignore it */
   1.913 +		if ((utfname[0] == '.') && (utfname[1] == '\0' 
   1.914 +			|| (utfname[1] == '.' && utfname[2] == '\0'))) {
   1.915 +		    Tcl_DStringFree(&ds);
   1.916 +		    continue;
   1.917 +		}
   1.918 +	    } else if (utfname[0] == '.' && utfname[1] == '.'
   1.919 +		    && utfname[2] == '\0') {
   1.920 +		/* 
   1.921 +		 * Have to check if this is a drive below, so we can
   1.922 +		 * correctly match 'hidden' and not hidden files.
   1.923 +		 */
   1.924 +		checkDrive = 1;
   1.925 +	    }
   1.926 +	    
   1.927 +	    /*
   1.928 +	     * Check to see if the file matches the pattern.  Note that
   1.929 +	     * we are ignoring the case sensitivity flag because Windows
   1.930 +	     * doesn't honor case even if the volume is case sensitive.
   1.931 +	     * If the volume also doesn't preserve case, then we
   1.932 +	     * previously returned the lower case form of the name.  This
   1.933 +	     * didn't seem quite right since there are
   1.934 +	     * non-case-preserving volumes that actually return mixed
   1.935 +	     * case.  So now we are returning exactly what we get from
   1.936 +	     * the system.
   1.937 +	     */
   1.938 +
   1.939 +	    if (Tcl_StringCaseMatch(utfname, pattern, 1)) {
   1.940 +		/*
   1.941 +		 * If the file matches, then we need to process the remainder
   1.942 +		 * of the path.
   1.943 +		 */
   1.944 +
   1.945 +		if (checkDrive) {
   1.946 +		    CONST char *fullname = Tcl_DStringAppend(&dsOrig, utfname,
   1.947 +			    Tcl_DStringLength(&ds));
   1.948 +		    isDrive = WinIsDrive(fullname, Tcl_DStringLength(&dsOrig));
   1.949 +		    Tcl_DStringSetLength(&dsOrig, dirLength);
   1.950 +		} else {
   1.951 +		    isDrive = 0;
   1.952 +		}
   1.953 +		if (NativeMatchType(isDrive, attr, native, types)) {
   1.954 +		    Tcl_ListObjAppendElement(interp, resultPtr, 
   1.955 +			    TclNewFSPathObj(pathPtr, utfname,
   1.956 +				    Tcl_DStringLength(&ds)));
   1.957 +		}
   1.958 +	    }
   1.959 +
   1.960 +	    /*
   1.961 +	     * Free ds here to ensure that native is valid above.
   1.962 +	     */
   1.963 +	    Tcl_DStringFree(&ds);
   1.964 +	} while ((*tclWinProcs->findNextFileProc)(handle, &data) == TRUE);
   1.965 +
   1.966 +	FindClose(handle);
   1.967 +	Tcl_DStringFree(&dirString);
   1.968 +	Tcl_DStringFree(&dsOrig);
   1.969 +	return TCL_OK;
   1.970 +    }
   1.971 +}
   1.972 +
   1.973 +/* 
   1.974 + * Does the given path represent a root volume?  We need this special
   1.975 + * case because for NTFS root volumes, the getFileAttributesProc returns
   1.976 + * a 'hidden' attribute when it should not.
   1.977 + */
   1.978 +static int
   1.979 +WinIsDrive(
   1.980 +    CONST char *name,     /* Name (UTF-8) */
   1.981 +    int len)              /* Length of name */
   1.982 +{
   1.983 +    int remove = 0;
   1.984 +    while (len > 4) {
   1.985 +        if ((name[len-1] != '.' || name[len-2] != '.') 
   1.986 +	    || (name[len-3] != '/' && name[len-3] != '\\')) {
   1.987 +            /* We don't have '/..' at the end */
   1.988 +	    if (remove == 0) {
   1.989 +	        break;
   1.990 +	    }
   1.991 +	    remove--;
   1.992 +	    while (len > 0) {
   1.993 +		len--;
   1.994 +		if (name[len] == '/' || name[len] == '\\') {
   1.995 +		    break;
   1.996 +		}
   1.997 +	    }
   1.998 +	    if (len < 4) {
   1.999 +	        len++;
  1.1000 +		break;
  1.1001 +	    }
  1.1002 +        } else {
  1.1003 +	    /* We do have '/..' */
  1.1004 +	    len -= 3;
  1.1005 +	    remove++;
  1.1006 +        }
  1.1007 +    }
  1.1008 +    if (len < 4) {
  1.1009 +	if (len == 0) {
  1.1010 +	    /* 
  1.1011 +	     * Not sure if this is possible, but we pass it on
  1.1012 +	     * anyway 
  1.1013 +	     */
  1.1014 +	} else if (len == 1 && (name[0] == '/' || name[0] == '\\')) {
  1.1015 +	    /* Path is pointing to the root volume */
  1.1016 +	    return 1;
  1.1017 +	} else if ((name[1] == ':') 
  1.1018 +		   && (len == 2 || (name[2] == '/' || name[2] == '\\'))) {
  1.1019 +	    /* Path is of the form 'x:' or 'x:/' or 'x:\' */
  1.1020 +	    return 1;
  1.1021 +	}
  1.1022 +    }
  1.1023 +    return 0;
  1.1024 +}
  1.1025 +
  1.1026 +/* 
  1.1027 + * Does the given path represent a reserved window path name?  If not
  1.1028 + * return 0, if true, return the number of characters of the path that
  1.1029 + * we actually want (not any trailing :).
  1.1030 + */
  1.1031 +static int WinIsReserved(
  1.1032 +   CONST char *path)    /* Path in UTF-8  */
  1.1033 +{
  1.1034 +    if ((path[0] == 'c' || path[0] == 'C') 
  1.1035 +	&& (path[1] == 'o' || path[1] == 'O')) {
  1.1036 +	if ((path[2] == 'm' || path[2] == 'M')
  1.1037 +	    && path[3] >= '1' && path[3] <= '4') {
  1.1038 +	    /* May have match for 'com[1-4]:?', which is a serial port */
  1.1039 +	    if (path[4] == '\0') {
  1.1040 +		return 4;
  1.1041 +	    } else if (path [4] == ':' && path[5] == '\0') {
  1.1042 +		return 4;
  1.1043 +	    }
  1.1044 +	} else if ((path[2] == 'n' || path[2] == 'N') && path[3] == '\0') {
  1.1045 +	    /* Have match for 'con' */
  1.1046 +	    return 3;
  1.1047 +	}
  1.1048 +    } else if ((path[0] == 'l' || path[0] == 'L')
  1.1049 +	       && (path[1] == 'p' || path[1] == 'P')
  1.1050 +	       && (path[2] == 't' || path[2] == 'T')) {
  1.1051 +	if (path[3] >= '1' && path[3] <= '3') {
  1.1052 +	    /* May have match for 'lpt[1-3]:?' */
  1.1053 +	    if (path[4] == '\0') {
  1.1054 +		return 4;
  1.1055 +	    } else if (path [4] == ':' && path[5] == '\0') {
  1.1056 +		return 4;
  1.1057 +	    }
  1.1058 +	}
  1.1059 +    } else if (stricmp(path, "prn") == 0) {
  1.1060 +	/* Have match for 'prn' */
  1.1061 +	return 3;
  1.1062 +    } else if (stricmp(path, "nul") == 0) {
  1.1063 +	/* Have match for 'nul' */
  1.1064 +	return 3;
  1.1065 +    } else if (stricmp(path, "aux") == 0) {
  1.1066 +	/* Have match for 'aux' */
  1.1067 +	return 3;
  1.1068 +    }
  1.1069 +    return 0;
  1.1070 +}
  1.1071 +
  1.1072 +/*
  1.1073 + *----------------------------------------------------------------------
  1.1074 + * 
  1.1075 + * NativeMatchType --
  1.1076 + * 
  1.1077 + * This function needs a special case for a path which is a root
  1.1078 + * volume, because for NTFS root volumes, the getFileAttributesProc
  1.1079 + * returns a 'hidden' attribute when it should not.
  1.1080 + * 
  1.1081 + * We never make any calss to a 'get attributes' routine here,
  1.1082 + * since we have arranged things so that our caller already knows
  1.1083 + * such information.
  1.1084 + * 
  1.1085 + * Results:
  1.1086 + *  0 = file doesn't match
  1.1087 + *  1 = file matches
  1.1088 + * 
  1.1089 + *----------------------------------------------------------------------
  1.1090 + */
  1.1091 +static int 
  1.1092 +NativeMatchType(
  1.1093 +    int isDrive,              /* Is this a drive */
  1.1094 +    DWORD attr,               /* We already know the attributes 
  1.1095 +                               * for the file */
  1.1096 +    CONST TCHAR* nativeName,  /* Native path to check */
  1.1097 +    Tcl_GlobTypeData *types)  /* Type description to match against */
  1.1098 +{
  1.1099 +    /*
  1.1100 +     * 'attr' represents the attributes of the file, but we only
  1.1101 +     * want to retrieve this info if it is absolutely necessary
  1.1102 +     * because it is an expensive call.  Unfortunately, to deal
  1.1103 +     * with hidden files properly, we must always retrieve it.
  1.1104 +     */
  1.1105 +
  1.1106 +    if (types == NULL) {
  1.1107 +	/* If invisible, don't return the file */
  1.1108 +	if (attr & FILE_ATTRIBUTE_HIDDEN && !isDrive) {
  1.1109 +	    return 0;
  1.1110 +	}
  1.1111 +    } else {
  1.1112 +	if (attr & FILE_ATTRIBUTE_HIDDEN && !isDrive) {
  1.1113 +	    /* If invisible */
  1.1114 +	    if ((types->perm == 0) || 
  1.1115 +		    !(types->perm & TCL_GLOB_PERM_HIDDEN)) {
  1.1116 +		return 0;
  1.1117 +	    }
  1.1118 +	} else {
  1.1119 +	    /* Visible */
  1.1120 +	    if (types->perm & TCL_GLOB_PERM_HIDDEN) {
  1.1121 +		return 0;
  1.1122 +	    }
  1.1123 +	}
  1.1124 +	
  1.1125 +	if (types->perm != 0) {
  1.1126 +	    if (
  1.1127 +		((types->perm & TCL_GLOB_PERM_RONLY) &&
  1.1128 +			!(attr & FILE_ATTRIBUTE_READONLY)) ||
  1.1129 +		((types->perm & TCL_GLOB_PERM_R) &&
  1.1130 +			(0 /* File exists => R_OK on Windows */)) ||
  1.1131 +		((types->perm & TCL_GLOB_PERM_W) &&
  1.1132 +			(attr & FILE_ATTRIBUTE_READONLY)) ||
  1.1133 +		((types->perm & TCL_GLOB_PERM_X) &&
  1.1134 +			(!(attr & FILE_ATTRIBUTE_DIRECTORY)
  1.1135 +			 && !NativeIsExec(nativeName)))
  1.1136 +		) {
  1.1137 +		return 0;
  1.1138 +	    }
  1.1139 +	}
  1.1140 +	if ((types->type & TCL_GLOB_TYPE_DIR) 
  1.1141 +	    && (attr & FILE_ATTRIBUTE_DIRECTORY)) {
  1.1142 +	    /* Quicker test for directory, which is a common case */
  1.1143 +	    return 1;
  1.1144 +	} else if (types->type != 0) {
  1.1145 +	    unsigned short st_mode;
  1.1146 +	    int isExec = NativeIsExec(nativeName);
  1.1147 +	    
  1.1148 +	    st_mode = NativeStatMode(attr, 0, isExec);
  1.1149 +
  1.1150 +	    /*
  1.1151 +	     * In order bcdpfls as in 'find -t'
  1.1152 +	     */
  1.1153 +	    if (
  1.1154 +		((types->type & TCL_GLOB_TYPE_BLOCK) &&
  1.1155 +			S_ISBLK(st_mode)) ||
  1.1156 +		((types->type & TCL_GLOB_TYPE_CHAR) &&
  1.1157 +			S_ISCHR(st_mode)) ||
  1.1158 +		((types->type & TCL_GLOB_TYPE_DIR) &&
  1.1159 +			S_ISDIR(st_mode)) ||
  1.1160 +		((types->type & TCL_GLOB_TYPE_PIPE) &&
  1.1161 +			S_ISFIFO(st_mode)) ||
  1.1162 +		((types->type & TCL_GLOB_TYPE_FILE) &&
  1.1163 +			S_ISREG(st_mode))
  1.1164 +#ifdef S_ISSOCK
  1.1165 +		|| ((types->type & TCL_GLOB_TYPE_SOCK) &&
  1.1166 +			S_ISSOCK(st_mode))
  1.1167 +#endif
  1.1168 +		) {
  1.1169 +		/* Do nothing -- this file is ok */
  1.1170 +	    } else {
  1.1171 +#ifdef S_ISLNK
  1.1172 +		if (types->type & TCL_GLOB_TYPE_LINK) {
  1.1173 +		    st_mode = NativeStatMode(attr, 1, isExec);
  1.1174 +		    if (S_ISLNK(st_mode)) {
  1.1175 +			return 1;
  1.1176 +		    }
  1.1177 +		}
  1.1178 +#endif
  1.1179 +		return 0;
  1.1180 +	    }
  1.1181 +	}		
  1.1182 +    } 
  1.1183 +    return 1;
  1.1184 +}
  1.1185 +
  1.1186 +/*
  1.1187 + *----------------------------------------------------------------------
  1.1188 + *
  1.1189 + * TclpGetUserHome --
  1.1190 + *
  1.1191 + *	This function takes the passed in user name and finds the
  1.1192 + *	corresponding home directory specified in the password file.
  1.1193 + *
  1.1194 + * Results:
  1.1195 + *	The result is a pointer to a string specifying the user's home
  1.1196 + *	directory, or NULL if the user's home directory could not be
  1.1197 + *	determined.  Storage for the result string is allocated in
  1.1198 + *	bufferPtr; the caller must call Tcl_DStringFree() when the result
  1.1199 + *	is no longer needed.
  1.1200 + *
  1.1201 + * Side effects:
  1.1202 + *	None.
  1.1203 + *
  1.1204 + *----------------------------------------------------------------------
  1.1205 + */
  1.1206 +
  1.1207 +char *
  1.1208 +TclpGetUserHome(name, bufferPtr)
  1.1209 +    CONST char *name;		/* User name for desired home directory. */
  1.1210 +    Tcl_DString *bufferPtr;	/* Uninitialized or free DString filled
  1.1211 +				 * with name of user's home directory. */
  1.1212 +{
  1.1213 +    char *result;
  1.1214 +    HINSTANCE netapiInst;
  1.1215 +
  1.1216 +    result = NULL;
  1.1217 +
  1.1218 +    Tcl_DStringInit(bufferPtr);
  1.1219 +
  1.1220 +    netapiInst = LoadLibraryA("netapi32.dll");
  1.1221 +    if (netapiInst != NULL) {
  1.1222 +	NETAPIBUFFERFREEPROC *netApiBufferFreeProc;
  1.1223 +	NETGETDCNAMEPROC *netGetDCNameProc;
  1.1224 +	NETUSERGETINFOPROC *netUserGetInfoProc;
  1.1225 +
  1.1226 +	netApiBufferFreeProc = (NETAPIBUFFERFREEPROC *)
  1.1227 +		GetProcAddress(netapiInst, "NetApiBufferFree");
  1.1228 +	netGetDCNameProc = (NETGETDCNAMEPROC *) 
  1.1229 +		GetProcAddress(netapiInst, "NetGetDCName");
  1.1230 +	netUserGetInfoProc = (NETUSERGETINFOPROC *) 
  1.1231 +		GetProcAddress(netapiInst, "NetUserGetInfo");
  1.1232 +	if ((netUserGetInfoProc != NULL) && (netGetDCNameProc != NULL)
  1.1233 +		&& (netApiBufferFreeProc != NULL)) {
  1.1234 +	    USER_INFO_1 *uiPtr;
  1.1235 +	    Tcl_DString ds;
  1.1236 +	    int nameLen, badDomain;
  1.1237 +	    char *domain;
  1.1238 +	    WCHAR *wName, *wHomeDir, *wDomain;
  1.1239 +	    WCHAR buf[MAX_PATH];
  1.1240 +
  1.1241 +	    badDomain = 0;
  1.1242 +	    nameLen = -1;
  1.1243 +	    wDomain = NULL;
  1.1244 +	    domain = strchr(name, '@');
  1.1245 +	    if (domain != NULL) {
  1.1246 +		Tcl_DStringInit(&ds);
  1.1247 +		wName = Tcl_UtfToUniCharDString(domain + 1, -1, &ds);
  1.1248 +		badDomain = (*netGetDCNameProc)(NULL, wName,
  1.1249 +			(LPBYTE *) &wDomain);
  1.1250 +		Tcl_DStringFree(&ds);
  1.1251 +		nameLen = domain - name;
  1.1252 +	    }
  1.1253 +	    if (badDomain == 0) {
  1.1254 +		Tcl_DStringInit(&ds);
  1.1255 +		wName = Tcl_UtfToUniCharDString(name, nameLen, &ds);
  1.1256 +		if ((*netUserGetInfoProc)(wDomain, wName, 1,
  1.1257 +			(LPBYTE *) &uiPtr) == 0) {
  1.1258 +		    wHomeDir = uiPtr->usri1_home_dir;
  1.1259 +		    if ((wHomeDir != NULL) && (wHomeDir[0] != L'\0')) {
  1.1260 +			Tcl_UniCharToUtfDString(wHomeDir, lstrlenW(wHomeDir),
  1.1261 +				bufferPtr);
  1.1262 +		    } else {
  1.1263 +			/* 
  1.1264 +			 * User exists but has no home dir.  Return
  1.1265 +			 * "{Windows Drive}:/users/default".
  1.1266 +			 */
  1.1267 +
  1.1268 +			GetWindowsDirectoryW(buf, MAX_PATH);
  1.1269 +			Tcl_UniCharToUtfDString(buf, 2, bufferPtr);
  1.1270 +			Tcl_DStringAppend(bufferPtr, "/users/default", -1);
  1.1271 +		    }
  1.1272 +		    result = Tcl_DStringValue(bufferPtr);
  1.1273 +		    (*netApiBufferFreeProc)((void *) uiPtr);
  1.1274 +		}
  1.1275 +		Tcl_DStringFree(&ds);
  1.1276 +	    }
  1.1277 +	    if (wDomain != NULL) {
  1.1278 +		(*netApiBufferFreeProc)((void *) wDomain);
  1.1279 +	    }
  1.1280 +	}
  1.1281 +	FreeLibrary(netapiInst);
  1.1282 +    }
  1.1283 +    if (result == NULL) {
  1.1284 +	/*
  1.1285 +	 * Look in the "Password Lists" section of system.ini for the 
  1.1286 +	 * local user.  There are also entries in that section that begin 
  1.1287 +	 * with a "*" character that are used by Windows for other 
  1.1288 +	 * purposes; ignore user names beginning with a "*".
  1.1289 +	 */
  1.1290 +
  1.1291 +	char buf[MAX_PATH];
  1.1292 +
  1.1293 +	if (name[0] != '*') {
  1.1294 +	    if (GetPrivateProfileStringA("Password Lists", name, "", buf, 
  1.1295 +		    MAX_PATH, "system.ini") > 0) {
  1.1296 +		/* 
  1.1297 +		 * User exists, but there is no such thing as a home 
  1.1298 +		 * directory in system.ini.  Return "{Windows drive}:/".
  1.1299 +		 */
  1.1300 +
  1.1301 +		GetWindowsDirectoryA(buf, MAX_PATH);
  1.1302 +		Tcl_DStringAppend(bufferPtr, buf, 3);
  1.1303 +		result = Tcl_DStringValue(bufferPtr);
  1.1304 +	    }
  1.1305 +	}
  1.1306 +    }
  1.1307 +
  1.1308 +    return result;
  1.1309 +}
  1.1310 +
  1.1311 +/*
  1.1312 + *---------------------------------------------------------------------------
  1.1313 + *
  1.1314 + * NativeAccess --
  1.1315 + *
  1.1316 + *	This function replaces the library version of access(), fixing the
  1.1317 + *	following bugs:
  1.1318 + * 
  1.1319 + *	1. access() returns that all files have execute permission.
  1.1320 + *
  1.1321 + * Results:
  1.1322 + *	See access documentation.
  1.1323 + *
  1.1324 + * Side effects:
  1.1325 + *	See access documentation.
  1.1326 + *
  1.1327 + *---------------------------------------------------------------------------
  1.1328 + */
  1.1329 +
  1.1330 +static int
  1.1331 +NativeAccess(
  1.1332 +    CONST TCHAR *nativePath,	/* Path of file to access (UTF-8). */
  1.1333 +    int mode)			/* Permission setting. */
  1.1334 +{
  1.1335 +    DWORD attr;
  1.1336 +
  1.1337 +    attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
  1.1338 +
  1.1339 +    if (attr == 0xffffffff) {
  1.1340 +	/*
  1.1341 +	 * File doesn't exist.
  1.1342 +	 */
  1.1343 +
  1.1344 +	TclWinConvertError(GetLastError());
  1.1345 +	return -1;
  1.1346 +    }
  1.1347 +
  1.1348 +    if ((mode & W_OK) 
  1.1349 +      && (tclWinProcs->getFileSecurityProc == NULL)
  1.1350 +      && (attr & FILE_ATTRIBUTE_READONLY)) {
  1.1351 +	/*
  1.1352 +	 * We don't have the advanced 'getFileSecurityProc', and
  1.1353 +	 * our attributes say the file is not writable.  If we
  1.1354 +	 * do have 'getFileSecurityProc', we'll do a more
  1.1355 +	 * robust XP-related check below.
  1.1356 +	 */
  1.1357 +
  1.1358 +	Tcl_SetErrno(EACCES);
  1.1359 +	return -1;
  1.1360 +    }
  1.1361 +
  1.1362 +    if (mode & X_OK) {
  1.1363 +	if (!(attr & FILE_ATTRIBUTE_DIRECTORY) && !NativeIsExec(nativePath)) {
  1.1364 +	    /*
  1.1365 +	     * It's not a directory and doesn't have the correct extension.
  1.1366 +	     * Therefore it can't be executable
  1.1367 +	     */
  1.1368 +
  1.1369 +	    Tcl_SetErrno(EACCES);
  1.1370 +	    return -1;
  1.1371 +	}
  1.1372 +    }
  1.1373 +
  1.1374 +    /*
  1.1375 +     * It looks as if the permissions are ok, but if we are on NT, 2000 or XP,
  1.1376 +     * we have a more complex permissions structure so we try to check that.
  1.1377 +     * The code below is remarkably complex for such a simple thing as finding
  1.1378 +     * what permissions the OS has set for a file.
  1.1379 +     *
  1.1380 +     * If we are simply checking for file existence, then we don't need all
  1.1381 +     * these complications (which are really quite slow: with this code 'file
  1.1382 +     * readable' is 5-6 times slower than 'file exists').
  1.1383 +     */
  1.1384 +
  1.1385 +    if ((mode != F_OK) && (tclWinProcs->getFileSecurityProc != NULL)) {
  1.1386 +	SECURITY_DESCRIPTOR *sdPtr = NULL;
  1.1387 +	unsigned long size;
  1.1388 +	GENERIC_MAPPING genMap;
  1.1389 +	HANDLE hToken = NULL;
  1.1390 +	DWORD desiredAccess = 0;
  1.1391 +	DWORD grantedAccess = 0;
  1.1392 +	BOOL accessYesNo = FALSE;
  1.1393 +	PRIVILEGE_SET privSet;
  1.1394 +	DWORD privSetSize = sizeof(PRIVILEGE_SET);
  1.1395 +	int error;
  1.1396 +
  1.1397 +	/*
  1.1398 +	 * First find out how big the buffer needs to be
  1.1399 +	 */
  1.1400 +
  1.1401 +	size = 0;
  1.1402 +	(*tclWinProcs->getFileSecurityProc)(nativePath,
  1.1403 +		OWNER_SECURITY_INFORMATION | GROUP_SECURITY_INFORMATION
  1.1404 +		| DACL_SECURITY_INFORMATION, 0, 0, &size);
  1.1405 +
  1.1406 +	/*
  1.1407 +	 * Should have failed with ERROR_INSUFFICIENT_BUFFER
  1.1408 +	 */
  1.1409 +
  1.1410 +	error = GetLastError();
  1.1411 +	if (error != ERROR_INSUFFICIENT_BUFFER) {
  1.1412 +	    /*
  1.1413 +	     * Most likely case is ERROR_ACCESS_DENIED, which we will convert
  1.1414 +	     * to EACCES - just what we want!
  1.1415 +	     */
  1.1416 +
  1.1417 +	    TclWinConvertError((DWORD)error);
  1.1418 +	    return -1;
  1.1419 +	}
  1.1420 +
  1.1421 +	/*
  1.1422 +	 * Now size contains the size of buffer needed
  1.1423 +	 */
  1.1424 +
  1.1425 +	sdPtr = (SECURITY_DESCRIPTOR *) HeapAlloc(GetProcessHeap(), 0, size);
  1.1426 +
  1.1427 +	if (sdPtr == NULL) {
  1.1428 +	    goto accessError;
  1.1429 +	}
  1.1430 +
  1.1431 +	/*
  1.1432 +	 * Call GetFileSecurity() for real
  1.1433 +	 */
  1.1434 +
  1.1435 +	if (!(*tclWinProcs->getFileSecurityProc)(nativePath,
  1.1436 +		OWNER_SECURITY_INFORMATION | GROUP_SECURITY_INFORMATION
  1.1437 +		| DACL_SECURITY_INFORMATION, sdPtr, size, &size)) {
  1.1438 +	    /*
  1.1439 +	     * Error getting owner SD
  1.1440 +	     */
  1.1441 +
  1.1442 +	    goto accessError;
  1.1443 +	}
  1.1444 +
  1.1445 +	/*
  1.1446 +	 * Perform security impersonation of the user and open the
  1.1447 +	 * resulting thread token.
  1.1448 +	 */
  1.1449 +
  1.1450 +	if (!(*tclWinProcs->impersonateSelfProc)(SecurityImpersonation)) {
  1.1451 +	    /*
  1.1452 +	     * Unable to perform security impersonation.
  1.1453 +	     */
  1.1454 +	    
  1.1455 +	    goto accessError;
  1.1456 +	}
  1.1457 +	if (!(*tclWinProcs->openThreadTokenProc)(GetCurrentThread (),
  1.1458 +		TOKEN_DUPLICATE | TOKEN_QUERY, FALSE, &hToken)) {
  1.1459 +	    /*
  1.1460 +	     * Unable to get current thread's token.
  1.1461 +	     */
  1.1462 +	    
  1.1463 +	    goto accessError;
  1.1464 +	}
  1.1465 +	
  1.1466 +	(*tclWinProcs->revertToSelfProc)();
  1.1467 +	
  1.1468 +	/*
  1.1469 +	 * Setup desiredAccess according to the access priveleges we are
  1.1470 +	 * checking.
  1.1471 +	 */
  1.1472 +
  1.1473 +	if (mode & R_OK) {
  1.1474 +	    desiredAccess |= FILE_GENERIC_READ;
  1.1475 +	}
  1.1476 +	if (mode & W_OK) {
  1.1477 +	    desiredAccess |= FILE_GENERIC_WRITE;
  1.1478 +	}
  1.1479 +	if (mode & X_OK) {
  1.1480 +	    desiredAccess |= FILE_GENERIC_EXECUTE;
  1.1481 +	}
  1.1482 +
  1.1483 +	memset (&genMap, 0x0, sizeof (GENERIC_MAPPING));
  1.1484 +	genMap.GenericRead = FILE_GENERIC_READ;
  1.1485 +	genMap.GenericWrite = FILE_GENERIC_WRITE;
  1.1486 +	genMap.GenericExecute = FILE_GENERIC_EXECUTE;
  1.1487 +	genMap.GenericAll = FILE_ALL_ACCESS;
  1.1488 +	
  1.1489 +	/*
  1.1490 +	 * Perform access check using the token.
  1.1491 +	 */
  1.1492 +
  1.1493 +	if (!(*tclWinProcs->accessCheckProc)(sdPtr, hToken, desiredAccess,
  1.1494 +		&genMap, &privSet, &privSetSize, &grantedAccess,
  1.1495 +		&accessYesNo)) {
  1.1496 +	    /*
  1.1497 +	     * Unable to perform access check.
  1.1498 +	     */
  1.1499 +
  1.1500 +	accessError:
  1.1501 +	    TclWinConvertError(GetLastError());
  1.1502 +	    if (sdPtr != NULL) {
  1.1503 +		HeapFree(GetProcessHeap(), 0, sdPtr);
  1.1504 +	    }
  1.1505 +	    if (hToken != NULL) {
  1.1506 +		CloseHandle(hToken);
  1.1507 +	    }
  1.1508 +	    return -1;
  1.1509 +	}
  1.1510 +
  1.1511 +	/*
  1.1512 +	 * Clean up.
  1.1513 +	 */
  1.1514 +
  1.1515 +	HeapFree(GetProcessHeap (), 0, sdPtr);
  1.1516 +	CloseHandle(hToken);
  1.1517 +	if (!accessYesNo) {
  1.1518 +	    Tcl_SetErrno(EACCES);
  1.1519 +	    return -1;
  1.1520 +	}
  1.1521 +	/*
  1.1522 +	 * For directories the above checks are ok.  For files, though,
  1.1523 +	 * we must still check the 'attr' value.
  1.1524 +	 */
  1.1525 +	if ((mode & W_OK)
  1.1526 +	  && !(attr & FILE_ATTRIBUTE_DIRECTORY)
  1.1527 +	  && (attr & FILE_ATTRIBUTE_READONLY)) {
  1.1528 +	    Tcl_SetErrno(EACCES);
  1.1529 +	    return -1;
  1.1530 +	}
  1.1531 +    }
  1.1532 +    return 0;
  1.1533 +}
  1.1534 +
  1.1535 +/*
  1.1536 + *----------------------------------------------------------------------
  1.1537 + *
  1.1538 + * NativeIsExec --
  1.1539 + *
  1.1540 + *	Determines if a path is executable.  On windows this is 
  1.1541 + *	simply defined by whether the path ends in any of ".exe",
  1.1542 + *	".com", or ".bat"
  1.1543 + *
  1.1544 + * Results:
  1.1545 + *	1 = executable, 0 = not.
  1.1546 + *
  1.1547 + *----------------------------------------------------------------------
  1.1548 + */
  1.1549 +static int
  1.1550 +NativeIsExec(nativePath)
  1.1551 +    CONST TCHAR *nativePath;
  1.1552 +{
  1.1553 +    if (tclWinProcs->useWide) {
  1.1554 +	CONST WCHAR *path;
  1.1555 +	int len;
  1.1556 +
  1.1557 +	path = (CONST WCHAR*)nativePath;
  1.1558 +	len = wcslen(path);
  1.1559 +
  1.1560 +	if (len < 5) {
  1.1561 +	    return 0;
  1.1562 +	}
  1.1563 +
  1.1564 +	if (path[len-4] != L'.') {
  1.1565 +	    return 0;
  1.1566 +	}
  1.1567 +
  1.1568 +	/*
  1.1569 +	 * Use wide-char case-insensitive comparison
  1.1570 +	 */
  1.1571 +	if ((_wcsicmp(path+len-3,L"exe") == 0)
  1.1572 +		|| (_wcsicmp(path+len-3,L"com") == 0)
  1.1573 +		|| (_wcsicmp(path+len-3,L"bat") == 0)) {
  1.1574 +	    return 1;
  1.1575 +	}
  1.1576 +    } else {
  1.1577 +	CONST char *p;
  1.1578 +
  1.1579 +	/* We are only looking for pure ascii */
  1.1580 +
  1.1581 +	p = strrchr((CONST char*)nativePath, '.');
  1.1582 +	if (p != NULL) {
  1.1583 +	    p++;
  1.1584 +	    /* 
  1.1585 +	     * Note: in the old code, stat considered '.pif' files as
  1.1586 +	     * executable, whereas access did not.
  1.1587 +	     */
  1.1588 +	    if ((stricmp(p, "exe") == 0)
  1.1589 +		    || (stricmp(p, "com") == 0)
  1.1590 +		    || (stricmp(p, "bat") == 0)) {
  1.1591 +		/*
  1.1592 +		 * File that ends with .exe, .com, or .bat is executable.
  1.1593 +		 */
  1.1594 +
  1.1595 +		return 1;
  1.1596 +	    }
  1.1597 +	}
  1.1598 +    }
  1.1599 +    return 0;
  1.1600 +}
  1.1601 +
  1.1602 +/*
  1.1603 + *----------------------------------------------------------------------
  1.1604 + *
  1.1605 + * TclpObjChdir --
  1.1606 + *
  1.1607 + *	This function replaces the library version of chdir().
  1.1608 + *
  1.1609 + * Results:
  1.1610 + *	See chdir() documentation.
  1.1611 + *
  1.1612 + * Side effects:
  1.1613 + *	See chdir() documentation.  
  1.1614 + *
  1.1615 + *----------------------------------------------------------------------
  1.1616 + */
  1.1617 +
  1.1618 +int 
  1.1619 +TclpObjChdir(pathPtr)
  1.1620 +    Tcl_Obj *pathPtr; 	/* Path to new working directory. */
  1.1621 +{
  1.1622 +    int result;
  1.1623 +    CONST TCHAR *nativePath;
  1.1624 +#ifdef __CYGWIN__
  1.1625 +    extern int cygwin_conv_to_posix_path 
  1.1626 +	_ANSI_ARGS_((CONST char *, char *));
  1.1627 +    char posixPath[MAX_PATH+1];
  1.1628 +    CONST char *path;
  1.1629 +    Tcl_DString ds;
  1.1630 +#endif /* __CYGWIN__ */
  1.1631 +
  1.1632 +    nativePath = (CONST TCHAR *) Tcl_FSGetNativePath(pathPtr);
  1.1633 +#ifdef __CYGWIN__
  1.1634 +    /* Cygwin chdir only groks POSIX path. */
  1.1635 +    path = Tcl_WinTCharToUtf(nativePath, -1, &ds);
  1.1636 +    cygwin_conv_to_posix_path(path, posixPath);
  1.1637 +    result = (chdir(posixPath) == 0 ? 1 : 0);
  1.1638 +    Tcl_DStringFree(&ds);
  1.1639 +#else /* __CYGWIN__ */
  1.1640 +    result = (*tclWinProcs->setCurrentDirectoryProc)(nativePath);
  1.1641 +#endif /* __CYGWIN__ */
  1.1642 +
  1.1643 +    if (result == 0) {
  1.1644 +	TclWinConvertError(GetLastError());
  1.1645 +	return -1;
  1.1646 +    }
  1.1647 +    return 0;
  1.1648 +}
  1.1649 +
  1.1650 +#ifdef __CYGWIN__
  1.1651 +/*
  1.1652 + *---------------------------------------------------------------------------
  1.1653 + *
  1.1654 + * TclpReadlink --
  1.1655 + *
  1.1656 + *     This function replaces the library version of readlink().
  1.1657 + *
  1.1658 + * Results:
  1.1659 + *     The result is a pointer to a string specifying the contents
  1.1660 + *     of the symbolic link given by 'path', or NULL if the symbolic
  1.1661 + *     link could not be read.  Storage for the result string is
  1.1662 + *     allocated in bufferPtr; the caller must call Tcl_DStringFree()
  1.1663 + *     when the result is no longer needed.
  1.1664 + *
  1.1665 + * Side effects:
  1.1666 + *     See readlink() documentation.
  1.1667 + *
  1.1668 + *---------------------------------------------------------------------------
  1.1669 + */
  1.1670 +
  1.1671 +char *
  1.1672 +TclpReadlink(path, linkPtr)
  1.1673 +    CONST char *path;          /* Path of file to readlink (UTF-8). */
  1.1674 +    Tcl_DString *linkPtr;      /* Uninitialized or free DString filled
  1.1675 +                                * with contents of link (UTF-8). */
  1.1676 +{
  1.1677 +    char link[MAXPATHLEN];
  1.1678 +    int length;
  1.1679 +    char *native;
  1.1680 +    Tcl_DString ds;
  1.1681 +
  1.1682 +    native = Tcl_UtfToExternalDString(NULL, path, -1, &ds);
  1.1683 +    length = readlink(native, link, sizeof(link));     /* INTL: Native. */
  1.1684 +    Tcl_DStringFree(&ds);
  1.1685 +    
  1.1686 +    if (length < 0) {
  1.1687 +	return NULL;
  1.1688 +    }
  1.1689 +
  1.1690 +    Tcl_ExternalToUtfDString(NULL, link, length, linkPtr);
  1.1691 +    return Tcl_DStringValue(linkPtr);
  1.1692 +}
  1.1693 +#endif /* __CYGWIN__ */
  1.1694 +
  1.1695 +/*
  1.1696 + *----------------------------------------------------------------------
  1.1697 + *
  1.1698 + * TclpGetCwd --
  1.1699 + *
  1.1700 + *	This function replaces the library version of getcwd().
  1.1701 + *
  1.1702 + * Results:
  1.1703 + *	The result is a pointer to a string specifying the current
  1.1704 + *	directory, or NULL if the current directory could not be
  1.1705 + *	determined.  If NULL is returned, an error message is left in the
  1.1706 + *	interp's result.  Storage for the result string is allocated in
  1.1707 + *	bufferPtr; the caller must call Tcl_DStringFree() when the result
  1.1708 + *	is no longer needed.
  1.1709 + *
  1.1710 + * Side effects:
  1.1711 + *	None.
  1.1712 + *
  1.1713 + *----------------------------------------------------------------------
  1.1714 + */
  1.1715 +
  1.1716 +CONST char *
  1.1717 +TclpGetCwd(interp, bufferPtr)
  1.1718 +    Tcl_Interp *interp;		/* If non-NULL, used for error reporting. */
  1.1719 +    Tcl_DString *bufferPtr;	/* Uninitialized or free DString filled
  1.1720 +				 * with name of current directory. */
  1.1721 +{
  1.1722 +    WCHAR buffer[MAX_PATH];
  1.1723 +    char *p;
  1.1724 +
  1.1725 +    if ((*tclWinProcs->getCurrentDirectoryProc)(MAX_PATH, buffer) == 0) {
  1.1726 +	TclWinConvertError(GetLastError());
  1.1727 +	if (interp != NULL) {
  1.1728 +	    Tcl_AppendResult(interp,
  1.1729 +		    "error getting working directory name: ",
  1.1730 +		    Tcl_PosixError(interp), (char *) NULL);
  1.1731 +	}
  1.1732 +	return NULL;
  1.1733 +    }
  1.1734 +
  1.1735 +    /*
  1.1736 +     * Watch for the weird Windows c:\\UNC syntax.
  1.1737 +     */
  1.1738 +
  1.1739 +    if (tclWinProcs->useWide) {
  1.1740 +	WCHAR *native;
  1.1741 +
  1.1742 +	native = (WCHAR *) buffer;
  1.1743 +	if ((native[0] != '\0') && (native[1] == ':') 
  1.1744 +		&& (native[2] == '\\') && (native[3] == '\\')) {
  1.1745 +	    native += 2;
  1.1746 +	}
  1.1747 +	Tcl_WinTCharToUtf((TCHAR *) native, -1, bufferPtr);
  1.1748 +    } else {
  1.1749 +	char *native;
  1.1750 +
  1.1751 +	native = (char *) buffer;
  1.1752 +	if ((native[0] != '\0') && (native[1] == ':') 
  1.1753 +		&& (native[2] == '\\') && (native[3] == '\\')) {
  1.1754 +	    native += 2;
  1.1755 +	}
  1.1756 +	Tcl_WinTCharToUtf((TCHAR *) native, -1, bufferPtr);
  1.1757 +    }
  1.1758 +
  1.1759 +    /*
  1.1760 +     * Convert to forward slashes for easier use in scripts.
  1.1761 +     */
  1.1762 +	      
  1.1763 +    for (p = Tcl_DStringValue(bufferPtr); *p != '\0'; p++) {
  1.1764 +	if (*p == '\\') {
  1.1765 +	    *p = '/';
  1.1766 +	}
  1.1767 +    }
  1.1768 +    return Tcl_DStringValue(bufferPtr);
  1.1769 +}
  1.1770 +
  1.1771 +int 
  1.1772 +TclpObjStat(pathPtr, statPtr)
  1.1773 +    Tcl_Obj *pathPtr;          /* Path of file to stat */
  1.1774 +    Tcl_StatBuf *statPtr;      /* Filled with results of stat call. */
  1.1775 +{
  1.1776 +#ifdef OLD_API
  1.1777 +    Tcl_Obj *transPtr;
  1.1778 +    /*
  1.1779 +     * Eliminate file names containing wildcard characters, or subsequent 
  1.1780 +     * call to FindFirstFile() will expand them, matching some other file.
  1.1781 +     */
  1.1782 +
  1.1783 +    transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
  1.1784 +    if (transPtr == NULL || (strpbrk(Tcl_GetString(transPtr), "?*") != NULL)) {
  1.1785 +	if (transPtr != NULL) {
  1.1786 +	    Tcl_DecrRefCount(transPtr);
  1.1787 +	}
  1.1788 +	Tcl_SetErrno(ENOENT);
  1.1789 +	return -1;
  1.1790 +    }
  1.1791 +    Tcl_DecrRefCount(transPtr);
  1.1792 +#endif
  1.1793 +    
  1.1794 +    /*
  1.1795 +     * Ensure correct file sizes by forcing the OS to write any
  1.1796 +     * pending data to disk. This is done only for channels which are
  1.1797 +     * dirty, i.e. have been written to since the last flush here.
  1.1798 +     */
  1.1799 +
  1.1800 +    TclWinFlushDirtyChannels ();
  1.1801 +
  1.1802 +    return NativeStat((CONST TCHAR*) Tcl_FSGetNativePath(pathPtr), statPtr, 0);
  1.1803 +}
  1.1804 +
  1.1805 +/*
  1.1806 + *----------------------------------------------------------------------
  1.1807 + *
  1.1808 + * NativeStat --
  1.1809 + *
  1.1810 + *	This function replaces the library version of stat(), fixing 
  1.1811 + *	the following bugs:
  1.1812 + *
  1.1813 + *	1. stat("c:") returns an error.
  1.1814 + *	2. Borland stat() return time in GMT instead of localtime.
  1.1815 + *	3. stat("\\server\mount") would return error.
  1.1816 + *	4. Accepts slashes or backslashes.
  1.1817 + *	5. st_dev and st_rdev were wrong for UNC paths.
  1.1818 + *
  1.1819 + * Results:
  1.1820 + *	See stat documentation.
  1.1821 + *
  1.1822 + * Side effects:
  1.1823 + *	See stat documentation.
  1.1824 + *
  1.1825 + *----------------------------------------------------------------------
  1.1826 + */
  1.1827 +
  1.1828 +static int 
  1.1829 +NativeStat(nativePath, statPtr, checkLinks)
  1.1830 +    CONST TCHAR *nativePath;   /* Path of file to stat */
  1.1831 +    Tcl_StatBuf *statPtr;      /* Filled with results of stat call. */
  1.1832 +    int checkLinks;            /* If non-zero, behave like 'lstat' */
  1.1833 +{
  1.1834 +    Tcl_DString ds;
  1.1835 +    DWORD attr;
  1.1836 +    WCHAR nativeFullPath[MAX_PATH];
  1.1837 +    TCHAR *nativePart;
  1.1838 +    CONST char *fullPath;
  1.1839 +    int dev;
  1.1840 +    unsigned short mode;
  1.1841 +    
  1.1842 +    if (tclWinProcs->getFileAttributesExProc == NULL) {
  1.1843 +        /* 
  1.1844 +         * We don't have the faster attributes proc, so we're
  1.1845 +         * probably running on Win95
  1.1846 +         */
  1.1847 +	WIN32_FIND_DATAT data;
  1.1848 +	HANDLE handle;
  1.1849 +
  1.1850 +	handle = (*tclWinProcs->findFirstFileProc)(nativePath, &data);
  1.1851 +	if (handle == INVALID_HANDLE_VALUE) {
  1.1852 +	    /* 
  1.1853 +	     * FindFirstFile() doesn't work on root directories, so call
  1.1854 +	     * GetFileAttributes() to see if the specified file exists.
  1.1855 +	     */
  1.1856 +
  1.1857 +	    attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
  1.1858 +	    if (attr == INVALID_FILE_ATTRIBUTES) {
  1.1859 +		Tcl_SetErrno(ENOENT);
  1.1860 +		return -1;
  1.1861 +	    }
  1.1862 +
  1.1863 +	    /* 
  1.1864 +	     * Make up some fake information for this file.  It has the 
  1.1865 +	     * correct file attributes and a time of 0.
  1.1866 +	     */
  1.1867 +
  1.1868 +	    memset(&data, 0, sizeof(data));
  1.1869 +	    data.a.dwFileAttributes = attr;
  1.1870 +	} else {
  1.1871 +	    FindClose(handle);
  1.1872 +	}
  1.1873 +
  1.1874 +    
  1.1875 +	(*tclWinProcs->getFullPathNameProc)(nativePath, MAX_PATH, nativeFullPath,
  1.1876 +		&nativePart);
  1.1877 +
  1.1878 +	fullPath = Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds);
  1.1879 +
  1.1880 +	dev = -1;
  1.1881 +	if ((fullPath[0] == '\\') && (fullPath[1] == '\\')) {
  1.1882 +	    CONST char *p;
  1.1883 +	    DWORD dw;
  1.1884 +	    CONST TCHAR *nativeVol;
  1.1885 +	    Tcl_DString volString;
  1.1886 +
  1.1887 +	    p = strchr(fullPath + 2, '\\');
  1.1888 +	    p = strchr(p + 1, '\\');
  1.1889 +	    if (p == NULL) {
  1.1890 +		/*
  1.1891 +		 * Add terminating backslash to fullpath or 
  1.1892 +		 * GetVolumeInformation() won't work.
  1.1893 +		 */
  1.1894 +
  1.1895 +		fullPath = Tcl_DStringAppend(&ds, "\\", 1);
  1.1896 +		p = fullPath + Tcl_DStringLength(&ds);
  1.1897 +	    } else {
  1.1898 +		p++;
  1.1899 +	    }
  1.1900 +	    nativeVol = Tcl_WinUtfToTChar(fullPath, p - fullPath, &volString);
  1.1901 +	    dw = (DWORD) -1;
  1.1902 +	    (*tclWinProcs->getVolumeInformationProc)(nativeVol, NULL, 0, &dw,
  1.1903 +		    NULL, NULL, NULL, 0);
  1.1904 +	    /*
  1.1905 +	     * GetFullPathName() turns special devices like "NUL" into
  1.1906 +	     * "\\.\NUL", but GetVolumeInformation() returns failure for
  1.1907 +	     * "\\.\NUL".  This will cause "NUL" to get a drive number of
  1.1908 +	     * -1, which makes about as much sense as anything since the
  1.1909 +	     * special devices don't live on any drive.
  1.1910 +	     */
  1.1911 +
  1.1912 +	    dev = dw;
  1.1913 +	    Tcl_DStringFree(&volString);
  1.1914 +	} else if ((fullPath[0] != '\0') && (fullPath[1] == ':')) {
  1.1915 +	    dev = Tcl_UniCharToLower(fullPath[0]) - 'a';
  1.1916 +	}
  1.1917 +	Tcl_DStringFree(&ds);
  1.1918 +	
  1.1919 +	attr = data.a.dwFileAttributes;
  1.1920 +
  1.1921 +	statPtr->st_size  = ((Tcl_WideInt)data.a.nFileSizeLow) |
  1.1922 +		(((Tcl_WideInt)data.a.nFileSizeHigh) << 32);
  1.1923 +	statPtr->st_atime = ToCTime(data.a.ftLastAccessTime);
  1.1924 +	statPtr->st_mtime = ToCTime(data.a.ftLastWriteTime);
  1.1925 +	statPtr->st_ctime = ToCTime(data.a.ftCreationTime);
  1.1926 +    } else {
  1.1927 +	WIN32_FILE_ATTRIBUTE_DATA data;
  1.1928 +	if((*tclWinProcs->getFileAttributesExProc)(nativePath,
  1.1929 +						   GetFileExInfoStandard,
  1.1930 +						   &data) != TRUE) {
  1.1931 +	    Tcl_SetErrno(ENOENT);
  1.1932 +	    return -1;
  1.1933 +	}
  1.1934 +
  1.1935 +    
  1.1936 +	(*tclWinProcs->getFullPathNameProc)(nativePath, MAX_PATH, 
  1.1937 +					    nativeFullPath, &nativePart);
  1.1938 +
  1.1939 +	fullPath = Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds);
  1.1940 +
  1.1941 +	dev = -1;
  1.1942 +	if ((fullPath[0] == '\\') && (fullPath[1] == '\\')) {
  1.1943 +	    CONST char *p;
  1.1944 +	    DWORD dw;
  1.1945 +	    CONST TCHAR *nativeVol;
  1.1946 +	    Tcl_DString volString;
  1.1947 +
  1.1948 +	    p = strchr(fullPath + 2, '\\');
  1.1949 +	    p = strchr(p + 1, '\\');
  1.1950 +	    if (p == NULL) {
  1.1951 +		/*
  1.1952 +		 * Add terminating backslash to fullpath or 
  1.1953 +		 * GetVolumeInformation() won't work.
  1.1954 +		 */
  1.1955 +
  1.1956 +		fullPath = Tcl_DStringAppend(&ds, "\\", 1);
  1.1957 +		p = fullPath + Tcl_DStringLength(&ds);
  1.1958 +	    } else {
  1.1959 +		p++;
  1.1960 +	    }
  1.1961 +	    nativeVol = Tcl_WinUtfToTChar(fullPath, p - fullPath, &volString);
  1.1962 +	    dw = (DWORD) -1;
  1.1963 +	    (*tclWinProcs->getVolumeInformationProc)(nativeVol, NULL, 0, &dw,
  1.1964 +		    NULL, NULL, NULL, 0);
  1.1965 +	    /*
  1.1966 +	     * GetFullPathName() turns special devices like "NUL" into
  1.1967 +	     * "\\.\NUL", but GetVolumeInformation() returns failure for
  1.1968 +	     * "\\.\NUL".  This will cause "NUL" to get a drive number of
  1.1969 +	     * -1, which makes about as much sense as anything since the
  1.1970 +	     * special devices don't live on any drive.
  1.1971 +	     */
  1.1972 +
  1.1973 +	    dev = dw;
  1.1974 +	    Tcl_DStringFree(&volString);
  1.1975 +	} else if ((fullPath[0] != '\0') && (fullPath[1] == ':')) {
  1.1976 +	    dev = Tcl_UniCharToLower(fullPath[0]) - 'a';
  1.1977 +	}
  1.1978 +	Tcl_DStringFree(&ds);
  1.1979 +	
  1.1980 +	attr = data.dwFileAttributes;
  1.1981 +	
  1.1982 +	statPtr->st_size  = ((Tcl_WideInt)data.nFileSizeLow) |
  1.1983 +		(((Tcl_WideInt)data.nFileSizeHigh) << 32);
  1.1984 +	statPtr->st_atime = ToCTime(data.ftLastAccessTime);
  1.1985 +	statPtr->st_mtime = ToCTime(data.ftLastWriteTime);
  1.1986 +	statPtr->st_ctime = ToCTime(data.ftCreationTime);
  1.1987 +    }
  1.1988 +
  1.1989 +    mode = NativeStatMode(attr, checkLinks, NativeIsExec(nativePath));
  1.1990 +    
  1.1991 +    statPtr->st_dev	= (dev_t) dev;
  1.1992 +    statPtr->st_ino	= 0;
  1.1993 +    statPtr->st_mode	= mode;
  1.1994 +    statPtr->st_nlink	= 1;
  1.1995 +    statPtr->st_uid	= 0;
  1.1996 +    statPtr->st_gid	= 0;
  1.1997 +    statPtr->st_rdev	= (dev_t) dev;
  1.1998 +    return 0;
  1.1999 +}
  1.2000 +
  1.2001 +/*
  1.2002 + *----------------------------------------------------------------------
  1.2003 + *
  1.2004 + * NativeStatMode --
  1.2005 + *
  1.2006 + *	Calculate just the 'st_mode' field of a 'stat' structure.
  1.2007 + *
  1.2008 + *----------------------------------------------------------------------
  1.2009 + */
  1.2010 +static unsigned short
  1.2011 +NativeStatMode(DWORD attr, int checkLinks, int isExec) 
  1.2012 +{
  1.2013 +    int mode;
  1.2014 +    if (checkLinks && (attr & FILE_ATTRIBUTE_REPARSE_POINT)) {
  1.2015 +	/* It is a link */
  1.2016 +	mode = S_IFLNK;
  1.2017 +    } else {
  1.2018 +	mode  = (attr & FILE_ATTRIBUTE_DIRECTORY) ? S_IFDIR | S_IEXEC : S_IFREG;
  1.2019 +    }
  1.2020 +    mode |= (attr & FILE_ATTRIBUTE_READONLY) ? S_IREAD : S_IREAD | S_IWRITE;
  1.2021 +    if (isExec) {
  1.2022 +	mode |= S_IEXEC;
  1.2023 +    }
  1.2024 +    
  1.2025 +    /*
  1.2026 +     * Propagate the S_IREAD, S_IWRITE, S_IEXEC bits to the group and 
  1.2027 +     * other positions.
  1.2028 +     */
  1.2029 +
  1.2030 +    mode |= (mode & 0x0700) >> 3;
  1.2031 +    mode |= (mode & 0x0700) >> 6;
  1.2032 +    return (unsigned short)mode;
  1.2033 +}
  1.2034 +
  1.2035 +/*
  1.2036 + *------------------------------------------------------------------------
  1.2037 + *
  1.2038 + * ToCTime --
  1.2039 + *
  1.2040 + *	Converts a Windows FILETIME to a time_t in UTC.
  1.2041 + *
  1.2042 + * Results:
  1.2043 + *	Returns the count of seconds from the Posix epoch.
  1.2044 + *
  1.2045 + *------------------------------------------------------------------------
  1.2046 + */
  1.2047 +
  1.2048 +static time_t
  1.2049 +ToCTime(
  1.2050 +    FILETIME fileTime)		/* UTC time */
  1.2051 +{
  1.2052 +    LARGE_INTEGER convertedTime;
  1.2053 +
  1.2054 +    convertedTime.LowPart = fileTime.dwLowDateTime;
  1.2055 +    convertedTime.HighPart = (LONG) fileTime.dwHighDateTime;
  1.2056 +
  1.2057 +    return (time_t) ((convertedTime.QuadPart
  1.2058 +	    - (Tcl_WideInt) POSIX_EPOCH_AS_FILETIME) / (Tcl_WideInt) 10000000);
  1.2059 +}
  1.2060 +
  1.2061 +/*
  1.2062 + *------------------------------------------------------------------------
  1.2063 + *
  1.2064 + * FromCTime --
  1.2065 + *
  1.2066 + *	Converts a time_t to a Windows FILETIME
  1.2067 + *
  1.2068 + * Results:
  1.2069 + *	Returns the count of 100-ns ticks seconds from the Windows epoch.
  1.2070 + *
  1.2071 + *------------------------------------------------------------------------
  1.2072 + */
  1.2073 +
  1.2074 +static void
  1.2075 +FromCTime(
  1.2076 +    time_t posixTime,
  1.2077 +    FILETIME* fileTime)		/* UTC Time */
  1.2078 +{
  1.2079 +    LARGE_INTEGER convertedTime;
  1.2080 +    convertedTime.QuadPart = ((LONGLONG) posixTime) * 10000000
  1.2081 +	+ POSIX_EPOCH_AS_FILETIME;
  1.2082 +    fileTime->dwLowDateTime = convertedTime.LowPart;
  1.2083 +    fileTime->dwHighDateTime = convertedTime.HighPart;
  1.2084 +}
  1.2085 +
  1.2086 +#if 0
  1.2087 +/*
  1.2088 + *-------------------------------------------------------------------------
  1.2089 + *
  1.2090 + * TclWinResolveShortcut --
  1.2091 + *
  1.2092 + *	Resolve a potential Windows shortcut to get the actual file or 
  1.2093 + *	directory in question.  
  1.2094 + *
  1.2095 + * Results:
  1.2096 + *	Returns 1 if the shortcut could be resolved, or 0 if there was
  1.2097 + *	an error or if the filename was not a shortcut.
  1.2098 + *	If bufferPtr did hold the name of a shortcut, it is modified to
  1.2099 + *	hold the resolved target of the shortcut instead.
  1.2100 + *
  1.2101 + * Side effects:
  1.2102 + *	Loads and unloads OLE package to determine if filename refers to
  1.2103 + *	a shortcut.
  1.2104 + *
  1.2105 + *-------------------------------------------------------------------------
  1.2106 + */
  1.2107 +
  1.2108 +int
  1.2109 +TclWinResolveShortcut(bufferPtr)
  1.2110 +    Tcl_DString *bufferPtr;	/* Holds name of file to resolve.  On 
  1.2111 +				 * return, holds resolved file name. */
  1.2112 +{
  1.2113 +    HRESULT hres; 
  1.2114 +    IShellLink *psl; 
  1.2115 +    IPersistFile *ppf; 
  1.2116 +    WIN32_FIND_DATA wfd; 
  1.2117 +    WCHAR wpath[MAX_PATH];
  1.2118 +    char *path, *ext;
  1.2119 +    char realFileName[MAX_PATH];
  1.2120 +
  1.2121 +    /*
  1.2122 +     * Windows system calls do not automatically resolve
  1.2123 +     * shortcuts like UNIX automatically will with symbolic links.
  1.2124 +     */
  1.2125 +
  1.2126 +    path = Tcl_DStringValue(bufferPtr);
  1.2127 +    ext = strrchr(path, '.');
  1.2128 +    if ((ext == NULL) || (stricmp(ext, ".lnk") != 0)) {
  1.2129 +	return 0;
  1.2130 +    }
  1.2131 +
  1.2132 +    CoInitialize(NULL);
  1.2133 +    path = Tcl_DStringValue(bufferPtr);
  1.2134 +    realFileName[0] = '\0';
  1.2135 +    hres = CoCreateInstance(&CLSID_ShellLink, NULL, CLSCTX_INPROC_SERVER, 
  1.2136 +	    &IID_IShellLink, &psl); 
  1.2137 +    if (SUCCEEDED(hres)) { 
  1.2138 +	hres = psl->lpVtbl->QueryInterface(psl, &IID_IPersistFile, &ppf);
  1.2139 +	if (SUCCEEDED(hres)) { 
  1.2140 +	    MultiByteToWideChar(CP_ACP, 0, path, -1, wpath, sizeof(wpath));
  1.2141 +	    hres = ppf->lpVtbl->Load(ppf, wpath, STGM_READ); 
  1.2142 +	    if (SUCCEEDED(hres)) {
  1.2143 +		hres = psl->lpVtbl->Resolve(psl, NULL, 
  1.2144 +			SLR_ANY_MATCH | SLR_NO_UI); 
  1.2145 +		if (SUCCEEDED(hres)) { 
  1.2146 +		    hres = psl->lpVtbl->GetPath(psl, realFileName, MAX_PATH, 
  1.2147 +			    &wfd, 0);
  1.2148 +		} 
  1.2149 +	    } 
  1.2150 +	    ppf->lpVtbl->Release(ppf); 
  1.2151 +	} 
  1.2152 +	psl->lpVtbl->Release(psl); 
  1.2153 +    } 
  1.2154 +    CoUninitialize();
  1.2155 +
  1.2156 +    if (realFileName[0] != '\0') {
  1.2157 +	Tcl_DStringSetLength(bufferPtr, 0);
  1.2158 +	Tcl_DStringAppend(bufferPtr, realFileName, -1);
  1.2159 +	return 1;
  1.2160 +    }
  1.2161 +    return 0;
  1.2162 +}
  1.2163 +#endif
  1.2164 +
  1.2165 +Tcl_Obj* 
  1.2166 +TclpObjGetCwd(interp)
  1.2167 +    Tcl_Interp *interp;
  1.2168 +{
  1.2169 +    Tcl_DString ds;
  1.2170 +    if (TclpGetCwd(interp, &ds) != NULL) {
  1.2171 +	Tcl_Obj *cwdPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
  1.2172 +	Tcl_IncrRefCount(cwdPtr);
  1.2173 +	Tcl_DStringFree(&ds);
  1.2174 +	return cwdPtr;
  1.2175 +    } else {
  1.2176 +	return NULL;
  1.2177 +    }
  1.2178 +}
  1.2179 +
  1.2180 +int 
  1.2181 +TclpObjAccess(pathPtr, mode)
  1.2182 +    Tcl_Obj *pathPtr;
  1.2183 +    int mode;
  1.2184 +{
  1.2185 +    return NativeAccess((CONST TCHAR*) Tcl_FSGetNativePath(pathPtr), mode);
  1.2186 +}
  1.2187 +
  1.2188 +int 
  1.2189 +TclpObjLstat(pathPtr, statPtr)
  1.2190 +    Tcl_Obj *pathPtr;
  1.2191 +    Tcl_StatBuf *statPtr; 
  1.2192 +{
  1.2193 +    /*
  1.2194 +     * Ensure correct file sizes by forcing the OS to write any
  1.2195 +     * pending data to disk. This is done only for channels which are
  1.2196 +     * dirty, i.e. have been written to since the last flush here.
  1.2197 +     */
  1.2198 +
  1.2199 +    TclWinFlushDirtyChannels ();
  1.2200 +
  1.2201 +    return NativeStat((CONST TCHAR*) Tcl_FSGetNativePath(pathPtr), statPtr, 1);
  1.2202 +}
  1.2203 +
  1.2204 +#ifdef S_IFLNK
  1.2205 +
  1.2206 +Tcl_Obj* 
  1.2207 +TclpObjLink(pathPtr, toPtr, linkAction)
  1.2208 +    Tcl_Obj *pathPtr;
  1.2209 +    Tcl_Obj *toPtr;
  1.2210 +    int linkAction;
  1.2211 +{
  1.2212 +    if (toPtr != NULL) {
  1.2213 +	int res;
  1.2214 +	TCHAR* LinkTarget = (TCHAR*)Tcl_FSGetNativePath(toPtr);
  1.2215 +	TCHAR* LinkSource = (TCHAR*)Tcl_FSGetNativePath(pathPtr);
  1.2216 +	if (LinkSource == NULL || LinkTarget == NULL) {
  1.2217 +	    return NULL;
  1.2218 +	}
  1.2219 +	res = WinLink(LinkSource, LinkTarget, linkAction);
  1.2220 +	if (res == 0) {
  1.2221 +	    return toPtr;
  1.2222 +	} else {
  1.2223 +	    return NULL;
  1.2224 +	}
  1.2225 +    } else {
  1.2226 +	TCHAR* LinkSource = (TCHAR*)Tcl_FSGetNativePath(pathPtr);
  1.2227 +	if (LinkSource == NULL) {
  1.2228 +	    return NULL;
  1.2229 +	}
  1.2230 +	return WinReadLink(LinkSource);
  1.2231 +    }
  1.2232 +}
  1.2233 +
  1.2234 +#endif
  1.2235 +
  1.2236 +
  1.2237 +/*
  1.2238 + *---------------------------------------------------------------------------
  1.2239 + *
  1.2240 + * TclpFilesystemPathType --
  1.2241 + *
  1.2242 + *      This function is part of the native filesystem support, and
  1.2243 + *      returns the path type of the given path.  Returns NTFS or FAT
  1.2244 + *      or whatever is returned by the 'volume information' proc.
  1.2245 + *
  1.2246 + * Results:
  1.2247 + *      NULL at present.
  1.2248 + *
  1.2249 + * Side effects:
  1.2250 + *	None.
  1.2251 + *
  1.2252 + *---------------------------------------------------------------------------
  1.2253 + */
  1.2254 +Tcl_Obj*
  1.2255 +TclpFilesystemPathType(pathObjPtr)
  1.2256 +    Tcl_Obj* pathObjPtr;
  1.2257 +{
  1.2258 +#define VOL_BUF_SIZE 32
  1.2259 +    int found;
  1.2260 +    WCHAR volType[VOL_BUF_SIZE];
  1.2261 +    char* firstSeparator;
  1.2262 +    CONST char *path;
  1.2263 +    
  1.2264 +    Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathObjPtr);
  1.2265 +    if (normPath == NULL) return NULL;
  1.2266 +    path = Tcl_GetString(normPath);
  1.2267 +    if (path == NULL) return NULL;
  1.2268 +    
  1.2269 +    firstSeparator = strchr(path, '/');
  1.2270 +    if (firstSeparator == NULL) {
  1.2271 +	found = tclWinProcs->getVolumeInformationProc(
  1.2272 +		Tcl_FSGetNativePath(pathObjPtr), NULL, 0, NULL, NULL, 
  1.2273 +		NULL, (WCHAR *)volType, VOL_BUF_SIZE);
  1.2274 +    } else {
  1.2275 +	Tcl_Obj *driveName = Tcl_NewStringObj(path, firstSeparator - path+1);
  1.2276 +	Tcl_IncrRefCount(driveName);
  1.2277 +	found = tclWinProcs->getVolumeInformationProc(
  1.2278 +		Tcl_FSGetNativePath(driveName), NULL, 0, NULL, NULL, 
  1.2279 +		NULL, (WCHAR *)volType, VOL_BUF_SIZE);
  1.2280 +	Tcl_DecrRefCount(driveName);
  1.2281 +    }
  1.2282 +
  1.2283 +    if (found == 0) {
  1.2284 +	return NULL;
  1.2285 +    } else {
  1.2286 +	Tcl_DString ds;
  1.2287 +	Tcl_Obj *objPtr;
  1.2288 +	
  1.2289 +	Tcl_WinTCharToUtf((CONST char *)volType, -1, &ds);
  1.2290 +	objPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds),Tcl_DStringLength(&ds));
  1.2291 +	Tcl_DStringFree(&ds);
  1.2292 +	return objPtr;
  1.2293 +    }
  1.2294 +#undef VOL_BUF_SIZE
  1.2295 +}
  1.2296 +
  1.2297 +
  1.2298 +/*
  1.2299 + *---------------------------------------------------------------------------
  1.2300 + *
  1.2301 + * TclpObjNormalizePath --
  1.2302 + *
  1.2303 + *	This function scans through a path specification and replaces it,
  1.2304 + *	in place, with a normalized version.  This means using the
  1.2305 + *	'longname', and expanding any symbolic links contained within the
  1.2306 + *	path.
  1.2307 + *
  1.2308 + * Results:
  1.2309 + *	The new 'nextCheckpoint' value, giving as far as we could
  1.2310 + *	understand in the path.
  1.2311 + *
  1.2312 + * Side effects:
  1.2313 + *	The pathPtr string, which must contain a valid path, is
  1.2314 + *	possibly modified in place.
  1.2315 + *
  1.2316 + *---------------------------------------------------------------------------
  1.2317 + */
  1.2318 +
  1.2319 +int
  1.2320 +TclpObjNormalizePath(interp, pathPtr, nextCheckpoint)
  1.2321 +    Tcl_Interp *interp;
  1.2322 +    Tcl_Obj *pathPtr;
  1.2323 +    int nextCheckpoint;
  1.2324 +{
  1.2325 +    char *lastValidPathEnd = NULL;
  1.2326 +    /* This will hold the normalized string */
  1.2327 +    Tcl_DString dsNorm;
  1.2328 +    char *path;
  1.2329 +    char *currentPathEndPosition;
  1.2330 +
  1.2331 +    Tcl_DStringInit(&dsNorm);
  1.2332 +    path = Tcl_GetString(pathPtr);
  1.2333 +
  1.2334 +    if (TclWinGetPlatformId() == VER_PLATFORM_WIN32_WINDOWS) {
  1.2335 +	/* 
  1.2336 +	 * We're on Win95, 98 or ME.  There are two assumptions
  1.2337 +	 * in this block of code.  First that the native (NULL)
  1.2338 +	 * encoding is basically ascii, and second that symbolic
  1.2339 +	 * links are not possible.  Both of these assumptions
  1.2340 +	 * appear to be true of these operating systems.
  1.2341 +	 */
  1.2342 +	int isDrive = 1;
  1.2343 +	Tcl_DString ds;
  1.2344 +
  1.2345 +	currentPathEndPosition = path + nextCheckpoint;
  1.2346 +        if (*currentPathEndPosition == '/') {
  1.2347 +	    currentPathEndPosition++;
  1.2348 +        }
  1.2349 +	while (1) {
  1.2350 +	    char cur = *currentPathEndPosition;
  1.2351 +	    if ((cur == '/' || cur == 0) && (path != currentPathEndPosition)) {
  1.2352 +		/* Reached directory separator, or end of string */
  1.2353 +		CONST char *nativePath = Tcl_UtfToExternalDString(NULL, path, 
  1.2354 +			    currentPathEndPosition - path, &ds);
  1.2355 +
  1.2356 +		/*
  1.2357 +		 * Now we convert the tail of the current path to its
  1.2358 +		 * 'long form', and append it to 'dsNorm' which holds
  1.2359 +		 * the current normalized path, if the file exists.
  1.2360 +		 */
  1.2361 +		if (isDrive) {
  1.2362 +		    if (GetFileAttributesA(nativePath) == INVALID_FILE_ATTRIBUTES) {
  1.2363 +			/* File doesn't exist */
  1.2364 +			if (isDrive) {
  1.2365 +			    int len = WinIsReserved(path);
  1.2366 +			    if (len > 0) {
  1.2367 +				/* Actually it does exist - COM1, etc */
  1.2368 +				int i;
  1.2369 +				for (i=0;i<len;i++) {
  1.2370 +				    if (nativePath[i] >= 'a') {
  1.2371 +					((char*)nativePath)[i] -= ('a' - 'A');
  1.2372 +				    }
  1.2373 +				}
  1.2374 +				Tcl_DStringAppend(&dsNorm, nativePath, len);
  1.2375 +				lastValidPathEnd = currentPathEndPosition;
  1.2376 +			    }
  1.2377 +			}
  1.2378 +			Tcl_DStringFree(&ds);
  1.2379 +			break;
  1.2380 +		    }
  1.2381 +		    if (nativePath[0] >= 'a') {
  1.2382 +			((char*)nativePath)[0] -= ('a' - 'A');
  1.2383 +		    }
  1.2384 +		    Tcl_DStringAppend(&dsNorm,nativePath,Tcl_DStringLength(&ds));
  1.2385 +		} else {
  1.2386 +		    WIN32_FIND_DATA fData;
  1.2387 +		    HANDLE handle;
  1.2388 +		    
  1.2389 +		    handle = FindFirstFileA(nativePath, &fData);
  1.2390 +		    if (handle == INVALID_HANDLE_VALUE) {
  1.2391 +			if (GetFileAttributesA(nativePath) 
  1.2392 +			    == INVALID_FILE_ATTRIBUTES) {
  1.2393 +			    /* File doesn't exist */
  1.2394 +			    Tcl_DStringFree(&ds);
  1.2395 +			    break;
  1.2396 +			}
  1.2397 +			/* This is usually the '/' in 'c:/' at end of string */
  1.2398 +			Tcl_DStringAppend(&dsNorm,"/", 1);
  1.2399 +		    } else {
  1.2400 +			char *nativeName;
  1.2401 +			if (fData.cFileName[0] != '\0') {
  1.2402 +			    nativeName = fData.cFileName;
  1.2403 +			} else {
  1.2404 +			    nativeName = fData.cAlternateFileName;
  1.2405 +			}
  1.2406 +			FindClose(handle);
  1.2407 +			Tcl_DStringAppend(&dsNorm,"/", 1);
  1.2408 +			Tcl_DStringAppend(&dsNorm,nativeName,-1);
  1.2409 +		    }
  1.2410 +		}
  1.2411 +		Tcl_DStringFree(&ds);
  1.2412 +		lastValidPathEnd = currentPathEndPosition;
  1.2413 +		if (cur == 0) {
  1.2414 +		    break;
  1.2415 +		}
  1.2416 +		/* 
  1.2417 +		 * If we get here, we've got past one directory
  1.2418 +		 * delimiter, so we know it is no longer a drive 
  1.2419 +		 */
  1.2420 +		isDrive = 0;
  1.2421 +	    }
  1.2422 +	    currentPathEndPosition++;
  1.2423 +	}
  1.2424 +    } else {
  1.2425 +	/* We're on WinNT or 2000 or XP */
  1.2426 +	Tcl_Obj *temp = NULL;
  1.2427 +	int isDrive = 1;
  1.2428 +	Tcl_DString ds;
  1.2429 +
  1.2430 +	currentPathEndPosition = path + nextCheckpoint;
  1.2431 +	if (*currentPathEndPosition == '/') {
  1.2432 +	    currentPathEndPosition++;
  1.2433 +	}
  1.2434 +	while (1) {
  1.2435 +	    char cur = *currentPathEndPosition;
  1.2436 +	    if ((cur == '/' || cur == 0) && (path != currentPathEndPosition)) {
  1.2437 +		/* Reached directory separator, or end of string */
  1.2438 +		WIN32_FILE_ATTRIBUTE_DATA data;
  1.2439 +		CONST char *nativePath = Tcl_WinUtfToTChar(path, 
  1.2440 +			    currentPathEndPosition - path, &ds);
  1.2441 +		if ((*tclWinProcs->getFileAttributesExProc)(nativePath,
  1.2442 +		    GetFileExInfoStandard, &data) != TRUE) {
  1.2443 +		    /* File doesn't exist */
  1.2444 +		    if (isDrive) {
  1.2445 +			int len = WinIsReserved(path);
  1.2446 +			if (len > 0) {
  1.2447 +			    /* Actually it does exist - COM1, etc */
  1.2448 +			    int i;
  1.2449 +			    for (i=0;i<len;i++) {
  1.2450 +				WCHAR wc = ((WCHAR*)nativePath)[i];
  1.2451 +				if (wc >= L'a') {
  1.2452 +				    wc -= (L'a' - L'A');
  1.2453 +				    ((WCHAR*)nativePath)[i] = wc;
  1.2454 +				}
  1.2455 +			    }
  1.2456 +			    Tcl_DStringAppend(&dsNorm, nativePath,
  1.2457 +					      sizeof(WCHAR)*len);
  1.2458 +			    lastValidPathEnd = currentPathEndPosition;
  1.2459 +			}
  1.2460 +		    }
  1.2461 +		    Tcl_DStringFree(&ds);
  1.2462 +		    break;
  1.2463 +		}
  1.2464 +
  1.2465 +		/* 
  1.2466 +		 * File 'nativePath' does exist if we get here.  We
  1.2467 +		 * now want to check if it is a symlink and otherwise
  1.2468 +		 * continue with the rest of the path.
  1.2469 +		 */
  1.2470 +		
  1.2471 +		/* 
  1.2472 +		 * Check for symlinks, except at last component
  1.2473 +		 * of path (we don't follow final symlinks). Also
  1.2474 +		 * a drive (C:/) for example, may sometimes have
  1.2475 +		 * the reparse flag set for some reason I don't
  1.2476 +		 * understand.  We therefore don't perform this
  1.2477 +		 * check for drives.
  1.2478 +		 */
  1.2479 +		if (cur != 0 && !isDrive && (data.dwFileAttributes 
  1.2480 +				 & FILE_ATTRIBUTE_REPARSE_POINT)) {
  1.2481 +		    Tcl_Obj *to = WinReadLinkDirectory(nativePath);
  1.2482 +		    if (to != NULL) {
  1.2483 +			/* Read the reparse point ok */
  1.2484 +			/* Tcl_GetStringFromObj(to, &pathLen); */
  1.2485 +			nextCheckpoint = 0; /* pathLen */
  1.2486 +			Tcl_AppendToObj(to, currentPathEndPosition, -1);
  1.2487 +			/* Convert link to forward slashes */
  1.2488 +			for (path = Tcl_GetString(to); *path != 0; path++) {
  1.2489 +			    if (*path == '\\') *path = '/';
  1.2490 +			}
  1.2491 +			path = Tcl_GetString(to);
  1.2492 +			currentPathEndPosition = path + nextCheckpoint;
  1.2493 +			if (temp != NULL) {
  1.2494 +			    Tcl_DecrRefCount(temp);
  1.2495 +			}
  1.2496 +			temp = to;
  1.2497 +			/* Reset variables so we can restart normalization */
  1.2498 +			isDrive = 1;
  1.2499 +			Tcl_DStringFree(&dsNorm);
  1.2500 +			Tcl_DStringInit(&dsNorm);
  1.2501 +			Tcl_DStringFree(&ds);
  1.2502 +			continue;
  1.2503 +		    }
  1.2504 +		}
  1.2505 +		/*
  1.2506 +		 * Now we convert the tail of the current path to its
  1.2507 +		 * 'long form', and append it to 'dsNorm' which holds
  1.2508 +		 * the current normalized path
  1.2509 +		 */
  1.2510 +		if (isDrive) {
  1.2511 +		    WCHAR drive = ((WCHAR*)nativePath)[0];
  1.2512 +		    if (drive >= L'a') {
  1.2513 +		        drive -= (L'a' - L'A');
  1.2514 +			((WCHAR*)nativePath)[0] = drive;
  1.2515 +		    }
  1.2516 +		    Tcl_DStringAppend(&dsNorm,nativePath,Tcl_DStringLength(&ds));
  1.2517 +		} else {
  1.2518 +		    char *checkDots = NULL;
  1.2519 +		    
  1.2520 +		    if (lastValidPathEnd[1] == '.') {
  1.2521 +			checkDots = lastValidPathEnd + 1;
  1.2522 +			while (checkDots < currentPathEndPosition) {
  1.2523 +			    if (*checkDots != '.') {
  1.2524 +				checkDots = NULL;
  1.2525 +				break;
  1.2526 +			    }
  1.2527 +			    checkDots++;
  1.2528 +			}
  1.2529 +		    }
  1.2530 +		    if (checkDots != NULL) {
  1.2531 +			int dotLen = currentPathEndPosition - lastValidPathEnd;
  1.2532 +			/* 
  1.2533 +			 * Path is just dots.  We shouldn't really
  1.2534 +			 * ever see a path like that.  However, to be
  1.2535 +			 * nice we at least don't mangle the path -- 
  1.2536 +			 * we just add the dots as a path segment and
  1.2537 +			 * continue
  1.2538 +			 */
  1.2539 +			Tcl_DStringAppend(&dsNorm,
  1.2540 +					  (TCHAR*)((WCHAR*)(nativePath 
  1.2541 +						+ Tcl_DStringLength(&ds)) 
  1.2542 +						- dotLen),
  1.2543 +					  (int)(dotLen * sizeof(WCHAR)));
  1.2544 +		    } else {
  1.2545 +			/* Normal path */
  1.2546 +			WIN32_FIND_DATAW fData;
  1.2547 +			HANDLE handle;
  1.2548 +			
  1.2549 +			handle = FindFirstFileW((WCHAR*)nativePath, &fData);
  1.2550 +			if (handle == INVALID_HANDLE_VALUE) {
  1.2551 +			    /* This is usually the '/' in 'c:/' at end of string */
  1.2552 +			    Tcl_DStringAppend(&dsNorm,(CONST char*)L"/", 
  1.2553 +					      sizeof(WCHAR));
  1.2554 +			} else {
  1.2555 +			    WCHAR *nativeName;
  1.2556 +			    if (fData.cFileName[0] != '\0') {
  1.2557 +				nativeName = fData.cFileName;
  1.2558 +			    } else {
  1.2559 +				nativeName = fData.cAlternateFileName;
  1.2560 +			    }
  1.2561 +			    FindClose(handle);
  1.2562 +			    Tcl_DStringAppend(&dsNorm,(CONST char*)L"/", 
  1.2563 +					      sizeof(WCHAR));
  1.2564 +			    Tcl_DStringAppend(&dsNorm,(TCHAR*)nativeName, 
  1.2565 +					      (int) (wcslen(nativeName)*sizeof(WCHAR)));
  1.2566 +			}
  1.2567 +		    }
  1.2568 +		}
  1.2569 +		Tcl_DStringFree(&ds);
  1.2570 +		lastValidPathEnd = currentPathEndPosition;
  1.2571 +		if (cur == 0) {
  1.2572 +		    break;
  1.2573 +		}
  1.2574 +		/* 
  1.2575 +		 * If we get here, we've got past one directory
  1.2576 +		 * delimiter, so we know it is no longer a drive 
  1.2577 +		 */
  1.2578 +		isDrive = 0;
  1.2579 +	    }
  1.2580 +	    currentPathEndPosition++;
  1.2581 +	}
  1.2582 +    }
  1.2583 +    /* Common code path for all Windows platforms */
  1.2584 +    nextCheckpoint = currentPathEndPosition - path;
  1.2585 +    if (lastValidPathEnd != NULL) {
  1.2586 +	/* 
  1.2587 +	 * Concatenate the normalized string in dsNorm with the
  1.2588 +	 * tail of the path which we didn't recognise.  The
  1.2589 +	 * string in dsNorm is in the native encoding, so we
  1.2590 +	 * have to convert it to Utf.
  1.2591 +	 */
  1.2592 +	Tcl_DString dsTemp;
  1.2593 +	Tcl_WinTCharToUtf(Tcl_DStringValue(&dsNorm), 
  1.2594 +			  Tcl_DStringLength(&dsNorm), &dsTemp);
  1.2595 +	nextCheckpoint = Tcl_DStringLength(&dsTemp);
  1.2596 +	if (*lastValidPathEnd != 0) {
  1.2597 +	    /* Not the end of the string */
  1.2598 +	    int len;
  1.2599 +	    char *path;
  1.2600 +	    Tcl_Obj *tmpPathPtr;
  1.2601 +	    tmpPathPtr = Tcl_NewStringObj(Tcl_DStringValue(&dsTemp), 
  1.2602 +					  nextCheckpoint);
  1.2603 +	    Tcl_AppendToObj(tmpPathPtr, lastValidPathEnd, -1);
  1.2604 +	    path = Tcl_GetStringFromObj(tmpPathPtr, &len);
  1.2605 +	    Tcl_SetStringObj(pathPtr, path, len);
  1.2606 +	    Tcl_DecrRefCount(tmpPathPtr);
  1.2607 +	} else {
  1.2608 +	    /* End of string was reached above */
  1.2609 +	    Tcl_SetStringObj(pathPtr, Tcl_DStringValue(&dsTemp),
  1.2610 +			     nextCheckpoint);
  1.2611 +	}
  1.2612 +	Tcl_DStringFree(&dsTemp);
  1.2613 +    }
  1.2614 +    Tcl_DStringFree(&dsNorm);
  1.2615 +    return nextCheckpoint;
  1.2616 +}
  1.2617 +
  1.2618 +/*
  1.2619 + *---------------------------------------------------------------------------
  1.2620 + *
  1.2621 + * TclpUtime --
  1.2622 + *
  1.2623 + *	Set the modification date for a file.
  1.2624 + *
  1.2625 + * Results:
  1.2626 + *	0 on success, -1 on error.
  1.2627 + *
  1.2628 + * Side effects:
  1.2629 + *	Sets errno to a representation of any Windows problem that's observed
  1.2630 + *	in the process.
  1.2631 + *
  1.2632 + *---------------------------------------------------------------------------
  1.2633 + */
  1.2634 +
  1.2635 +int
  1.2636 +TclpUtime(
  1.2637 +    Tcl_Obj *pathPtr,		/* File to modify */
  1.2638 +    struct utimbuf *tval)	/* New modification date structure */
  1.2639 +{
  1.2640 +    int res = 0;
  1.2641 +    HANDLE fileHandle;
  1.2642 +    CONST TCHAR *native;
  1.2643 +    DWORD attr = 0;
  1.2644 +    DWORD flags = FILE_ATTRIBUTE_NORMAL;
  1.2645 +    FILETIME lastAccessTime, lastModTime;
  1.2646 +
  1.2647 +    FromCTime(tval->actime, &lastAccessTime);
  1.2648 +    FromCTime(tval->modtime, &lastModTime);
  1.2649 +
  1.2650 +    native = (CONST TCHAR *)Tcl_FSGetNativePath(pathPtr);
  1.2651 +
  1.2652 +    attr = (*tclWinProcs->getFileAttributesProc)(native);
  1.2653 +
  1.2654 +    if (attr != INVALID_FILE_ATTRIBUTES && attr & FILE_ATTRIBUTE_DIRECTORY) {
  1.2655 +	flags = FILE_FLAG_BACKUP_SEMANTICS;
  1.2656 +    }
  1.2657 +
  1.2658 +    /*
  1.2659 +     * We use the native APIs (not 'utime') because there are some daylight
  1.2660 +     * savings complications that utime gets wrong.
  1.2661 +     */
  1.2662 +
  1.2663 +    fileHandle = (tclWinProcs->createFileProc) (
  1.2664 +	    native, FILE_WRITE_ATTRIBUTES, 0, NULL,
  1.2665 +	    OPEN_EXISTING, flags, NULL);
  1.2666 +
  1.2667 +    if (fileHandle == INVALID_HANDLE_VALUE ||
  1.2668 +	    !SetFileTime(fileHandle, NULL, &lastAccessTime, &lastModTime)) {
  1.2669 +	TclWinConvertError(GetLastError());
  1.2670 +	res = -1;
  1.2671 +    }
  1.2672 +    if (fileHandle != INVALID_HANDLE_VALUE) {
  1.2673 +	CloseHandle(fileHandle);
  1.2674 +    }
  1.2675 +    return res;
  1.2676 +}