close sebres#19: implements safe "catch" in clock NS - avoid overwrit…

…e of interp state by select and setup timezone (as well as in other "catched" blocks on lazy loading or initialization); windows: load registry package on demand only (if possible, using same safe "catch" command).
flightaware · Apr 16, 2020 · 93ac84f · 93ac84f
1 parent 8bbd204
commit 93ac84f
Show file tree

Hide file tree

Showing 3 changed files with 117 additions and 24 deletions.
diff --git a/generic/tclClock.c b/generic/tclClock.c
@@ -143,6 +143,9 @@ static struct tm *	ThreadSafeLocalTime(const time_t *);
 static size_t		TzsetIfNecessary(void);
 static void		ClockDeleteCmdProc(ClientData);
 
+static int		ClockSafeCatchCmd(
+			    ClientData clientData, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
 /*
  * Structure containing description of "native" clock commands to create.
  */
@@ -176,6 +179,7 @@ static const struct ClockCommand clockCommands[] = {
 		ClockGetjuliandayfromerayearmonthdayObjCmd,	NULL, NULL},
     {"GetJulianDayFromEraYearWeekDay",
 		ClockGetjuliandayfromerayearweekdayObjCmd,	NULL, NULL},
+    {"catch",		ClockSafeCatchCmd,	TclCompileBasicMin1ArgCmd, NULL},
     {NULL, NULL, NULL, NULL}
 };
 
@@ -1323,7 +1327,7 @@ ClockSetupTimeZone(
     /* setup now */
     callargs[0] = dataPtr->literals[LIT_SETUPTIMEZONE];
     if (Tcl_EvalObjv(interp, 2, callargs, 0) == TCL_OK) {
-    	/* save unnormalized last used */
+	/* save unnormalized last used */
 	Tcl_SetObjRef(dataPtr->lastSetupTimeZoneUnnorm, timezoneObj);
 	return callargs[1];
     }
@@ -4554,6 +4558,76 @@ ClockSecondsObjCmd(
     return TCL_OK;
 }
 
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClockSafeCatchCmd --
+ *
+ *	Same as "::catch" command but avoids overwriting of interp state.
+ *
+ *	See [554117edde] for more info (and proper solution).
+ *
+ *----------------------------------------------------------------------
+ */
+int
+ClockSafeCatchCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    typedef struct InterpState {
+        int status;			/* return code status */
+        int flags;			/* Each remaining field saves the */
+        int returnLevel;		/* corresponding field of the Interp */
+        int returnCode;			/* struct. These fields taken together are */
+        Tcl_Obj *errorInfo;		/* the "state" of the interp. */
+        Tcl_Obj *errorCode;
+        Tcl_Obj *returnOpts;
+        Tcl_Obj *objResult;
+        Tcl_Obj *errorStack;
+        int resetErrorStack;
+    } InterpState;
+
+    Interp *iPtr = (Interp *)interp;
+    int ret, flags = 0;
+    InterpState *statePtr;
+
+    if (objc == 1) {
+	/* wrong # args : */
+	return Tcl_CatchObjCmd(NULL, interp, objc, objv);
+    }
+
+    statePtr = (InterpState *)Tcl_SaveInterpState(interp, 0);
+    if (!statePtr->errorInfo) {
+	/* todo: avoid traced get of errorInfo here */
+	Tcl_InitObjRef(statePtr->errorInfo,
+		Tcl_ObjGetVar2(interp, iPtr->eiVar, NULL, 0));
+	flags |= ERR_LEGACY_COPY;
+    }
+    if (!statePtr->errorCode) {
+	/* todo: avoid traced get of errorCode here */
+	Tcl_InitObjRef(statePtr->errorCode,
+		Tcl_ObjGetVar2(interp, iPtr->ecVar, NULL, 0));
+	flags |= ERR_LEGACY_COPY;
+    }
+
+    /* original catch */
+    ret = Tcl_CatchObjCmd(NULL, interp, objc, objv);
+
+    if (ret == TCL_ERROR) {
+	Tcl_DiscardInterpState((Tcl_InterpState)statePtr);
+	return TCL_ERROR;
+    }
+    /* overwrite result in state with catch result */
+    Tcl_SetObjRef(statePtr->objResult, Tcl_GetObjResult(interp));
+    /* set result (together with restore state) to interpreter */
+    (void) Tcl_RestoreInterpState(interp, (Tcl_InterpState)statePtr);
+    /* todo: unless ERR_LEGACY_COPY not set in restore (branch [bug-554117edde] not merged yet) */
+    iPtr->flags |= (flags & ERR_LEGACY_COPY);
+    return ret;
+}
+
 /*
  *----------------------------------------------------------------------
  *

diff --git a/generic/tclClockModInt.c b/generic/tclClockModInt.c
@@ -52,6 +52,7 @@ int TclCompileClockReadingCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr,
 Tcl_ObjCmdProc *_ClockClicksObjCmd;
 Tcl_ObjCmdProc *_ClockMillisecondsObjCmd;
 Tcl_ObjCmdProc *_ClockMicrosecondsObjCmd;
+Tcl_ObjCmdProc * _TclNRCatchObjCmd;
 
 int ClockClicksObjCmd(ClientData clientData, Tcl_Interp *interp,
    int objc, Tcl_Obj *const *objv)
@@ -69,6 +70,12 @@ int ClockMicrosecondsObjCmd(ClientData clientData, Tcl_Interp *interp,
     return _ClockMicrosecondsObjCmd(clientData, interp, objc, objv);
 }
 
+int Tcl_CatchObjCmd(ClientData dummy, Tcl_Interp *interp,
+   int objc, Tcl_Obj *const objv[])
+{
+    return Tcl_NRCallObjProc(interp, _TclNRCatchObjCmd, dummy, objc, objv);
+}
+
 /* Currently no external declaration for tclStringHashKeyType */
 
 static unsigned
@@ -213,6 +220,9 @@ void _InitModTclIntInternals(Tcl_Interp *interp) {
 	InterpCommand(interp, "::tcl::clock::milliseconds")->objProc;
     _ClockMicrosecondsObjCmd =
 	InterpCommand(interp, "::tcl::clock::microseconds")->objProc;
+
+    _TclNRCatchObjCmd =
+	InterpCommand(interp, "::catch")->nreProc;
 }
 
 /*

diff --git a/lib/clock.tcl b/lib/clock.tcl
@@ -16,25 +16,9 @@
 #
 #----------------------------------------------------------------------
 
-# We must have message catalogs that support the root locale, and we need
-# access to the Registry on Windows systems.
+# We must have message catalogs that support the root locale.
 
-uplevel \#0 {
-    package require msgcat 1.6
-    if { $::tcl_platform(platform) eq {windows} } {
-	if { [catch { package require registry 1.1 }] } {
-	    # try to load registry directly from root (if uninstalled / development env):
-	    if {![regexp {[/\\]library$} [info library]] || [catch {
-		load [lindex \
-			[glob -tails -directory [file dirname [info nameofexecutable]] \
-			    tclreg*[expr {[::tcl::pkgconfig get debug] ? {g} : {}}].dll] 0 \
-		] registry
-	    }]} {
-		namespace eval ::tcl::clock [list variable NoRegistry {}]
-	    }
-	}
-    }
-}
+package require msgcat 1.6
 
 # Put the library directory into the namespace for the ensemble so that the
 # library code can find message catalogs and time zone definition files.
@@ -671,6 +655,33 @@ proc ::tcl::clock::EnterLocale { locale } {
     return $locale
 }
 
+#----------------------------------------------------------------------
+#
+# _hasRegistry --
+#
+#	Helper that checks whether registry module is available (Windows only)
+#	and loads it on demand.
+#
+#----------------------------------------------------------------------
+proc ::tcl::clock::_hasRegistry {} {
+    if { $::tcl_platform(platform) eq {windows} } {
+	if { [catch { package require registry 1.1 }] } {
+	    # try to load registry directly from root (if uninstalled / development env):
+	    if {[regexp {[/\\]library$} [info library]]} {catch {
+		load [lindex \
+			[glob -tails -directory [file dirname [info nameofexecutable]] \
+			    tclreg*[expr {[::tcl::pkgconfig get debug] ? {g} : {}}].dll] 0 \
+		] registry
+	    }}
+	}
+    }
+    if { $::tcl_platform(platform) ne {windows} || [namespace which -command ::registry] eq "" } {
+    	proc ::tcl::clock::_hasRegistry {} {return 0}
+    	return 0
+    }
+    return 1
+}
+
 #----------------------------------------------------------------------
 #
 # LoadWindowsDateTimeFormats --
@@ -696,8 +707,7 @@ proc ::tcl::clock::EnterLocale { locale } {
 proc ::tcl::clock::LoadWindowsDateTimeFormats { locale } {
     # Bail out if we can't find the Registry
 
-    variable NoRegistry
-    if { [info exists NoRegistry] } return
+    if { ![_hasRegistry] } return
 
     if { ![catch {
 	registry get "HKEY_CURRENT_USER\\Control Panel\\International" \
@@ -957,7 +967,7 @@ proc ::tcl::clock::SetupTimeZone { timezone {alias {}} } {
 
     if {! [info exists TZData($timezone)] } {
 
-    	variable TimeZoneBad
+	variable TimeZoneBad
 	if { [dict exists $TimeZoneBad $timezone] } {
 	    return -code error \
 		-errorcode [list CLOCK badTimeZone $timezone] \
@@ -1078,10 +1088,9 @@ proc ::tcl::clock::SetupTimeZone { timezone {alias {}} } {
 
 proc ::tcl::clock::GuessWindowsTimeZone {} {
     variable WinZoneInfo
-    variable NoRegistry
     variable TimeZoneBad
 
-    if { [info exists NoRegistry] } {
+    if { ![_hasRegistry] } {
 	return :localtime
     }