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