diff --git a/NEWS.rst b/NEWS.rst index 8baa7c09c..84436731d 100644 --- a/NEWS.rst +++ b/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_\` variable + during this creation step, then restored to their original value. (fix + issue #623) .. _5.6 release notes: diff --git a/doc/source/module.rst b/doc/source/module.rst index 54d265004..b9ab6e5ed 100644 --- a/doc/source/module.rst +++ b/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_\` 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_\` 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_ Value to set to environment variable :envvar:`` for diff --git a/tcl/envmngt.tcl.in b/tcl/envmngt.tcl.in index 88bdc1f22..61ed715da 100644 --- a/tcl/envmngt.tcl.in +++ b/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 diff --git a/tcl/interp.tcl.in b/tcl/interp.tcl.in index 4016e0264..a0b21fab2 100644 --- a/tcl/interp.tcl.in +++ b/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 diff --git a/tcl/main.tcl.in b/tcl/main.tcl.in index 9c88f405d..4a90e0634 100644 --- a/tcl/main.tcl.in +++ b/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) } } } diff --git a/testsuite/modules.00-init/110-quar.exp b/testsuite/modules.00-init/110-quar.exp index 7c07357f6..26f697c02 100644 --- a/testsuite/modules.00-init/110-quar.exp +++ b/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