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