diff options
| -rw-r--r-- | generic/tclInterp.c | 284 | ||||
| -rw-r--r-- | unix/tclAppInit.c | 61 | ||||
| -rw-r--r-- | win/tclAppInit.c | 52 |
3 files changed, 381 insertions, 16 deletions
diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 77d06f6..7ce4adf 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -12,6 +12,7 @@ */ #include "tclInt.h" +#include <assert.h> /* * A pointer to a string that holds an initialization script that if non-NULL @@ -276,6 +277,8 @@ static void MakeSafe(Tcl_Interp *interp); static void RunLimitHandlers(LimitHandler *handlerPtr, Tcl_Interp *interp); static void TimeLimitCallback(void *clientData); +static int RunPreInitScript(Tcl_Interp *interp); +static Tcl_Obj * LocatePreInitScript(Tcl_Interp *interp); /* NRE enabling */ static Tcl_NRPostProc NRPostInvokeHidden; @@ -309,6 +312,283 @@ Tcl_SetPreInitScript( } /* + * CheckForFileInDir -- + * + * Little helper to check if a file exists within a directory and is readable. + * + * Results: + * Returns path to the file if it exists, NULL if not. Reference count + * of returned Tcl_Obj is incremented before returning to account for the + * caller owning a reference. + */ +static Tcl_Obj * +CheckForFileInDir( + Tcl_Obj *dirPathPtr, + Tcl_Obj *fileNamePtr) +{ + Tcl_Obj *path[2]; + path[0] = dirPathPtr; + path[1] = fileNamePtr; + Tcl_Obj *fullPathPtr = TclJoinPath(2, path, 0); + Tcl_IncrRefCount(fullPathPtr); + if (Tcl_FSAccess(fullPathPtr, R_OK) == 0) { + return fullPathPtr; + } + Tcl_DecrRefCount(fullPathPtr); + return NULL; +} + +/* + * LocatePreInitScript -- + * + * Locates the Tcl initialization script, "init.tcl". + * + * Results: + * Returns a Tcl_Obj containing the path or NULL if not found. + * Reference count of returned Tcl_Obj is incremented before returning + * to account for the caller owning a reference. + * + * Side effects: + * Sets the tcl_library variable to the directory containing init.tcl. + */ +Tcl_Obj * +LocatePreInitScript(Tcl_Interp *interp) +{ + /* + * The search order for the init.tcl is as follows: + * + * $tcl_library - + * Can specify a primary location, if set, no other locations will be + * checked. This is the recommended way for a program that embeds Tcl + * to specifically tell Tcl where to find an init.tcl file. + * + * $env(TCL_LIBRARY) - + * Highest priority so user can always override the search path unless + * the application has specified an exact directory above + * + * $tclDefaultLibrary - + * INTERNAL: This variable is set by Tcl on those platforms where it + * can determine at runtime the directory where it expects the init.tcl + * file to be. If set, this value is unset after use. External users of + * Tcl should not make use of the variable to customize this function. + * + * [tcl::pkgconfig get scriptdir,runtime] - + * The directory determined by configure to be the place where Tcl's + * script library is to be installed. + * + * ancestor directories of the executable - + * The lib and library subdirectories of the parent and grand-parent + * directories of the directory containing the executable. + * + * The first directory on this path that contains a init.tcl script + * will be set as the value of tcl_library and the init.tcl file sourced. + * + * Note the following differences from Tcl 9.0 where this functionality + * was implemented as a Tcl script. + * + * - the $tcl_libPath variable is no longer used. It was maked OBSOLETE + * and not supposed to be used. Applications that embed Tcl and want + * to customize should set tcl_library or call Tcl_PreInitScript + * instead. + */ + + Tcl_Obj *dirPtr; + Tcl_Obj *searchedDirs; + Tcl_Obj *initScriptPathPtr = NULL; + Tcl_Obj *ancestors[2] = {NULL, NULL}; + Tcl_Obj *literals[] = {NULL, NULL, NULL, NULL, NULL}; + enum { INITLIT, VERSIONLIT, PATCHLIT, LIBLIT, LIBRARYLIT }; + + /* + * Need to track checked directories for error reporting. As a side + * benefit, because they are tracked here we can keep overwriting dirPtr + * without leaking memory. + */ + searchedDirs = Tcl_NewListObj(0, NULL); + + literals[INITLIT] = Tcl_NewStringObj("init.tcl", 8); + Tcl_IncrRefCount(literals[INITLIT]); + + dirPtr = Tcl_GetVar2Ex(interp, "tcl_library", NULL, TCL_GLOBAL_ONLY); + if (dirPtr != NULL) { + Tcl_ListObjAppendElement(NULL, searchedDirs, dirPtr); + initScriptPathPtr = CheckForFileInDir(dirPtr, literals[INITLIT]); + /* + * As per documentation and historical behavior do not search further + * even on failure in the case of tcl_library being set. + */ + goto done; + } + + /* + * For remaining paths, failure means we just go on to the next one. + * Would be more elegant to use a loop over possible paths and check + * file existence in the body but that means paths that never get used + * are constructed. Instead we use a macro to reduce code duplication. + */ +#define TRY_PATH(dirarg_) \ + do { \ + dirPtr = (dirarg_); \ + if (dirPtr) { \ + Tcl_ListObjAppendElement(NULL, searchedDirs, dirPtr); \ + /* Tcl_IsEmpty check - bug 465d4546e2 */ \ + if (!Tcl_IsEmpty(dirPtr)) { \ + initScriptPathPtr = \ + CheckForFileInDir(dirPtr, literals[INITLIT]); \ + if (initScriptPathPtr != NULL) { \ + goto done; \ + } \ + } \ + } \ + } while (0) + + /* + * As documented, we do not check subdirectories of TCL_LIBRARY. + * This differs from the behavior of tcl 9.0. + */ + TRY_PATH(Tcl_GetVar2Ex(interp, "env", "TCL_LIBRARY", TCL_GLOBAL_ONLY)); + + TRY_PATH(TclZipfs_TclLibrary()); + + TRY_PATH(Tcl_GetVar2Ex(interp, "tclDefaultLibrary", NULL, TCL_GLOBAL_ONLY)); + if (dirPtr == NULL) { + /* + * tcl::pkgconfig get scriptdir,runtime. Why only if + * tclDefaultLibrary is not set? Historical compatibility + */ +#ifdef CFG_RUNTIME_SCRDIR + TRY_PATH(Tcl_NewStringObj(CFG_RUNTIME_SCRDIR, -1)); +#endif + } + + assert(initScriptPathPtr == NULL); + + /* + * Now try ancestor directories of the executable. If "parent" is the + * parent of the directory containing the exe, paths are searched + * in the following order in the original Tcl 9.0 implementation: + * 1. parent/lib/tclVERSION + * 2. parent/../lib/tclVERSION + * 3. parent/library + * 4. parent/../library + * 5. parent/../tclVERSION/library + * 6. parent/../tclPATCHLEVEL/library + * 7. parent/../../tclPATCHLEVEL/library + * Heck! Why not search the whole damn disk! + * Pending further discussion, we only do 1-4, and further always + * prioritize parent over grandparent. + */ + + literals[VERSIONLIT] = Tcl_NewStringObj("tcl" TCL_VERSION, -1); + Tcl_IncrRefCount(literals[VERSIONLIT]); + literals[LIBLIT] = Tcl_NewStringObj("lib", 3); + Tcl_IncrRefCount(literals[LIBLIT]); + literals[LIBRARYLIT] = Tcl_NewStringObj("library", 7); + Tcl_IncrRefCount(literals[LIBRARYLIT]); + + /* Reminder - TclGetObjNameOfExecutable return need not be released */ + Tcl_Obj *exePtr = TclGetObjNameOfExecutable(); + if (exePtr == NULL) { + goto done; + } + exePtr = TclPathPart(interp, exePtr, TCL_PATH_DIRNAME); + if (exePtr == NULL) { + goto done; + } + ancestors[0] = TclPathPart(interp, exePtr, TCL_PATH_DIRNAME); + Tcl_DecrRefCount(exePtr); + if (ancestors[0] == NULL) { + goto done; + } + ancestors[1] = TclPathPart(interp, ancestors[0], TCL_PATH_DIRNAME); + if (ancestors[1] == NULL) { + goto done; + } + /* + * Note: ancestors[] are freed at function end. TclPathPart returns + * Tcl_Obj with ref count incremented so do not incr ref it here. + */ + + Tcl_Obj *paths[3]; + for (size_t i = 0; i < sizeof(ancestors) / sizeof(ancestors[0]); ++i) { + paths[0] = ancestors[i]; + paths[1] = literals[LIBLIT]; + paths[2] = literals[VERSIONLIT]; + TRY_PATH(TclJoinPath(3, paths, 0)); + + paths[1] = literals[LIBRARYLIT]; + TRY_PATH(TclJoinPath(2, paths, 0)); + } + +done: /* initScriptPtr != NULL => dirPtr holds dir of init.tcl */ + if (initScriptPathPtr == NULL) { + Tcl_SetObjResult(interp, + Tcl_ObjPrintf( + "Cannot find a usable init.tcl in the following directories: \n" + " %s\n\n" + "This probably means that Tcl wasn't installed properly.\n", + Tcl_GetString(searchedDirs))); + } else { + Tcl_SetVar2Ex(interp, "tcl_library", NULL, dirPtr, TCL_GLOBAL_ONLY); + } + for (size_t i = 0; i < sizeof(ancestors) / sizeof(ancestors[0]); ++i) { + if (ancestors[i]) { + Tcl_DecrRefCount(ancestors[i]); + } + } + for (size_t i = 0; i < sizeof(literals)/sizeof(literals[0]); i++) { + if (literals[i] != NULL) { + Tcl_DecrRefCount(literals[i]); + } + } + /* Note all examined dirPtr values get freed with searchedDirs */ + Tcl_DecrRefCount(searchedDirs); + return initScriptPathPtr; +#undef TRY_PATH +} + +/* + * RunPreInitScript -- + * + * Locates and invokes the Tcl initialization script, "init.tcl". + * + * Results: + * Returns a standard Tcl completion code. + * + * Side effects: + * Pretty much anything, depending on the contents of the script. + */ +int +RunPreInitScript(Tcl_Interp *interp) +{ + /* + * Note the following differences from 9.0. If a init.tcl is found and + * sourced, further directories are NOT searched even if the init.tcl + * sourcing raised errors. This is by design as it is indicative of some + * configuration error and attempting a fix through trial and error is + * not a robust solution. + * + * Further, this search mechanism cannot be bypassed by defining an + * alternate tclInit command before calling Tcl_Init() as was the case + * in Tcl 9.0. Use the Tcl_SetPreInitScript function to instead. + */ + Tcl_Obj *initScriptPathPtr = LocatePreInitScript(interp); + if (initScriptPathPtr == NULL) { + return TCL_ERROR; + } + Tcl_IncrRefCount(initScriptPathPtr); + int result = Tcl_FSEvalFile(interp, initScriptPathPtr); + Tcl_DecrRefCount(initScriptPathPtr); + if (result != TCL_OK) { + Tcl_ObjPrintf("Error sourcing Tcl initialization script from %s:\n%s", + Tcl_GetString(initScriptPathPtr), + Tcl_GetString(Tcl_GetObjResult(interp))); + } + return result; +} + + +/* *---------------------------------------------------------------------- * * Tcl_Init -- @@ -397,6 +677,9 @@ Tcl_Init( * alternate tclInit command before calling Tcl_Init(). */ +#if 1 + result = RunPreInitScript(interp); +#else result = Tcl_EvalEx(interp, "if {[namespace which -command tclInit] eq \"\"} {\n" " proc tclInit {} {\n" @@ -462,6 +745,7 @@ Tcl_Init( " }\n" "}\n" "tclInit", TCL_INDEX_NONE, 0); +#endif TclpSetInitialEncodings(); end: *names = (*names)->nextPtr; diff --git a/unix/tclAppInit.c b/unix/tclAppInit.c index 761cc57..8f84587 100644 --- a/unix/tclAppInit.c +++ b/unix/tclAppInit.c @@ -38,6 +38,17 @@ extern Tcl_LibraryInitProc Tclxttest_Init; #endif /* TCL_XT_TEST */ /* + * The following allows changing of the script file read at startup. + */ +#ifndef TCL_RC_FILE +#ifdef DJGPP +#define TCL_RC_FILE "~/tclshrc.tcl" +#else +#define TCL_RC_FILE "~/.tclshrc" +#endif +#endif + +/* * The following #if block allows you to change the AppInit function by using * a #define of TCL_LOCAL_APPINIT instead of rewriting this entire file. The * #if checks for that #define and uses Tcl_AppInit if it does not exist. @@ -46,6 +57,7 @@ extern Tcl_LibraryInitProc Tclxttest_Init; #ifndef TCL_LOCAL_APPINIT #define TCL_LOCAL_APPINIT Tcl_AppInit #endif + #ifndef MODULE_SCOPE # define MODULE_SCOPE extern #endif @@ -63,6 +75,40 @@ MODULE_SCOPE int TCL_LOCAL_MAIN_HOOK(int *argc, char ***argv); #endif /* + * TclSetRcFilePath -- + * + * Sets the path of the Tcl startup file (usually ".tclshrc"). Will + * do tilde expansion and normalization of the passed path and set + * the tclRcFilePath variable to the result + * + * Results: + * A Tcl result code. + * + * Side effects: + * Sets the tclRcFilePath variable. + * + * TODO - this function is duplicated in the Windows version of tclAppInit.c. + * Consider adding it to Tcl library and callable via the stubs table. + */ +static int +TclSetRcFilePath(Tcl_Interp *interp, const char *path) +{ + Tcl_DString ds; + if (Tcl_FSTildeExpand(interp, path, &ds) != TCL_OK) { + return TCL_ERROR; + } + Tcl_Obj *rcPathObj = Tcl_DStringToObj(&ds); + /* Reminder: don't worry about rcPathObj ref count on success/failure */ + if (Tcl_SetVar2Ex(interp, "tcl_rcFileName", NULL, rcPathObj, + TCL_GLOBAL_ONLY) == NULL) { + return TCL_ERROR; + } + return TCL_OK; + +} + + +/* *---------------------------------------------------------------------- * * main -- @@ -161,19 +207,14 @@ Tcl_AppInit( * run interactively. Typically the startup file is "~/.apprc" where "app" * is the name of the application. If this line is deleted then no * user-specific startup file will be run under any conditions. + * In keeping with the historical behavior, errors setting the name + * for example, if the home directory cannot be found, are ignored. */ -#ifdef DJGPP -#define INITFILENAME "tclshrc.tcl" -#else -#define INITFILENAME ".tclshrc" -#endif - - (void) Tcl_EvalEx(interp, - "set tcl_rcFileName [file tildeexpand ~/" INITFILENAME "]", - -1, TCL_EVAL_GLOBAL); + (void) TclSetRcFilePath(interp, TCL_RC_FILE); + Tcl_ResetResult(interp); return TCL_OK; } - + /* * Local Variables: * mode: c diff --git a/win/tclAppInit.c b/win/tclAppInit.c index bba1063..1f7ed4c 100644 --- a/win/tclAppInit.c +++ b/win/tclAppInit.c @@ -67,6 +67,13 @@ int _CRT_glob = 0; MODULE_SCOPE int TCL_LOCAL_APPINIT(Tcl_Interp *); /* + * The following allows changing of the script file read at startup. + */ +#ifndef TCL_RC_FILE +#define TCL_RC_FILE "~/tclshrc.tcl" +#endif + +/* * The following #if block allows you to change how Tcl finds the startup * script, prime the library or encoding paths, fiddle with the argv, etc., * without needing to rewrite Tcl_Main() @@ -77,6 +84,40 @@ MODULE_SCOPE int TCL_LOCAL_MAIN_HOOK(int *argc, TCHAR ***argv); #endif /* + * TclSetRcFilePath -- + * + * Sets the path of the Tcl startup file (usually ".tclshrc"). Will + * do tilde expansion and normalization of the passed path and set + * the tclRcFilePath variable to the result + * + * Results: + * A Tcl result code. + * + * Side effects: + * Sets the tclRcFilePath variable. + * + * TODO - this function is duplicated in the Unix version of tclAppInit.c. + * Consider adding it to Tcl library and callable via the stubs table. + */ +static int +TclSetRcFilePath(Tcl_Interp *interp, const char *path) +{ + Tcl_DString ds; + if (Tcl_FSTildeExpand(interp, path, &ds) != TCL_OK) { + return TCL_ERROR; + } + Tcl_Obj *rcPathObj = Tcl_DStringToObj(&ds); + /* Reminder: don't worry about rcPathObj ref count on success/failure */ + if (Tcl_SetVar2Ex(interp, "tcl_rcFileName", NULL, rcPathObj, + TCL_GLOBAL_ONLY) == NULL) { + return TCL_ERROR; + } + return TCL_OK; + +} + + +/* *---------------------------------------------------------------------- * * main -- @@ -196,15 +237,14 @@ Tcl_AppInit( * run interactively. Typically the startup file is "~/.apprc" where "app" * is the name of the application. If this line is deleted then no * user-specific startup file will be run under any conditions. + * In keeping with the historical behavior, errors setting the name + * for example, if the home directory cannot be found, are ignored. */ - - (void)Tcl_EvalEx(interp, - "set tcl_rcFileName [file tildeexpand ~/tclshrc.tcl]", - TCL_AUTO_LENGTH, TCL_EVAL_GLOBAL); - + (void) TclSetRcFilePath(interp, TCL_RC_FILE); + Tcl_ResetResult(interp); return TCL_OK; } - + /* * Local Variables: * mode: c |