From 9336a020ee8538c5927e9cbe8cbad80ef915c741 Mon Sep 17 00:00:00 2001 From: apnadkarni Date: Fri, 8 Jul 2022 04:06:35 +0000 Subject: Start on TIP-602 implementation. Work in progress --- generic/tclEnv.c | 3 ++ generic/tclFCmd.c | 8 +++-- generic/tclFileName.c | 86 +++++++++++++++++++++++++++++++++++++++++---------- generic/tclIOUtil.c | 10 ++++-- generic/tclInt.h | 2 ++ generic/tclPathObj.c | 22 +++++++++---- library/safe.tcl | 2 ++ unix/tclUnixInit.c | 15 +++++++++ win/tclWinFCmd.c | 8 +++-- 9 files changed, 126 insertions(+), 30 deletions(-) diff --git a/generic/tclEnv.c b/generic/tclEnv.c index 73a8b84..e469fe9 100644 --- a/generic/tclEnv.c +++ b/generic/tclEnv.c @@ -365,6 +365,7 @@ TclSetEnv( Tcl_MutexUnlock(&envMutex); +#ifdef TCL_TILDE_EXPAND if (!strcmp(name, "HOME")) { /* * If the user's home directory has changed, we must invalidate the @@ -373,6 +374,8 @@ TclSetEnv( Tcl_FSMountsChanged(NULL); } +#endif + } /* diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c index ad60146..c19623d 100644 --- a/generic/tclFCmd.c +++ b/generic/tclFCmd.c @@ -882,7 +882,8 @@ FileBasename( Tcl_IncrRefCount(splitPtr); if (objc != 0) { - if ((objc == 1) && (*TclGetString(pathPtr) == '~')) { +#ifdef TCL_TILDE_EXPAND + if ((objc == 1) && (*TclGetString(pathPtr) == '~')) { Tcl_DecrRefCount(splitPtr); if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) { return NULL; @@ -890,9 +891,10 @@ FileBasename( splitPtr = Tcl_FSSplitPath(pathPtr, &objc); Tcl_IncrRefCount(splitPtr); } +#endif - /* - * Return the last component, unless it is the only component, and it + /* + * Return the last component, unless it is the only component, and it * is the root of an absolute path. */ diff --git a/generic/tclFileName.c b/generic/tclFileName.c index dba137c..b13a435 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -362,6 +362,7 @@ Tcl_GetPathType( * file). The exported function Tcl_FSGetPathType should be used by * extensions. * + * If TCL_TILDE_EXPAND defined: * Note that '~' paths are always considered TCL_PATH_ABSOLUTE, even * though expanding the '~' could lead to any possible path type. This * function should therefore be considered a low-level, string @@ -389,8 +390,9 @@ TclpGetNativePathType( const char *path = TclGetString(pathPtr); if (path[0] == '~') { - /* - * This case is common to all platforms. Paths that begin with ~ are +#ifdef TCL_TILDE_EXPAND + /* + * This case is common to all platforms. Paths that begin with ~ are * absolute. */ @@ -401,6 +403,9 @@ TclpGetNativePathType( } *driveNameLengthPtr = end - path; } +#else + type = TCL_PATH_RELATIVE; +#endif } else { switch (tclPlatform) { case TCL_PLATFORM_UNIX: { @@ -697,13 +702,17 @@ SplitUnixPath( length = path - elementStart; if (length > 0) { Tcl_Obj *nextElt; - if ((elementStart[0] == '~') && (elementStart != origPath)) { +#ifdef TCL_TILDE_EXPAND + if ((elementStart[0] == '~') && (elementStart != origPath)) { TclNewLiteralStringObj(nextElt, "./"); Tcl_AppendToObj(nextElt, elementStart, length); } else { nextElt = Tcl_NewStringObj(elementStart, length); } - Tcl_ListObjAppendElement(NULL, result, nextElt); +#else + nextElt = Tcl_NewStringObj(elementStart, length); +#endif + Tcl_ListObjAppendElement(NULL, result, nextElt); } if (*path++ == '\0') { break; @@ -766,10 +775,13 @@ SplitWinPath( length = p - elementStart; if (length > 0) { Tcl_Obj *nextElt; - if ((elementStart != path) && ((elementStart[0] == '~') - || (isalpha(UCHAR(elementStart[0])) - && elementStart[1] == ':'))) { - TclNewLiteralStringObj(nextElt, "./"); + if ((elementStart != path) && + ( +#ifdef TCL_TILDE_EXPAND + (elementStart[0] == '~') || +#endif + (isalpha(UCHAR(elementStart[0])) && elementStart[1] == ':'))) { + TclNewLiteralStringObj(nextElt, "./"); Tcl_AppendToObj(nextElt, elementStart, length); } else { nextElt = Tcl_NewStringObj(elementStart, length); @@ -871,9 +883,15 @@ TclpNativeJoinPath( p = joining; if (length != 0) { - if ((p[0] == '.') && (p[1] == '/') && ((p[2] == '~') - || (tclPlatform==TCL_PLATFORM_WINDOWS && isalpha(UCHAR(p[2])) - && (p[3] == ':')))) { + if ((p[0] == '.') && + (p[1] == '/') && + ( +#ifdef TCL_TILDE_EXPAND + (p[2] == '~') || +#endif + (tclPlatform==TCL_PLATFORM_WINDOWS && + isalpha(UCHAR(p[2])) && + (p[3] == ':')))) { p += 2; } } @@ -1146,6 +1164,7 @@ TclGetExtension( return p; } +#ifdef TCL_TILDE_EXPAND /* *---------------------------------------------------------------------- * @@ -1204,6 +1223,35 @@ DoTildeSubst( } return Tcl_DStringValue(resultPtr); } +#endif /* TCL_TILDE_EXPAND */ + +/* + *---------------------------------------------------------------------- + * + * TclResolveTildePaths -- + * + * Given a Tcl_Obj that is a list of paths, returns a Tcl_Obj containing + * the paths with any ~-prefixed paths resolved. Returns NULL if + * none of the paths contained a ~-prefixed path, or passed in value + * was not a list, or if NULL was passed in. + * + * ~-prefixed paths that cannot be resolved are removed from the + * returned list. + * + * Results: + * Returns a Tcl_Obj with resolved paths or NULL. + * + *---------------------------------------------------------------------- + */ +Tcl_Obj *TclResolveTildePaths( + Tcl_Interp *interp, + Tcl_Obj *pathsObj) +{ + /* TODO */ + + return NULL; +} + /* *---------------------------------------------------------------------- @@ -1729,7 +1777,6 @@ TclGlob( * NULL. */ { const char *separators; - const char *head; char *tail, *start; int result; Tcl_Obj *filenamesObj, *savedResultObj; @@ -1745,7 +1792,6 @@ TclGlob( } if (pathPrefix == NULL) { - char c; Tcl_DString buffer; Tcl_DStringInit(&buffer); @@ -1755,7 +1801,10 @@ TclGlob( * Perform tilde substitution, if needed. */ - if (start[0] == '~') { +#ifdef TCL_TILDE_EXPAND + if (start[0] == '~') { + const char *head; + char c; /* * Find the first path separator after the tilde. */ @@ -1794,6 +1843,9 @@ TclGlob( } else { tail = pattern; } +#else + tail = pattern; +#endif /* TCL_TILDE_EXPAND */ } else { Tcl_IncrRefCount(pathPrefix); tail = pattern; @@ -2351,14 +2403,16 @@ DoGlob( for (i=0; result==TCL_OK && i 0) { Tcl_Obj *nextElt; - if (elementStart[0] == '~') { +#ifdef TCL_TILDE_EXPAND + if (elementStart[0] == '~') { TclNewLiteralStringObj(nextElt, "./"); Tcl_AppendToObj(nextElt, elementStart, length); } else { nextElt = Tcl_NewStringObj(elementStart, length); } - Tcl_ListObjAppendElement(NULL, result, nextElt); +#else + nextElt = Tcl_NewStringObj(elementStart, length); +#endif /* TCL_TILDE_EXPAND */ + Tcl_ListObjAppendElement(NULL, result, nextElt); } if (*p++ == '\0') { break; diff --git a/generic/tclInt.h b/generic/tclInt.h index 6997dda..0923795 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3020,6 +3020,8 @@ MODULE_SCOPE int TclIsDigitProc(int byte); MODULE_SCOPE int TclIsBareword(int byte); MODULE_SCOPE Tcl_Obj * TclJoinPath(size_t elements, Tcl_Obj * const objv[], int forceRelative); +MODULE_SCOPE Tcl_Obj * TclResolveTildePaths(Tcl_Interp *interp, + Tcl_Obj *pathsObj); MODULE_SCOPE int TclJoinThread(Tcl_ThreadId id, int *result); MODULE_SCOPE void TclLimitRemoveAllHandlers(Tcl_Interp *interp); MODULE_SCOPE Tcl_Obj * TclLindexList(Tcl_Interp *interp, diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index f7da276..aff0a33 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.c @@ -699,7 +699,8 @@ TclPathPart( splitPtr = Tcl_FSSplitPath(pathPtr, &splitElements); Tcl_IncrRefCount(splitPtr); - if (splitElements == 1 && TclGetString(pathPtr)[0] == '~') { +#ifdef TCL_TILDE_EXPAND + if (splitElements == 1 && TclGetString(pathPtr)[0] == '~') { Tcl_Obj *norm; TclDecrRefCount(splitPtr); @@ -710,7 +711,8 @@ TclPathPart( splitPtr = Tcl_FSSplitPath(norm, &splitElements); Tcl_IncrRefCount(splitPtr); } - if (portion == TCL_PATH_TAIL) { +#endif /* TCL_TILDE_EXPAND */ + if (portion == TCL_PATH_TAIL) { /* * Return the last component, unless it is the only component, and * it is the root of an absolute path. @@ -1038,8 +1040,9 @@ TclJoinPath( } ptr = Tcl_GetStringFromObj(res, &length); - /* - * Strip off any './' before a tilde, unless this is the beginning of +#ifdef TCL_TILDE_EXPAND + /* + * Strip off any './' before a tilde, unless this is the beginning of * the path. */ @@ -1047,9 +1050,10 @@ TclJoinPath( (strElt[1] == '/') && (strElt[2] == '~')) { strElt += 2; } +#endif /* TCL_TILDE_EXPAND */ - /* - * A NULL value for fsPtr at this stage basically means we're trying + /* + * A NULL value for fsPtr at this stage basically means we're trying * to join a relative path onto something which is also relative (or * empty). There's nothing particularly wrong with that. */ @@ -1246,6 +1250,7 @@ TclNewFSPathObj( const char *p; int state = 0, count = 0; +#ifdef TCL_TILDE_EXPAND /* [Bug 2806250] - this is only a partial solution of the problem. * The PATHFLAGS != 0 representation assumes in many places that * the "tail" part stored in the normPathPtr field is itself a @@ -1269,6 +1274,7 @@ TclNewFSPathObj( Tcl_DecrRefCount(tail); return pathPtr; } +#endif /* TCL_TILDE_EXPAND */ TclNewObj(pathPtr); fsPathPtr = (FsPath *)Tcl_Alloc(sizeof(FsPath)); @@ -2230,6 +2236,7 @@ SetFsPathFromAny( * Handle tilde substitutions, if needed. */ +#ifdef TCL_TILDE_EXPAND if (len && name[0] == '~') { Tcl_DString temp; size_t split; @@ -2341,6 +2348,9 @@ SetFsPathFromAny( } else { transPtr = TclJoinPath(1, &pathPtr, 1); } +#else + transPtr = TclJoinPath(1, &pathPtr, 1); +#endif /* TCL_TILDE_EXPAND */ /* * Now we have a translated filename in 'transPtr'. This will have forward diff --git a/library/safe.tcl b/library/safe.tcl index 6c905fb..09c82e5 100644 --- a/library/safe.tcl +++ b/library/safe.tcl @@ -733,6 +733,8 @@ proc ::safe::CheckFileName {child file} { # prevent discovery of what home directories exist. proc ::safe::AliasFileSubcommand {child subcommand name} { + # TODO - if TIP602 is accepted for Tcl9, this check could be removed. + # The check is required if TCL_TILDE_EXPAND is defined. if {[string match ~* $name]} { set name ./$name } diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c index ec85fbe..9d84a21 100644 --- a/unix/tclUnixInit.c +++ b/unix/tclUnixInit.c @@ -863,6 +863,21 @@ TclpSetVariables( Tcl_SetVar2(interp, "tcl_pkgPath", NULL, pkgPath, TCL_GLOBAL_ONLY); } +#ifndef TCL_TILDE_EXPAND + { + Tcl_Obj *resolvedPaths = + TclResolveTildePaths(interp, + Tcl_GetVar2Ex( + interp, + "tcl_pkgPath", + NULL, + TCL_GLOBAL_ONLY)); + if (resolvedPaths) { + Tcl_SetVar2Ex(interp, "tcl_pkgPath", NULL, resolvedPaths, TCL_GLOBAL_ONLY); + } + } +#endif + #ifdef DJGPP Tcl_SetVar2(interp, "tcl_platform", "platform", "dos", TCL_GLOBAL_ONLY); #else diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c index 025ac4b..003f7bb 100644 --- a/win/tclWinFCmd.c +++ b/win/tclWinFCmd.c @@ -1719,7 +1719,8 @@ ConvertFileNameFormat( * Deal with issues of tildes being absolute. */ - if (Tcl_DStringValue(&dsTemp)[0] == '~') { +#ifdef TCL_TILDE_EXPAND + if (Tcl_DStringValue(&dsTemp)[0] == '~') { TclNewLiteralStringObj(tempPath, "./"); Tcl_AppendToObj(tempPath, Tcl_DStringValue(&dsTemp), Tcl_DStringLength(&dsTemp)); @@ -1727,7 +1728,10 @@ ConvertFileNameFormat( } else { tempPath = TclDStringToObj(&dsTemp); } - Tcl_ListObjReplace(NULL, splitPath, i, 1, 1, &tempPath); +#else + tempPath = TclDStringToObj(&dsTemp); +#endif /* TCL_TILDE_EXPAND */ + Tcl_ListObjReplace(NULL, splitPath, i, 1, 1, &tempPath); FindClose(handle); } } -- cgit v0.12