开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Windows编程 > 通讯编程 > 查看源码
tclWinFile.c
资源名称：ns-allinone-2.33.tar.gz　[点击查看]
上传用户：rrhhcc
上传日期：2015-12-11
资源大小：54129k
文件大小：73k
源码类别：

通讯编程

开发平台：

Visual C++

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