diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tclCmdAH.c | 11 | ||||
| -rw-r--r-- | generic/tclCmdIL.c | 66 | ||||
| -rw-r--r-- | generic/tclIO.c | 4 | ||||
| -rw-r--r-- | generic/tclIORTrans.c | 120 | ||||
| -rw-r--r-- | generic/tclIndexObj.c | 47 | ||||
| -rw-r--r-- | generic/tclOO.h | 14 | ||||
| -rw-r--r-- | generic/tclOODecls.h | 24 | ||||
| -rw-r--r-- | generic/tclOOIntDecls.h | 16 | ||||
| -rw-r--r-- | generic/tclTest.c | 46 | ||||
| -rw-r--r-- | generic/tclThreadTest.c | 12 |
10 files changed, 213 insertions, 147 deletions
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index fc9d39d..d036bd6 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -1063,6 +1063,17 @@ TclMakeFileCommandSafe( } Tcl_DStringFree(&oldBuf); Tcl_DStringFree(&newBuf); + + /* + * Ugh. The [file] command is now actually safe, but it is assumed by + * scripts that it is not, which messes up security policies. [Bug + * 3211758] + */ + + if (Tcl_HideCommand(interp, "file", "file") != TCL_OK) { + Tcl_Panic("problem making 'file' safe: %s", + Tcl_GetString(Tcl_GetObjResult(interp))); + } return TCL_OK; } diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 95532d3..b312026 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -1140,32 +1140,40 @@ InfoFrameCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; - int level, topLevel; - CmdFrame *framePtr; + int level, topLevel, code = TCL_OK; + CmdFrame *runPtr, *framePtr; + CoroutineData *corPtr = iPtr->execEnvPtr->corPtr; + + if (objc > 2) { + Tcl_WrongNumArgs(interp, 1, objv, "?number?"); + return TCL_ERROR; + } topLevel = ((iPtr->cmdFramePtr == NULL) ? 0 : iPtr->cmdFramePtr->level); - - if (iPtr->execEnvPtr->corPtr) { + if (corPtr) { /* * A coroutine: must fix the level computations AND the cmdFrame chain, * which is interrupted at the base. */ + CmdFrame *lastPtr = NULL; - CoroutineData *corPtr = iPtr->execEnvPtr->corPtr; - CmdFrame *runPtr = iPtr->cmdFramePtr; - CmdFrame *lastPtr = NULL; + runPtr = iPtr->cmdFramePtr; + /* TODO - deal with overflow */ topLevel += corPtr->caller.cmdFramePtr->level; - while (runPtr && (runPtr != corPtr->caller.cmdFramePtr)) { - lastPtr = runPtr; - runPtr = runPtr->nextPtr; - } - if (lastPtr && !runPtr) { - lastPtr->nextPtr = corPtr->caller.cmdFramePtr; - } + while (runPtr) { + runPtr->level += corPtr->caller.cmdFramePtr->level; + lastPtr = runPtr; + runPtr = runPtr->nextPtr; + } + if (lastPtr) { + lastPtr->nextPtr = corPtr->caller.cmdFramePtr; + } else { + iPtr->cmdFramePtr = corPtr->caller.cmdFramePtr; + } } if (objc == 1) { @@ -1174,10 +1182,7 @@ InfoFrameCmd( */ Tcl_SetObjResult(interp, Tcl_NewIntObj(topLevel)); - return TCL_OK; - } else if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, "?number?"); - return TCL_ERROR; + goto done; } /* @@ -1185,7 +1190,8 @@ InfoFrameCmd( */ if (TclGetIntFromObj(interp, objv[1], &level) != TCL_OK) { - return TCL_ERROR; + code = TCL_ERROR; + goto done; } if ((level > topLevel) || (level <= - topLevel)) { @@ -1194,7 +1200,8 @@ InfoFrameCmd( NULL); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "STACK_FRAME", TclGetString(objv[1]), NULL); - return TCL_ERROR; + code = TCL_ERROR; + goto done; } /* @@ -1214,7 +1221,24 @@ InfoFrameCmd( } Tcl_SetObjResult(interp, TclInfoFrame(interp, framePtr)); - return TCL_OK; + + done: + if (corPtr) { + + if (iPtr->cmdFramePtr == corPtr->caller.cmdFramePtr) { + iPtr->cmdFramePtr = NULL; + } else { + runPtr = iPtr->cmdFramePtr; + while (runPtr->nextPtr != corPtr->caller.cmdFramePtr) { + runPtr->level -= corPtr->caller.cmdFramePtr->level; + runPtr = runPtr->nextPtr; + } + runPtr->level = 1; + runPtr->nextPtr = NULL; + } + + } + return code; } /* diff --git a/generic/tclIO.c b/generic/tclIO.c index ae1b89a..082cf70 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -9215,8 +9215,8 @@ CopyData( if ((size == 0) && Tcl_Eof(inChan) && !(cmdPtr && (mask == 0))) { break; } - if (((!Tcl_Eof(inChan)) || (cmdPtr && (mask == 0))) && - !(mask & TCL_READABLE)) { + if (cmdPtr && (!Tcl_Eof(inChan) || (mask == 0)) && + !(mask & TCL_READABLE)) { if (mask & TCL_WRITABLE) { Tcl_DeleteChannelHandler(outChan, CopyEventProc, csPtr); } diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c index ef37d5c..b095dcf 100644 --- a/generic/tclIORTrans.c +++ b/generic/tclIORTrans.c @@ -161,6 +161,8 @@ typedef struct { int mode; /* Mask of R/W mode */ int nonblocking; /* Flag: Channel is blocking or not. */ int readIsDrained; /* Flag: Read buffers are flushed. */ + int dead; /* Boolean signal that some operations + * should no longer be attempted. */ ResultBuffer result; } ReflectedTransform; @@ -1008,27 +1010,27 @@ ReflectClose( * the per-interp DeleteReflectedTransformMap exit-handler. */ - if (rtPtr->interp) { + if (!rtPtr->dead) { rtmPtr = GetReflectedTransformMap(rtPtr->interp); hPtr = Tcl_FindHashEntry(&rtmPtr->map, Tcl_GetString(rtPtr->handle)); if (hPtr) { Tcl_DeleteHashEntry(hPtr); } - } - /* - * In a threaded interpreter we manage a per-thread map as well, to allow - * us to survive if the script level pulls the rug out under a channel by - * deleting the owning thread. - */ + /* + * In a threaded interpreter we manage a per-thread map as well, + * to allow us to survive if the script level pulls the rug out + * under a channel by deleting the owning thread. + */ #ifdef TCL_THREADS - rtmPtr = GetThreadReflectedTransformMap(); - hPtr = Tcl_FindHashEntry(&rtmPtr->map, Tcl_GetString(rtPtr->handle)); - if (hPtr) { - Tcl_DeleteHashEntry(hPtr); - } + rtmPtr = GetThreadReflectedTransformMap(); + hPtr = Tcl_FindHashEntry(&rtmPtr->map, Tcl_GetString(rtPtr->handle)); + if (hPtr) { + Tcl_DeleteHashEntry(hPtr); + } #endif + } Tcl_EventuallyFree (rtPtr, (Tcl_FreeProc *) FreeReflectedTransform); return errorCodeSet ? errorCode : ((result == TCL_OK) ? EOK : EINVAL); @@ -1771,6 +1773,7 @@ NewReflectedTransform( rtPtr->readIsDrained = 0; rtPtr->nonblocking = (((Channel *) parentChan)->state->flags & CHANNEL_NONBLOCKING); + rtPtr->dead = 0; /* * Query parent for current blocking mode. @@ -1950,7 +1953,7 @@ InvokeTclMethod( int result; /* Result code of method invokation */ Tcl_Obj *resObj = NULL; /* Result of method invokation. */ - if (!rtPtr->interp) { + if (rtPtr->dead) { /* * The transform is marked as dead. Bail out immediately, with an * appropriate error. @@ -2163,7 +2166,8 @@ DeleteReflectedTransformMap( hPtr != NULL; hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch)) { rtPtr = Tcl_GetHashValue(hPtr); - rtPtr->interp = NULL; + + rtPtr->dead = 1; Tcl_DeleteHashEntry(hPtr); } Tcl_DeleteHashTable(&rtmPtr->map); @@ -2175,6 +2179,32 @@ DeleteReflectedTransformMap( */ /* + * Get the map of all channels handled by the current thread. This is a + * ReflectedTransformMap, but on a per-thread basis, not per-interp. Go + * through the channels and remove all which were handled by this + * interpreter. They have already been marked as dead. + */ + + rtmPtr = GetThreadReflectedTransformMap(); + for (hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch); + hPtr != NULL; + hPtr = Tcl_NextHashEntry(&hSearch)) { + rtPtr = Tcl_GetHashValue(hPtr); + + if (rtPtr->interp != interp) { + /* + * Ignore entries for other interpreters. + */ + + continue; + } + + rtPtr->dead = 1; + FreeReflectedTransformArgs(rtPtr); + Tcl_DeleteHashEntry(hPtr); + } + + /* * Go through the list of pending results and cancel all whose events were * destined for this interpreter. While this is in progress we block any * other access to the list of pending results. @@ -2210,29 +2240,6 @@ DeleteReflectedTransformMap( } Tcl_MutexUnlock(&rtForwardMutex); - /* - * Get the map of all channels handled by the current thread. This is a - * ReflectedTransformMap, but on a per-thread basis, not per-interp. Go - * through the channels and remove all which were handled by this - * interpreter. They have already been marked as dead. - */ - - rtmPtr = GetThreadReflectedTransformMap(); - for (hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch); - hPtr != NULL; - hPtr = Tcl_NextHashEntry(&hSearch)) { - rtPtr = Tcl_GetHashValue(hPtr); - - if (rtPtr->interp != interp) { - /* - * Ignore entries for other interpreters. - */ - - continue; - } - - Tcl_DeleteHashEntry(hPtr); - } #endif } @@ -2303,6 +2310,24 @@ DeleteThreadReflectedTransformMap( */ /* + * Get the map of all channels handled by the current thread. This is a + * ReflectedTransformMap, but on a per-thread basis, not per-interp. Go + * through the channels, remove all, mark them as dead. + */ + + rtmPtr = GetThreadReflectedTransformMap(); + for (hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch); + hPtr != NULL; + hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch)) { + ReflectedTransform *rtPtr = Tcl_GetHashValue(hPtr); + + rtPtr->dead = 1; + FreeReflectedTransformArgs(rtPtr); + Tcl_DeleteHashEntry(hPtr); + } + ckfree(rtmPtr); + + /* * Go through the list of pending results and cancel all whose events were * destined for this thread. While this is in progress we block any * other access to the list of pending results. @@ -2340,24 +2365,6 @@ DeleteThreadReflectedTransformMap( Tcl_ConditionNotify(&resultPtr->done); } Tcl_MutexUnlock(&rtForwardMutex); - - /* - * Get the map of all channels handled by the current thread. This is a - * ReflectedTransformMap, but on a per-thread basis, not per-interp. Go - * through the channels, remove all, mark them as dead. - */ - - rtmPtr = GetThreadReflectedTransformMap(); - for (hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch); - hPtr != NULL; - hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch)) { - ReflectedTransform *rtPtr = Tcl_GetHashValue(hPtr); - - rtPtr->interp = NULL; - FreeReflectedTransformArgs(rtPtr); - Tcl_DeleteHashEntry(hPtr); - } - ckfree(rtmPtr); } static void @@ -2377,7 +2384,7 @@ ForwardOpToOwnerThread( Tcl_MutexLock(&rtForwardMutex); - if (rtPtr->interp == NULL) { + if (rtPtr->dead) { /* * The channel is marked as dead. Bail out immediately, with an * appropriate error. Do not forget to unlock the mutex on this path. @@ -2403,6 +2410,7 @@ ForwardOpToOwnerThread( resultPtr->src = Tcl_GetCurrentThread(); resultPtr->dst = dst; + resultPtr->dsti = rtPtr->interp; resultPtr->done = NULL; resultPtr->result = -1; resultPtr->evPtr = evPtr; diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index 6f378a4..8651542 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -1113,13 +1113,15 @@ Tcl_ParseArgsObjv( if (remObjv != NULL) { /* - * Then we should copy the name of the command (0th argument). + * Then we should copy the name of the command (0th argument). The + * upper bound on the number of elements is known, and (undocumented, + * but historically true) there should be a NULL argument after the + * last result. [Bug 3413857] */ nrem = 1; - leftovers = ckalloc((nrem + 1) * sizeof(Tcl_Obj *)); - leftovers[nrem-1] = objv[0]; - leftovers[nrem] = NULL; + leftovers = ckalloc((1 + *objcPtr) * sizeof(Tcl_Obj *)); + leftovers[0] = objv[0]; } else { nrem = 0; leftovers = NULL; @@ -1182,14 +1184,7 @@ Tcl_ParseArgsObjv( } dstIndex++; /* This argument is now handled */ - nrem++; - - /* - * Allocate nrem (+1 extra for NULL terminator) pointers. - */ - - leftovers = ckrealloc(leftovers, (nrem+1) * sizeof(Tcl_Obj *)); - leftovers[nrem-1] = curArg; + leftovers[nrem++] = curArg; continue; } @@ -1227,7 +1222,14 @@ Tcl_ParseArgsObjv( objc--; break; case TCL_ARGV_REST: - *((int *) infoPtr->dstPtr) = dstIndex; + /* + * Only store the point where we got to if it's not to be written + * to NULL, so that TCL_ARGV_AUTO_REST works. + */ + + if (infoPtr->dstPtr != NULL) { + *((int *) infoPtr->dstPtr) = dstIndex; + } goto argsDone; case TCL_ARGV_FLOAT: if (objc == 0) { @@ -1282,7 +1284,9 @@ Tcl_ParseArgsObjv( /* * If we broke out of the loop because of an OPT_REST argument, copy the - * remaining arguments down. + * remaining arguments down. Note that there is always at least one + * argument left over - the command name - so we always have a result if + * our caller is willing to receive it. [Bug 3413857] */ argsDone: @@ -1295,19 +1299,12 @@ Tcl_ParseArgsObjv( } if (objc > 0) { - leftovers = ckrealloc(leftovers, (nrem+objc+1) * sizeof(Tcl_Obj *)); - while (objc) { - leftovers[nrem] = objv[srcIndex]; - nrem++; - srcIndex++; - objc--; - } - } else if (leftovers != NULL) { - ckfree(leftovers); + memcpy(leftovers+nrem, objv+srcIndex, objc*sizeof(Tcl_Obj *)); + nrem += objc; } leftovers[nrem] = NULL; - *objcPtr = nrem; - *remObjv = leftovers; + *objcPtr = nrem++; + *remObjv = ckrealloc(leftovers, nrem * sizeof(Tcl_Obj *)); return TCL_OK; /* diff --git a/generic/tclOO.h b/generic/tclOO.h index c791930..fef2bd0 100644 --- a/generic/tclOO.h +++ b/generic/tclOO.h @@ -14,6 +14,20 @@ #define TCLOO_H_INCLUDED #include "tcl.h" +#ifndef TCLOOAPI +# if defined(BUILD_tcl) || defined(BUILD_TclOO) +# define TCLOOAPI MODULE_SCOPE +# else +# define TCLOOAPI extern +# undef USE_TCLOO_STUBS +# define USE_TCLOO_STUBS 1 +# endif +#endif + +extern const char *TclOOInitializeStubs( + Tcl_Interp *, const char *version); +#define Tcl_OOInitStubs(interp) TclOOInitializeStubs((interp), TCLOO_VERSION) + /* * Be careful when it comes to versioning; need to make sure that the * standalone TclOO version matches. Also make sure that this matches the diff --git a/generic/tclOODecls.h b/generic/tclOODecls.h index 5e48b0b..6316303 100644 --- a/generic/tclOODecls.h +++ b/generic/tclOODecls.h @@ -5,30 +5,6 @@ #ifndef _TCLOODECLS #define _TCLOODECLS -#ifndef TCLOOAPI -# ifdef BUILD_tcl -# define TCLOOAPI MODULE_SCOPE -# else -# define TCLOOAPI extern -# undef USE_TCLOO_STUBS -# define USE_TCLOO_STUBS 1 -# endif -#endif - -/* - * WARNING: This file is automatically generated by the tools/genStubs.tcl - * script. Any modifications to the function declarations below should be made - * in the generic/tclOO.decls script. - */ - -#if defined(USE_TCL_STUBS) -extern const char *TclOOInitializeStubs(Tcl_Interp *, const char *version); -#define Tcl_OOInitStubs(interp) TclOOInitializeStubs((interp),TCLOO_VERSION) -#else -#define Tcl_OOInitStubs(interp) \ - Tcl_PkgRequire((interp),"TclOO",TCLOO_VERSION,0) -#endif - /* !BEGIN!: Do not edit below this line. */ /* diff --git a/generic/tclOOIntDecls.h b/generic/tclOOIntDecls.h index 49a43aa..c751838 100644 --- a/generic/tclOOIntDecls.h +++ b/generic/tclOOIntDecls.h @@ -5,22 +5,6 @@ #ifndef _TCLOOINTDECLS #define _TCLOOINTDECLS -#ifndef TCLOOAPI -# ifdef BUILD_tcl -# define TCLOOAPI MODULE_SCOPE -# else -# define TCLOOAPI extern -# undef USE_TCLOO_STUBS -# define USE_TCLOO_STUBS 1 -# endif -#endif - -/* - * WARNING: This file is automatically generated by the tools/genStubs.tcl - * script. Any modifications to the function declarations below should be made - * in the generic/tclOO.decls script. - */ - /* !BEGIN!: Do not edit below this line. */ /* diff --git a/generic/tclTest.c b/generic/tclTest.c index 96dcb36..30c95c8 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -311,6 +311,8 @@ static int TestpanicCmd(ClientData dummy, static int TestfinexitObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +static int TestparseargsCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); static int TestparserObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); @@ -624,6 +626,7 @@ Tcltest_Init( NULL); Tcl_CreateCommand(interp, "testpanic", TestpanicCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testfinexit", TestfinexitObjCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "testparseargs", TestparseargsCmd,NULL,NULL); Tcl_CreateObjCommand(interp, "testparser", TestparserObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testparsevar", TestparsevarObjCmd, @@ -7082,6 +7085,49 @@ TestconcatobjCmd( } /* + *---------------------------------------------------------------------- + * + * TestparseargsCmd -- + * + * This procedure implements the "testparseargs" command. It is used to + * test that Tcl_ParseArgsObjv does indeed return the right number of + * arguments. In other words, that [Bug 3413857] was fixed properly. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +TestparseargsCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Arguments. */ +{ + int count = objc, foo = 0; + Tcl_Obj **remObjv, *result[3]; + Tcl_ArgvInfo argTable[] = { + {TCL_ARGV_CONSTANT, "-bool", INT2PTR(1), &foo, "booltest", NULL}, + TCL_ARGV_AUTO_REST, TCL_ARGV_AUTO_HELP, TCL_ARGV_TABLE_END + }; + + if (Tcl_ParseArgsObjv(interp, argTable, &count, objv, &remObjv)!=TCL_OK) { + return TCL_ERROR; + } + result[0] = Tcl_NewIntObj(foo); + result[1] = Tcl_NewIntObj(count); + result[2] = Tcl_NewListObj(count, remObjv); + Tcl_SetObjResult(interp, Tcl_NewListObj(3, result)); + ckfree(remObjv); + return TCL_OK; +} + +/* * Local Variables: * mode: c * c-basic-offset: 4 diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c index 71d5a66..3345081 100644 --- a/generic/tclThreadTest.c +++ b/generic/tclThreadTest.c @@ -46,7 +46,7 @@ static Tcl_ThreadDataKey dataKey; * protected by threadMutex. */ -static ThreadSpecificData *threadList; +static ThreadSpecificData *threadList = NULL; /* * The following bit-values are legal for the "flags" field of the @@ -623,9 +623,9 @@ NewTestThread( * Clean up. */ - ListRemove(tsdPtr); - Tcl_Release(tsdPtr->interp); Tcl_DeleteInterp(tsdPtr->interp); + Tcl_Release(tsdPtr->interp); + ListRemove(tsdPtr); Tcl_ExitThread(result); TCL_THREAD_CREATE_RETURN; @@ -744,6 +744,7 @@ ListRemove( tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr; } tsdPtr->nextPtr = tsdPtr->prevPtr = 0; + tsdPtr->interp = NULL; Tcl_MutexUnlock(&threadMutex); } @@ -1148,6 +1149,11 @@ ThreadExitProc( char *threadEvalScript = clientData; ThreadEventResult *resultPtr, *nextPtr; Tcl_ThreadId self = Tcl_GetCurrentThread(); + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + if (tsdPtr->interp != NULL) { + ListRemove(tsdPtr); + } Tcl_MutexLock(&threadMutex); |