Protect Tcl sub-interpreter creation with quarantine mechanism

NEWS.rst

@@ -238,6 +238,12 @@ Modules 5.7.0 (not yet released)
   :mconfig:`ignore_cache_subcmds` is changed with :subcmd:`config`
   sub-command, it sets the :envvar:`MODULES_IGNORE_CACHE_SUBCMDS`
   environment variable. (fix issue #563)
+* Protect the creation of the Tcl sub-interpreters used to evaluate modulercs
+  and modulefiles with the quarantine mechanism. Environment variables listed
+  in the :mconfig:`run_quarantine` configuration option are unset or set to
+  the value of their corresponding :envvar:`MODULES_RUNENV_\<VAR\>` variable
+  during this creation step, then restored to their original value. (fix
+  issue #623)
 
 
 .. _5.6 release notes:

doc/source/module.rst

@@ -5880,6 +5880,15 @@ ENVIRONMENT
  Original values of these environment variables set in quarantine are passed
  to :file:`modulecmd.tcl` via :envvar:`__MODULES_QUAR_\<VAR\>` variables.
 
+ Each variable found in :envvar:`MODULES_RUN_QUARANTINE` is also set in
+ quarantine by :file:`modulecmd.tcl` during the creation of the Tcl
+ sub-interpreters used to evaluate modulercs and modulefiles. Variables are
+ unset or set to the value of their corresponding
+ :envvar:`MODULES_RUNENV_\<VAR\>` variable during this creation step, then
+ their original value is restored. It protects sub-interpreter initialization
+ from side-effect coming from current definition of these variables (e.g., a
+ ``TCL_LIBRARY`` variable pointing at a broken Tcl installation).
+
  This environment variable value supersedes the default value set in the
  :mconfig:`run_quarantine` configuration option. It can be defined with the
  :subcmd:`config` sub-command.
@@ -5888,6 +5897,9 @@ ENVIRONMENT
 
     .. versionadded:: 4.1
 
+    .. versionchanged:: 5.7
+       Quarantine also applied during Tcl sub-interpreter creation
+
 .. envvar:: MODULES_RUNENV_<VAR>
 
  Value to set to environment variable :envvar:`<VAR>` for

tcl/envmngt.tcl.in

@@ -1438,6 +1438,21 @@ proc isEnvVarDefined {var_name} {
    return [info exists ::env($var_name)]
 }
 
+# Get list of valid variable names found in run_quarantine configuration
+# option, cleared from duplicate entries. Warn about invalid names if asked
+proc getQuarantineVarList {{report_bad 0}} {
+   set var_list {}
+   foreach var [split [getConf run_quarantine]] {
+      if {[regexp {^[A-Za-z_][A-Za-z0-9_]*$} $var]} {
+         lappendNoDup var_list $var
+      } elseif {$report_bad && [string length $var]} {
+         reportWarning "Bad variable name set in MODULES_RUN_QUARANTINE\
+            ($var)"
+      }
+   }
+   return $var_list
+}
+
 proc setEnvVarIfUndefined {var_name value} {
    if {![isEnvVarDefined $var_name]} {
       set ::env($var_name) $value

tcl/interp.tcl.in

@@ -29,8 +29,41 @@ proc nimp {cmd args} {
 }
 
 proc createInterp {itrp} {
+   # set quarantine variables to their runtime value or unset them during
+   # interp creation to protect this initialization step from their current
+   # definition (e.g., a TCL_LIBRARY variable pointing at a broken Tcl
+   # installation)
+   set quar_var_list [getQuarantineVarList]
+   foreach var $quar_var_list {
+      if {[info exists ::env($var)]} {
+         set quar_orig_val($var) $::env($var)
+      }
+      if {[info exists ::env(MODULES_RUNENV_$var)]} {
+         reportDebug "Set '$var' environment variable in quarantine\
+            ($::env(MODULES_RUNENV_$var))"
+         set ::env($var) $::env(MODULES_RUNENV_$var)
+      } else {
+         reportDebug "Unset '$var' environment variable in quarantine"
+         unset -nocomplain ::env($var)
+      }
+   }
+
    reportDebug "creating interp $itrp"
    interp create $itrp
+
+   # restore environment variables put in quarantine once interp is created
+   foreach var $quar_var_list {
+      if {[info exists quar_orig_val($var)]} {
+         set ::env($var) $quar_orig_val($var)
+      } else {
+         unset -nocomplain ::env($var)
+         # also unset variable in created interp if it was set during
+         # creation: this env entry is not removed by the unset above and a
+         # read attempt on it would raise a "no such variable" error
+         ##nagelfar ignore Found constant
+         interp eval $itrp [list unset -nocomplain ::env($var)]
+      }
+   }
 }
 
 # Get identifier name of current Tcl modulefile interpreter. An interp is

tcl/main.tcl.in

@@ -904,25 +904,19 @@ if {[catch {
    # put back quarantine variables in env, if quarantine mechanism supported
    if {[info exists env(__MODULES_QUARANTINE_SET)] &&\
       $env(__MODULES_QUARANTINE_SET) eq {1}} {
-      foreach var [split [getConf run_quarantine]] {
-         # check variable name is valid
-         if {[regexp {^[A-Za-z_][A-Za-z0-9_]*$} $var]} {
-            set quarvar __MODULES_QUAR_${var}
-            # put back value
-            if {[info exists env($quarvar)]} {
-               reportDebug "Release '$var' environment variable from\
-                  quarantine ($env($quarvar))"
-               set env($var) $env($quarvar)
-               unset env($quarvar)
-            # or unset env var if no value found in quarantine
-            } elseif {[info exists env($var)]} {
-               reportDebug "Unset '$var' environment variable after\
-                  quarantine"
-               unset env($var)
-            }
-         } elseif {[string length $var]} {
-            reportWarning "Bad variable name set in MODULES_RUN_QUARANTINE\
-               ($var)"
+      foreach var [getQuarantineVarList 1] {
+         set quarvar __MODULES_QUAR_${var}
+         # put back value
+         if {[info exists env($quarvar)]} {
+            reportDebug "Release '$var' environment variable from\
+               quarantine ($env($quarvar))"
+            set env($var) $env($quarvar)
+            unset env($quarvar)
+         # or unset env var if no value found in quarantine
+         } elseif {[info exists env($var)]} {
+            reportDebug "Unset '$var' environment variable after\
+               quarantine"
+            unset env($var)
          }
       }
    }

testsuite/modules.00-init/110-quar.exp

@@ -188,3 +188,80 @@ reset_test_env
 } elseif {$verbose} {
    send_user "\tSkipping quarantine mechanism checks\n"
 }
+
+
+#
+# Quarantine protection of Tcl sub-interpreter creation (issue #623)
+#
+
+# fake Tcl library directories whose init.tcl script leaves a mark in
+# environment when sourced by a sub-interpreter then applies the genuine
+# init.tcl content of the Tcl interpreter running modulecmd. This content
+# is embedded in the fake script, as raising an error instead would engage
+# the init.tcl fallback search of tclInit, which panics on Tcl 9.1a1, like
+# sourcing the genuine init.tcl file when it lies in a zipfs archive.
+# ::argv only exists in the master interpreter, which also sources this
+# script when TCL_LIBRARY designates one of these directories
+set real_tcl_lib [exec $TCLSH << {puts -nonewline [info library]}]
+set real_init_content [exec $TCLSH << {set fid [open [file join\
+    [info library] init.tcl] r]; puts -nonewline [read $fid]; close $fid}]
+set fakelib1 [file join [pwd] faketcllib1]
+set fakelib2 [file join [pwd] faketcllib2]
+foreach {fakelib mark} [list $fakelib1 lib1 $fakelib2 lib2] {
+    file mkdir $fakelib
+    set fid [open $fakelib/init.tcl w]
+    puts $fid "if {!\[info exists ::argv\]} {"
+    puts $fid "    set ::env(TESTSUITE_FAKE_TCL_INIT) $mark"
+    puts $fid "}"
+    puts $fid "set ::tcl_library {$real_tcl_lib}"
+    puts $fid $real_init_content
+    close $fid
+}
+
+# modulefile reporting mark left by fake Tcl library and TCL_LIBRARY value
+set modfile [file join [pwd] faketcllib.mod]
+set fid [open $modfile w]
+puts $fid {#%Module
+if {[info exists env(TESTSUITE_FAKE_TCL_INIT)]} {
+    puts stderr "TESTSUITE_FAKE_TCL_INIT=$env(TESTSUITE_FAKE_TCL_INIT)"
+}
+if {[info exists env(TCL_LIBRARY)]} {
+    puts stderr "TCL_LIBRARY=$env(TCL_LIBRARY)"
+}}
+close $fid
+
+setenv_var TCL_LIBRARY $fakelib1
+
+# no quarantine: sub-interpreter initialization is affected by the broken
+# Tcl library installation found in environment
+set ans [list]
+lappend ans "TESTSUITE_FAKE_TCL_INIT=lib1"
+lappend ans "TCL_LIBRARY=$fakelib1"
+testouterr_cmd sh "source $modfile" OK [join $ans \n]
+
+# variable in quarantine: sub-interpreter creation is protected but variable
+# is restored afterward for modulefile evaluation
+setenv_var MODULES_RUN_QUARANTINE TCL_LIBRARY
+testouterr_cmd sh "source $modfile" OK "TCL_LIBRARY=$fakelib1"
+
+# defined runtime value is applied during sub-interpreter creation
+setenv_var MODULES_RUNENV_TCL_LIBRARY $fakelib2
+set ans [list]
+lappend ans "TESTSUITE_FAKE_TCL_INIT=lib2"
+lappend ans "TCL_LIBRARY=$fakelib1"
+testouterr_cmd sh "source $modfile" OK [join $ans \n]
+
+# variable initially unset with a defined runtime value: sub-interpreter
+# should not keep trace of the variable set during its creation once this
+# variable is unset after this step
+unsetenv_var TCL_LIBRARY
+testouterr_cmd sh "source $modfile" OK "TESTSUITE_FAKE_TCL_INIT=lib2"
+
+
+#
+#  Clean up variables used in this test case
+#
+
+file delete -force $fakelib1 $fakelib2 $modfile
+
+reset_test_env