1/* 2 * tclPathObj.c -- 3 * 4 * This file contains the implementation of Tcl's "path" object type used 5 * to represent and manipulate a general (virtual) filesystem entity in 6 * an efficient manner. 7 * 8 * Copyright (c) 2003 Vince Darley. 9 * 10 * See the file "license.terms" for information on usage and redistribution of 11 * this file, and for a DISCLAIMER OF ALL WARRANTIES. 12 * 13 * RCS: @(#) $Id: tclPathObj.c,v 1.66.2.12 2010/05/21 12:18:17 nijtmans Exp $ 14 */ 15 16#include "tclInt.h" 17#include "tclFileSystem.h" 18 19/* 20 * Prototypes for functions defined later in this file. 21 */ 22 23static Tcl_Obj * AppendPath(Tcl_Obj *head, Tcl_Obj *tail); 24static void DupFsPathInternalRep(Tcl_Obj *srcPtr, 25 Tcl_Obj *copyPtr); 26static void FreeFsPathInternalRep(Tcl_Obj *pathPtr); 27static void UpdateStringOfFsPath(Tcl_Obj *pathPtr); 28static int SetFsPathFromAny(Tcl_Interp *interp, Tcl_Obj *pathPtr); 29static int FindSplitPos(const char *path, int separator); 30static int IsSeparatorOrNull(int ch); 31static Tcl_Obj * GetExtension(Tcl_Obj *pathPtr); 32 33/* 34 * Define the 'path' object type, which Tcl uses to represent file paths 35 * internally. 36 */ 37 38static Tcl_ObjType tclFsPathType = { 39 "path", /* name */ 40 FreeFsPathInternalRep, /* freeIntRepProc */ 41 DupFsPathInternalRep, /* dupIntRepProc */ 42 UpdateStringOfFsPath, /* updateStringProc */ 43 SetFsPathFromAny /* setFromAnyProc */ 44}; 45 46/* 47 * struct FsPath -- 48 * 49 * Internal representation of a Tcl_Obj of "path" type. This can be used to 50 * represent relative or absolute paths, and has certain optimisations when 51 * used to represent paths which are already normalized and absolute. 52 * 53 * Note that both 'translatedPathPtr' and 'normPathPtr' can be a circular 54 * reference to the container Tcl_Obj of this FsPath. 55 * 56 * There are two cases, with the first being the most common: 57 * 58 * (i) flags == 0, => Ordinary path. 59 * 60 * translatedPathPtr contains the translated path (which may be a circular 61 * reference to the object itself). If it is NULL then the path is pure 62 * normalized (and the normPathPtr will be a circular reference). cwdPtr is 63 * null for an absolute path, and non-null for a relative path (unless the cwd 64 * has never been set, in which case the cwdPtr may also be null for a 65 * relative path). 66 * 67 * (ii) flags != 0, => Special path, see TclNewFSPathObj 68 * 69 * Now, this is a path like 'file join $dir $tail' where, cwdPtr is the $dir 70 * and normPathPtr is the $tail. 71 * 72 */ 73 74typedef struct FsPath { 75 Tcl_Obj *translatedPathPtr; /* Name without any ~user sequences. If this 76 * is NULL, then this is a pure normalized, 77 * absolute path object, in which the parent 78 * Tcl_Obj's string rep is already both 79 * translated and normalized. */ 80 Tcl_Obj *normPathPtr; /* Normalized absolute path, without ., .. or 81 * ~user sequences. If the Tcl_Obj containing 82 * this FsPath is already normalized, this may 83 * be a circular reference back to the 84 * container. If that is NOT the case, we have 85 * a refCount on the object. */ 86 Tcl_Obj *cwdPtr; /* If null, path is absolute, else this points 87 * to the cwd object used for this path. We 88 * have a refCount on the object. */ 89 int flags; /* Flags to describe interpretation - see 90 * below. */ 91 ClientData nativePathPtr; /* Native representation of this path, which 92 * is filesystem dependent. */ 93 int filesystemEpoch; /* Used to ensure the path representation was 94 * generated during the correct filesystem 95 * epoch. The epoch changes when 96 * filesystem-mounts are changed. */ 97 struct FilesystemRecord *fsRecPtr; 98 /* Pointer to the filesystem record entry to 99 * use for this path. */ 100} FsPath; 101 102/* 103 * Flag values for FsPath->flags. 104 */ 105 106#define TCLPATH_APPENDED 1 107#define TCLPATH_NEEDNORM 4 108 109/* 110 * Define some macros to give us convenient access to path-object specific 111 * fields. 112 */ 113 114#define PATHOBJ(pathPtr) ((FsPath *) (pathPtr)->internalRep.otherValuePtr) 115#define SETPATHOBJ(pathPtr,fsPathPtr) \ 116 ((pathPtr)->internalRep.otherValuePtr = (void *) (fsPathPtr)) 117#define PATHFLAGS(pathPtr) (PATHOBJ(pathPtr)->flags) 118 119/* 120 *--------------------------------------------------------------------------- 121 * 122 * TclFSNormalizeAbsolutePath -- 123 * 124 * Takes an absolute path specification and computes a 'normalized' path 125 * from it. 126 * 127 * A normalized path is one which has all '../', './' removed. Also it is 128 * one which is in the 'standard' format for the native platform. On 129 * Unix, this means the path must be free of symbolic links/aliases, and 130 * on Windows it means we want the long form, with that long form's 131 * case-dependence (which gives us a unique, case-dependent path). 132 * 133 * The behaviour of this function if passed a non-absolute path is NOT 134 * defined. 135 * 136 * pathPtr may have a refCount of zero, or may be a shared object. 137 * 138 * Results: 139 * The result is returned in a Tcl_Obj with a refCount of 1, which is 140 * therefore owned by the caller. It must be freed (with 141 * Tcl_DecrRefCount) by the caller when no longer needed. 142 * 143 * Side effects: 144 * None (beyond the memory allocation for the result). 145 * 146 * Special note: 147 * This code was originally based on code from Matt Newman and 148 * Jean-Claude Wippler, but has since been totally rewritten by Vince 149 * Darley to deal with symbolic links. 150 * 151 *--------------------------------------------------------------------------- 152 */ 153 154Tcl_Obj * 155TclFSNormalizeAbsolutePath( 156 Tcl_Interp *interp, /* Interpreter to use */ 157 Tcl_Obj *pathPtr, /* Absolute path to normalize */ 158 ClientData *clientDataPtr) /* If non-NULL, then may be set to the 159 * fs-specific clientData for this path. This 160 * will happen when that extra information can 161 * be calculated efficiently as a side-effect 162 * of normalization. */ 163{ 164 ClientData clientData = NULL; 165 const char *dirSep, *oldDirSep; 166 int first = 1; /* Set to zero once we've passed the first 167 * directory separator - we can't use '..' to 168 * remove the volume in a path. */ 169 Tcl_Obj *retVal = NULL; 170 dirSep = TclGetString(pathPtr); 171 172 if (tclPlatform == TCL_PLATFORM_WINDOWS) { 173 if ( (dirSep[0] == '/' || dirSep[0] == '\\') 174 && (dirSep[1] == '/' || dirSep[1] == '\\') 175 && (dirSep[2] == '?') 176 && (dirSep[3] == '/' || dirSep[3] == '\\')) { 177 /* NT extended path */ 178 dirSep += 4; 179 180 if ( (dirSep[0] == 'U' || dirSep[0] == 'u') 181 && (dirSep[1] == 'N' || dirSep[1] == 'n') 182 && (dirSep[2] == 'C' || dirSep[2] == 'c') 183 && (dirSep[3] == '/' || dirSep[3] == '\\')) { 184 /* NT extended UNC path */ 185 dirSep += 4; 186 } 187 } 188 if (dirSep[0] != 0 && dirSep[1] == ':' && 189 (dirSep[2] == '/' || dirSep[2] == '\\')) { 190 /* Do nothing */ 191 } else if ((dirSep[0] == '/' || dirSep[0] == '\\') 192 && (dirSep[1] == '/' || dirSep[1] == '\\')) { 193 /* 194 * UNC style path, where we must skip over the first separator, 195 * since the first two segments are actually inseparable. 196 */ 197 198 dirSep += 2; 199 dirSep += FindSplitPos(dirSep, '/'); 200 if (*dirSep != 0) { 201 dirSep++; 202 } 203 } 204 } 205 206 /* 207 * Scan forward from one directory separator to the next, checking for 208 * '..' and '.' sequences which must be handled specially. In particular 209 * handling of '..' can be complicated if the directory before is a link, 210 * since we will have to expand the link to be able to back up one level. 211 */ 212 213 while (*dirSep != 0) { 214 oldDirSep = dirSep; 215 if (!first) { 216 dirSep++; 217 } 218 dirSep += FindSplitPos(dirSep, '/'); 219 if (dirSep[0] == 0 || dirSep[1] == 0) { 220 if (retVal != NULL) { 221 Tcl_AppendToObj(retVal, oldDirSep, dirSep - oldDirSep); 222 } 223 break; 224 } 225 if (dirSep[1] == '.') { 226 if (retVal != NULL) { 227 Tcl_AppendToObj(retVal, oldDirSep, dirSep - oldDirSep); 228 oldDirSep = dirSep; 229 } 230 again: 231 if (IsSeparatorOrNull(dirSep[2])) { 232 /* 233 * Need to skip '.' in the path. 234 */ 235 int curLen; 236 237 if (retVal == NULL) { 238 const char *path = TclGetString(pathPtr); 239 retVal = Tcl_NewStringObj(path, dirSep - path); 240 Tcl_IncrRefCount(retVal); 241 } 242 (void) Tcl_GetStringFromObj(retVal, &curLen); 243 if (curLen == 0) { 244 Tcl_AppendToObj(retVal, dirSep, 1); 245 } 246 dirSep += 2; 247 oldDirSep = dirSep; 248 if (dirSep[0] != 0 && dirSep[1] == '.') { 249 goto again; 250 } 251 continue; 252 } 253 if (dirSep[2] == '.' && IsSeparatorOrNull(dirSep[3])) { 254 Tcl_Obj *link; 255 int curLen; 256 char *linkStr; 257 258 /* 259 * Have '..' so need to skip previous directory. 260 */ 261 262 if (retVal == NULL) { 263 const char *path = TclGetString(pathPtr); 264 265 retVal = Tcl_NewStringObj(path, dirSep - path); 266 Tcl_IncrRefCount(retVal); 267 } 268 (void) Tcl_GetStringFromObj(retVal, &curLen); 269 if (curLen == 0) { 270 Tcl_AppendToObj(retVal, dirSep, 1); 271 } 272 if (!first || (tclPlatform == TCL_PLATFORM_UNIX)) { 273 link = Tcl_FSLink(retVal, NULL, 0); 274 if (link != NULL) { 275 /* 276 * Got a link. Need to check if the link is relative 277 * or absolute, for those platforms where relative 278 * links exist. 279 */ 280 281 if (tclPlatform != TCL_PLATFORM_WINDOWS && 282 Tcl_FSGetPathType(link) == TCL_PATH_RELATIVE) { 283 /* 284 * We need to follow this link which is relative 285 * to retVal's directory. This means concatenating 286 * the link onto the directory of the path so far. 287 */ 288 289 const char *path = 290 Tcl_GetStringFromObj(retVal, &curLen); 291 292 while (--curLen >= 0) { 293 if (IsSeparatorOrNull(path[curLen])) { 294 break; 295 } 296 } 297 if (Tcl_IsShared(retVal)) { 298 TclDecrRefCount(retVal); 299 retVal = Tcl_DuplicateObj(retVal); 300 Tcl_IncrRefCount(retVal); 301 } 302 303 /* 304 * We want the trailing slash. 305 */ 306 307 Tcl_SetObjLength(retVal, curLen+1); 308 Tcl_AppendObjToObj(retVal, link); 309 TclDecrRefCount(link); 310 linkStr = Tcl_GetStringFromObj(retVal, &curLen); 311 } else { 312 /* 313 * Absolute link. 314 */ 315 316 TclDecrRefCount(retVal); 317 retVal = link; 318 linkStr = Tcl_GetStringFromObj(retVal, &curLen); 319 320 /* 321 * Convert to forward-slashes on windows. 322 */ 323 324 if (tclPlatform == TCL_PLATFORM_WINDOWS) { 325 int i; 326 327 for (i = 0; i < curLen; i++) { 328 if (linkStr[i] == '\\') { 329 linkStr[i] = '/'; 330 } 331 } 332 } 333 } 334 } else { 335 linkStr = Tcl_GetStringFromObj(retVal, &curLen); 336 } 337 338 /* 339 * Either way, we now remove the last path element. 340 * (but not the first character of the path) 341 */ 342 343 while (--curLen >= 0) { 344 if (IsSeparatorOrNull(linkStr[curLen])) { 345 if (curLen) { 346 Tcl_SetObjLength(retVal, curLen); 347 } else { 348 Tcl_SetObjLength(retVal, 1); 349 } 350 break; 351 } 352 } 353 } 354 dirSep += 3; 355 oldDirSep = dirSep; 356 357 if ((curLen == 0) && (dirSep[0] != 0)) { 358 Tcl_SetObjLength(retVal, 0); 359 } 360 361 if (dirSep[0] != 0 && dirSep[1] == '.') { 362 goto again; 363 } 364 continue; 365 } 366 } 367 first = 0; 368 if (retVal != NULL) { 369 Tcl_AppendToObj(retVal, oldDirSep, dirSep - oldDirSep); 370 } 371 } 372 373 /* 374 * If we didn't make any changes, just use the input path. 375 */ 376 377 if (retVal == NULL) { 378 retVal = pathPtr; 379 Tcl_IncrRefCount(retVal); 380 381 if (Tcl_IsShared(retVal)) { 382 /* 383 * Unfortunately, the platform-specific normalization code which 384 * will be called below has no way of dealing with the case where 385 * an object is shared. It is expecting to modify an object in 386 * place. So, we must duplicate this here to ensure an object with 387 * a single ref-count. 388 * 389 * If that changes in the future (e.g. the normalize proc is given 390 * one object and is able to return a different one), then we 391 * could remove this code. 392 */ 393 394 TclDecrRefCount(retVal); 395 retVal = Tcl_DuplicateObj(pathPtr); 396 Tcl_IncrRefCount(retVal); 397 } 398 } 399 400 /* 401 * Ensure a windows drive like C:/ has a trailing separator 402 */ 403 404 if (tclPlatform == TCL_PLATFORM_WINDOWS) { 405 int len; 406 const char *path = Tcl_GetStringFromObj(retVal, &len); 407 408 if (len == 2 && path[0] != 0 && path[1] == ':') { 409 if (Tcl_IsShared(retVal)) { 410 TclDecrRefCount(retVal); 411 retVal = Tcl_DuplicateObj(retVal); 412 Tcl_IncrRefCount(retVal); 413 } 414 Tcl_AppendToObj(retVal, "/", 1); 415 } 416 } 417 418 /* 419 * Now we have an absolute path, with no '..', '.' sequences, but it still 420 * may not be in 'unique' form, depending on the platform. For instance, 421 * Unix is case-sensitive, so the path is ok. Windows is case-insensitive, 422 * and also has the weird 'longname/shortname' thing (e.g. C:/Program 423 * Files/ and C:/Progra~1/ are equivalent). 424 * 425 * Virtual file systems which may be registered may have other criteria 426 * for normalizing a path. 427 */ 428 429 TclFSNormalizeToUniquePath(interp, retVal, 0, &clientData); 430 431 /* 432 * Since we know it is a normalized path, we can actually convert this 433 * object into an FsPath for greater efficiency 434 */ 435 436 TclFSMakePathFromNormalized(interp, retVal, clientData); 437 if (clientDataPtr != NULL) { 438 *clientDataPtr = clientData; 439 } 440 441 /* 442 * This has a refCount of 1 for the caller, unlike many Tcl_Obj APIs. 443 */ 444 445 return retVal; 446} 447 448/* 449 *---------------------------------------------------------------------- 450 * 451 * Tcl_FSGetPathType -- 452 * 453 * Determines whether a given path is relative to the current directory, 454 * relative to the current volume, or absolute. 455 * 456 * Results: 457 * Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or 458 * TCL_PATH_VOLUME_RELATIVE. 459 * 460 * Side effects: 461 * None. 462 * 463 *---------------------------------------------------------------------- 464 */ 465 466Tcl_PathType 467Tcl_FSGetPathType( 468 Tcl_Obj *pathPtr) 469{ 470 return TclFSGetPathType(pathPtr, NULL, NULL); 471} 472 473/* 474 *---------------------------------------------------------------------- 475 * 476 * TclFSGetPathType -- 477 * 478 * Determines whether a given path is relative to the current directory, 479 * relative to the current volume, or absolute. If the caller wishes to 480 * know which filesystem claimed the path (in the case for which the path 481 * is absolute), then a reference to a filesystem pointer can be passed 482 * in (but passing NULL is acceptable). 483 * 484 * Results: 485 * Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or 486 * TCL_PATH_VOLUME_RELATIVE. The filesystem reference will be set if and 487 * only if it is non-NULL and the function's return value is 488 * TCL_PATH_ABSOLUTE. 489 * 490 * Side effects: 491 * None. 492 * 493 *---------------------------------------------------------------------- 494 */ 495 496Tcl_PathType 497TclFSGetPathType( 498 Tcl_Obj *pathPtr, 499 Tcl_Filesystem **filesystemPtrPtr, 500 int *driveNameLengthPtr) 501{ 502 FsPath *fsPathPtr; 503 504 if (Tcl_FSConvertToPathType(NULL, pathPtr) != TCL_OK) { 505 return TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr, 506 NULL); 507 } 508 509 fsPathPtr = PATHOBJ(pathPtr); 510 if (fsPathPtr->cwdPtr == NULL) { 511 return TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr, 512 NULL); 513 } 514 515 if (PATHFLAGS(pathPtr) == 0) { 516 /* The path is not absolute... */ 517#ifdef __WIN32__ 518 /* ... on Windows we must make another call to determine whether 519 * it's relative or volumerelative [Bug 2571597]. */ 520 return TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr, 521 NULL); 522#else 523 /* On other systems, quickly deduce !absolute -> relative */ 524 return TCL_PATH_RELATIVE; 525#endif 526 } 527 return TclFSGetPathType(fsPathPtr->cwdPtr, filesystemPtrPtr, 528 driveNameLengthPtr); 529} 530 531/* 532 *--------------------------------------------------------------------------- 533 * 534 * TclPathPart 535 * 536 * This function calculates the requested part of the given path, which 537 * can be: 538 * 539 * - the directory above ('file dirname') 540 * - the tail ('file tail') 541 * - the extension ('file extension') 542 * - the root ('file root') 543 * 544 * The 'portion' parameter dictates which of these to calculate. There 545 * are a number of special cases both to be more efficient, and because 546 * the behaviour when given a path with only a single element is defined 547 * to require the expansion of that single element, where possible. 548 * 549 * Should look into integrating 'FileBasename' in tclFCmd.c into this 550 * function. 551 * 552 * Results: 553 * NULL if an error occurred, otherwise a Tcl_Obj owned by the caller 554 * (i.e. most likely with refCount 1). 555 * 556 * Side effects: 557 * None. 558 * 559 *--------------------------------------------------------------------------- 560 */ 561 562Tcl_Obj * 563TclPathPart( 564 Tcl_Interp *interp, /* Used for error reporting */ 565 Tcl_Obj *pathPtr, /* Path to take dirname of */ 566 Tcl_PathPart portion) /* Requested portion of name */ 567{ 568 if (pathPtr->typePtr == &tclFsPathType) { 569 FsPath *fsPathPtr = PATHOBJ(pathPtr); 570 571 if (TclFSEpochOk(fsPathPtr->filesystemEpoch) 572 && (PATHFLAGS(pathPtr) != 0)) { 573 switch (portion) { 574 case TCL_PATH_DIRNAME: { 575 /* 576 * Check if the joined-on bit has any directory delimiters in 577 * it. If so, the 'dirname' would be a joining of the main 578 * part with the dirname of the joined-on bit. We could handle 579 * that special case here, but we don't, and instead just use 580 * the standardPath code. 581 */ 582 583 int numBytes; 584 const char *rest = 585 Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &numBytes); 586 587 if (strchr(rest, '/') != NULL) { 588 goto standardPath; 589 } 590 /* 591 * If the joined-on bit is empty, then [file dirname] is 592 * documented to return all but the last non-empty element 593 * of the path, so we need to split apart the main part to 594 * get the right answer. We could do that here, but it's 595 * simpler to fall back to the standardPath code. 596 * [Bug 2710920] 597 */ 598 if (numBytes == 0) { 599 goto standardPath; 600 } 601 if (tclPlatform == TCL_PLATFORM_WINDOWS 602 && strchr(rest, '\\') != NULL) { 603 goto standardPath; 604 } 605 606 /* 607 * The joined-on path is simple, so we can just return here. 608 */ 609 610 Tcl_IncrRefCount(fsPathPtr->cwdPtr); 611 return fsPathPtr->cwdPtr; 612 } 613 case TCL_PATH_TAIL: { 614 /* 615 * Check if the joined-on bit has any directory delimiters in 616 * it. If so, the 'tail' would be only the part following the 617 * last delimiter. We could handle that special case here, but 618 * we don't, and instead just use the standardPath code. 619 */ 620 621 int numBytes; 622 const char *rest = 623 Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &numBytes); 624 625 if (strchr(rest, '/') != NULL) { 626 goto standardPath; 627 } 628 /* 629 * If the joined-on bit is empty, then [file tail] is 630 * documented to return the last non-empty element 631 * of the path, so we need to split off the last element 632 * of the main part to get the right answer. We could do 633 * that here, but it's simpler to fall back to the 634 * standardPath code. [Bug 2710920] 635 */ 636 if (numBytes == 0) { 637 goto standardPath; 638 } 639 if (tclPlatform == TCL_PLATFORM_WINDOWS 640 && strchr(rest, '\\') != NULL) { 641 goto standardPath; 642 } 643 Tcl_IncrRefCount(fsPathPtr->normPathPtr); 644 return fsPathPtr->normPathPtr; 645 } 646 case TCL_PATH_EXTENSION: 647 return GetExtension(fsPathPtr->normPathPtr); 648 case TCL_PATH_ROOT: { 649 const char *fileName, *extension; 650 int length; 651 652 fileName = Tcl_GetStringFromObj(fsPathPtr->normPathPtr, 653 &length); 654 extension = TclGetExtension(fileName); 655 if (extension == NULL) { 656 /* 657 * There is no extension so the root is the same as the 658 * path we were given. 659 */ 660 661 Tcl_IncrRefCount(pathPtr); 662 return pathPtr; 663 } else { 664 /* 665 * Need to return the whole path with the extension 666 * suffix removed. Do that by joining our "head" to 667 * our "tail" with the extension suffix removed from 668 * the tail. 669 */ 670 671 Tcl_Obj *resultPtr = 672 TclNewFSPathObj(fsPathPtr->cwdPtr, fileName, 673 (int)(length - strlen(extension))); 674 675 Tcl_IncrRefCount(resultPtr); 676 return resultPtr; 677 } 678 } 679 default: 680 /* We should never get here */ 681 Tcl_Panic("Bad portion to TclPathPart"); 682 /* For less clever compilers */ 683 return NULL; 684 } 685 } else if (fsPathPtr->cwdPtr != NULL) { 686 /* Relative path */ 687 goto standardPath; 688 } else { 689 /* Absolute path */ 690 goto standardPath; 691 } 692 } else { 693 int splitElements; 694 Tcl_Obj *splitPtr, *resultPtr; 695 696 standardPath: 697 resultPtr = NULL; 698 if (portion == TCL_PATH_EXTENSION) { 699 return GetExtension(pathPtr); 700 } else if (portion == TCL_PATH_ROOT) { 701 int length; 702 const char *fileName, *extension; 703 704 fileName = Tcl_GetStringFromObj(pathPtr, &length); 705 extension = TclGetExtension(fileName); 706 if (extension == NULL) { 707 Tcl_IncrRefCount(pathPtr); 708 return pathPtr; 709 } else { 710 Tcl_Obj *root = Tcl_NewStringObj(fileName, 711 (int) (length - strlen(extension))); 712 713 Tcl_IncrRefCount(root); 714 return root; 715 } 716 } 717 718 /* 719 * The behaviour we want here is slightly different to the standard 720 * Tcl_FSSplitPath in the handling of home directories; 721 * Tcl_FSSplitPath preserves the "~" while this code computes the 722 * actual full path name, if we had just a single component. 723 */ 724 725 splitPtr = Tcl_FSSplitPath(pathPtr, &splitElements); 726 Tcl_IncrRefCount(splitPtr); 727 if (splitElements == 1 && TclGetString(pathPtr)[0] == '~') { 728 Tcl_Obj *norm; 729 730 TclDecrRefCount(splitPtr); 731 norm = Tcl_FSGetNormalizedPath(interp, pathPtr); 732 if (norm == NULL) { 733 return NULL; 734 } 735 splitPtr = Tcl_FSSplitPath(norm, &splitElements); 736 Tcl_IncrRefCount(splitPtr); 737 } 738 if (portion == TCL_PATH_TAIL) { 739 /* 740 * Return the last component, unless it is the only component, and 741 * it is the root of an absolute path. 742 */ 743 744 if ((splitElements > 0) && ((splitElements > 1) || 745 (Tcl_FSGetPathType(pathPtr) == TCL_PATH_RELATIVE))) { 746 Tcl_ListObjIndex(NULL, splitPtr, splitElements-1, &resultPtr); 747 } else { 748 resultPtr = Tcl_NewObj(); 749 } 750 } else { 751 /* 752 * Return all but the last component. If there is only one 753 * component, return it if the path was non-relative, otherwise 754 * return the current directory. 755 */ 756 757 if (splitElements > 1) { 758 resultPtr = Tcl_FSJoinPath(splitPtr, splitElements - 1); 759 } else if (splitElements == 0 || 760 (Tcl_FSGetPathType(pathPtr) == TCL_PATH_RELATIVE)) { 761 TclNewLiteralStringObj(resultPtr, "."); 762 } else { 763 Tcl_ListObjIndex(NULL, splitPtr, 0, &resultPtr); 764 } 765 } 766 Tcl_IncrRefCount(resultPtr); 767 TclDecrRefCount(splitPtr); 768 return resultPtr; 769 } 770} 771 772/* 773 * Simple helper function 774 */ 775 776static Tcl_Obj * 777GetExtension( 778 Tcl_Obj *pathPtr) 779{ 780 const char *tail, *extension; 781 Tcl_Obj *ret; 782 783 tail = TclGetString(pathPtr); 784 extension = TclGetExtension(tail); 785 if (extension == NULL) { 786 ret = Tcl_NewObj(); 787 } else { 788 ret = Tcl_NewStringObj(extension, -1); 789 } 790 Tcl_IncrRefCount(ret); 791 return ret; 792} 793 794/* 795 *--------------------------------------------------------------------------- 796 * 797 * Tcl_FSJoinPath -- 798 * 799 * This function takes the given Tcl_Obj, which should be a valid list, 800 * and returns the path object given by considering the first 'elements' 801 * elements as valid path segments (each path segment may be a complete 802 * path, a partial path or just a single possible directory or file 803 * name). If any path segment is actually an absolute path, then all 804 * prior path segments are discarded. 805 * 806 * If elements < 0, we use the entire list that was given. 807 * 808 * It is possible that the returned object is actually an element of the 809 * given list, so the caller should be careful to store a refCount to it 810 * before freeing the list. 811 * 812 * Results: 813 * Returns object with refCount of zero, (or if non-zero, it has 814 * references elsewhere in Tcl). Either way, the caller must increment 815 * its refCount before use. Note that in the case where the caller has 816 * asked to join zero elements of the list, the return value will be an 817 * empty-string Tcl_Obj. 818 * 819 * If the given listObj was invalid, then the calling routine has a bug, 820 * and this function will just return NULL. 821 * 822 * Side effects: 823 * None. 824 * 825 *--------------------------------------------------------------------------- 826 */ 827 828Tcl_Obj * 829Tcl_FSJoinPath( 830 Tcl_Obj *listObj, /* Path elements to join, may have a zero 831 * reference count. */ 832 int elements) /* Number of elements to use (-1 = all) */ 833{ 834 Tcl_Obj *res; 835 int i; 836 Tcl_Filesystem *fsPtr = NULL; 837 838 if (elements < 0) { 839 if (Tcl_ListObjLength(NULL, listObj, &elements) != TCL_OK) { 840 return NULL; 841 } 842 } else { 843 /* 844 * Just make sure it is a valid list. 845 */ 846 847 int listTest; 848 849 if (Tcl_ListObjLength(NULL, listObj, &listTest) != TCL_OK) { 850 return NULL; 851 } 852 853 /* 854 * Correct this if it is too large, otherwise we will waste our time 855 * joining null elements to the path. 856 */ 857 858 if (elements > listTest) { 859 elements = listTest; 860 } 861 } 862 863 res = NULL; 864 865 for (i = 0; i < elements; i++) { 866 Tcl_Obj *elt, *driveName = NULL; 867 int driveNameLength, strEltLen, length; 868 Tcl_PathType type; 869 char *strElt, *ptr; 870 871 Tcl_ListObjIndex(NULL, listObj, i, &elt); 872 873 /* 874 * This is a special case where we can be much more efficient, where 875 * we are joining a single relative path onto an object that is 876 * already of path type. The 'TclNewFSPathObj' call below creates an 877 * object which can be normalized more efficiently. Currently we only 878 * use the special case when we have exactly two elements, but we 879 * could expand that in the future. 880 */ 881 882 if ((i == (elements-2)) && (i == 0) && (elt->typePtr == &tclFsPathType) 883 && !(elt->bytes != NULL && (elt->bytes[0] == '\0'))) { 884 Tcl_Obj *tail; 885 886 Tcl_ListObjIndex(NULL, listObj, i+1, &tail); 887 type = TclGetPathType(tail, NULL, NULL, NULL); 888 if (type == TCL_PATH_RELATIVE) { 889 const char *str; 890 int len; 891 892 str = Tcl_GetStringFromObj(tail, &len); 893 if (len == 0) { 894 /* 895 * This happens if we try to handle the root volume '/'. 896 * There's no need to return a special path object, when 897 * the base itself is just fine! 898 */ 899 900 if (res != NULL) { 901 TclDecrRefCount(res); 902 } 903 return elt; 904 } 905 906 /* 907 * If it doesn't begin with '.' and is a unix path or it a 908 * windows path without backslashes, then we can be very 909 * efficient here. (In fact even a windows path with 910 * backslashes can be joined efficiently, but the path object 911 * would not have forward slashes only, and this would 912 * therefore contradict our 'file join' documentation). 913 */ 914 915 if (str[0] != '.' && ((tclPlatform != TCL_PLATFORM_WINDOWS) 916 || (strchr(str, '\\') == NULL))) { 917 /* 918 * Finally, on Windows, 'file join' is defined to convert 919 * all backslashes to forward slashes, so the base part 920 * cannot have backslashes either. 921 */ 922 923 if ((tclPlatform != TCL_PLATFORM_WINDOWS) 924 || (strchr(Tcl_GetString(elt), '\\') == NULL)) { 925 if (res != NULL) { 926 TclDecrRefCount(res); 927 } 928 return TclNewFSPathObj(elt, str, len); 929 } 930 } 931 932 /* 933 * Otherwise we don't have an easy join, and we must let the 934 * more general code below handle things. 935 */ 936 } else if (tclPlatform == TCL_PLATFORM_UNIX) { 937 if (res != NULL) { 938 TclDecrRefCount(res); 939 } 940 return tail; 941 } else { 942 const char *str = TclGetString(tail); 943 944 if (tclPlatform == TCL_PLATFORM_WINDOWS) { 945 if (strchr(str, '\\') == NULL) { 946 if (res != NULL) { 947 TclDecrRefCount(res); 948 } 949 return tail; 950 } 951 } 952 } 953 } 954 strElt = Tcl_GetStringFromObj(elt, &strEltLen); 955 type = TclGetPathType(elt, &fsPtr, &driveNameLength, &driveName); 956 if (type != TCL_PATH_RELATIVE) { 957 /* 958 * Zero out the current result. 959 */ 960 961 if (res != NULL) { 962 TclDecrRefCount(res); 963 } 964 965 if (driveName != NULL) { 966 /* 967 * We've been given a separate drive-name object, because the 968 * prefix in 'elt' is not in a suitable format for us (e.g. it 969 * may contain irrelevant multiple separators, like 970 * C://///foo). 971 */ 972 973 res = Tcl_DuplicateObj(driveName); 974 TclDecrRefCount(driveName); 975 976 /* 977 * Do not set driveName to NULL, because we will check its 978 * value below (but we won't access the contents, since those 979 * have been cleaned-up). 980 */ 981 } else { 982 res = Tcl_NewStringObj(strElt, driveNameLength); 983 } 984 strElt += driveNameLength; 985 } else if (driveName != NULL) { 986 Tcl_DecrRefCount(driveName); 987 } 988 989 /* 990 * Optimisation block: if this is the last element to be examined, and 991 * it is absolute or the only element, and the drive-prefix was ok (if 992 * there is one), it might be that the path is already in a suitable 993 * form to be returned. Then we can short-cut the rest of this 994 * function. 995 */ 996 997 if ((driveName == NULL) && (i == (elements - 1)) 998 && (type != TCL_PATH_RELATIVE || res == NULL)) { 999 /* 1000 * It's the last path segment. Perform a quick check if the path 1001 * is already in a suitable form. 1002 */ 1003 1004 if (tclPlatform == TCL_PLATFORM_WINDOWS) { 1005 if (strchr(strElt, '\\') != NULL) { 1006 goto noQuickReturn; 1007 } 1008 } 1009 ptr = strElt; 1010 while (*ptr != '\0') { 1011 if (*ptr == '/' && (ptr[1] == '/' || ptr[1] == '\0')) { 1012 /* 1013 * We have a repeated file separator, which means the path 1014 * is not in normalized form 1015 */ 1016 1017 goto noQuickReturn; 1018 } 1019 ptr++; 1020 } 1021 if (res != NULL) { 1022 TclDecrRefCount(res); 1023 } 1024 1025 /* 1026 * This element is just what we want to return already - no 1027 * further manipulation is requred. 1028 */ 1029 1030 return elt; 1031 } 1032 1033 /* 1034 * The path element was not of a suitable form to be returned as is. 1035 * We need to perform a more complex operation here. 1036 */ 1037 1038 noQuickReturn: 1039 if (res == NULL) { 1040 res = Tcl_NewObj(); 1041 ptr = Tcl_GetStringFromObj(res, &length); 1042 } else { 1043 ptr = Tcl_GetStringFromObj(res, &length); 1044 } 1045 1046 /* 1047 * Strip off any './' before a tilde, unless this is the beginning of 1048 * the path. 1049 */ 1050 1051 if (length > 0 && strEltLen > 0 && (strElt[0] == '.') && 1052 (strElt[1] == '/') && (strElt[2] == '~')) { 1053 strElt += 2; 1054 } 1055 1056 /* 1057 * A NULL value for fsPtr at this stage basically means we're trying 1058 * to join a relative path onto something which is also relative (or 1059 * empty). There's nothing particularly wrong with that. 1060 */ 1061 1062 if (*strElt == '\0') { 1063 continue; 1064 } 1065 1066 if (fsPtr == &tclNativeFilesystem || fsPtr == NULL) { 1067 TclpNativeJoinPath(res, strElt); 1068 } else { 1069 char separator = '/'; 1070 int needsSep = 0; 1071 1072 if (fsPtr->filesystemSeparatorProc != NULL) { 1073 Tcl_Obj *sep = (*fsPtr->filesystemSeparatorProc)(res); 1074 1075 if (sep != NULL) { 1076 separator = TclGetString(sep)[0]; 1077 } 1078 } 1079 1080 if (length > 0 && ptr[length -1] != '/') { 1081 Tcl_AppendToObj(res, &separator, 1); 1082 length++; 1083 } 1084 Tcl_SetObjLength(res, length + (int) strlen(strElt)); 1085 1086 ptr = TclGetString(res) + length; 1087 for (; *strElt != '\0'; strElt++) { 1088 if (*strElt == separator) { 1089 while (strElt[1] == separator) { 1090 strElt++; 1091 } 1092 if (strElt[1] != '\0') { 1093 if (needsSep) { 1094 *ptr++ = separator; 1095 } 1096 } 1097 } else { 1098 *ptr++ = *strElt; 1099 needsSep = 1; 1100 } 1101 } 1102 length = ptr - TclGetString(res); 1103 Tcl_SetObjLength(res, length); 1104 } 1105 } 1106 if (res == NULL) { 1107 res = Tcl_NewObj(); 1108 } 1109 return res; 1110} 1111 1112/* 1113 *--------------------------------------------------------------------------- 1114 * 1115 * Tcl_FSConvertToPathType -- 1116 * 1117 * This function tries to convert the given Tcl_Obj to a valid Tcl path 1118 * type, taking account of the fact that the cwd may have changed even if 1119 * this object is already supposedly of the correct type. 1120 * 1121 * The filename may begin with "~" (to indicate current user's home 1122 * directory) or "~<user>" (to indicate any user's home directory). 1123 * 1124 * Results: 1125 * Standard Tcl error code. 1126 * 1127 * Side effects: 1128 * The old representation may be freed, and new memory allocated. 1129 * 1130 *--------------------------------------------------------------------------- 1131 */ 1132 1133int 1134Tcl_FSConvertToPathType( 1135 Tcl_Interp *interp, /* Interpreter in which to store error message 1136 * (if necessary). */ 1137 Tcl_Obj *pathPtr) /* Object to convert to a valid, current path 1138 * type. */ 1139{ 1140 /* 1141 * While it is bad practice to examine an object's type directly, this is 1142 * actually the best thing to do here. The reason is that if we are 1143 * converting this object to FsPath type for the first time, we don't need 1144 * to worry whether the 'cwd' has changed. On the other hand, if this 1145 * object is already of FsPath type, and is a relative path, we do have to 1146 * worry about the cwd. If the cwd has changed, we must recompute the 1147 * path. 1148 */ 1149 1150 if (pathPtr->typePtr == &tclFsPathType) { 1151 if (TclFSEpochOk(PATHOBJ(pathPtr)->filesystemEpoch)) { 1152 return TCL_OK; 1153 } 1154 1155 if (pathPtr->bytes == NULL) { 1156 UpdateStringOfFsPath(pathPtr); 1157 } 1158 FreeFsPathInternalRep(pathPtr); 1159 pathPtr->typePtr = NULL; 1160 } 1161 1162 return Tcl_ConvertToType(interp, pathPtr, &tclFsPathType); 1163 1164 /* 1165 * We used to have more complex code here: 1166 * 1167 * FsPath *fsPathPtr = PATHOBJ(pathPtr); 1168 * if (fsPathPtr->cwdPtr == NULL || PATHFLAGS(pathPtr) != 0) { 1169 * return TCL_OK; 1170 * } else { 1171 * if (TclFSCwdPointerEquals(&fsPathPtr->cwdPtr)) { 1172 * return TCL_OK; 1173 * } else { 1174 * if (pathPtr->bytes == NULL) { 1175 * UpdateStringOfFsPath(pathPtr); 1176 * } 1177 * FreeFsPathInternalRep(pathPtr); 1178 * pathPtr->typePtr = NULL; 1179 * return Tcl_ConvertToType(interp, pathPtr, &tclFsPathType); 1180 * } 1181 * } 1182 * 1183 * But we no longer believe this is necessary. 1184 */ 1185} 1186 1187/* 1188 * Helper function for normalization. 1189 */ 1190 1191static int 1192IsSeparatorOrNull( 1193 int ch) 1194{ 1195 if (ch == 0) { 1196 return 1; 1197 } 1198 switch (tclPlatform) { 1199 case TCL_PLATFORM_UNIX: 1200 return (ch == '/' ? 1 : 0); 1201 case TCL_PLATFORM_WINDOWS: 1202 return ((ch == '/' || ch == '\\') ? 1 : 0); 1203 } 1204 return 0; 1205} 1206 1207/* 1208 * Helper function for SetFsPathFromAny. Returns position of first directory 1209 * delimiter in the path. If no separator is found, then returns the position 1210 * of the end of the string. 1211 */ 1212 1213static int 1214FindSplitPos( 1215 const char *path, 1216 int separator) 1217{ 1218 int count = 0; 1219 switch (tclPlatform) { 1220 case TCL_PLATFORM_UNIX: 1221 while (path[count] != 0) { 1222 if (path[count] == separator) { 1223 return count; 1224 } 1225 count++; 1226 } 1227 break; 1228 1229 case TCL_PLATFORM_WINDOWS: 1230 while (path[count] != 0) { 1231 if (path[count] == separator || path[count] == '\\') { 1232 return count; 1233 } 1234 count++; 1235 } 1236 break; 1237 } 1238 return count; 1239} 1240 1241/* 1242 *--------------------------------------------------------------------------- 1243 * 1244 * TclNewFSPathObj -- 1245 * 1246 * Creates a path object whose string representation is '[file join 1247 * dirPtr addStrRep]', but does so in a way that allows for more 1248 * efficient creation and caching of normalized paths, and more efficient 1249 * 'file dirname', 'file tail', etc. 1250 * 1251 * Assumptions: 1252 * 'dirPtr' must be an absolute path. 'len' may not be zero. 1253 * 1254 * Results: 1255 * The new Tcl object, with refCount zero. 1256 * 1257 * Side effects: 1258 * Memory is allocated. 'dirPtr' gets an additional refCount. 1259 * 1260 *--------------------------------------------------------------------------- 1261 */ 1262 1263Tcl_Obj * 1264TclNewFSPathObj( 1265 Tcl_Obj *dirPtr, 1266 const char *addStrRep, 1267 int len) 1268{ 1269 FsPath *fsPathPtr; 1270 Tcl_Obj *pathPtr; 1271 ThreadSpecificData *tsdPtr; 1272 const char *p; 1273 int state = 0, count = 0; 1274 1275 /* [Bug 2806250] - this is only a partial solution of the problem. 1276 * The PATHFLAGS != 0 representation assumes in many places that 1277 * the "tail" part stored in the normPathPtr field is itself a 1278 * relative path. Strings that begin with "~" are not relative paths, 1279 * so we must prevent their storage in the normPathPtr field. 1280 * 1281 * More generally we ought to be testing "addStrRep" for any value 1282 * that is not a relative path, but in an unconstrained VFS world 1283 * that could be just about anything, and testing could be expensive. 1284 * Since this routine plays a big role in [glob], anything that slows 1285 * it down would be unwelcome. For now, continue the risk of further 1286 * bugs when some Tcl_Filesystem uses otherwise relative path strings 1287 * as absolute path strings. Sensible Tcl_Filesystems will avoid 1288 * that by mounting on path prefixes like foo:// which cannot be the 1289 * name of a file or directory read from a native [glob] operation. 1290 */ 1291 if (addStrRep[0] == '~') { 1292 Tcl_Obj *tail = Tcl_NewStringObj(addStrRep, len); 1293 1294 pathPtr = AppendPath(dirPtr, tail); 1295 Tcl_DecrRefCount(tail); 1296 return pathPtr; 1297 } 1298 1299 tsdPtr = TCL_TSD_INIT(&tclFsDataKey); 1300 1301 pathPtr = Tcl_NewObj(); 1302 fsPathPtr = (FsPath *) ckalloc(sizeof(FsPath)); 1303 1304 /* 1305 * Set up the path. 1306 */ 1307 1308 fsPathPtr->translatedPathPtr = NULL; 1309 fsPathPtr->normPathPtr = Tcl_NewStringObj(addStrRep, len); 1310 Tcl_IncrRefCount(fsPathPtr->normPathPtr); 1311 fsPathPtr->cwdPtr = dirPtr; 1312 Tcl_IncrRefCount(dirPtr); 1313 fsPathPtr->nativePathPtr = NULL; 1314 fsPathPtr->fsRecPtr = NULL; 1315 fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; 1316 1317 SETPATHOBJ(pathPtr, fsPathPtr); 1318 PATHFLAGS(pathPtr) = TCLPATH_APPENDED; 1319 pathPtr->typePtr = &tclFsPathType; 1320 pathPtr->bytes = NULL; 1321 pathPtr->length = 0; 1322 1323 /* 1324 * Look for path components made up of only "." 1325 * This is overly conservative analysis to keep simple. It may 1326 * mark some things as needing more aggressive normalization 1327 * that don't actually need it. No harm done. 1328 */ 1329 for (p = addStrRep; len > 0; p++, len--) { 1330 switch (state) { 1331 case 0: /* So far only "." since last dirsep or start */ 1332 switch (*p) { 1333 case '.': 1334 count++; 1335 break; 1336 case '/': 1337 case '\\': 1338 case ':': 1339 if (count) { 1340 PATHFLAGS(pathPtr) |= TCLPATH_NEEDNORM; 1341 len = 0; 1342 } 1343 break; 1344 default: 1345 count = 0; 1346 state = 1; 1347 } 1348 case 1: /* Scanning for next dirsep */ 1349 switch (*p) { 1350 case '/': 1351 case '\\': 1352 case ':': 1353 state = 0; 1354 break; 1355 } 1356 } 1357 } 1358 if (len == 0 && count) { 1359 PATHFLAGS(pathPtr) |= TCLPATH_NEEDNORM; 1360 } 1361 1362 return pathPtr; 1363} 1364 1365static Tcl_Obj * 1366AppendPath( 1367 Tcl_Obj *head, 1368 Tcl_Obj *tail) 1369{ 1370 int numBytes; 1371 const char *bytes; 1372 Tcl_Obj *copy = Tcl_DuplicateObj(head); 1373 1374 bytes = Tcl_GetStringFromObj(copy, &numBytes); 1375 1376 /* 1377 * Should we perhaps use 'Tcl_FSPathSeparator'? But then what about the 1378 * Windows special case? Perhaps we should just check if cwd is a root 1379 * volume. We should never get numBytes == 0 in this code path. 1380 */ 1381 1382 switch (tclPlatform) { 1383 case TCL_PLATFORM_UNIX: 1384 if (bytes[numBytes-1] != '/') { 1385 Tcl_AppendToObj(copy, "/", 1); 1386 } 1387 break; 1388 1389 case TCL_PLATFORM_WINDOWS: 1390 /* 1391 * We need the extra 'numBytes != 2', and ':' checks because a volume 1392 * relative path doesn't get a '/'. For example 'glob C:*cat*.exe' 1393 * will return 'C:cat32.exe' 1394 */ 1395 1396 if (bytes[numBytes-1] != '/' && bytes[numBytes-1] != '\\') { 1397 if (numBytes!= 2 || bytes[1] != ':') { 1398 Tcl_AppendToObj(copy, "/", 1); 1399 } 1400 } 1401 break; 1402 } 1403 1404 Tcl_AppendObjToObj(copy, tail); 1405 return copy; 1406} 1407 1408/* 1409 *--------------------------------------------------------------------------- 1410 * 1411 * TclFSMakePathRelative -- 1412 * 1413 * Only for internal use. 1414 * 1415 * Takes a path and a directory, where we _assume_ both path and 1416 * directory are absolute, normalized and that the path lies inside the 1417 * directory. Returns a Tcl_Obj representing filename of the path 1418 * relative to the directory. 1419 * 1420 * Results: 1421 * NULL on error, otherwise a valid object, typically with refCount of 1422 * zero, which it is assumed the caller will increment. 1423 * 1424 * Side effects: 1425 * The old representation may be freed, and new memory allocated. 1426 * 1427 *--------------------------------------------------------------------------- 1428 */ 1429 1430Tcl_Obj * 1431TclFSMakePathRelative( 1432 Tcl_Interp *interp, /* Used for error reporting if not NULL. */ 1433 Tcl_Obj *pathPtr, /* The path we have. */ 1434 Tcl_Obj *cwdPtr) /* Make it relative to this. */ 1435{ 1436 int cwdLen, len; 1437 const char *tempStr; 1438 ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); 1439 1440 if (pathPtr->typePtr == &tclFsPathType) { 1441 FsPath *fsPathPtr = PATHOBJ(pathPtr); 1442 1443 if (PATHFLAGS(pathPtr) != 0 1444 && fsPathPtr->cwdPtr == cwdPtr) { 1445 pathPtr = fsPathPtr->normPathPtr; 1446 1447 /* TODO: Determine how much, if any, of this forcing 1448 * the relative path tail into the "path" Tcl_ObjType 1449 * with a recorded cwdPtr context has any actual value. 1450 * 1451 * Nothing is getting cached. Not normPathPtr, not nativePathPtr, 1452 * nor fsRecPtr, so storing the cwdPtr context against which such 1453 * cached values might later be validated appears to be of no 1454 * value. Take that away, and all this code is just a mildly 1455 * optimized equivalent of a call to SetFsPathFromAny(). That 1456 * optimization may have some value, *if* these value in fact 1457 * get used as "path" values before used as something else. 1458 * If not, though, whatever cost we pay below to convert to 1459 * one of the "path" intreps is just a waste, it seems. The 1460 * usual convention in the core is to delay ObjType conversion 1461 * until it is needed and demanded, and I don't see why this 1462 * section of code should be an exception to that. Leaving it 1463 * in place for the rest of the 8.5.* releases just for sake 1464 * of stability. 1465 */ 1466 1467 /* 1468 * Free old representation. 1469 */ 1470 1471 if (pathPtr->typePtr != NULL) { 1472 if (pathPtr->bytes == NULL) { 1473 if (pathPtr->typePtr->updateStringProc == NULL) { 1474 if (interp != NULL) { 1475 Tcl_ResetResult(interp); 1476 Tcl_AppendResult(interp, "can't find object" 1477 "string representation", NULL); 1478 } 1479 return NULL; 1480 } 1481 pathPtr->typePtr->updateStringProc(pathPtr); 1482 } 1483 TclFreeIntRep(pathPtr); 1484 } 1485 1486 /* 1487 * Now pathPtr is a string object. 1488 */ 1489 1490 fsPathPtr = (FsPath *) ckalloc(sizeof(FsPath)); 1491 1492 /* 1493 * Circular reference, by design. 1494 */ 1495 1496 fsPathPtr->translatedPathPtr = pathPtr; 1497 fsPathPtr->normPathPtr = NULL; 1498 fsPathPtr->cwdPtr = cwdPtr; 1499 Tcl_IncrRefCount(cwdPtr); 1500 fsPathPtr->nativePathPtr = NULL; 1501 fsPathPtr->fsRecPtr = NULL; 1502 fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; 1503 1504 SETPATHOBJ(pathPtr, fsPathPtr); 1505 PATHFLAGS(pathPtr) = 0; 1506 pathPtr->typePtr = &tclFsPathType; 1507 1508 return pathPtr; 1509 } 1510 } 1511 1512 /* 1513 * We know the cwd is a normalised object which does not end in a 1514 * directory delimiter, unless the cwd is the name of a volume, in which 1515 * case it will end in a delimiter! We handle this situation here. A 1516 * better test than the '!= sep' might be to simply check if 'cwd' is a 1517 * root volume. 1518 * 1519 * Note that if we get this wrong, we will strip off either too much or 1520 * too little below, leading to wrong answers returned by glob. 1521 */ 1522 1523 tempStr = Tcl_GetStringFromObj(cwdPtr, &cwdLen); 1524 1525 /* 1526 * Should we perhaps use 'Tcl_FSPathSeparator'? But then what about the 1527 * Windows special case? Perhaps we should just check if cwd is a root 1528 * volume. 1529 */ 1530 1531 switch (tclPlatform) { 1532 case TCL_PLATFORM_UNIX: 1533 if (tempStr[cwdLen-1] != '/') { 1534 cwdLen++; 1535 } 1536 break; 1537 case TCL_PLATFORM_WINDOWS: 1538 if (tempStr[cwdLen-1] != '/' && tempStr[cwdLen-1] != '\\') { 1539 cwdLen++; 1540 } 1541 break; 1542 } 1543 tempStr = Tcl_GetStringFromObj(pathPtr, &len); 1544 1545 return Tcl_NewStringObj(tempStr + cwdLen, len - cwdLen); 1546} 1547 1548/* 1549 *--------------------------------------------------------------------------- 1550 * 1551 * TclFSMakePathFromNormalized -- 1552 * 1553 * Like SetFsPathFromAny, but assumes the given object is an absolute 1554 * normalized path. Only for internal use. 1555 * 1556 * Results: 1557 * Standard Tcl error code. 1558 * 1559 * Side effects: 1560 * The old representation may be freed, and new memory allocated. 1561 * 1562 *--------------------------------------------------------------------------- 1563 */ 1564 1565int 1566TclFSMakePathFromNormalized( 1567 Tcl_Interp *interp, /* Used for error reporting if not NULL. */ 1568 Tcl_Obj *pathPtr, /* The object to convert. */ 1569 ClientData nativeRep) /* The native rep for the object, if known 1570 * else NULL. */ 1571{ 1572 FsPath *fsPathPtr; 1573 ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); 1574 1575 if (pathPtr->typePtr == &tclFsPathType) { 1576 return TCL_OK; 1577 } 1578 1579 /* 1580 * Free old representation 1581 */ 1582 1583 if (pathPtr->typePtr != NULL) { 1584 if (pathPtr->bytes == NULL) { 1585 if (pathPtr->typePtr->updateStringProc == NULL) { 1586 if (interp != NULL) { 1587 Tcl_ResetResult(interp); 1588 Tcl_AppendResult(interp, "can't find object" 1589 "string representation", NULL); 1590 } 1591 return TCL_ERROR; 1592 } 1593 pathPtr->typePtr->updateStringProc(pathPtr); 1594 } 1595 TclFreeIntRep(pathPtr); 1596 } 1597 1598 fsPathPtr = (FsPath *) ckalloc(sizeof(FsPath)); 1599 1600 /* 1601 * It's a pure normalized absolute path. 1602 */ 1603 1604 fsPathPtr->translatedPathPtr = NULL; 1605 1606 /* 1607 * Circular reference by design. 1608 */ 1609 1610 fsPathPtr->normPathPtr = pathPtr; 1611 fsPathPtr->cwdPtr = NULL; 1612 fsPathPtr->nativePathPtr = nativeRep; 1613 fsPathPtr->fsRecPtr = NULL; 1614 fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; 1615 1616 SETPATHOBJ(pathPtr, fsPathPtr); 1617 PATHFLAGS(pathPtr) = 0; 1618 pathPtr->typePtr = &tclFsPathType; 1619 1620 return TCL_OK; 1621} 1622 1623/* 1624 *--------------------------------------------------------------------------- 1625 * 1626 * Tcl_FSNewNativePath -- 1627 * 1628 * This function performs the something like the reverse of the usual 1629 * obj->path->nativerep conversions. If some code retrieves a path in 1630 * native form (from, e.g. readlink or a native dialog), and that path is 1631 * to be used at the Tcl level, then calling this function is an 1632 * efficient way of creating the appropriate path object type. 1633 * 1634 * Any memory which is allocated for 'clientData' should be retained 1635 * until clientData is passed to the filesystem's freeInternalRepProc 1636 * when it can be freed. The built in platform-specific filesystems use 1637 * 'ckalloc' to allocate clientData, and ckfree to free it. 1638 * 1639 * Results: 1640 * NULL or a valid path object pointer, with refCount zero. 1641 * 1642 * Side effects: 1643 * New memory may be allocated. 1644 * 1645 *--------------------------------------------------------------------------- 1646 */ 1647 1648Tcl_Obj * 1649Tcl_FSNewNativePath( 1650 Tcl_Filesystem *fromFilesystem, 1651 ClientData clientData) 1652{ 1653 Tcl_Obj *pathPtr; 1654 FsPath *fsPathPtr; 1655 1656 FilesystemRecord *fsFromPtr; 1657 ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); 1658 1659 pathPtr = TclFSInternalToNormalized(fromFilesystem, clientData, 1660 &fsFromPtr); 1661 if (pathPtr == NULL) { 1662 return NULL; 1663 } 1664 1665 /* 1666 * Free old representation; shouldn't normally be any, but best to be 1667 * safe. 1668 */ 1669 1670 if (pathPtr->typePtr != NULL) { 1671 if (pathPtr->bytes == NULL) { 1672 if (pathPtr->typePtr->updateStringProc == NULL) { 1673 return NULL; 1674 } 1675 pathPtr->typePtr->updateStringProc(pathPtr); 1676 } 1677 TclFreeIntRep(pathPtr); 1678 } 1679 1680 fsPathPtr = (FsPath *) ckalloc(sizeof(FsPath)); 1681 1682 fsPathPtr->translatedPathPtr = NULL; 1683 1684 /* 1685 * Circular reference, by design. 1686 */ 1687 1688 fsPathPtr->normPathPtr = pathPtr; 1689 fsPathPtr->cwdPtr = NULL; 1690 fsPathPtr->nativePathPtr = clientData; 1691 fsPathPtr->fsRecPtr = fsFromPtr; 1692 fsPathPtr->fsRecPtr->fileRefCount++; 1693 fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; 1694 1695 SETPATHOBJ(pathPtr, fsPathPtr); 1696 PATHFLAGS(pathPtr) = 0; 1697 pathPtr->typePtr = &tclFsPathType; 1698 1699 return pathPtr; 1700} 1701 1702/* 1703 *--------------------------------------------------------------------------- 1704 * 1705 * Tcl_FSGetTranslatedPath -- 1706 * 1707 * This function attempts to extract the translated path from the given 1708 * Tcl_Obj. If the translation succeeds (i.e. the object is a valid 1709 * path), then it is returned. Otherwise NULL will be returned, and an 1710 * error message may be left in the interpreter (if it is non-NULL) 1711 * 1712 * Results: 1713 * NULL or a valid Tcl_Obj pointer. 1714 * 1715 * Side effects: 1716 * Only those of 'Tcl_FSConvertToPathType' 1717 * 1718 *--------------------------------------------------------------------------- 1719 */ 1720 1721Tcl_Obj * 1722Tcl_FSGetTranslatedPath( 1723 Tcl_Interp *interp, 1724 Tcl_Obj *pathPtr) 1725{ 1726 Tcl_Obj *retObj = NULL; 1727 FsPath *srcFsPathPtr; 1728 1729 if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) { 1730 return NULL; 1731 } 1732 srcFsPathPtr = PATHOBJ(pathPtr); 1733 if (srcFsPathPtr->translatedPathPtr == NULL) { 1734 if (PATHFLAGS(pathPtr) != 0) { 1735 /* 1736 * We lack a translated path result, but we have a directory 1737 * (cwdPtr) and a tail (normPathPtr), and if we join the 1738 * translated version of cwdPtr to normPathPtr, we'll get the 1739 * translated result we need, and can store it for future use. 1740 */ 1741 1742 Tcl_Obj *translatedCwdPtr = Tcl_FSGetTranslatedPath(interp, 1743 srcFsPathPtr->cwdPtr); 1744 if (translatedCwdPtr == NULL) { 1745 return NULL; 1746 } 1747 1748 retObj = Tcl_FSJoinToPath(translatedCwdPtr, 1, 1749 &(srcFsPathPtr->normPathPtr)); 1750 srcFsPathPtr->translatedPathPtr = retObj; 1751 Tcl_IncrRefCount(retObj); 1752 Tcl_DecrRefCount(translatedCwdPtr); 1753 } else { 1754 /* 1755 * It is a pure absolute, normalized path object. This is 1756 * something like being a 'pure list'. The object's string, 1757 * translatedPath and normalizedPath are all identical. 1758 */ 1759 1760 retObj = srcFsPathPtr->normPathPtr; 1761 } 1762 } else { 1763 /* 1764 * It is an ordinary path object. 1765 */ 1766 1767 retObj = srcFsPathPtr->translatedPathPtr; 1768 } 1769 1770 if (retObj != NULL) { 1771 Tcl_IncrRefCount(retObj); 1772 } 1773 return retObj; 1774} 1775 1776/* 1777 *--------------------------------------------------------------------------- 1778 * 1779 * Tcl_FSGetTranslatedStringPath -- 1780 * 1781 * This function attempts to extract the translated path from the given 1782 * Tcl_Obj. If the translation succeeds (i.e. the object is a valid 1783 * path), then the path is returned. Otherwise NULL will be returned, and 1784 * an error message may be left in the interpreter (if it is non-NULL) 1785 * 1786 * Results: 1787 * NULL or a valid string. 1788 * 1789 * Side effects: 1790 * Only those of 'Tcl_FSConvertToPathType' 1791 * 1792 *--------------------------------------------------------------------------- 1793 */ 1794 1795const char * 1796Tcl_FSGetTranslatedStringPath( 1797 Tcl_Interp *interp, 1798 Tcl_Obj *pathPtr) 1799{ 1800 Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr); 1801 1802 if (transPtr != NULL) { 1803 int len; 1804 const char *orig = Tcl_GetStringFromObj(transPtr, &len); 1805 char *result = (char *) ckalloc((unsigned) len+1); 1806 1807 memcpy(result, orig, (size_t) len+1); 1808 TclDecrRefCount(transPtr); 1809 return result; 1810 } 1811 1812 return NULL; 1813} 1814 1815/* 1816 *--------------------------------------------------------------------------- 1817 * 1818 * Tcl_FSGetNormalizedPath -- 1819 * 1820 * This important function attempts to extract from the given Tcl_Obj a 1821 * unique normalised path representation, whose string value can be used 1822 * as a unique identifier for the file. 1823 * 1824 * Results: 1825 * NULL or a valid path object pointer. 1826 * 1827 * Side effects: 1828 * New memory may be allocated. The Tcl 'errno' may be modified in the 1829 * process of trying to examine various path possibilities. 1830 * 1831 *--------------------------------------------------------------------------- 1832 */ 1833 1834Tcl_Obj * 1835Tcl_FSGetNormalizedPath( 1836 Tcl_Interp *interp, 1837 Tcl_Obj *pathPtr) 1838{ 1839 FsPath *fsPathPtr; 1840 1841 if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) { 1842 return NULL; 1843 } 1844 fsPathPtr = PATHOBJ(pathPtr); 1845 1846 if (PATHFLAGS(pathPtr) != 0) { 1847 /* 1848 * This is a special path object which is the result of something like 1849 * 'file join' 1850 */ 1851 1852 Tcl_Obj *dir, *copy; 1853 int cwdLen, pathType; 1854 ClientData clientData = NULL; 1855 1856 pathType = Tcl_FSGetPathType(fsPathPtr->cwdPtr); 1857 dir = Tcl_FSGetNormalizedPath(interp, fsPathPtr->cwdPtr); 1858 if (dir == NULL) { 1859 return NULL; 1860 } 1861 /* TODO: Figure out why this is needed. */ 1862 if (pathPtr->bytes == NULL) { 1863 UpdateStringOfFsPath(pathPtr); 1864 } 1865 1866 copy = AppendPath(dir, fsPathPtr->normPathPtr); 1867 Tcl_IncrRefCount(dir); 1868 Tcl_IncrRefCount(copy); 1869 1870 /* 1871 * We now own a reference on both 'dir' and 'copy' 1872 */ 1873 1874 (void) Tcl_GetStringFromObj(dir, &cwdLen); 1875 cwdLen += (Tcl_GetString(copy)[cwdLen] == '/'); 1876 1877 /* Normalize the combined string. */ 1878 1879 if (PATHFLAGS(pathPtr) & TCLPATH_NEEDNORM) { 1880 /* 1881 * If the "tail" part has components (like /../) that cause 1882 * the combined path to need more complete normalizing, 1883 * call on the more powerful routine to accomplish that so 1884 * we avoid [Bug 2385549] ... 1885 */ 1886 1887 Tcl_Obj *newCopy = TclFSNormalizeAbsolutePath(interp, copy, NULL); 1888 Tcl_DecrRefCount(copy); 1889 copy = newCopy; 1890 } else { 1891 /* 1892 * ... but in most cases where we join a trouble free tail 1893 * to a normalized head, we can more efficiently normalize the 1894 * combined path by passing over only the unnormalized tail 1895 * portion. When this is sufficient, prior developers claim 1896 * this should be much faster. We use 'cwdLen-1' so that we are 1897 * already pointing at the dir-separator that we know about. 1898 * The normalization code will actually start off directly 1899 * after that separator. 1900 */ 1901 1902 TclFSNormalizeToUniquePath(interp, copy, cwdLen-1, 1903 (fsPathPtr->nativePathPtr == NULL ? &clientData : NULL)); 1904 } 1905 1906 /* Now we need to construct the new path object. */ 1907 1908 if (pathType == TCL_PATH_RELATIVE) { 1909 Tcl_Obj *origDir = fsPathPtr->cwdPtr; 1910 1911 /* 1912 * NOTE: here we are (dangerously?) assuming that origDir points 1913 * to a Tcl_Obj with Tcl_ObjType == &tclFsPathType . The 1914 * pathType = Tcl_FSGetPathType(fsPathPtr->cwdPtr); 1915 * above that set the pathType value should have established 1916 * that, but it's far less clear on what basis we know there's 1917 * been no shimmering since then. 1918 */ 1919 1920 FsPath *origDirFsPathPtr = PATHOBJ(origDir); 1921 1922 fsPathPtr->cwdPtr = origDirFsPathPtr->cwdPtr; 1923 Tcl_IncrRefCount(fsPathPtr->cwdPtr); 1924 1925 TclDecrRefCount(fsPathPtr->normPathPtr); 1926 fsPathPtr->normPathPtr = copy; 1927 1928 /* 1929 * That's our reference to copy used. 1930 */ 1931 1932 TclDecrRefCount(dir); 1933 TclDecrRefCount(origDir); 1934 } else { 1935 TclDecrRefCount(fsPathPtr->cwdPtr); 1936 fsPathPtr->cwdPtr = NULL; 1937 TclDecrRefCount(fsPathPtr->normPathPtr); 1938 fsPathPtr->normPathPtr = copy; 1939 1940 /* 1941 * That's our reference to copy used. 1942 */ 1943 1944 TclDecrRefCount(dir); 1945 } 1946 if (clientData != NULL) { 1947 /* 1948 * This may be unnecessary. It appears that the 1949 * TclFSNormalizeToUniquePath call above should have already 1950 * set this up. Not changing out of fear of the unknown. 1951 */ 1952 1953 fsPathPtr->nativePathPtr = clientData; 1954 } 1955 PATHFLAGS(pathPtr) = 0; 1956 } 1957 1958 /* 1959 * Ensure cwd hasn't changed. 1960 */ 1961 1962 if (fsPathPtr->cwdPtr != NULL) { 1963 if (!TclFSCwdPointerEquals(&fsPathPtr->cwdPtr)) { 1964 if (pathPtr->bytes == NULL) { 1965 UpdateStringOfFsPath(pathPtr); 1966 } 1967 FreeFsPathInternalRep(pathPtr); 1968 pathPtr->typePtr = NULL; 1969 if (Tcl_ConvertToType(interp, pathPtr, &tclFsPathType) != TCL_OK) { 1970 return NULL; 1971 } 1972 fsPathPtr = PATHOBJ(pathPtr); 1973 } else if (fsPathPtr->normPathPtr == NULL) { 1974 int cwdLen; 1975 Tcl_Obj *copy; 1976 ClientData clientData = NULL; 1977 1978 copy = AppendPath(fsPathPtr->cwdPtr, pathPtr); 1979 1980 (void) Tcl_GetStringFromObj(fsPathPtr->cwdPtr, &cwdLen); 1981 cwdLen += (Tcl_GetString(copy)[cwdLen] == '/'); 1982 1983 /* 1984 * Normalize the combined string, but only starting after the end 1985 * of the previously normalized 'dir'. This should be much faster! 1986 */ 1987 1988 TclFSNormalizeToUniquePath(interp, copy, cwdLen-1, 1989 (fsPathPtr->nativePathPtr == NULL ? &clientData : NULL)); 1990 fsPathPtr->normPathPtr = copy; 1991 Tcl_IncrRefCount(fsPathPtr->normPathPtr); 1992 if (clientData != NULL) { 1993 fsPathPtr->nativePathPtr = clientData; 1994 } 1995 } 1996 } 1997 if (fsPathPtr->normPathPtr == NULL) { 1998 ClientData clientData = NULL; 1999 Tcl_Obj *useThisCwd = NULL; 2000 int pureNormalized = 1; 2001 2002 /* 2003 * Since normPathPtr is NULL, but this is a valid path object, we know 2004 * that the translatedPathPtr cannot be NULL. 2005 */ 2006 2007 Tcl_Obj *absolutePath = fsPathPtr->translatedPathPtr; 2008 const char *path = TclGetString(absolutePath); 2009 2010 Tcl_IncrRefCount(absolutePath); 2011 2012 /* 2013 * We have to be a little bit careful here to avoid infinite loops 2014 * we're asking Tcl_FSGetPathType to return the path's type, but that 2015 * call can actually result in a lot of other filesystem action, which 2016 * might loop back through here. 2017 */ 2018 2019 if (path[0] == '\0') { 2020 /* 2021 * Special handling for the empty string value. This one is 2022 * very weird with [file normalize {}] => {}. (The reasoning 2023 * supporting this is unknown to DGP, but he fears changing it.) 2024 * Attempt here to keep the expectations of other parts of 2025 * Tcl_Filesystem code about state of the FsPath fields satisfied. 2026 * 2027 * In particular, capture the cwd value and save so it can be 2028 * stored in the cwdPtr field below. 2029 */ 2030 2031 useThisCwd = Tcl_FSGetCwd(interp); 2032 } else { 2033 /* 2034 * We don't ask for the type of 'pathPtr' here, because that is 2035 * not correct for our purposes when we have a path like '~'. Tcl 2036 * has a bit of a contradiction in that '~' paths are defined as 2037 * 'absolute', but in reality can be just about anything, 2038 * depending on how env(HOME) is set. 2039 */ 2040 2041 Tcl_PathType type = Tcl_FSGetPathType(absolutePath); 2042 2043 if (type == TCL_PATH_RELATIVE) { 2044 useThisCwd = Tcl_FSGetCwd(interp); 2045 2046 if (useThisCwd == NULL) { 2047 return NULL; 2048 } 2049 2050 pureNormalized = 0; 2051 Tcl_DecrRefCount(absolutePath); 2052 absolutePath = Tcl_FSJoinToPath(useThisCwd, 1, &absolutePath); 2053 Tcl_IncrRefCount(absolutePath); 2054 2055 /* 2056 * We have a refCount on the cwd. 2057 */ 2058#ifdef __WIN32__ 2059 } else if (type == TCL_PATH_VOLUME_RELATIVE) { 2060 /* 2061 * Only Windows has volume-relative paths. 2062 */ 2063 2064 Tcl_DecrRefCount(absolutePath); 2065 absolutePath = TclWinVolumeRelativeNormalize(interp, 2066 path, &useThisCwd); 2067 if (absolutePath == NULL) { 2068 return NULL; 2069 } 2070 pureNormalized = 0; 2071#endif /* __WIN32__ */ 2072 } 2073 } 2074 2075 /* 2076 * Already has refCount incremented. 2077 */ 2078 2079 fsPathPtr->normPathPtr = TclFSNormalizeAbsolutePath(interp, 2080 absolutePath, 2081 (fsPathPtr->nativePathPtr == NULL ? &clientData : NULL)); 2082 if (0 && (clientData != NULL)) { 2083 fsPathPtr->nativePathPtr = 2084 (*fsPathPtr->fsRecPtr->fsPtr->dupInternalRepProc)(clientData); 2085 } 2086 2087 /* 2088 * Check if path is pure normalized (this can only be the case if it 2089 * is an absolute path). 2090 */ 2091 2092 if (pureNormalized) { 2093 if (!strcmp(TclGetString(fsPathPtr->normPathPtr), 2094 TclGetString(pathPtr))) { 2095 /* 2096 * The path was already normalized. Get rid of the duplicate. 2097 */ 2098 2099 TclDecrRefCount(fsPathPtr->normPathPtr); 2100 2101 /* 2102 * We do *not* increment the refCount for this circular 2103 * reference. 2104 */ 2105 2106 fsPathPtr->normPathPtr = pathPtr; 2107 } 2108 } 2109 if (useThisCwd != NULL) { 2110 /* 2111 * We just need to free an object we allocated above for relative 2112 * paths (this was returned by Tcl_FSJoinToPath above), and then 2113 * of course store the cwd. 2114 */ 2115 2116 fsPathPtr->cwdPtr = useThisCwd; 2117 } 2118 TclDecrRefCount(absolutePath); 2119 } 2120 2121 return fsPathPtr->normPathPtr; 2122} 2123 2124/* 2125 *--------------------------------------------------------------------------- 2126 * 2127 * Tcl_FSGetInternalRep -- 2128 * 2129 * Extract the internal representation of a given path object, in the 2130 * given filesystem. If the path object belongs to a different 2131 * filesystem, we return NULL. 2132 * 2133 * If the internal representation is currently NULL, we attempt to 2134 * generate it, by calling the filesystem's 2135 * 'Tcl_FSCreateInternalRepProc'. 2136 * 2137 * Results: 2138 * NULL or a valid internal representation. 2139 * 2140 * Side effects: 2141 * An attempt may be made to convert the object. 2142 * 2143 *--------------------------------------------------------------------------- 2144 */ 2145 2146ClientData 2147Tcl_FSGetInternalRep( 2148 Tcl_Obj *pathPtr, 2149 Tcl_Filesystem *fsPtr) 2150{ 2151 FsPath *srcFsPathPtr; 2152 2153 if (Tcl_FSConvertToPathType(NULL, pathPtr) != TCL_OK) { 2154 return NULL; 2155 } 2156 srcFsPathPtr = PATHOBJ(pathPtr); 2157 2158 /* 2159 * We will only return the native representation for the caller's 2160 * filesystem. Otherwise we will simply return NULL. This means that there 2161 * must be a unique bi-directional mapping between paths and filesystems, 2162 * and that this mapping will not allow 'remapped' files -- files which 2163 * are in one filesystem but mapped into another. Another way of putting 2164 * this is that 'stacked' filesystems are not allowed. We recognise that 2165 * this is a potentially useful feature for the future. 2166 * 2167 * Even something simple like a 'pass through' filesystem which logs all 2168 * activity and passes the calls onto the native system would be nice, but 2169 * not easily achievable with the current implementation. 2170 */ 2171 2172 if (srcFsPathPtr->fsRecPtr == NULL) { 2173 /* 2174 * This only usually happens in wrappers like TclpStat which create a 2175 * string object and pass it to TclpObjStat. Code which calls the 2176 * Tcl_FS.. functions should always have a filesystem already set. 2177 * Whether this code path is legal or not depends on whether we decide 2178 * to allow external code to call the native filesystem directly. It 2179 * is at least safer to allow this sub-optimal routing. 2180 */ 2181 2182 Tcl_FSGetFileSystemForPath(pathPtr); 2183 2184 /* 2185 * If we fail through here, then the path is probably not a valid path 2186 * in the filesystsem, and is most likely to be a use of the empty 2187 * path "" via a direct call to one of the objectified interfaces 2188 * (e.g. from the Tcl testsuite). 2189 */ 2190 2191 srcFsPathPtr = PATHOBJ(pathPtr); 2192 if (srcFsPathPtr->fsRecPtr == NULL) { 2193 return NULL; 2194 } 2195 } 2196 2197 /* 2198 * There is still one possibility we should consider; if the file belongs 2199 * to a different filesystem, perhaps it is actually linked through to a 2200 * file in our own filesystem which we do care about. The way we can check 2201 * for this is we ask what filesystem this path belongs to. 2202 */ 2203 2204 if (fsPtr != srcFsPathPtr->fsRecPtr->fsPtr) { 2205 const Tcl_Filesystem *actualFs = Tcl_FSGetFileSystemForPath(pathPtr); 2206 2207 if (actualFs == fsPtr) { 2208 return Tcl_FSGetInternalRep(pathPtr, fsPtr); 2209 } 2210 return NULL; 2211 } 2212 2213 if (srcFsPathPtr->nativePathPtr == NULL) { 2214 Tcl_FSCreateInternalRepProc *proc; 2215 char *nativePathPtr; 2216 2217 proc = srcFsPathPtr->fsRecPtr->fsPtr->createInternalRepProc; 2218 if (proc == NULL) { 2219 return NULL; 2220 } 2221 2222 nativePathPtr = (*proc)(pathPtr); 2223 srcFsPathPtr = PATHOBJ(pathPtr); 2224 srcFsPathPtr->nativePathPtr = nativePathPtr; 2225 } 2226 2227 return srcFsPathPtr->nativePathPtr; 2228} 2229 2230/* 2231 *--------------------------------------------------------------------------- 2232 * 2233 * TclFSEnsureEpochOk -- 2234 * 2235 * This will ensure the pathPtr is up to date and can be converted into a 2236 * "path" type, and that we are able to generate a complete normalized 2237 * path which is used to determine the filesystem match. 2238 * 2239 * Results: 2240 * Standard Tcl return code. 2241 * 2242 * Side effects: 2243 * An attempt may be made to convert the object. 2244 * 2245 *--------------------------------------------------------------------------- 2246 */ 2247 2248int 2249TclFSEnsureEpochOk( 2250 Tcl_Obj *pathPtr, 2251 Tcl_Filesystem **fsPtrPtr) 2252{ 2253 FsPath *srcFsPathPtr; 2254 2255 if (pathPtr->typePtr != &tclFsPathType) { 2256 return TCL_OK; 2257 } 2258 2259 srcFsPathPtr = PATHOBJ(pathPtr); 2260 2261 /* 2262 * Check if the filesystem has changed in some way since this object's 2263 * internal representation was calculated. 2264 */ 2265 2266 if (!TclFSEpochOk(srcFsPathPtr->filesystemEpoch)) { 2267 /* 2268 * We have to discard the stale representation and recalculate it. 2269 */ 2270 2271 if (pathPtr->bytes == NULL) { 2272 UpdateStringOfFsPath(pathPtr); 2273 } 2274 FreeFsPathInternalRep(pathPtr); 2275 pathPtr->typePtr = NULL; 2276 if (SetFsPathFromAny(NULL, pathPtr) != TCL_OK) { 2277 return TCL_ERROR; 2278 } 2279 srcFsPathPtr = PATHOBJ(pathPtr); 2280 } 2281 2282 /* 2283 * Check whether the object is already assigned to a fs. 2284 */ 2285 2286 if (srcFsPathPtr->fsRecPtr != NULL) { 2287 *fsPtrPtr = srcFsPathPtr->fsRecPtr->fsPtr; 2288 } 2289 return TCL_OK; 2290} 2291 2292/* 2293 *--------------------------------------------------------------------------- 2294 * 2295 * TclFSSetPathDetails -- 2296 * 2297 * ??? 2298 * 2299 * Results: 2300 * None 2301 * 2302 * Side effects: 2303 * ??? 2304 * 2305 *--------------------------------------------------------------------------- 2306 */ 2307 2308void 2309TclFSSetPathDetails( 2310 Tcl_Obj *pathPtr, 2311 FilesystemRecord *fsRecPtr, 2312 ClientData clientData) 2313{ 2314 ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); 2315 FsPath *srcFsPathPtr; 2316 2317 /* 2318 * Make sure pathPtr is of the correct type. 2319 */ 2320 2321 if (pathPtr->typePtr != &tclFsPathType) { 2322 if (SetFsPathFromAny(NULL, pathPtr) != TCL_OK) { 2323 return; 2324 } 2325 } 2326 2327 srcFsPathPtr = PATHOBJ(pathPtr); 2328 srcFsPathPtr->fsRecPtr = fsRecPtr; 2329 srcFsPathPtr->nativePathPtr = clientData; 2330 srcFsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; 2331 fsRecPtr->fileRefCount++; 2332} 2333 2334/* 2335 *--------------------------------------------------------------------------- 2336 * 2337 * Tcl_FSEqualPaths -- 2338 * 2339 * This function tests whether the two paths given are equal path 2340 * objects. If either or both is NULL, 0 is always returned. 2341 * 2342 * Results: 2343 * 1 or 0. 2344 * 2345 * Side effects: 2346 * None. 2347 * 2348 *--------------------------------------------------------------------------- 2349 */ 2350 2351int 2352Tcl_FSEqualPaths( 2353 Tcl_Obj *firstPtr, 2354 Tcl_Obj *secondPtr) 2355{ 2356 char *firstStr, *secondStr; 2357 int firstLen, secondLen, tempErrno; 2358 2359 if (firstPtr == secondPtr) { 2360 return 1; 2361 } 2362 2363 if (firstPtr == NULL || secondPtr == NULL) { 2364 return 0; 2365 } 2366 firstStr = Tcl_GetStringFromObj(firstPtr, &firstLen); 2367 secondStr = Tcl_GetStringFromObj(secondPtr, &secondLen); 2368 if ((firstLen == secondLen) && (strcmp(firstStr, secondStr) == 0)) { 2369 return 1; 2370 } 2371 2372 /* 2373 * Try the most thorough, correct method of comparing fully normalized 2374 * paths. 2375 */ 2376 2377 tempErrno = Tcl_GetErrno(); 2378 firstPtr = Tcl_FSGetNormalizedPath(NULL, firstPtr); 2379 secondPtr = Tcl_FSGetNormalizedPath(NULL, secondPtr); 2380 Tcl_SetErrno(tempErrno); 2381 2382 if (firstPtr == NULL || secondPtr == NULL) { 2383 return 0; 2384 } 2385 2386 firstStr = Tcl_GetStringFromObj(firstPtr, &firstLen); 2387 secondStr = Tcl_GetStringFromObj(secondPtr, &secondLen); 2388 return (firstLen == secondLen) && (strcmp(firstStr, secondStr) == 0); 2389} 2390 2391/* 2392 *--------------------------------------------------------------------------- 2393 * 2394 * SetFsPathFromAny -- 2395 * 2396 * This function tries to convert the given Tcl_Obj to a valid Tcl path 2397 * type. 2398 * 2399 * The filename may begin with "~" (to indicate current user's home 2400 * directory) or "~<user>" (to indicate any user's home directory). 2401 * 2402 * Results: 2403 * Standard Tcl error code. 2404 * 2405 * Side effects: 2406 * The old representation may be freed, and new memory allocated. 2407 * 2408 *--------------------------------------------------------------------------- 2409 */ 2410 2411static int 2412SetFsPathFromAny( 2413 Tcl_Interp *interp, /* Used for error reporting if not NULL. */ 2414 Tcl_Obj *pathPtr) /* The object to convert. */ 2415{ 2416 int len; 2417 FsPath *fsPathPtr; 2418 Tcl_Obj *transPtr; 2419 char *name; 2420#if defined(__CYGWIN__) && defined(__WIN32__) 2421 int copied = 0; 2422#endif 2423 ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); 2424 2425 if (pathPtr->typePtr == &tclFsPathType) { 2426 return TCL_OK; 2427 } 2428 2429 /* 2430 * First step is to translate the filename. This is similar to 2431 * Tcl_TranslateFilename, but shouldn't convert everything to windows 2432 * backslashes on that platform. The current implementation of this piece 2433 * is a slightly optimised version of the various Tilde/Split/Join stuff 2434 * to avoid multiple split/join operations. 2435 * 2436 * We remove any trailing directory separator. 2437 * 2438 * However, the split/join routines are quite complex, and one has to make 2439 * sure not to break anything on Unix or Win (fCmd.test, fileName.test and 2440 * cmdAH.test exercise most of the code). 2441 */ 2442 2443 name = Tcl_GetStringFromObj(pathPtr, &len); 2444 2445 /* 2446 * Handle tilde substitutions, if needed. 2447 */ 2448 2449 if (name[0] == '~') { 2450 char *expandedUser; 2451 Tcl_DString temp; 2452 int split; 2453 char separator = '/'; 2454 2455 split = FindSplitPos(name, separator); 2456 if (split != len) { 2457 /* 2458 * We have multiple pieces '~user/foo/bar...' 2459 */ 2460 2461 name[split] = '\0'; 2462 } 2463 2464 /* 2465 * Do some tilde substitution. 2466 */ 2467 2468 if (name[1] == '\0') { 2469 /* 2470 * We have just '~' 2471 */ 2472 2473 const char *dir; 2474 Tcl_DString dirString; 2475 2476 if (split != len) { 2477 name[split] = separator; 2478 } 2479 2480 dir = TclGetEnv("HOME", &dirString); 2481 if (dir == NULL) { 2482 if (interp) { 2483 Tcl_ResetResult(interp); 2484 Tcl_AppendResult(interp, "couldn't find HOME environment " 2485 "variable to expand path", NULL); 2486 } 2487 return TCL_ERROR; 2488 } 2489 Tcl_DStringInit(&temp); 2490 Tcl_JoinPath(1, &dir, &temp); 2491 Tcl_DStringFree(&dirString); 2492 } else { 2493 /* 2494 * We have a user name '~user' 2495 */ 2496 2497 Tcl_DStringInit(&temp); 2498 if (TclpGetUserHome(name+1, &temp) == NULL) { 2499 if (interp != NULL) { 2500 Tcl_ResetResult(interp); 2501 Tcl_AppendResult(interp, "user \"", name+1, 2502 "\" doesn't exist", NULL); 2503 } 2504 Tcl_DStringFree(&temp); 2505 if (split != len) { 2506 name[split] = separator; 2507 } 2508 return TCL_ERROR; 2509 } 2510 if (split != len) { 2511 name[split] = separator; 2512 } 2513 } 2514 2515 expandedUser = Tcl_DStringValue(&temp); 2516 transPtr = Tcl_NewStringObj(expandedUser, Tcl_DStringLength(&temp)); 2517 2518 if (split != len) { 2519 /* 2520 * Join up the tilde substitution with the rest. 2521 */ 2522 2523 if (name[split+1] == separator) { 2524 /* 2525 * Somewhat tricky case like ~//foo/bar. Make use of 2526 * Split/Join machinery to get it right. Assumes all paths 2527 * beginning with ~ are part of the native filesystem. 2528 */ 2529 2530 int objc; 2531 Tcl_Obj **objv; 2532 Tcl_Obj *parts = TclpNativeSplitPath(pathPtr, NULL); 2533 2534 Tcl_ListObjGetElements(NULL, parts, &objc, &objv); 2535 2536 /* 2537 * Skip '~'. It's replaced by its expansion. 2538 */ 2539 2540 objc--; objv++; 2541 while (objc--) { 2542 TclpNativeJoinPath(transPtr, Tcl_GetString(*objv++)); 2543 } 2544 TclDecrRefCount(parts); 2545 } else { 2546 /* 2547 * Simple case. "rest" is relative path. Just join it. The 2548 * "rest" object will be freed when Tcl_FSJoinToPath returns 2549 * (unless something else claims a refCount on it). 2550 */ 2551 2552 Tcl_Obj *joined; 2553 Tcl_Obj *rest = Tcl_NewStringObj(name+split+1, -1); 2554 2555 Tcl_IncrRefCount(transPtr); 2556 joined = Tcl_FSJoinToPath(transPtr, 1, &rest); 2557 TclDecrRefCount(transPtr); 2558 transPtr = joined; 2559 } 2560 } 2561 Tcl_DStringFree(&temp); 2562 } else { 2563 transPtr = Tcl_FSJoinToPath(pathPtr, 0, NULL); 2564 } 2565 2566#if defined(__CYGWIN__) && defined(__WIN32__) 2567 { 2568 char winbuf[MAX_PATH+1]; 2569 2570 /* 2571 * In the Cygwin world, call conv_to_win32_path in order to use the 2572 * mount table to translate the file name into something Windows will 2573 * understand. Take care when converting empty strings! 2574 */ 2575 2576 name = Tcl_GetStringFromObj(transPtr, &len); 2577 if (len > 0) { 2578 cygwin_conv_to_win32_path(name, winbuf); 2579 TclWinNoBackslash(winbuf); 2580 if (Tcl_IsShared(transPtr)) { 2581 copied = 1; 2582 transPtr = Tcl_DuplicateObj(transPtr); 2583 Tcl_IncrRefCount(transPtr); 2584 } 2585 Tcl_SetStringObj(transPtr, winbuf, -1); 2586 } 2587 } 2588#endif /* __CYGWIN__ && __WIN32__ */ 2589 2590 /* 2591 * Now we have a translated filename in 'transPtr'. This will have forward 2592 * slashes on Windows, and will not contain any ~user sequences. 2593 */ 2594 2595 fsPathPtr = (FsPath *) ckalloc(sizeof(FsPath)); 2596 2597 fsPathPtr->translatedPathPtr = transPtr; 2598 if (transPtr != pathPtr) { 2599 Tcl_IncrRefCount(fsPathPtr->translatedPathPtr); 2600 } 2601 fsPathPtr->normPathPtr = NULL; 2602 fsPathPtr->cwdPtr = NULL; 2603 fsPathPtr->nativePathPtr = NULL; 2604 fsPathPtr->fsRecPtr = NULL; 2605 fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; 2606 2607 /* 2608 * Free old representation before installing our new one. 2609 */ 2610 2611 TclFreeIntRep(pathPtr); 2612 SETPATHOBJ(pathPtr, fsPathPtr); 2613 PATHFLAGS(pathPtr) = 0; 2614 pathPtr->typePtr = &tclFsPathType; 2615#if defined(__CYGWIN__) && defined(__WIN32__) 2616 if (copied) { 2617 Tcl_DecrRefCount(transPtr); 2618 } 2619#endif 2620 2621 return TCL_OK; 2622} 2623 2624static void 2625FreeFsPathInternalRep( 2626 Tcl_Obj *pathPtr) /* Path object with internal rep to free. */ 2627{ 2628 FsPath *fsPathPtr = PATHOBJ(pathPtr); 2629 2630 if (fsPathPtr->translatedPathPtr != NULL) { 2631 if (fsPathPtr->translatedPathPtr != pathPtr) { 2632 TclDecrRefCount(fsPathPtr->translatedPathPtr); 2633 } 2634 } 2635 if (fsPathPtr->normPathPtr != NULL) { 2636 if (fsPathPtr->normPathPtr != pathPtr) { 2637 TclDecrRefCount(fsPathPtr->normPathPtr); 2638 } 2639 fsPathPtr->normPathPtr = NULL; 2640 } 2641 if (fsPathPtr->cwdPtr != NULL) { 2642 TclDecrRefCount(fsPathPtr->cwdPtr); 2643 } 2644 if (fsPathPtr->nativePathPtr != NULL && fsPathPtr->fsRecPtr != NULL) { 2645 Tcl_FSFreeInternalRepProc *freeProc = 2646 fsPathPtr->fsRecPtr->fsPtr->freeInternalRepProc; 2647 2648 if (freeProc != NULL) { 2649 (*freeProc)(fsPathPtr->nativePathPtr); 2650 fsPathPtr->nativePathPtr = NULL; 2651 } 2652 } 2653 if (fsPathPtr->fsRecPtr != NULL) { 2654 fsPathPtr->fsRecPtr->fileRefCount--; 2655 if (fsPathPtr->fsRecPtr->fileRefCount <= 0) { 2656 /* 2657 * It has been unregistered already. 2658 */ 2659 2660 ckfree((char *) fsPathPtr->fsRecPtr); 2661 } 2662 } 2663 2664 ckfree((char *) fsPathPtr); 2665} 2666 2667static void 2668DupFsPathInternalRep( 2669 Tcl_Obj *srcPtr, /* Path obj with internal rep to copy. */ 2670 Tcl_Obj *copyPtr) /* Path obj with internal rep to set. */ 2671{ 2672 FsPath *srcFsPathPtr = PATHOBJ(srcPtr); 2673 FsPath *copyFsPathPtr = (FsPath *) ckalloc(sizeof(FsPath)); 2674 2675 SETPATHOBJ(copyPtr, copyFsPathPtr); 2676 2677 if (srcFsPathPtr->translatedPathPtr != NULL) { 2678 copyFsPathPtr->translatedPathPtr = srcFsPathPtr->translatedPathPtr; 2679 if (copyFsPathPtr->translatedPathPtr != copyPtr) { 2680 Tcl_IncrRefCount(copyFsPathPtr->translatedPathPtr); 2681 } 2682 } else { 2683 copyFsPathPtr->translatedPathPtr = NULL; 2684 } 2685 2686 if (srcFsPathPtr->normPathPtr != NULL) { 2687 copyFsPathPtr->normPathPtr = srcFsPathPtr->normPathPtr; 2688 if (copyFsPathPtr->normPathPtr != copyPtr) { 2689 Tcl_IncrRefCount(copyFsPathPtr->normPathPtr); 2690 } 2691 } else { 2692 copyFsPathPtr->normPathPtr = NULL; 2693 } 2694 2695 if (srcFsPathPtr->cwdPtr != NULL) { 2696 copyFsPathPtr->cwdPtr = srcFsPathPtr->cwdPtr; 2697 Tcl_IncrRefCount(copyFsPathPtr->cwdPtr); 2698 } else { 2699 copyFsPathPtr->cwdPtr = NULL; 2700 } 2701 2702 copyFsPathPtr->flags = srcFsPathPtr->flags; 2703 2704 if (srcFsPathPtr->fsRecPtr != NULL 2705 && srcFsPathPtr->nativePathPtr != NULL) { 2706 Tcl_FSDupInternalRepProc *dupProc = 2707 srcFsPathPtr->fsRecPtr->fsPtr->dupInternalRepProc; 2708 2709 if (dupProc != NULL) { 2710 copyFsPathPtr->nativePathPtr = 2711 (*dupProc)(srcFsPathPtr->nativePathPtr); 2712 } else { 2713 copyFsPathPtr->nativePathPtr = NULL; 2714 } 2715 } else { 2716 copyFsPathPtr->nativePathPtr = NULL; 2717 } 2718 copyFsPathPtr->fsRecPtr = srcFsPathPtr->fsRecPtr; 2719 copyFsPathPtr->filesystemEpoch = srcFsPathPtr->filesystemEpoch; 2720 if (copyFsPathPtr->fsRecPtr != NULL) { 2721 copyFsPathPtr->fsRecPtr->fileRefCount++; 2722 } 2723 2724 copyPtr->typePtr = &tclFsPathType; 2725} 2726 2727/* 2728 *--------------------------------------------------------------------------- 2729 * 2730 * UpdateStringOfFsPath -- 2731 * 2732 * Gives an object a valid string rep. 2733 * 2734 * Results: 2735 * None. 2736 * 2737 * Side effects: 2738 * Memory may be allocated. 2739 * 2740 *--------------------------------------------------------------------------- 2741 */ 2742 2743static void 2744UpdateStringOfFsPath( 2745 register Tcl_Obj *pathPtr) /* path obj with string rep to update. */ 2746{ 2747 FsPath *fsPathPtr = PATHOBJ(pathPtr); 2748 int cwdLen; 2749 Tcl_Obj *copy; 2750 2751 if (PATHFLAGS(pathPtr) == 0 || fsPathPtr->cwdPtr == NULL) { 2752 Tcl_Panic("Called UpdateStringOfFsPath with invalid object"); 2753 } 2754 2755 copy = AppendPath(fsPathPtr->cwdPtr, fsPathPtr->normPathPtr); 2756 2757 pathPtr->bytes = Tcl_GetStringFromObj(copy, &cwdLen); 2758 pathPtr->length = cwdLen; 2759 copy->bytes = tclEmptyStringRep; 2760 copy->length = 0; 2761 TclDecrRefCount(copy); 2762} 2763 2764/* 2765 *--------------------------------------------------------------------------- 2766 * 2767 * TclNativePathInFilesystem -- 2768 * 2769 * Any path object is acceptable to the native filesystem, by default (we 2770 * will throw errors when illegal paths are actually tried to be used). 2771 * 2772 * However, this behavior means the native filesystem must be the last 2773 * filesystem in the lookup list (otherwise it will claim all files 2774 * belong to it, and other filesystems will never get a look in). 2775 * 2776 * Results: 2777 * TCL_OK, to indicate 'yes', -1 to indicate no. 2778 * 2779 * Side effects: 2780 * None. 2781 * 2782 *--------------------------------------------------------------------------- 2783 */ 2784 2785int 2786TclNativePathInFilesystem( 2787 Tcl_Obj *pathPtr, 2788 ClientData *clientDataPtr) 2789{ 2790 /* 2791 * A special case is required to handle the empty path "". This is a valid 2792 * path (i.e. the user should be able to do 'file exists ""' without 2793 * throwing an error), but equally the path doesn't exist. Those are the 2794 * semantics of Tcl (at present anyway), so we have to abide by them here. 2795 */ 2796 2797 if (pathPtr->typePtr == &tclFsPathType) { 2798 if (pathPtr->bytes != NULL && pathPtr->bytes[0] == '\0') { 2799 /* 2800 * We reject the empty path "". 2801 */ 2802 2803 return -1; 2804 } 2805 2806 /* 2807 * Otherwise there is no way this path can be empty. 2808 */ 2809 } else { 2810 /* 2811 * It is somewhat unusual to reach this code path without the object 2812 * being of tclFsPathType. However, we do our best to deal with the 2813 * situation. 2814 */ 2815 2816 int len; 2817 2818 (void) Tcl_GetStringFromObj(pathPtr, &len); 2819 if (len == 0) { 2820 /* 2821 * We reject the empty path "". 2822 */ 2823 2824 return -1; 2825 } 2826 } 2827 2828 /* 2829 * Path is of correct type, or is of non-zero length, so we accept it. 2830 */ 2831 2832 return TCL_OK; 2833} 2834 2835/* 2836 * Local Variables: 2837 * mode: c 2838 * c-basic-offset: 4 2839 * fill-column: 78 2840 * End: 2841 */ 2842