Artifact Content
Not logged in
Bounty program for improvements to Tcl and certain Tcl packages.

Artifact c6b5d4f8d7921fad279bfdd6fbdd27846bf29d02:


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