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