diff options
Diffstat (limited to 'tests/safe.test')
| -rw-r--r-- | tests/safe.test | 312 |
1 files changed, 307 insertions, 5 deletions
diff --git a/tests/safe.test b/tests/safe.test index 0f82a6a..859f352 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -28,8 +28,6 @@ set ::auto_path [info library] # thus un-autoindexed) APIs in this test result arguments: catch {safe::interpConfigure} -proc equiv {x} {return $x} - # testing that nested and statics do what is advertised (we use a static # package - Tcltest - but it might be absent if we're in standard tclsh) @@ -94,7 +92,7 @@ test safe-3.2 {calling safe::interpCreate on trusted interp} -setup { lsort [a aliases] } -cleanup { safe::interpDelete a -} -result {::tcl::info::nameofexecutable clock encoding exit file glob load source} +} -result {::tcl::file::atime ::tcl::file::attributes ::tcl::file::copy ::tcl::file::delete ::tcl::file::dirname ::tcl::file::executable ::tcl::file::exists ::tcl::file::extension ::tcl::file::isdirectory ::tcl::file::isfile ::tcl::file::link ::tcl::file::lstat ::tcl::file::mkdir ::tcl::file::mtime ::tcl::file::nativename ::tcl::file::normalize ::tcl::file::owned ::tcl::file::readable ::tcl::file::readlink ::tcl::file::rename ::tcl::file::rootname ::tcl::file::size ::tcl::file::stat ::tcl::file::tail ::tcl::file::tempfile ::tcl::file::type ::tcl::file::volumes ::tcl::file::writable ::tcl::info::nameofexecutable clock encoding exit glob load source} test safe-3.3 {calling safe::interpCreate on trusted interp} -setup { catch {safe::interpDelete a} } -body { @@ -205,7 +203,12 @@ test safe-7.2 {tests specific path and interpFind/AddToAccessPath} -body { [catch {interp eval $i {package require http 1}} msg] $msg \ [safe::interpConfigure $i]\ [safe::interpDelete $i] -} -match glob -result "{\$p(:0:)} {\$p(:[expr 1+[llength [tcl::tm::list]]]:)} 1 {can't find package http 1} {-accessPath {[list $tcl_library */dummy/unixlike/test/path]} -statics 0 -nested 1 -deleteHook {}} {}" +} -match glob -result "{\$p(:0:)} {\$p(:*:)} 1 {can't find package http 1} {-accessPath {[list $tcl_library */dummy/unixlike/test/path]} -statics 0 -nested 1 -deleteHook {}} {}" +test safe-7.3 {check that safe subinterpreters work} { + set i [safe::interpCreate] + set j [safe::interpCreate [list $i x]] + list [interp eval $j {join {o k} ""}] [safe::interpDelete $i] [interp exists $j] +} {ok {} 0} # test source control on file name test safe-8.1 {safe source control on file} -setup { @@ -331,6 +334,20 @@ test safe-8.9 {safe source and return} -setup { catch {safe::interpDelete $i} removeFile $returnScript } -result ok +test safe-8.10 {safe source and return} -setup { + set returnScript [makeFile {return -level 2 "ok"} return.tcl] + catch {safe::interpDelete $i} +} -body { + safe::interpCreate $i + set token [safe::interpAddToAccessPath $i [file dirname $returnScript]] + $i eval [list apply {filename { + source $filename + error boom + }} $token/[file tail $returnScript]] +} -cleanup { + catch {safe::interpDelete $i} + removeFile $returnScript +} -result ok test safe-9.1 {safe interps' deleteHook} -setup { set i "a" @@ -408,6 +425,19 @@ test safe-10.1 {testing statics loading} -constraints TcltestPackage -setup { } -returnCodes error -cleanup { safe::interpDelete $i } -result {can't use package in a safe interpreter: no Safepkg1_SafeInit procedure} +test safe-10.1.1 {testing statics loading} -constraints TcltestPackage -setup { + set i [safe::interpCreate] +} -body { + catch {interp eval $i {load {} Safepkg1}} m o + dict get $o -errorinfo +} -returnCodes ok -cleanup { + unset -nocomplain m o + safe::interpDelete $i +} -result {can't use package in a safe interpreter: no Safepkg1_SafeInit procedure + invoked from within +"load {} Safepkg1" + invoked from within +"interp eval $i {load {} Safepkg1}"} test safe-10.2 {testing statics loading / -nostatics} -constraints TcltestPackage -body { set i [safe::interpCreate -nostatics] interp eval $i {load {} Safepkg1} @@ -427,6 +457,18 @@ test safe-10.4 {testing nested statics loading / -nestedloadok} -constraints Tcl } -returnCodes error -cleanup { safe::interpDelete $i } -result {can't use package in a safe interpreter: no Safepkg1_SafeInit procedure} +test safe-10.4.1 {testing nested statics loading / -nestedloadok} -constraints TcltestPackage -body { + set i [safe::interpCreate -nestedloadok] + catch {interp eval $i {interp create x; load {} Safepkg1 x}} m o + dict get $o -errorinfo +} -returnCodes ok -cleanup { + unset -nocomplain m o + safe::interpDelete $i +} -result {can't use package in a safe interpreter: no Safepkg1_SafeInit procedure + invoked from within +"load {} Safepkg1 x" + invoked from within +"interp eval $i {interp create x; load {} Safepkg1 x}"} test safe-11.1 {testing safe encoding} -setup { set i [safe::interpCreate] @@ -484,6 +526,23 @@ test safe-11.7 {testing safe encoding} -setup { } -returnCodes error -cleanup { safe::interpDelete $i } -result {wrong # args: should be "encoding convertfrom ?encoding? data"} +test safe-11.7.1 {testing safe encoding} -setup { + set i [safe::interpCreate] +} -body { + catch {interp eval $i encoding convertfrom} m o + dict get $o -errorinfo +} -returnCodes ok -cleanup { + unset -nocomplain m o + safe::interpDelete $i +} -result {wrong # args: should be "encoding convertfrom ?encoding? data" + while executing +"encoding convertfrom" + invoked from within +"::interp invokehidden interp1 encoding convertfrom" + invoked from within +"encoding convertfrom" + invoked from within +"interp eval $i encoding convertfrom"} test safe-11.8 {testing safe encoding} -setup { set i [safe::interpCreate] } -body { @@ -491,6 +550,23 @@ test safe-11.8 {testing safe encoding} -setup { } -returnCodes error -cleanup { safe::interpDelete $i } -result {wrong # args: should be "encoding convertto ?encoding? data"} +test safe-11.8.1 {testing safe encoding} -setup { + set i [safe::interpCreate] +} -body { + catch {interp eval $i encoding convertto} m o + dict get $o -errorinfo +} -returnCodes ok -cleanup { + unset -nocomplain m o + safe::interpDelete $i +} -result {wrong # args: should be "encoding convertto ?encoding? data" + while executing +"encoding convertto" + invoked from within +"::interp invokehidden interp1 encoding convertto" + invoked from within +"encoding convertto" + invoked from within +"interp eval $i encoding convertto"} test safe-12.1 {glob is restricted [Bug 2906841]} -setup { set i [safe::interpCreate] @@ -538,9 +614,235 @@ test safe-12.7 {glob is restricted} -setup { set i [safe::interpCreate] } -body { $i eval glob * +} -returnCodes error -cleanup { + safe::interpDelete $i +} -result {permission denied} + +proc buildEnvironment {filename} { + upvar 1 testdir testdir testdir2 testdir2 testfile testfile + set testdir [makeDirectory deletethisdir] + set testdir2 [makeDirectory deletemetoo $testdir] + set testfile [makeFile {} $filename $testdir2] +} +#### New tests for Safe base glob, with patches @ Bug 2964715 +test safe-13.1 {glob is restricted [Bug 2964715]} -setup { + set i [safe::interpCreate] +} -body { + $i eval glob * +} -returnCodes error -cleanup { + safe::interpDelete $i +} -result {permission denied} +test safe-13.2 {mimic the valid glob call by ::tcl::tm::UnknownHandler [Bug 2964715]} -setup { + set i [safe::interpCreate] + buildEnvironment deleteme.tm +} -body { + ::safe::interpAddToAccessPath $i $testdir2 + set result [$i eval glob -nocomplain -directory $testdir2 *.tm] + if {$result eq [list $testfile]} { + return "glob match" + } else { + return "no match: $result" + } +} -cleanup { + safe::interpDelete $i + removeDirectory $testdir +} -result {glob match} +test safe-13.3 {cf 13.2 but test glob failure when -directory is outside access path [Bug 2964715]} -setup { + set i [safe::interpCreate] + buildEnvironment deleteme.tm +} -body { + $i eval glob -directory $testdir2 *.tm +} -returnCodes error -cleanup { + safe::interpDelete $i + removeDirectory $testdir +} -result {permission denied} +test safe-13.4 {another valid glob call [Bug 2964715]} -setup { + set i [safe::interpCreate] + buildEnvironment deleteme.tm +} -body { + ::safe::interpAddToAccessPath $i $testdir + ::safe::interpAddToAccessPath $i $testdir2 + set result [$i eval \ + glob -nocomplain -directory $testdir [file join deletemetoo *.tm]] + if {$result eq [list $testfile]} { + return "glob match" + } else { + return "no match: $result" + } +} -cleanup { + safe::interpDelete $i + removeDirectory $testdir +} -result {glob match} +test safe-13.5 {as 13.4 but test glob failure when -directory is outside access path [Bug 2964715]} -setup { + set i [safe::interpCreate] + buildEnvironment deleteme.tm +} -body { + ::safe::interpAddToAccessPath $i $testdir2 + $i eval \ + glob -directory $testdir [file join deletemetoo *.tm] +} -returnCodes error -cleanup { + safe::interpDelete $i + removeDirectory $testdir +} -result {permission denied} +test safe-13.6 {as 13.4 but test silent failure when result is outside access_path [Bug 2964715]} -setup { + set i [safe::interpCreate] + buildEnvironment deleteme.tm +} -body { + ::safe::interpAddToAccessPath $i $testdir + $i eval \ + glob -nocomplain -directory $testdir [file join deletemetoo *.tm] +} -cleanup { + safe::interpDelete $i + removeDirectory $testdir +} -result {} +test safe-13.7 {mimic the glob call by tclPkgUnknown which gives a deliberate error in a safe interpreter [Bug 2964715]} -setup { + set i [safe::interpCreate] + buildEnvironment pkgIndex.tcl +} -body { + set safeTD [::safe::interpAddToAccessPath $i $testdir] + ::safe::interpAddToAccessPath $i $testdir2 + string map [list $safeTD EXPECTED] [$i eval [list \ + glob -directory $safeTD -join * pkgIndex.tcl]] +} -cleanup { + safe::interpDelete $i + removeDirectory $testdir +} -result {{EXPECTED/deletemetoo/pkgIndex.tcl}} +# Note the extra {} around the result above; that's *expected* because of the +# format of virtual path roots. +test safe-13.8 {mimic the glob call by tclPkgUnknown without the deliberate error that is specific to pkgIndex.tcl [Bug 2964715]} -setup { + set i [safe::interpCreate] + buildEnvironment notIndex.tcl +} -body { + set safeTD [::safe::interpAddToAccessPath $i $testdir] + ::safe::interpAddToAccessPath $i $testdir2 + $i eval [list glob -directory $safeTD -join -nocomplain * notIndex.tcl] +} -cleanup { + safe::interpDelete $i + removeDirectory $testdir +} -result {} +test safe-13.9 {as 13.8 but test glob failure when -directory is outside access path [Bug 2964715]} -setup { + set i [safe::interpCreate] + buildEnvironment notIndex.tcl +} -body { + ::safe::interpAddToAccessPath $i $testdir2 + set result [$i eval \ + glob -directory $testdir -join -nocomplain * notIndex.tcl] + if {$result eq [list $testfile]} { + return {glob match} + } else { + return "no match: $result" + } } -cleanup { safe::interpDelete $i -} -match glob -result * + removeDirectory $testdir +} -result {no match: } +test safe-13.10 {as 13.8 but test silent failure when result is outside access_path [Bug 2964715]} -setup { + set i [safe::interpCreate] + buildEnvironment notIndex.tcl +} -body { + ::safe::interpAddToAccessPath $i $testdir + $i eval glob -directory $testdir -join -nocomplain * notIndex.tcl +} -cleanup { + safe::interpDelete $i + removeDirectory $testdir +} -result {} +rename buildEnvironment {} + +#### Test for the module path +test safe-14.1 {Check that module path is the same as in the master interpreter [Bug 2964715]} -setup { + set i [safe::interpCreate] +} -body { + set tm {} + foreach token [$i eval ::tcl::tm::path list] { + lappend tm [dict get [set ::safe::S${i}(access_path,map)] $token] + } + return $tm +} -cleanup { + safe::interpDelete $i +} -result [::tcl::tm::path list] + +test safe-15.1 {safe file ensemble does not surprise code} -setup { + set i [interp create -safe] +} -body { + set result [expr {"file" in [interp hidden $i]}] + lappend result [interp eval $i {tcl::file::split a/b/c}] + lappend result [catch {interp eval $i {tcl::file::isdirectory .}}] + lappend result [interp invokehidden $i file split a/b/c] + lappend result [catch {interp eval $i {file split a/b/c}} msg] $msg + lappend result [catch {interp invokehidden $i file isdirectory .}] + interp expose $i file + lappend result [catch {interp eval $i {file split a/b/c}} msg] $msg + lappend result [catch {interp eval $i {file isdirectory .}} msg] $msg +} -cleanup { + unset -nocomplain msg + interp delete $i +} -result {1 {a b c} 1 {a b c} 1 {invalid command name "file"} 1 0 {a b c} 1 {not allowed to invoke subcommand isdirectory of file}} +test safe-15.1.1 {safe file ensemble does not surprise code} -setup { + set i [interp create -safe] +} -body { + set result [expr {"file" in [interp hidden $i]}] + lappend result [interp eval $i {tcl::file::split a/b/c}] + lappend result [catch {interp eval $i {tcl::file::isdirectory .}}] + lappend result [interp invokehidden $i file split a/b/c] + lappend result [catch {interp eval $i {file split a/b/c}} msg] $msg + lappend result [catch {interp invokehidden $i file isdirectory .}] + interp expose $i file + lappend result [catch {interp eval $i {file split a/b/c}} msg] $msg + lappend result [catch {interp eval $i {file isdirectory .}} msg o] [dict get $o -errorinfo] +} -cleanup { + unset -nocomplain msg o + interp delete $i +} -result {1 {a b c} 1 {a b c} 1 {invalid command name "file"} 1 0 {a b c} 1 {not allowed to invoke subcommand isdirectory of file + while executing +"file isdirectory ." + invoked from within +"interp eval $i {file isdirectory .}"}} + +### ~ should have no special meaning in paths in safe interpreters +test safe-16.1 {Bug 3529949: defang ~ in paths} -setup { + set savedHOME $env(HOME) + set env(HOME) /foo/bar + set i [safe::interpCreate] +} -body { + $i eval { + set d [format %c 126] + list [file join [file dirname $d] [file tail $d]] + } +} -cleanup { + safe::interpDelete $i + set env(HOME) $savedHOME +} -result {./~} +test safe-16.2 {Bug 3529949: defang ~user in paths} -setup { + set i [safe::interpCreate] + set user $tcl_platform(user) +} -body { + string map [list $user USER] [$i eval \ + "file join \[file dirname ~$user\] \[file tail ~$user\]"] +} -cleanup { + safe::interpDelete $i +} -result {./~USER} +test safe-16.3 {Bug 3529949: defang ~ in globs} -setup { + set syntheticHOME [makeDirectory foo] + makeFile {} bar $syntheticHOME + set savedHOME $env(HOME) + set env(HOME) $syntheticHOME + set i [safe::interpCreate] +} -body { + ::safe::interpAddToAccessPath $i $syntheticHOME + $i eval {glob -nocomplain ~/*} +} -cleanup { + safe::interpDelete $i + set env(HOME) $savedHOME + removeDirectory $syntheticHOME +} -result {} +test safe-16.4 {Bug 3529949: defang ~user in globs} -setup { + set i [safe::interpCreate] +} -body { + ::safe::interpAddToAccessPath $i $~$tcl_platform(user) + $i eval [list glob -nocomplain ~$tcl_platform(user)/*] +} -cleanup { + safe::interpDelete $i +} -result {} set ::auto_path $saveAutoPath # cleanup |