1/* 2 * tclWinFCmd.c 3 * 4 * This file implements the Windows specific portion of file manipulation 5 * subcommands of the "file" command. 6 * 7 * Copyright (c) 1996-1998 Sun Microsystems, Inc. 8 * 9 * See the file "license.terms" for information on usage and redistribution 10 * of this file, and for a DISCLAIMER OF ALL WARRANTIES. 11 * 12 * RCS: @(#) $Id: tclWinFCmd.c,v 1.35.2.5 2006/08/30 17:48:48 hobbs Exp $ 13 */ 14 15#include "tclWinInt.h" 16 17/* 18 * The following constants specify the type of callback when 19 * TraverseWinTree() calls the traverseProc() 20 */ 21 22#define DOTREE_PRED 1 /* pre-order directory */ 23#define DOTREE_POSTD 2 /* post-order directory */ 24#define DOTREE_F 3 /* regular file */ 25 26/* 27 * Callbacks for file attributes code. 28 */ 29 30static int GetWinFileAttributes _ANSI_ARGS_((Tcl_Interp *interp, 31 int objIndex, Tcl_Obj *fileName, 32 Tcl_Obj **attributePtrPtr)); 33static int GetWinFileLongName _ANSI_ARGS_((Tcl_Interp *interp, 34 int objIndex, Tcl_Obj *fileName, 35 Tcl_Obj **attributePtrPtr)); 36static int GetWinFileShortName _ANSI_ARGS_((Tcl_Interp *interp, 37 int objIndex, Tcl_Obj *fileName, 38 Tcl_Obj **attributePtrPtr)); 39static int SetWinFileAttributes _ANSI_ARGS_((Tcl_Interp *interp, 40 int objIndex, Tcl_Obj *fileName, 41 Tcl_Obj *attributePtr)); 42static int CannotSetAttribute _ANSI_ARGS_((Tcl_Interp *interp, 43 int objIndex, Tcl_Obj *fileName, 44 Tcl_Obj *attributePtr)); 45 46/* 47 * Constants and variables necessary for file attributes subcommand. 48 */ 49 50enum { 51 WIN_ARCHIVE_ATTRIBUTE, 52 WIN_HIDDEN_ATTRIBUTE, 53 WIN_LONGNAME_ATTRIBUTE, 54 WIN_READONLY_ATTRIBUTE, 55 WIN_SHORTNAME_ATTRIBUTE, 56 WIN_SYSTEM_ATTRIBUTE 57}; 58 59static int attributeArray[] = {FILE_ATTRIBUTE_ARCHIVE, FILE_ATTRIBUTE_HIDDEN, 60 0, FILE_ATTRIBUTE_READONLY, 0, FILE_ATTRIBUTE_SYSTEM}; 61 62 63CONST char *tclpFileAttrStrings[] = { 64 "-archive", "-hidden", "-longname", "-readonly", 65 "-shortname", "-system", (char *) NULL 66}; 67 68CONST TclFileAttrProcs tclpFileAttrProcs[] = { 69 {GetWinFileAttributes, SetWinFileAttributes}, 70 {GetWinFileAttributes, SetWinFileAttributes}, 71 {GetWinFileLongName, CannotSetAttribute}, 72 {GetWinFileAttributes, SetWinFileAttributes}, 73 {GetWinFileShortName, CannotSetAttribute}, 74 {GetWinFileAttributes, SetWinFileAttributes}}; 75 76#ifdef HAVE_NO_SEH 77 78/* 79 * Unlike Borland and Microsoft, we don't register exception handlers 80 * by pushing registration records onto the runtime stack. Instead, we 81 * register them by creating an EXCEPTION_REGISTRATION within the activation 82 * record. 83 */ 84 85typedef struct EXCEPTION_REGISTRATION { 86 struct EXCEPTION_REGISTRATION* link; 87 EXCEPTION_DISPOSITION (*handler)( struct _EXCEPTION_RECORD*, void*, 88 struct _CONTEXT*, void* ); 89 void* ebp; 90 void* esp; 91 int status; 92} EXCEPTION_REGISTRATION; 93 94#endif 95 96/* 97 * Prototype for the TraverseWinTree callback function. 98 */ 99 100typedef int (TraversalProc)(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr, 101 int type, Tcl_DString *errorPtr); 102 103/* 104 * Declarations for local procedures defined in this file: 105 */ 106 107static void StatError(Tcl_Interp *interp, Tcl_Obj *fileName); 108static int ConvertFileNameFormat(Tcl_Interp *interp, 109 int objIndex, Tcl_Obj *fileName, int longShort, 110 Tcl_Obj **attributePtrPtr); 111static int DoCopyFile(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr); 112static int DoCreateDirectory(CONST TCHAR *pathPtr); 113static int DoRemoveJustDirectory(CONST TCHAR *nativeSrc, 114 int ignoreError, Tcl_DString *errorPtr); 115static int DoRemoveDirectory(Tcl_DString *pathPtr, int recursive, 116 Tcl_DString *errorPtr); 117static int DoRenameFile(CONST TCHAR *nativeSrc, CONST TCHAR *dstPtr); 118static int TraversalCopy(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr, 119 int type, Tcl_DString *errorPtr); 120static int TraversalDelete(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr, 121 int type, Tcl_DString *errorPtr); 122static int TraverseWinTree(TraversalProc *traverseProc, 123 Tcl_DString *sourcePtr, Tcl_DString *dstPtr, 124 Tcl_DString *errorPtr); 125 126 127/* 128 *--------------------------------------------------------------------------- 129 * 130 * TclpObjRenameFile, DoRenameFile -- 131 * 132 * Changes the name of an existing file or directory, from src to dst. 133 * If src and dst refer to the same file or directory, does nothing 134 * and returns success. Otherwise if dst already exists, it will be 135 * deleted and replaced by src subject to the following conditions: 136 * If src is a directory, dst may be an empty directory. 137 * If src is a file, dst may be a file. 138 * In any other situation where dst already exists, the rename will 139 * fail. 140 * 141 * Results: 142 * If the file or directory was successfully renamed, returns TCL_OK. 143 * Otherwise the return value is TCL_ERROR and errno is set to 144 * indicate the error. Some possible values for errno are: 145 * 146 * ENAMETOOLONG: src or dst names are too long. 147 * EACCES: src or dst parent directory can't be read and/or written. 148 * EEXIST: dst is a non-empty directory. 149 * EINVAL: src is a root directory or dst is a subdirectory of src. 150 * EISDIR: dst is a directory, but src is not. 151 * ENOENT: src doesn't exist. src or dst is "". 152 * ENOTDIR: src is a directory, but dst is not. 153 * EXDEV: src and dst are on different filesystems. 154 * 155 * EACCES: exists an open file already referring to src or dst. 156 * EACCES: src or dst specify the current working directory (NT). 157 * EACCES: src specifies a char device (nul:, com1:, etc.) 158 * EEXIST: dst specifies a char device (nul:, com1:, etc.) (NT) 159 * EACCES: dst specifies a char device (nul:, com1:, etc.) (95) 160 * 161 * Side effects: 162 * The implementation supports cross-filesystem renames of files, 163 * but the caller should be prepared to emulate cross-filesystem 164 * renames of directories if errno is EXDEV. 165 * 166 *--------------------------------------------------------------------------- 167 */ 168 169int 170TclpObjRenameFile(srcPathPtr, destPathPtr) 171 Tcl_Obj *srcPathPtr; 172 Tcl_Obj *destPathPtr; 173{ 174 return DoRenameFile(Tcl_FSGetNativePath(srcPathPtr), 175 Tcl_FSGetNativePath(destPathPtr)); 176} 177 178static int 179DoRenameFile( 180 CONST TCHAR *nativeSrc, /* Pathname of file or dir to be renamed 181 * (native). */ 182 CONST TCHAR *nativeDst) /* New pathname for file or directory 183 * (native). */ 184{ 185#ifdef HAVE_NO_SEH 186 EXCEPTION_REGISTRATION registration; 187#endif 188 DWORD srcAttr, dstAttr; 189 int retval = -1; 190 191 /* 192 * The MoveFile API acts differently under Win95/98 and NT 193 * WRT NULL and "". Avoid passing these values. 194 */ 195 196 if (nativeSrc == NULL || nativeSrc[0] == '\0' || 197 nativeDst == NULL || nativeDst[0] == '\0') { 198 Tcl_SetErrno(ENOENT); 199 return TCL_ERROR; 200 } 201 202 /* 203 * The MoveFile API would throw an exception under NT 204 * if one of the arguments is a char block device. 205 */ 206 207#ifndef HAVE_NO_SEH 208 __try { 209 if ((*tclWinProcs->moveFileProc)(nativeSrc, nativeDst) != FALSE) { 210 retval = TCL_OK; 211 } 212 } __except (EXCEPTION_EXECUTE_HANDLER) {} 213#else 214 215 /* 216 * Don't have SEH available, do things the hard way. 217 * Note that this needs to be one block of asm, to avoid stack 218 * imbalance; also, it is illegal for one asm block to contain 219 * a jump to another. 220 */ 221 222 __asm__ __volatile__ ( 223 /* 224 * Pick up params before messing with the stack */ 225 226 "movl %[nativeDst], %%ebx" "\n\t" 227 "movl %[nativeSrc], %%ecx" "\n\t" 228 229 /* 230 * Construct an EXCEPTION_REGISTRATION to protect the 231 * call to MoveFile 232 */ 233 "leal %[registration], %%edx" "\n\t" 234 "movl %%fs:0, %%eax" "\n\t" 235 "movl %%eax, 0x0(%%edx)" "\n\t" /* link */ 236 "leal 1f, %%eax" "\n\t" 237 "movl %%eax, 0x4(%%edx)" "\n\t" /* handler */ 238 "movl %%ebp, 0x8(%%edx)" "\n\t" /* ebp */ 239 "movl %%esp, 0xc(%%edx)" "\n\t" /* esp */ 240 "movl $0, 0x10(%%edx)" "\n\t" /* status */ 241 242 /* Link the EXCEPTION_REGISTRATION on the chain */ 243 244 "movl %%edx, %%fs:0" "\n\t" 245 246 /* Call MoveFile( nativeSrc, nativeDst ) */ 247 248 "pushl %%ebx" "\n\t" 249 "pushl %%ecx" "\n\t" 250 "movl %[moveFile], %%eax" "\n\t" 251 "call *%%eax" "\n\t" 252 253 /* 254 * Come here on normal exit. Recover the EXCEPTION_REGISTRATION 255 * and put the status return from MoveFile into it. 256 */ 257 258 "movl %%fs:0, %%edx" "\n\t" 259 "movl %%eax, 0x10(%%edx)" "\n\t" 260 "jmp 2f" "\n" 261 262 /* 263 * Come here on an exception. Recover the EXCEPTION_REGISTRATION 264 */ 265 266 "1:" "\t" 267 "movl %%fs:0, %%edx" "\n\t" 268 "movl 0x8(%%edx), %%edx" "\n\t" 269 270 /* 271 * Come here however we exited. Restore context from the 272 * EXCEPTION_REGISTRATION in case the stack is unbalanced. 273 */ 274 275 "2:" "\t" 276 "movl 0xc(%%edx), %%esp" "\n\t" 277 "movl 0x8(%%edx), %%ebp" "\n\t" 278 "movl 0x0(%%edx), %%eax" "\n\t" 279 "movl %%eax, %%fs:0" "\n\t" 280 281 : 282 /* No outputs */ 283 : 284 [registration] "m" (registration), 285 [nativeDst] "m" (nativeDst), 286 [nativeSrc] "m" (nativeSrc), 287 [moveFile] "r" (tclWinProcs->moveFileProc) 288 : 289 "%eax", "%ebx", "%ecx", "%edx", "memory" 290 ); 291 if (registration.status != FALSE) { 292 retval = TCL_OK; 293 } 294#endif 295 296 if (retval != -1) 297 return retval; 298 299 TclWinConvertError(GetLastError()); 300 301 srcAttr = (*tclWinProcs->getFileAttributesProc)(nativeSrc); 302 dstAttr = (*tclWinProcs->getFileAttributesProc)(nativeDst); 303 if (srcAttr == 0xffffffff) { 304 if ((*tclWinProcs->getFullPathNameProc)(nativeSrc, 0, NULL, NULL) >= MAX_PATH) { 305 errno = ENAMETOOLONG; 306 return TCL_ERROR; 307 } 308 srcAttr = 0; 309 } 310 if (dstAttr == 0xffffffff) { 311 if ((*tclWinProcs->getFullPathNameProc)(nativeDst, 0, NULL, NULL) >= MAX_PATH) { 312 errno = ENAMETOOLONG; 313 return TCL_ERROR; 314 } 315 dstAttr = 0; 316 } 317 318 if (errno == EBADF) { 319 errno = EACCES; 320 return TCL_ERROR; 321 } 322 if (errno == EACCES) { 323 decode: 324 if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) { 325 TCHAR *nativeSrcRest, *nativeDstRest; 326 CONST char **srcArgv, **dstArgv; 327 int size, srcArgc, dstArgc; 328 WCHAR nativeSrcPath[MAX_PATH]; 329 WCHAR nativeDstPath[MAX_PATH]; 330 Tcl_DString srcString, dstString; 331 CONST char *src, *dst; 332 333 size = (*tclWinProcs->getFullPathNameProc)(nativeSrc, MAX_PATH, 334 nativeSrcPath, &nativeSrcRest); 335 if ((size == 0) || (size > MAX_PATH)) { 336 return TCL_ERROR; 337 } 338 size = (*tclWinProcs->getFullPathNameProc)(nativeDst, MAX_PATH, 339 nativeDstPath, &nativeDstRest); 340 if ((size == 0) || (size > MAX_PATH)) { 341 return TCL_ERROR; 342 } 343 (*tclWinProcs->charLowerProc)((TCHAR *) nativeSrcPath); 344 (*tclWinProcs->charLowerProc)((TCHAR *) nativeDstPath); 345 346 src = Tcl_WinTCharToUtf((TCHAR *) nativeSrcPath, -1, &srcString); 347 dst = Tcl_WinTCharToUtf((TCHAR *) nativeDstPath, -1, &dstString); 348 if (strncmp(src, dst, (size_t) Tcl_DStringLength(&srcString)) == 0) { 349 /* 350 * Trying to move a directory into itself. 351 */ 352 353 errno = EINVAL; 354 Tcl_DStringFree(&srcString); 355 Tcl_DStringFree(&dstString); 356 return TCL_ERROR; 357 } 358 Tcl_SplitPath(src, &srcArgc, &srcArgv); 359 Tcl_SplitPath(dst, &dstArgc, &dstArgv); 360 Tcl_DStringFree(&srcString); 361 Tcl_DStringFree(&dstString); 362 363 if (srcArgc == 1) { 364 /* 365 * They are trying to move a root directory. Whether 366 * or not it is across filesystems, this cannot be 367 * done. 368 */ 369 370 Tcl_SetErrno(EINVAL); 371 } else if ((srcArgc > 0) && (dstArgc > 0) && 372 (strcmp(srcArgv[0], dstArgv[0]) != 0)) { 373 /* 374 * If src is a directory and dst filesystem != src 375 * filesystem, errno should be EXDEV. It is very 376 * important to get this behavior, so that the caller 377 * can respond to a cross filesystem rename by 378 * simulating it with copy and delete. The MoveFile 379 * system call already handles the case of moving a 380 * file between filesystems. 381 */ 382 383 Tcl_SetErrno(EXDEV); 384 } 385 386 ckfree((char *) srcArgv); 387 ckfree((char *) dstArgv); 388 } 389 390 /* 391 * Other types of access failure is that dst is a read-only 392 * filesystem, that an open file referred to src or dest, or that 393 * src or dest specified the current working directory on the 394 * current filesystem. EACCES is returned for those cases. 395 */ 396 397 } else if (Tcl_GetErrno() == EEXIST) { 398 /* 399 * Reports EEXIST any time the target already exists. If it makes 400 * sense, remove the old file and try renaming again. 401 */ 402 403 if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) { 404 if (dstAttr & FILE_ATTRIBUTE_DIRECTORY) { 405 /* 406 * Overwrite empty dst directory with src directory. The 407 * following call will remove an empty directory. If it 408 * fails, it's because it wasn't empty. 409 */ 410 411 if (DoRemoveJustDirectory(nativeDst, 0, NULL) == TCL_OK) { 412 /* 413 * Now that that empty directory is gone, we can try 414 * renaming again. If that fails, we'll put this empty 415 * directory back, for completeness. 416 */ 417 418 if ((*tclWinProcs->moveFileProc)(nativeSrc, nativeDst) != FALSE) { 419 return TCL_OK; 420 } 421 422 /* 423 * Some new error has occurred. Don't know what it 424 * could be, but report this one. 425 */ 426 427 TclWinConvertError(GetLastError()); 428 (*tclWinProcs->createDirectoryProc)(nativeDst, NULL); 429 (*tclWinProcs->setFileAttributesProc)(nativeDst, dstAttr); 430 if (Tcl_GetErrno() == EACCES) { 431 /* 432 * Decode the EACCES to a more meaningful error. 433 */ 434 435 goto decode; 436 } 437 } 438 } else { /* (dstAttr & FILE_ATTRIBUTE_DIRECTORY) == 0 */ 439 Tcl_SetErrno(ENOTDIR); 440 } 441 } else { /* (srcAttr & FILE_ATTRIBUTE_DIRECTORY) == 0 */ 442 if (dstAttr & FILE_ATTRIBUTE_DIRECTORY) { 443 Tcl_SetErrno(EISDIR); 444 } else { 445 /* 446 * Overwrite existing file by: 447 * 448 * 1. Rename existing file to temp name. 449 * 2. Rename old file to new name. 450 * 3. If success, delete temp file. If failure, 451 * put temp file back to old name. 452 */ 453 454 TCHAR *nativeRest, *nativeTmp, *nativePrefix; 455 int result, size; 456 WCHAR tempBuf[MAX_PATH]; 457 458 size = (*tclWinProcs->getFullPathNameProc)(nativeDst, MAX_PATH, 459 tempBuf, &nativeRest); 460 if ((size == 0) || (size > MAX_PATH) || (nativeRest == NULL)) { 461 return TCL_ERROR; 462 } 463 nativeTmp = (TCHAR *) tempBuf; 464 ((char *) nativeRest)[0] = '\0'; 465 ((char *) nativeRest)[1] = '\0'; /* In case it's Unicode. */ 466 467 result = TCL_ERROR; 468 nativePrefix = (tclWinProcs->useWide) 469 ? (TCHAR *) L"tclr" : (TCHAR *) "tclr"; 470 if ((*tclWinProcs->getTempFileNameProc)(nativeTmp, 471 nativePrefix, 0, tempBuf) != 0) { 472 /* 473 * Strictly speaking, need the following DeleteFile and 474 * MoveFile to be joined as an atomic operation so no 475 * other app comes along in the meantime and creates the 476 * same temp file. 477 */ 478 479 nativeTmp = (TCHAR *) tempBuf; 480 (*tclWinProcs->deleteFileProc)(nativeTmp); 481 if ((*tclWinProcs->moveFileProc)(nativeDst, nativeTmp) != FALSE) { 482 if ((*tclWinProcs->moveFileProc)(nativeSrc, nativeDst) != FALSE) { 483 (*tclWinProcs->setFileAttributesProc)(nativeTmp, 484 FILE_ATTRIBUTE_NORMAL); 485 (*tclWinProcs->deleteFileProc)(nativeTmp); 486 return TCL_OK; 487 } else { 488 (*tclWinProcs->deleteFileProc)(nativeDst); 489 (*tclWinProcs->moveFileProc)(nativeTmp, nativeDst); 490 } 491 } 492 493 /* 494 * Can't backup dst file or move src file. Return that 495 * error. Could happen if an open file refers to dst. 496 */ 497 498 TclWinConvertError(GetLastError()); 499 if (Tcl_GetErrno() == EACCES) { 500 /* 501 * Decode the EACCES to a more meaningful error. 502 */ 503 504 goto decode; 505 } 506 } 507 return result; 508 } 509 } 510 } 511 return TCL_ERROR; 512} 513 514/* 515 *--------------------------------------------------------------------------- 516 * 517 * TclpObjCopyFile, DoCopyFile -- 518 * 519 * Copy a single file (not a directory). If dst already exists and 520 * is not a directory, it is removed. 521 * 522 * Results: 523 * If the file was successfully copied, returns TCL_OK. Otherwise 524 * the return value is TCL_ERROR and errno is set to indicate the 525 * error. Some possible values for errno are: 526 * 527 * EACCES: src or dst parent directory can't be read and/or written. 528 * EISDIR: src or dst is a directory. 529 * ENOENT: src doesn't exist. src or dst is "". 530 * 531 * EACCES: exists an open file already referring to dst (95). 532 * EACCES: src specifies a char device (nul:, com1:, etc.) (NT) 533 * ENOENT: src specifies a char device (nul:, com1:, etc.) (95) 534 * 535 * Side effects: 536 * It is not an error to copy to a char device. 537 * 538 *--------------------------------------------------------------------------- 539 */ 540 541int 542TclpObjCopyFile(srcPathPtr, destPathPtr) 543 Tcl_Obj *srcPathPtr; 544 Tcl_Obj *destPathPtr; 545{ 546 return DoCopyFile(Tcl_FSGetNativePath(srcPathPtr), 547 Tcl_FSGetNativePath(destPathPtr)); 548} 549 550static int 551DoCopyFile( 552 CONST TCHAR *nativeSrc, /* Pathname of file to be copied (native). */ 553 CONST TCHAR *nativeDst) /* Pathname of file to copy to (native). */ 554{ 555#ifdef HAVE_NO_SEH 556 EXCEPTION_REGISTRATION registration; 557#endif 558 int retval = -1; 559 560 /* 561 * The CopyFile API acts differently under Win95/98 and NT 562 * WRT NULL and "". Avoid passing these values. 563 */ 564 565 if (nativeSrc == NULL || nativeSrc[0] == '\0' || 566 nativeDst == NULL || nativeDst[0] == '\0') { 567 Tcl_SetErrno(ENOENT); 568 return TCL_ERROR; 569 } 570 571 /* 572 * The CopyFile API would throw an exception under NT if one 573 * of the arguments is a char block device. 574 */ 575 576#ifndef HAVE_NO_SEH 577 __try { 578 if ((*tclWinProcs->copyFileProc)(nativeSrc, nativeDst, 0) != FALSE) { 579 retval = TCL_OK; 580 } 581 } __except (EXCEPTION_EXECUTE_HANDLER) {} 582#else 583 584 /* 585 * Don't have SEH available, do things the hard way. 586 * Note that this needs to be one block of asm, to avoid stack 587 * imbalance; also, it is illegal for one asm block to contain 588 * a jump to another. 589 */ 590 591 __asm__ __volatile__ ( 592 593 /* 594 * Pick up parameters before messing with the stack 595 */ 596 597 "movl %[nativeDst], %%ebx" "\n\t" 598 "movl %[nativeSrc], %%ecx" "\n\t" 599 /* 600 * Construct an EXCEPTION_REGISTRATION to protect the 601 * call to CopyFile 602 */ 603 "leal %[registration], %%edx" "\n\t" 604 "movl %%fs:0, %%eax" "\n\t" 605 "movl %%eax, 0x0(%%edx)" "\n\t" /* link */ 606 "leal 1f, %%eax" "\n\t" 607 "movl %%eax, 0x4(%%edx)" "\n\t" /* handler */ 608 "movl %%ebp, 0x8(%%edx)" "\n\t" /* ebp */ 609 "movl %%esp, 0xc(%%edx)" "\n\t" /* esp */ 610 "movl $0, 0x10(%%edx)" "\n\t" /* status */ 611 612 /* Link the EXCEPTION_REGISTRATION on the chain */ 613 614 "movl %%edx, %%fs:0" "\n\t" 615 616 /* Call CopyFile( nativeSrc, nativeDst, 0 ) */ 617 618 "movl %[copyFile], %%eax" "\n\t" 619 "pushl $0" "\n\t" 620 "pushl %%ebx" "\n\t" 621 "pushl %%ecx" "\n\t" 622 "call *%%eax" "\n\t" 623 624 /* 625 * Come here on normal exit. Recover the EXCEPTION_REGISTRATION 626 * and put the status return from CopyFile into it. 627 */ 628 629 "movl %%fs:0, %%edx" "\n\t" 630 "movl %%eax, 0x10(%%edx)" "\n\t" 631 "jmp 2f" "\n" 632 633 /* 634 * Come here on an exception. Recover the EXCEPTION_REGISTRATION 635 */ 636 637 "1:" "\t" 638 "movl %%fs:0, %%edx" "\n\t" 639 "movl 0x8(%%edx), %%edx" "\n\t" 640 641 /* 642 * Come here however we exited. Restore context from the 643 * EXCEPTION_REGISTRATION in case the stack is unbalanced. 644 */ 645 646 "2:" "\t" 647 "movl 0xc(%%edx), %%esp" "\n\t" 648 "movl 0x8(%%edx), %%ebp" "\n\t" 649 "movl 0x0(%%edx), %%eax" "\n\t" 650 "movl %%eax, %%fs:0" "\n\t" 651 652 : 653 /* No outputs */ 654 : 655 [registration] "m" (registration), 656 [nativeDst] "m" (nativeDst), 657 [nativeSrc] "m" (nativeSrc), 658 [copyFile] "r" (tclWinProcs->copyFileProc) 659 : 660 "%eax", "%ebx", "%ecx", "%edx", "memory" 661 ); 662 if (registration.status != FALSE) { 663 retval = TCL_OK; 664 } 665#endif 666 667 if (retval != -1) 668 return retval; 669 670 TclWinConvertError(GetLastError()); 671 if (Tcl_GetErrno() == EBADF) { 672 Tcl_SetErrno(EACCES); 673 return TCL_ERROR; 674 } 675 if (Tcl_GetErrno() == EACCES) { 676 DWORD srcAttr, dstAttr; 677 678 srcAttr = (*tclWinProcs->getFileAttributesProc)(nativeSrc); 679 dstAttr = (*tclWinProcs->getFileAttributesProc)(nativeDst); 680 if (srcAttr != 0xffffffff) { 681 if (dstAttr == 0xffffffff) { 682 dstAttr = 0; 683 } 684 if ((srcAttr & FILE_ATTRIBUTE_DIRECTORY) || 685 (dstAttr & FILE_ATTRIBUTE_DIRECTORY)) { 686 if (srcAttr & FILE_ATTRIBUTE_REPARSE_POINT) { 687 /* Source is a symbolic link -- copy it */ 688 if (TclWinSymLinkCopyDirectory(nativeSrc, nativeDst) == 0) { 689 return TCL_OK; 690 } 691 } 692 Tcl_SetErrno(EISDIR); 693 } 694 if (dstAttr & FILE_ATTRIBUTE_READONLY) { 695 (*tclWinProcs->setFileAttributesProc)(nativeDst, 696 dstAttr & ~((DWORD)FILE_ATTRIBUTE_READONLY)); 697 if ((*tclWinProcs->copyFileProc)(nativeSrc, nativeDst, 0) != FALSE) { 698 return TCL_OK; 699 } 700 /* 701 * Still can't copy onto dst. Return that error, and 702 * restore attributes of dst. 703 */ 704 705 TclWinConvertError(GetLastError()); 706 (*tclWinProcs->setFileAttributesProc)(nativeDst, dstAttr); 707 } 708 } 709 } 710 return TCL_ERROR; 711} 712 713/* 714 *--------------------------------------------------------------------------- 715 * 716 * TclpObjDeleteFile, TclpDeleteFile -- 717 * 718 * Removes a single file (not a directory). 719 * 720 * Results: 721 * If the file was successfully deleted, returns TCL_OK. Otherwise 722 * the return value is TCL_ERROR and errno is set to indicate the 723 * error. Some possible values for errno are: 724 * 725 * EACCES: a parent directory can't be read and/or written. 726 * EISDIR: path is a directory. 727 * ENOENT: path doesn't exist or is "". 728 * 729 * EACCES: exists an open file already referring to path. 730 * EACCES: path is a char device (nul:, com1:, etc.) 731 * 732 * Side effects: 733 * The file is deleted, even if it is read-only. 734 * 735 *--------------------------------------------------------------------------- 736 */ 737 738int 739TclpObjDeleteFile(pathPtr) 740 Tcl_Obj *pathPtr; 741{ 742 return TclpDeleteFile(Tcl_FSGetNativePath(pathPtr)); 743} 744 745int 746TclpDeleteFile( 747 CONST TCHAR *nativePath) /* Pathname of file to be removed (native). */ 748{ 749 DWORD attr; 750 751 /* 752 * The DeleteFile API acts differently under Win95/98 and NT 753 * WRT NULL and "". Avoid passing these values. 754 */ 755 756 if (nativePath == NULL || nativePath[0] == '\0') { 757 Tcl_SetErrno(ENOENT); 758 return TCL_ERROR; 759 } 760 761 if ((*tclWinProcs->deleteFileProc)(nativePath) != FALSE) { 762 return TCL_OK; 763 } 764 TclWinConvertError(GetLastError()); 765 766 if (Tcl_GetErrno() == EACCES) { 767 attr = (*tclWinProcs->getFileAttributesProc)(nativePath); 768 if (attr != 0xffffffff) { 769 if (attr & FILE_ATTRIBUTE_DIRECTORY) { 770 if (attr & FILE_ATTRIBUTE_REPARSE_POINT) { 771 /* It is a symbolic link -- remove it */ 772 if (TclWinSymLinkDelete(nativePath, 0) == 0) { 773 return TCL_OK; 774 } 775 } 776 777 /* 778 * If we fall through here, it is a directory. 779 * 780 * Windows NT reports removing a directory as EACCES instead 781 * of EISDIR. 782 */ 783 784 Tcl_SetErrno(EISDIR); 785 } else if (attr & FILE_ATTRIBUTE_READONLY) { 786 int res = (*tclWinProcs->setFileAttributesProc)(nativePath, 787 attr & ~((DWORD)FILE_ATTRIBUTE_READONLY)); 788 if ((res != 0) && ((*tclWinProcs->deleteFileProc)(nativePath) 789 != FALSE)) { 790 return TCL_OK; 791 } 792 TclWinConvertError(GetLastError()); 793 if (res != 0) { 794 (*tclWinProcs->setFileAttributesProc)(nativePath, attr); 795 } 796 } 797 } 798 } else if (Tcl_GetErrno() == ENOENT) { 799 attr = (*tclWinProcs->getFileAttributesProc)(nativePath); 800 if (attr != 0xffffffff) { 801 if (attr & FILE_ATTRIBUTE_DIRECTORY) { 802 /* 803 * Windows 95 reports removing a directory as ENOENT instead 804 * of EISDIR. 805 */ 806 807 Tcl_SetErrno(EISDIR); 808 } 809 } 810 } else if (Tcl_GetErrno() == EINVAL) { 811 /* 812 * Windows NT reports removing a char device as EINVAL instead of 813 * EACCES. 814 */ 815 816 Tcl_SetErrno(EACCES); 817 } 818 819 return TCL_ERROR; 820} 821 822/* 823 *--------------------------------------------------------------------------- 824 * 825 * TclpObjCreateDirectory -- 826 * 827 * Creates the specified directory. All parent directories of the 828 * specified directory must already exist. The directory is 829 * automatically created with permissions so that user can access 830 * the new directory and create new files or subdirectories in it. 831 * 832 * Results: 833 * If the directory was successfully created, returns TCL_OK. 834 * Otherwise the return value is TCL_ERROR and errno is set to 835 * indicate the error. Some possible values for errno are: 836 * 837 * EACCES: a parent directory can't be read and/or written. 838 * EEXIST: path already exists. 839 * ENOENT: a parent directory doesn't exist. 840 * 841 * Side effects: 842 * A directory is created. 843 * 844 *--------------------------------------------------------------------------- 845 */ 846 847int 848TclpObjCreateDirectory(pathPtr) 849 Tcl_Obj *pathPtr; 850{ 851 return DoCreateDirectory(Tcl_FSGetNativePath(pathPtr)); 852} 853 854static int 855DoCreateDirectory( 856 CONST TCHAR *nativePath) /* Pathname of directory to create (native). */ 857{ 858 DWORD error; 859 if ((*tclWinProcs->createDirectoryProc)(nativePath, NULL) == 0) { 860 error = GetLastError(); 861 TclWinConvertError(error); 862 return TCL_ERROR; 863 } 864 return TCL_OK; 865} 866 867/* 868 *--------------------------------------------------------------------------- 869 * 870 * TclpObjCopyDirectory -- 871 * 872 * Recursively copies a directory. The target directory dst must 873 * not already exist. Note that this function does not merge two 874 * directory hierarchies, even if the target directory is an an 875 * empty directory. 876 * 877 * Results: 878 * If the directory was successfully copied, returns TCL_OK. 879 * Otherwise the return value is TCL_ERROR, errno is set to indicate 880 * the error, and the pathname of the file that caused the error 881 * is stored in errorPtr. See TclpCreateDirectory and TclpCopyFile 882 * for a description of possible values for errno. 883 * 884 * Side effects: 885 * An exact copy of the directory hierarchy src will be created 886 * with the name dst. If an error occurs, the error will 887 * be returned immediately, and remaining files will not be 888 * processed. 889 * 890 *--------------------------------------------------------------------------- 891 */ 892 893int 894TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr) 895 Tcl_Obj *srcPathPtr; 896 Tcl_Obj *destPathPtr; 897 Tcl_Obj **errorPtr; 898{ 899 Tcl_DString ds; 900 Tcl_DString srcString, dstString; 901 Tcl_Obj *normSrcPtr, *normDestPtr; 902 int ret; 903 904 normSrcPtr = Tcl_FSGetNormalizedPath(NULL,srcPathPtr); 905 if (normSrcPtr == NULL) { 906 return TCL_ERROR; 907 } 908 Tcl_WinUtfToTChar(Tcl_GetString(normSrcPtr), -1, &srcString); 909 normDestPtr = Tcl_FSGetNormalizedPath(NULL,destPathPtr); 910 if (normDestPtr == NULL) { 911 return TCL_ERROR; 912 } 913 Tcl_WinUtfToTChar(Tcl_GetString(normDestPtr), -1, &dstString); 914 915 ret = TraverseWinTree(TraversalCopy, &srcString, &dstString, &ds); 916 917 Tcl_DStringFree(&srcString); 918 Tcl_DStringFree(&dstString); 919 920 if (ret != TCL_OK) { 921 if (!strcmp(Tcl_DStringValue(&ds), Tcl_GetString(normSrcPtr))) { 922 *errorPtr = srcPathPtr; 923 } else if (!strcmp(Tcl_DStringValue(&ds), Tcl_GetString(normDestPtr))) { 924 *errorPtr = destPathPtr; 925 } else { 926 *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); 927 } 928 Tcl_DStringFree(&ds); 929 Tcl_IncrRefCount(*errorPtr); 930 } 931 return ret; 932} 933 934/* 935 *---------------------------------------------------------------------- 936 * 937 * TclpObjRemoveDirectory, DoRemoveDirectory -- 938 * 939 * Removes directory (and its contents, if the recursive flag is set). 940 * 941 * Results: 942 * If the directory was successfully removed, returns TCL_OK. 943 * Otherwise the return value is TCL_ERROR, errno is set to indicate 944 * the error, and the pathname of the file that caused the error 945 * is stored in errorPtr. Some possible values for errno are: 946 * 947 * EACCES: path directory can't be read and/or written. 948 * EEXIST: path is a non-empty directory. 949 * EINVAL: path is root directory or current directory. 950 * ENOENT: path doesn't exist or is "". 951 * ENOTDIR: path is not a directory. 952 * 953 * EACCES: path is a char device (nul:, com1:, etc.) (95) 954 * EINVAL: path is a char device (nul:, com1:, etc.) (NT) 955 * 956 * Side effects: 957 * Directory removed. If an error occurs, the error will be returned 958 * immediately, and remaining files will not be deleted. 959 * 960 *---------------------------------------------------------------------- 961 */ 962 963int 964TclpObjRemoveDirectory(pathPtr, recursive, errorPtr) 965 Tcl_Obj *pathPtr; 966 int recursive; 967 Tcl_Obj **errorPtr; 968{ 969 Tcl_DString ds; 970 Tcl_Obj *normPtr = NULL; 971 int ret; 972 if (recursive) { 973 /* 974 * In the recursive case, the string rep is used to construct a 975 * Tcl_DString which may be used extensively, so we can't 976 * optimize this case easily. 977 */ 978 Tcl_DString native; 979 normPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr); 980 if (normPtr == NULL) { 981 return TCL_ERROR; 982 } 983 Tcl_WinUtfToTChar(Tcl_GetString(normPtr), -1, &native); 984 ret = DoRemoveDirectory(&native, recursive, &ds); 985 Tcl_DStringFree(&native); 986 } else { 987 ret = DoRemoveJustDirectory(Tcl_FSGetNativePath(pathPtr), 988 0, &ds); 989 } 990 if (ret != TCL_OK) { 991 int len = Tcl_DStringLength(&ds); 992 if (len > 0) { 993 if (normPtr != NULL 994 && !strcmp(Tcl_DStringValue(&ds), Tcl_GetString(normPtr))) { 995 *errorPtr = pathPtr; 996 } else { 997 *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); 998 } 999 Tcl_IncrRefCount(*errorPtr); 1000 } 1001 Tcl_DStringFree(&ds); 1002 } 1003 return ret; 1004} 1005 1006static int 1007DoRemoveJustDirectory( 1008 CONST TCHAR *nativePath, /* Pathname of directory to be removed 1009 * (native). */ 1010 int ignoreError, /* If non-zero, don't initialize the 1011 * errorPtr under some circumstances 1012 * on return. */ 1013 Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free 1014 * DString filled with UTF-8 name of file 1015 * causing error. */ 1016{ 1017 /* 1018 * The RemoveDirectory API acts differently under Win95/98 and NT 1019 * WRT NULL and "". Avoid passing these values. 1020 */ 1021 1022 if (nativePath == NULL || nativePath[0] == '\0') { 1023 Tcl_SetErrno(ENOENT); 1024 goto end; 1025 } 1026 1027 if ((*tclWinProcs->removeDirectoryProc)(nativePath) != FALSE) { 1028 return TCL_OK; 1029 } 1030 TclWinConvertError(GetLastError()); 1031 1032 if (Tcl_GetErrno() == EACCES) { 1033 DWORD attr = (*tclWinProcs->getFileAttributesProc)(nativePath); 1034 if (attr != 0xffffffff) { 1035 if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) { 1036 /* 1037 * Windows 95 reports calling RemoveDirectory on a file as an 1038 * EACCES, not an ENOTDIR. 1039 */ 1040 1041 Tcl_SetErrno(ENOTDIR); 1042 goto end; 1043 } 1044 1045 if (attr & FILE_ATTRIBUTE_REPARSE_POINT) { 1046 /* It is a symbolic link -- remove it */ 1047 if (TclWinSymLinkDelete(nativePath, 1) != 0) { 1048 goto end; 1049 } 1050 } 1051 1052 if (attr & FILE_ATTRIBUTE_READONLY) { 1053 attr &= ~FILE_ATTRIBUTE_READONLY; 1054 if ((*tclWinProcs->setFileAttributesProc)(nativePath, attr) == FALSE) { 1055 goto end; 1056 } 1057 if ((*tclWinProcs->removeDirectoryProc)(nativePath) != FALSE) { 1058 return TCL_OK; 1059 } 1060 TclWinConvertError(GetLastError()); 1061 (*tclWinProcs->setFileAttributesProc)(nativePath, 1062 attr | FILE_ATTRIBUTE_READONLY); 1063 } 1064 1065 /* 1066 * Windows 95 and Win32s report removing a non-empty directory 1067 * as EACCES, not EEXIST. If the directory is not empty, 1068 * change errno so caller knows what's going on. 1069 */ 1070 1071 if (TclWinGetPlatformId() != VER_PLATFORM_WIN32_NT) { 1072 CONST char *path, *find; 1073 HANDLE handle; 1074 WIN32_FIND_DATAA data; 1075 Tcl_DString buffer; 1076 int len; 1077 1078 path = (CONST char *) nativePath; 1079 1080 Tcl_DStringInit(&buffer); 1081 len = strlen(path); 1082 find = Tcl_DStringAppend(&buffer, path, len); 1083 if ((len > 0) && (find[len - 1] != '\\')) { 1084 Tcl_DStringAppend(&buffer, "\\", 1); 1085 } 1086 find = Tcl_DStringAppend(&buffer, "*.*", 3); 1087 handle = FindFirstFileA(find, &data); 1088 if (handle != INVALID_HANDLE_VALUE) { 1089 while (1) { 1090 if ((strcmp(data.cFileName, ".") != 0) 1091 && (strcmp(data.cFileName, "..") != 0)) { 1092 /* 1093 * Found something in this directory. 1094 */ 1095 1096 Tcl_SetErrno(EEXIST); 1097 break; 1098 } 1099 if (FindNextFileA(handle, &data) == FALSE) { 1100 break; 1101 } 1102 } 1103 FindClose(handle); 1104 } 1105 Tcl_DStringFree(&buffer); 1106 } 1107 } 1108 } 1109 if (Tcl_GetErrno() == ENOTEMPTY) { 1110 /* 1111 * The caller depends on EEXIST to signify that the directory is 1112 * not empty, not ENOTEMPTY. 1113 */ 1114 1115 Tcl_SetErrno(EEXIST); 1116 } 1117 if ((ignoreError != 0) && (Tcl_GetErrno() == EEXIST)) { 1118 /* 1119 * If we're being recursive, this error may actually 1120 * be ok, so we don't want to initialise the errorPtr 1121 * yet. 1122 */ 1123 return TCL_ERROR; 1124 } 1125 1126 end: 1127 if (errorPtr != NULL) { 1128 Tcl_WinTCharToUtf(nativePath, -1, errorPtr); 1129 } 1130 return TCL_ERROR; 1131 1132} 1133 1134static int 1135DoRemoveDirectory( 1136 Tcl_DString *pathPtr, /* Pathname of directory to be removed 1137 * (native). */ 1138 int recursive, /* If non-zero, removes directories that 1139 * are nonempty. Otherwise, will only remove 1140 * empty directories. */ 1141 Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free 1142 * DString filled with UTF-8 name of file 1143 * causing error. */ 1144{ 1145 int res = DoRemoveJustDirectory(Tcl_DStringValue(pathPtr), recursive, 1146 errorPtr); 1147 1148 if ((res == TCL_ERROR) && (recursive != 0) && (Tcl_GetErrno() == EEXIST)) { 1149 /* 1150 * The directory is nonempty, but the recursive flag has been 1151 * specified, so we recursively remove all the files in the directory. 1152 */ 1153 return TraverseWinTree(TraversalDelete, pathPtr, NULL, errorPtr); 1154 } else { 1155 return res; 1156 } 1157} 1158 1159/* 1160 *--------------------------------------------------------------------------- 1161 * 1162 * TraverseWinTree -- 1163 * 1164 * Traverse directory tree specified by sourcePtr, calling the function 1165 * traverseProc for each file and directory encountered. If destPtr 1166 * is non-null, each of name in the sourcePtr directory is appended to 1167 * the directory specified by destPtr and passed as the second argument 1168 * to traverseProc() . 1169 * 1170 * Results: 1171 * Standard Tcl result. 1172 * 1173 * Side effects: 1174 * None caused by TraverseWinTree, however the user specified 1175 * traverseProc() may change state. If an error occurs, the error will 1176 * be returned immediately, and remaining files will not be processed. 1177 * 1178 *--------------------------------------------------------------------------- 1179 */ 1180 1181static int 1182TraverseWinTree( 1183 TraversalProc *traverseProc,/* Function to call for every file and 1184 * directory in source hierarchy. */ 1185 Tcl_DString *sourcePtr, /* Pathname of source directory to be 1186 * traversed (native). */ 1187 Tcl_DString *targetPtr, /* Pathname of directory to traverse in 1188 * parallel with source directory (native), 1189 * may be NULL. */ 1190 Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free 1191 * DString filled with UTF-8 name of file 1192 * causing error. */ 1193{ 1194 DWORD sourceAttr; 1195 TCHAR *nativeSource, *nativeTarget, *nativeErrfile; 1196 int result, found, sourceLen, targetLen, oldSourceLen, oldTargetLen; 1197 HANDLE handle; 1198 WIN32_FIND_DATAT data; 1199 1200 nativeErrfile = NULL; 1201 result = TCL_OK; 1202 oldTargetLen = 0; /* lint. */ 1203 1204 nativeSource = (TCHAR *) Tcl_DStringValue(sourcePtr); 1205 nativeTarget = (TCHAR *) (targetPtr == NULL 1206 ? NULL : Tcl_DStringValue(targetPtr)); 1207 1208 oldSourceLen = Tcl_DStringLength(sourcePtr); 1209 sourceAttr = (*tclWinProcs->getFileAttributesProc)(nativeSource); 1210 if (sourceAttr == 0xffffffff) { 1211 nativeErrfile = nativeSource; 1212 goto end; 1213 } 1214 if ((sourceAttr & FILE_ATTRIBUTE_DIRECTORY) == 0) { 1215 /* 1216 * Process the regular file 1217 */ 1218 1219 return (*traverseProc)(nativeSource, nativeTarget, DOTREE_F, errorPtr); 1220 } 1221 1222 if (tclWinProcs->useWide) { 1223 Tcl_DStringAppend(sourcePtr, (char *) L"\\*.*", 4 * sizeof(WCHAR) + 1); 1224 Tcl_DStringSetLength(sourcePtr, Tcl_DStringLength(sourcePtr) - 1); 1225 } else { 1226 Tcl_DStringAppend(sourcePtr, "\\*.*", 4); 1227 } 1228 nativeSource = (TCHAR *) Tcl_DStringValue(sourcePtr); 1229 handle = (*tclWinProcs->findFirstFileProc)(nativeSource, &data); 1230 if (handle == INVALID_HANDLE_VALUE) { 1231 /* 1232 * Can't read directory 1233 */ 1234 1235 TclWinConvertError(GetLastError()); 1236 nativeErrfile = nativeSource; 1237 goto end; 1238 } 1239 1240 nativeSource[oldSourceLen + 1] = '\0'; 1241 Tcl_DStringSetLength(sourcePtr, oldSourceLen); 1242 result = (*traverseProc)(nativeSource, nativeTarget, DOTREE_PRED, errorPtr); 1243 if (result != TCL_OK) { 1244 FindClose(handle); 1245 return result; 1246 } 1247 1248 sourceLen = oldSourceLen; 1249 1250 if (tclWinProcs->useWide) { 1251 sourceLen += sizeof(WCHAR); 1252 Tcl_DStringAppend(sourcePtr, (char *) L"\\", sizeof(WCHAR) + 1); 1253 Tcl_DStringSetLength(sourcePtr, sourceLen); 1254 } else { 1255 sourceLen += 1; 1256 Tcl_DStringAppend(sourcePtr, "\\", 1); 1257 } 1258 if (targetPtr != NULL) { 1259 oldTargetLen = Tcl_DStringLength(targetPtr); 1260 1261 targetLen = oldTargetLen; 1262 if (tclWinProcs->useWide) { 1263 targetLen += sizeof(WCHAR); 1264 Tcl_DStringAppend(targetPtr, (char *) L"\\", sizeof(WCHAR) + 1); 1265 Tcl_DStringSetLength(targetPtr, targetLen); 1266 } else { 1267 targetLen += 1; 1268 Tcl_DStringAppend(targetPtr, "\\", 1); 1269 } 1270 } 1271 1272 found = 1; 1273 for ( ; found; found = (*tclWinProcs->findNextFileProc)(handle, &data)) { 1274 TCHAR *nativeName; 1275 int len; 1276 1277 if (tclWinProcs->useWide) { 1278 WCHAR *wp; 1279 1280 wp = data.w.cFileName; 1281 if (*wp == '.') { 1282 wp++; 1283 if (*wp == '.') { 1284 wp++; 1285 } 1286 if (*wp == '\0') { 1287 continue; 1288 } 1289 } 1290 nativeName = (TCHAR *) data.w.cFileName; 1291 len = wcslen(data.w.cFileName) * sizeof(WCHAR); 1292 } else { 1293 if ((strcmp(data.a.cFileName, ".") == 0) 1294 || (strcmp(data.a.cFileName, "..") == 0)) { 1295 continue; 1296 } 1297 nativeName = (TCHAR *) data.a.cFileName; 1298 len = strlen(data.a.cFileName); 1299 } 1300 1301 /* 1302 * Append name after slash, and recurse on the file. 1303 */ 1304 1305 Tcl_DStringAppend(sourcePtr, (char *) nativeName, len + 1); 1306 Tcl_DStringSetLength(sourcePtr, Tcl_DStringLength(sourcePtr) - 1); 1307 if (targetPtr != NULL) { 1308 Tcl_DStringAppend(targetPtr, (char *) nativeName, len + 1); 1309 Tcl_DStringSetLength(targetPtr, Tcl_DStringLength(targetPtr) - 1); 1310 } 1311 result = TraverseWinTree(traverseProc, sourcePtr, targetPtr, 1312 errorPtr); 1313 if (result != TCL_OK) { 1314 break; 1315 } 1316 1317 /* 1318 * Remove name after slash. 1319 */ 1320 1321 Tcl_DStringSetLength(sourcePtr, sourceLen); 1322 if (targetPtr != NULL) { 1323 Tcl_DStringSetLength(targetPtr, targetLen); 1324 } 1325 } 1326 FindClose(handle); 1327 1328 /* 1329 * Strip off the trailing slash we added 1330 */ 1331 1332 Tcl_DStringSetLength(sourcePtr, oldSourceLen + 1); 1333 Tcl_DStringSetLength(sourcePtr, oldSourceLen); 1334 if (targetPtr != NULL) { 1335 Tcl_DStringSetLength(targetPtr, oldTargetLen + 1); 1336 Tcl_DStringSetLength(targetPtr, oldTargetLen); 1337 } 1338 if (result == TCL_OK) { 1339 /* 1340 * Call traverseProc() on a directory after visiting all the 1341 * files in that directory. 1342 */ 1343 1344 result = (*traverseProc)(Tcl_DStringValue(sourcePtr), 1345 (targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr)), 1346 DOTREE_POSTD, errorPtr); 1347 } 1348 end: 1349 if (nativeErrfile != NULL) { 1350 TclWinConvertError(GetLastError()); 1351 if (errorPtr != NULL) { 1352 Tcl_WinTCharToUtf(nativeErrfile, -1, errorPtr); 1353 } 1354 result = TCL_ERROR; 1355 } 1356 1357 return result; 1358} 1359 1360/* 1361 *---------------------------------------------------------------------- 1362 * 1363 * TraversalCopy 1364 * 1365 * Called from TraverseUnixTree in order to execute a recursive 1366 * copy of a directory. 1367 * 1368 * Results: 1369 * Standard Tcl result. 1370 * 1371 * Side effects: 1372 * Depending on the value of type, src may be copied to dst. 1373 * 1374 *---------------------------------------------------------------------- 1375 */ 1376 1377static int 1378TraversalCopy( 1379 CONST TCHAR *nativeSrc, /* Source pathname to copy. */ 1380 CONST TCHAR *nativeDst, /* Destination pathname of copy. */ 1381 int type, /* Reason for call - see TraverseWinTree() */ 1382 Tcl_DString *errorPtr) /* If non-NULL, initialized DString filled 1383 * with UTF-8 name of file causing error. */ 1384{ 1385 switch (type) { 1386 case DOTREE_F: { 1387 if (DoCopyFile(nativeSrc, nativeDst) == TCL_OK) { 1388 return TCL_OK; 1389 } 1390 break; 1391 } 1392 case DOTREE_PRED: { 1393 if (DoCreateDirectory(nativeDst) == TCL_OK) { 1394 DWORD attr = (*tclWinProcs->getFileAttributesProc)(nativeSrc); 1395 if ((*tclWinProcs->setFileAttributesProc)(nativeDst, attr) != FALSE) { 1396 return TCL_OK; 1397 } 1398 TclWinConvertError(GetLastError()); 1399 } 1400 break; 1401 } 1402 case DOTREE_POSTD: { 1403 return TCL_OK; 1404 } 1405 } 1406 1407 /* 1408 * There shouldn't be a problem with src, because we already 1409 * checked it to get here. 1410 */ 1411 1412 if (errorPtr != NULL) { 1413 Tcl_WinTCharToUtf(nativeDst, -1, errorPtr); 1414 } 1415 return TCL_ERROR; 1416} 1417 1418/* 1419 *---------------------------------------------------------------------- 1420 * 1421 * TraversalDelete -- 1422 * 1423 * Called by procedure TraverseWinTree for every file and 1424 * directory that it encounters in a directory hierarchy. This 1425 * procedure unlinks files, and removes directories after all the 1426 * containing files have been processed. 1427 * 1428 * Results: 1429 * Standard Tcl result. 1430 * 1431 * Side effects: 1432 * Files or directory specified by src will be deleted. If an 1433 * error occurs, the windows error is converted to a Posix error 1434 * and errno is set accordingly. 1435 * 1436 *---------------------------------------------------------------------- 1437 */ 1438 1439static int 1440TraversalDelete( 1441 CONST TCHAR *nativeSrc, /* Source pathname to delete. */ 1442 CONST TCHAR *dstPtr, /* Not used. */ 1443 int type, /* Reason for call - see TraverseWinTree() */ 1444 Tcl_DString *errorPtr) /* If non-NULL, initialized DString filled 1445 * with UTF-8 name of file causing error. */ 1446{ 1447 switch (type) { 1448 case DOTREE_F: { 1449 if (TclpDeleteFile(nativeSrc) == TCL_OK) { 1450 return TCL_OK; 1451 } 1452 break; 1453 } 1454 case DOTREE_PRED: { 1455 return TCL_OK; 1456 } 1457 case DOTREE_POSTD: { 1458 if (DoRemoveJustDirectory(nativeSrc, 0, NULL) == TCL_OK) { 1459 return TCL_OK; 1460 } 1461 break; 1462 } 1463 } 1464 1465 if (errorPtr != NULL) { 1466 Tcl_WinTCharToUtf(nativeSrc, -1, errorPtr); 1467 } 1468 return TCL_ERROR; 1469} 1470 1471/* 1472 *---------------------------------------------------------------------- 1473 * 1474 * StatError -- 1475 * 1476 * Sets the object result with the appropriate error. 1477 * 1478 * Results: 1479 * None. 1480 * 1481 * Side effects: 1482 * The interp's object result is set with an error message 1483 * based on the objIndex, fileName and errno. 1484 * 1485 *---------------------------------------------------------------------- 1486 */ 1487 1488static void 1489StatError( 1490 Tcl_Interp *interp, /* The interp that has the error */ 1491 Tcl_Obj *fileName) /* The name of the file which caused the 1492 * error. */ 1493{ 1494 TclWinConvertError(GetLastError()); 1495 Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 1496 "could not read \"", Tcl_GetString(fileName), 1497 "\": ", Tcl_PosixError(interp), 1498 (char *) NULL); 1499} 1500 1501/* 1502 *---------------------------------------------------------------------- 1503 * 1504 * GetWinFileAttributes -- 1505 * 1506 * Returns a Tcl_Obj containing the value of a file attribute. 1507 * This routine gets the -hidden, -readonly or -system attribute. 1508 * 1509 * Results: 1510 * Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object 1511 * will have ref count 0. If the return value is not TCL_OK, 1512 * attributePtrPtr is not touched. 1513 * 1514 * Side effects: 1515 * A new object is allocated if the file is valid. 1516 * 1517 *---------------------------------------------------------------------- 1518 */ 1519 1520static int 1521GetWinFileAttributes( 1522 Tcl_Interp *interp, /* The interp we are using for errors. */ 1523 int objIndex, /* The index of the attribute. */ 1524 Tcl_Obj *fileName, /* The name of the file. */ 1525 Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ 1526{ 1527 DWORD result; 1528 CONST TCHAR *nativeName; 1529 int attr; 1530 1531 nativeName = Tcl_FSGetNativePath(fileName); 1532 result = (*tclWinProcs->getFileAttributesProc)(nativeName); 1533 1534 if (result == 0xffffffff) { 1535 StatError(interp, fileName); 1536 return TCL_ERROR; 1537 } 1538 1539 attr = (int)(result & attributeArray[objIndex]); 1540 if ((objIndex == WIN_HIDDEN_ATTRIBUTE) && (attr != 0)) { 1541 /* 1542 * It is hidden. However there is a bug on some Windows 1543 * OSes in which root volumes (drives) formatted as NTFS 1544 * are declared hidden when they are not (and cannot be). 1545 * 1546 * We test for, and fix that case, here. 1547 */ 1548 int len; 1549 char *str = Tcl_GetStringFromObj(fileName,&len); 1550 if (len < 4) { 1551 if (len == 0) { 1552 /* 1553 * Not sure if this is possible, but we pass it on 1554 * anyway 1555 */ 1556 } else if (len == 1 && (str[0] == '/' || str[0] == '\\')) { 1557 /* Path is pointing to the root volume */ 1558 attr = 0; 1559 } else if ((str[1] == ':') 1560 && (len == 2 || (str[2] == '/' || str[2] == '\\'))) { 1561 /* Path is of the form 'x:' or 'x:/' or 'x:\' */ 1562 attr = 0; 1563 } 1564 } 1565 } 1566 *attributePtrPtr = Tcl_NewBooleanObj(attr); 1567 return TCL_OK; 1568} 1569 1570/* 1571 *---------------------------------------------------------------------- 1572 * 1573 * ConvertFileNameFormat -- 1574 * 1575 * Returns a Tcl_Obj containing either the long or short version of the 1576 * file name. 1577 * 1578 * Results: 1579 * Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object 1580 * will have ref count 0. If the return value is not TCL_OK, 1581 * attributePtrPtr is not touched. 1582 * 1583 * Warning: if you pass this function a drive name like 'c:' it 1584 * will actually return the current working directory on that 1585 * drive. To avoid this, make sure the drive name ends in a 1586 * slash, like this 'c:/'. 1587 * 1588 * Side effects: 1589 * A new object is allocated if the file is valid. 1590 * 1591 *---------------------------------------------------------------------- 1592 */ 1593 1594static int 1595ConvertFileNameFormat( 1596 Tcl_Interp *interp, /* The interp we are using for errors. */ 1597 int objIndex, /* The index of the attribute. */ 1598 Tcl_Obj *fileName, /* The name of the file. */ 1599 int longShort, /* 0 to short name, 1 to long name. */ 1600 Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ 1601{ 1602 int pathc, i; 1603 Tcl_Obj *splitPath; 1604 int result = TCL_OK; 1605 1606 splitPath = Tcl_FSSplitPath(fileName, &pathc); 1607 1608 if (splitPath == NULL || pathc == 0) { 1609 if (interp != NULL) { 1610 Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 1611 "could not read \"", Tcl_GetString(fileName), 1612 "\": no such file or directory", 1613 (char *) NULL); 1614 } 1615 result = TCL_ERROR; 1616 goto cleanup; 1617 } 1618 1619 for (i = 0; i < pathc; i++) { 1620 Tcl_Obj *elt; 1621 char *pathv; 1622 int pathLen; 1623 Tcl_ListObjIndex(NULL, splitPath, i, &elt); 1624 1625 pathv = Tcl_GetStringFromObj(elt, &pathLen); 1626 if ((pathv[0] == '/') 1627 || ((pathLen == 3) && (pathv[1] == ':')) 1628 || (strcmp(pathv, ".") == 0) 1629 || (strcmp(pathv, "..") == 0)) { 1630 /* 1631 * Handle "/", "//machine/export", "c:/", "." or ".." by just 1632 * copying the string literally. Uppercase the drive letter, 1633 * just because it looks better under Windows to do so. 1634 */ 1635 1636 simple: 1637 /* Here we are modifying the string representation in place */ 1638 /* I believe this is legal, since this won't affect any 1639 * file representation this thing may have. */ 1640 pathv[0] = (char) Tcl_UniCharToUpper(UCHAR(pathv[0])); 1641 } else { 1642 Tcl_Obj *tempPath; 1643 Tcl_DString ds; 1644 Tcl_DString dsTemp; 1645 TCHAR *nativeName; 1646 char *tempString; 1647 int tempLen; 1648 WIN32_FIND_DATAT data; 1649 HANDLE handle; 1650 DWORD attr; 1651 1652 tempPath = Tcl_FSJoinPath(splitPath, i+1); 1653 Tcl_IncrRefCount(tempPath); 1654 /* 1655 * We'd like to call Tcl_FSGetNativePath(tempPath) 1656 * but that is likely to lead to infinite loops 1657 */ 1658 Tcl_DStringInit(&ds); 1659 tempString = Tcl_GetStringFromObj(tempPath,&tempLen); 1660 nativeName = Tcl_WinUtfToTChar(tempString, tempLen, &ds); 1661 Tcl_DecrRefCount(tempPath); 1662 handle = (*tclWinProcs->findFirstFileProc)(nativeName, &data); 1663 if (handle == INVALID_HANDLE_VALUE) { 1664 /* 1665 * FindFirstFile() doesn't like root directories. We 1666 * would only get a root directory here if the caller 1667 * specified "c:" or "c:." and the current directory on the 1668 * drive was the root directory 1669 */ 1670 1671 attr = (*tclWinProcs->getFileAttributesProc)(nativeName); 1672 if ((attr != 0xFFFFFFFF) && (attr & FILE_ATTRIBUTE_DIRECTORY)) { 1673 Tcl_DStringFree(&ds); 1674 goto simple; 1675 } 1676 } 1677 1678 if (handle == INVALID_HANDLE_VALUE) { 1679 Tcl_DStringFree(&ds); 1680 if (interp != NULL) { 1681 StatError(interp, fileName); 1682 } 1683 result = TCL_ERROR; 1684 goto cleanup; 1685 } 1686 if (tclWinProcs->useWide) { 1687 nativeName = (TCHAR *) data.w.cAlternateFileName; 1688 if (longShort) { 1689 if (data.w.cFileName[0] != '\0') { 1690 nativeName = (TCHAR *) data.w.cFileName; 1691 } 1692 } else { 1693 if (data.w.cAlternateFileName[0] == '\0') { 1694 nativeName = (TCHAR *) data.w.cFileName; 1695 } 1696 } 1697 } else { 1698 nativeName = (TCHAR *) data.a.cAlternateFileName; 1699 if (longShort) { 1700 if (data.a.cFileName[0] != '\0') { 1701 nativeName = (TCHAR *) data.a.cFileName; 1702 } 1703 } else { 1704 if (data.a.cAlternateFileName[0] == '\0') { 1705 nativeName = (TCHAR *) data.a.cFileName; 1706 } 1707 } 1708 } 1709 1710 /* 1711 * Purify reports a extraneous UMR in Tcl_WinTCharToUtf() trying 1712 * to dereference nativeName as a Unicode string. I have proven 1713 * to myself that purify is wrong by running the following 1714 * example when nativeName == data.w.cAlternateFileName and 1715 * noting that purify doesn't complain about the first line, 1716 * but does complain about the second. 1717 * 1718 * fprintf(stderr, "%d\n", data.w.cAlternateFileName[0]); 1719 * fprintf(stderr, "%d\n", ((WCHAR *) nativeName)[0]); 1720 */ 1721 1722 Tcl_DStringInit(&dsTemp); 1723 Tcl_WinTCharToUtf(nativeName, -1, &dsTemp); 1724 /* Deal with issues of tildes being absolute */ 1725 if (Tcl_DStringValue(&dsTemp)[0] == '~') { 1726 tempPath = Tcl_NewStringObj("./",2); 1727 Tcl_AppendToObj(tempPath, Tcl_DStringValue(&dsTemp), 1728 Tcl_DStringLength(&dsTemp)); 1729 } else { 1730 tempPath = Tcl_NewStringObj(Tcl_DStringValue(&dsTemp), 1731 Tcl_DStringLength(&dsTemp)); 1732 } 1733 Tcl_ListObjReplace(NULL, splitPath, i, 1, 1, &tempPath); 1734 Tcl_DStringFree(&ds); 1735 Tcl_DStringFree(&dsTemp); 1736 FindClose(handle); 1737 } 1738 } 1739 1740 *attributePtrPtr = Tcl_FSJoinPath(splitPath, -1); 1741 1742cleanup: 1743 if (splitPath != NULL) { 1744 Tcl_DecrRefCount(splitPath); 1745 } 1746 1747 return result; 1748} 1749 1750/* 1751 *---------------------------------------------------------------------- 1752 * 1753 * GetWinFileLongName -- 1754 * 1755 * Returns a Tcl_Obj containing the long version of the file 1756 * name. 1757 * 1758 * Results: 1759 * Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object 1760 * will have ref count 0. If the return value is not TCL_OK, 1761 * attributePtrPtr is not touched. 1762 * 1763 * Side effects: 1764 * A new object is allocated if the file is valid. 1765 * 1766 *---------------------------------------------------------------------- 1767 */ 1768 1769static int 1770GetWinFileLongName( 1771 Tcl_Interp *interp, /* The interp we are using for errors. */ 1772 int objIndex, /* The index of the attribute. */ 1773 Tcl_Obj *fileName, /* The name of the file. */ 1774 Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ 1775{ 1776 return ConvertFileNameFormat(interp, objIndex, fileName, 1, attributePtrPtr); 1777} 1778 1779/* 1780 *---------------------------------------------------------------------- 1781 * 1782 * GetWinFileShortName -- 1783 * 1784 * Returns a Tcl_Obj containing the short version of the file 1785 * name. 1786 * 1787 * Results: 1788 * Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object 1789 * will have ref count 0. If the return value is not TCL_OK, 1790 * attributePtrPtr is not touched. 1791 * 1792 * Side effects: 1793 * A new object is allocated if the file is valid. 1794 * 1795 *---------------------------------------------------------------------- 1796 */ 1797 1798static int 1799GetWinFileShortName( 1800 Tcl_Interp *interp, /* The interp we are using for errors. */ 1801 int objIndex, /* The index of the attribute. */ 1802 Tcl_Obj *fileName, /* The name of the file. */ 1803 Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ 1804{ 1805 return ConvertFileNameFormat(interp, objIndex, fileName, 0, attributePtrPtr); 1806} 1807 1808/* 1809 *---------------------------------------------------------------------- 1810 * 1811 * SetWinFileAttributes -- 1812 * 1813 * Set the file attributes to the value given by attributePtr. 1814 * This routine sets the -hidden, -readonly, or -system attributes. 1815 * 1816 * Results: 1817 * Standard TCL error. 1818 * 1819 * Side effects: 1820 * The file's attribute is set. 1821 * 1822 *---------------------------------------------------------------------- 1823 */ 1824 1825static int 1826SetWinFileAttributes( 1827 Tcl_Interp *interp, /* The interp we are using for errors. */ 1828 int objIndex, /* The index of the attribute. */ 1829 Tcl_Obj *fileName, /* The name of the file. */ 1830 Tcl_Obj *attributePtr) /* The new value of the attribute. */ 1831{ 1832 DWORD fileAttributes; 1833 int yesNo; 1834 int result; 1835 CONST TCHAR *nativeName; 1836 1837 nativeName = Tcl_FSGetNativePath(fileName); 1838 fileAttributes = (*tclWinProcs->getFileAttributesProc)(nativeName); 1839 1840 if (fileAttributes == 0xffffffff) { 1841 StatError(interp, fileName); 1842 return TCL_ERROR; 1843 } 1844 1845 result = Tcl_GetBooleanFromObj(interp, attributePtr, &yesNo); 1846 if (result != TCL_OK) { 1847 return result; 1848 } 1849 1850 if (yesNo) { 1851 fileAttributes |= (attributeArray[objIndex]); 1852 } else { 1853 fileAttributes &= ~(attributeArray[objIndex]); 1854 } 1855 1856 if (!(*tclWinProcs->setFileAttributesProc)(nativeName, fileAttributes)) { 1857 StatError(interp, fileName); 1858 return TCL_ERROR; 1859 } 1860 1861 return result; 1862} 1863 1864/* 1865 *---------------------------------------------------------------------- 1866 * 1867 * SetWinFileLongName -- 1868 * 1869 * The attribute in question is a readonly attribute and cannot 1870 * be set. 1871 * 1872 * Results: 1873 * TCL_ERROR 1874 * 1875 * Side effects: 1876 * The object result is set to a pertinent error message. 1877 * 1878 *---------------------------------------------------------------------- 1879 */ 1880 1881static int 1882CannotSetAttribute( 1883 Tcl_Interp *interp, /* The interp we are using for errors. */ 1884 int objIndex, /* The index of the attribute. */ 1885 Tcl_Obj *fileName, /* The name of the file. */ 1886 Tcl_Obj *attributePtr) /* The new value of the attribute. */ 1887{ 1888 Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 1889 "cannot set attribute \"", tclpFileAttrStrings[objIndex], 1890 "\" for file \"", Tcl_GetString(fileName), 1891 "\": attribute is readonly", 1892 (char *) NULL); 1893 return TCL_ERROR; 1894} 1895 1896 1897/* 1898 *--------------------------------------------------------------------------- 1899 * 1900 * TclpObjListVolumes -- 1901 * 1902 * Lists the currently mounted volumes 1903 * 1904 * Results: 1905 * The list of volumes. 1906 * 1907 * Side effects: 1908 * None 1909 * 1910 *--------------------------------------------------------------------------- 1911 */ 1912 1913Tcl_Obj* 1914TclpObjListVolumes(void) 1915{ 1916 Tcl_Obj *resultPtr, *elemPtr; 1917 char buf[40 * 4]; /* There couldn't be more than 30 drives??? */ 1918 int i; 1919 char *p; 1920 1921 resultPtr = Tcl_NewObj(); 1922 1923 /* 1924 * On Win32s: 1925 * GetLogicalDriveStrings() isn't implemented. 1926 * GetLogicalDrives() returns incorrect information. 1927 */ 1928 1929 if (GetLogicalDriveStringsA(sizeof(buf), buf) == 0) { 1930 /* 1931 * GetVolumeInformation() will detects all drives, but causes 1932 * chattering on empty floppy drives. We only do this if 1933 * GetLogicalDriveStrings() didn't work. It has also been reported 1934 * that on some laptops it takes a while for GetVolumeInformation() 1935 * to return when pinging an empty floppy drive, another reason to 1936 * try to avoid calling it. 1937 */ 1938 1939 buf[1] = ':'; 1940 buf[2] = '/'; 1941 buf[3] = '\0'; 1942 1943 for (i = 0; i < 26; i++) { 1944 buf[0] = (char) ('a' + i); 1945 if (GetVolumeInformationA(buf, NULL, 0, NULL, NULL, NULL, NULL, 0) 1946 || (GetLastError() == ERROR_NOT_READY)) { 1947 elemPtr = Tcl_NewStringObj(buf, -1); 1948 Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr); 1949 } 1950 } 1951 } else { 1952 for (p = buf; *p != '\0'; p += 4) { 1953 p[2] = '/'; 1954 elemPtr = Tcl_NewStringObj(p, -1); 1955 Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr); 1956 } 1957 } 1958 1959 Tcl_IncrRefCount(resultPtr); 1960 return resultPtr; 1961} 1962