diff options
author | dgp <dgp@users.sourceforge.net> | 2008-06-25 17:18:42 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2008-06-25 17:18:42 (GMT) |
commit | 30e9d448eb8739e9d2218d88fc6c05afcc4aada6 (patch) | |
tree | 5ae7dc1ecc60d22f388807fa89a1b9d8ce69fcc5 | |
parent | f20a9319d8aa59061754469b303da6624e44dcb6 (diff) | |
download | tcl-30e9d448eb8739e9d2218d88fc6c05afcc4aada6.zip tcl-30e9d448eb8739e9d2218d88fc6c05afcc4aada6.tar.gz tcl-30e9d448eb8739e9d2218d88fc6c05afcc4aada6.tar.bz2 |
* generic/tcl.h: Bump to 8.5.3 for release.
* library/init.tcl:
* tools/tcl.wse.in:
* unix/configure.in:
* unix/tcl.spec:
* win/configure.in:
* unix/configure: autoconf-2.59
* win/configure:
* changes: Update for 8.5.3 release.
* library/tm.tcl: Modified the handling of Tcl Modules and of the
* library/safe.tcl: Safe Base to interact nicely with each other,
* library/init.tcl: enabling requiring Tcl Modules in safe
* tests/safe.test: interpreters. Fixes [Bug 1999119].
-rw-r--r-- | ChangeLog | 19 | ||||
-rw-r--r-- | changes | 4 | ||||
-rw-r--r-- | generic/tcl.h | 4 | ||||
-rw-r--r-- | library/init.tcl | 6 | ||||
-rw-r--r-- | library/safe.tcl | 150 | ||||
-rw-r--r-- | library/tm.tcl | 14 | ||||
-rw-r--r-- | tests/safe.test | 20 | ||||
-rw-r--r-- | tools/tcl.wse.in | 2 | ||||
-rwxr-xr-x | unix/configure | 2 | ||||
-rw-r--r-- | unix/configure.in | 4 | ||||
-rw-r--r-- | unix/tcl.spec | 4 | ||||
-rwxr-xr-x | win/configure | 2 | ||||
-rw-r--r-- | win/configure.in | 4 |
13 files changed, 193 insertions, 42 deletions
@@ -1,7 +1,26 @@ 2008-06-25 Don Porter <dgp@users.sourceforge.net> + *** 8.5.3 TAGGED FOR RELEASE *** + + * generic/tcl.h: Bump to 8.5.3 for release. + * library/init.tcl: + * tools/tcl.wse.in: + * unix/configure.in: + * unix/tcl.spec: + * win/configure.in: + + * unix/configure: autoconf-2.59 + * win/configure: + * changes: Update for 8.5.3 release. +2008-06-25 Andreas Kupries <andreask@activestate.com> + + * library/tm.tcl: Modified the handling of Tcl Modules and of the + * library/safe.tcl: Safe Base to interact nicely with each other, + * library/init.tcl: enabling requiring Tcl Modules in safe + * tests/safe.test: interpreters. Fixes [Bug 1999119]. + 2008-06-25 Pat Thoyts <patthoyts@users.sourceforge.net> * win/rules.vc: Backported fix for dde/registry versions and @@ -1,6 +1,6 @@ Recent user-visible changes to Tcl: -RCS: @(#) $Id: changes,v 1.116.2.15 2008/06/25 16:05:56 dgp Exp $ +RCS: @(#) $Id: changes,v 1.116.2.16 2008/06/25 17:18:42 dgp Exp $ 1. No more [command1] [command2] construct for grouping multiple commands on a single command line. @@ -7221,4 +7221,6 @@ variables without "." added to customization hooks (kupries) 2008-06-24 (bug fix)[1999176] crash in [glob -dir {} a] (porter) +2008-06-25 (bug fix)[1999119] Support TM packages in Safe Base (kupries) + --- Released 8.5.3, June 30, 2008 --- See ChangeLog for details --- diff --git a/generic/tcl.h b/generic/tcl.h index fb0e972..b14bd50 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tcl.h,v 1.231.2.18 2008/06/25 15:56:09 dgp Exp $ + * RCS: @(#) $Id: tcl.h,v 1.231.2.19 2008/06/25 17:18:42 dgp Exp $ */ #ifndef _TCL @@ -63,7 +63,7 @@ extern "C" { #define TCL_RELEASE_SERIAL 3 #define TCL_VERSION "8.5" -#define TCL_PATCH_LEVEL "8.5.3b1" +#define TCL_PATCH_LEVEL "8.5.3" /* * The following definitions set up the proper options for Windows compilers. diff --git a/library/init.tcl b/library/init.tcl index bc1c417..30c534d 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -3,7 +3,7 @@ # Default system startup file for Tcl-based applications. Defines # "unknown" procedure and auto-load facilities. # -# RCS: @(#) $Id: init.tcl,v 1.91.2.11 2008/06/25 15:56:15 dgp Exp $ +# RCS: @(#) $Id: init.tcl,v 1.91.2.12 2008/06/25 17:18:43 dgp Exp $ # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. @@ -17,7 +17,7 @@ if {[info commands package] == ""} { error "version mismatch: library\nscripts expect Tcl version 7.5b1 or later but the loaded version is\nonly [info patchlevel]" } -package require -exact Tcl 8.5.3b1 +package require -exact Tcl 8.5.3 # Compute the auto path to use in this interpreter. # The values on the path come from several locations: @@ -156,7 +156,7 @@ if {(![interp issafe]) && ($tcl_platform(platform) eq "windows")} { if {[interp issafe]} { - package unknown ::tclPkgUnknown + package unknown {::tcl::tm::UnknownHandler ::tclPkgUnknown} } else { # Set up search for Tcl Modules (TIP #189). # and setup platform specific unknown package handlers diff --git a/library/safe.tcl b/library/safe.tcl index 186c2e7..c29b394 100644 --- a/library/safe.tcl +++ b/library/safe.tcl @@ -12,7 +12,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: safe.tcl,v 1.16 2006/11/03 00:34:52 hobbs Exp $ +# RCS: @(#) $Id: safe.tcl,v 1.16.2.1 2008/06/25 17:18:43 dgp Exp $ # # The implementation is based on namespaces. These naming conventions @@ -369,12 +369,24 @@ namespace eval ::safe { lappend slave_auto_path "\$[PathToken $i]" incr i } + # Extend the access list with the paths used to look for Tcl + # Modules. We safe the virtual form separately as well, as + # syncing it with the slave has to be defered until the + # necessary commands are present for setup. + foreach dir [::tcl::tm::list] { + lappend access_path $dir + Set [PathToken $i $slave] $dir + lappend slave_auto_path "\$[PathToken $i]" + lappend slave_tm_path "\$[PathToken $i]" + incr i + } + Set [TmPathListName $slave] $slave_tm_path Set $nname $i - Set [PathListName $slave] $access_path + Set [PathListName $slave] $access_path Set [VirtualPathListName $slave] $slave_auto_path - Set [StaticsOkName $slave] $staticsok - Set [NestedOkName $slave] $nestedok + Set [StaticsOkName $slave] $staticsok + Set [NestedOkName $slave] $nestedok Set [DeleteHookName $slave] $deletehook SyncAccessPath $slave @@ -439,7 +451,7 @@ proc ::safe::interpAddToAccessPath {slave path} { # NB we need to add [namespace current], aliases are always # absolute paths. ::interp alias $slave source {} [namespace current]::AliasSource $slave - ::interp alias $slave load {} [namespace current]::AliasLoad $slave + ::interp alias $slave load {} [namespace current]::AliasLoad $slave # This alias lets the slave use the encoding names, convertfrom, # convertto, and system, but not "encoding system <name>" to set @@ -448,6 +460,10 @@ proc ::safe::interpAddToAccessPath {slave path} { ::interp alias $slave encoding {} [namespace current]::AliasEncoding \ $slave + # Handling Tcl Modules, we need a restricted form of Glob. + ::interp alias $slave glob {} [namespace current]::AliasGlob \ + $slave + # This alias lets the slave have access to a subset of the 'file' # command functionality. @@ -463,15 +479,25 @@ proc ::safe::interpAddToAccessPath {slave path} { # by Tcl_MakeSafe(3) - # Source init.tcl into the slave, to get auto_load and other - # procedures defined: + # Source init.tcl and tm.tcl into the slave, to get auto_load + # and other procedures defined: - if {[catch {::interp eval $slave\ + if {[catch {::interp eval $slave \ {source [file join $tcl_library init.tcl]}} msg]} { Log $slave "can't source init.tcl ($msg)" error "can't source init.tcl into slave $slave ($msg)" } + if {[catch {::interp eval $slave \ + {source [file join $tcl_library tm.tcl]}} msg]} { + Log $slave "can't source tm.tcl ($msg)" + error "can't source tm.tcl into slave $slave ($msg)" + } + + # Sync the paths used to search for Tcl modules. This can be + # done only now, after tm.tcl was loaded. + ::interp eval $slave [list ::tcl::tm::add {*}[Set [TmPathListName $slave]]] + return $slave } @@ -610,6 +636,10 @@ proc ::safe::setLogCmd {args} { proc VirtualPathListName {slave} { return "[InterpStateName $slave](access_path_slave)" } + # returns the variable name of the complete tm path list + proc TmPathListName {slave} { + return "[InterpStateName $slave](tm_path_slave)" + } # returns the variable name of the number of items proc PathNumberName {slave} { return "[InterpStateName $slave](access_path,n)" @@ -707,19 +737,96 @@ proc ::safe::setLogCmd {args} { } } + # AliasGlob is the target of the "glob" alias in safe interpreters. + + proc AliasGlob {slave args} { + Log $slave "GLOB ! $args" NOTICE + set cmd {} + set at 0 + + set dir {} + set virtualdir {} + + while {$at < [llength $args]} { + switch -glob -- [set opt [lindex $args $at]] { + -nocomplain - + -join { lappend cmd $opt ; incr at } + -directory { + lappend cmd $opt ; incr at + set virtualdir [lindex $args $at] + + # get the real path from the virtual one. + if {[catch {set dir [TranslatePath $slave $virtualdir]} msg]} { + Log $slave $msg + return -code error "permission denied" + } + # check that the path is in the access path of that slave + if {[catch {DirInAccessPath $slave $dir} msg]} { + Log $slave $msg + return -code error "permission denied" + } + lappend cmd $dir ; incr at + } + pkgIndex.tcl { + # Oops, this is globbing a subdirectory in regular + # package search. That is not wanted. Abort, + # handler does catch already (because glob was not + # defined before). See package.tcl, lines 484ff in + # tclPkgUnknown. + error "unknown command glob" + } + -* { + Log $slave "Safe base rejecting glob option '$opt'" + error "Safe base rejecting glob option '$opt'" + } + default { + lappend cmd $opt ; incr at + } + } + } + + Log $slave "GLOB = $cmd" NOTICE + + if {[catch {::interp invokehidden $slave glob {*}$cmd} msg]} { + Log $slave $msg + return -code error "script error" + } + + Log $slave "GLOB @ $msg" NOTICE + + # Translate path back to what the slave should see. + set res {} + foreach p $msg { + regsub -- ^$dir $p $virtualdir p + lappend res $p + } + + Log $slave "GLOB @ $res" NOTICE + return $res + } # AliasSource is the target of the "source" alias in safe interpreters. proc AliasSource {slave args} { set argc [llength $args] - # Allow only "source filename" + # Extended for handling of Tcl Modules to allow not only + # "source filename", but "source -encoding E filename" as + # well. + if {[lindex $args 0] eq "-encoding"} { + incr argc -2 + set encoding [lrange $args 0 1] + set at 2 + } else { + set at 0 + set encoding {} + } if {$argc != 1} { - set msg "wrong # args: should be \"source fileName\"" + set msg "wrong # args: should be \"source ?-encoding E? fileName\"" Log $slave "$msg ($args)" return -code error $msg } - set file [lindex $args 0] + set file [lindex $args $at] # get the real path from the virtual one. if {[catch {set file [TranslatePath $slave $file]} msg]} { @@ -740,7 +847,7 @@ proc ::safe::setLogCmd {args} { } # passed all the tests , lets source it: - if {[catch {::interp invokehidden $slave source $file} msg]} { + if {[catch {::interp invokehidden $slave source {*}$encoding $file} msg]} { Log $slave $msg return -code error "script error" } @@ -840,6 +947,25 @@ proc ::safe::setLogCmd {args} { } } + proc DirInAccessPath {slave dir} { + set access_path [GetAccessPath $slave] + + if {[file isfile $dir]} { + error "\"$dir\": is a file" + } + + # Normalize paths for comparison since lsearch knows nothing of + # potential pathname anomalies. + set norm_dir [file normalize $dir] + foreach path $access_path { + lappend norm_access_path [file normalize $path] + } + + if {[lsearch -exact $norm_access_path $norm_dir] == -1} { + error "\"$dir\": not in access_path" + } + } + # This procedure enables access from a safe interpreter to only a subset of # the subcommands of a command: diff --git a/library/tm.tcl b/library/tm.tcl index aee74f5..4f58d12 100644 --- a/library/tm.tcl +++ b/library/tm.tcl @@ -214,11 +214,11 @@ proc ::tcl::tm::UnknownHandler {original name args} { set satisfied 0 foreach path $paths { - if {![file exists $path]} { + if {![interp issafe] && ![file exists $path]} { continue } set currentsearchpath [file join $path $pkgroot] - if {![file exists $currentsearchpath]} { + if {![interp issafe] && ![file exists $currentsearchpath]} { continue } set strip [llength [file split $path]] @@ -352,9 +352,13 @@ proc ::tcl::tm::roots {paths} { foreach pa $paths { set p [file join $pa tcl$major] for {set n $minor} {$n >= 0} {incr n -1} { - path add [file normalize [file join $p ${major}.${n}]] + set px [file join $p ${major}.${n}] + if {![interp issafe]} { set px [file normalize $px] } + path add $px } - path add [file normalize [file join $p site-tcl]] + set px [file join $p site-tcl] + if {![interp issafe]} { set px [file normalize $px] } + path add $px } return } @@ -362,4 +366,4 @@ proc ::tcl::tm::roots {paths} { # Initialization. Set up the default paths, then insert the new # handler into the chain. -::tcl::tm::Defaults +if {![interp issafe]} { ::tcl::tm::Defaults } diff --git a/tests/safe.test b/tests/safe.test index e1b4a36..a578136 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -10,12 +10,12 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: safe.test,v 1.22 2006/12/05 18:45:51 andreas_kupries Exp $ +# RCS: @(#) $Id: safe.test,v 1.22.2.1 2008/06/25 17:18:43 dgp Exp $ package require Tcl 8.5 if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest + package require tcltest 2 namespace import -force ::tcltest::* } @@ -89,7 +89,7 @@ test safe-3.2 {calling safe::interpCreate on trusted interp} { set l [lsort [a aliases]] safe::interpDelete a set l -} {clock encoding exit file load source} +} {clock encoding exit file glob load source} test safe-3.3 {calling safe::interpCreate on trusted interp} { catch {safe::interpDelete a} safe::interpCreate a @@ -201,7 +201,7 @@ test safe-7.1 {tests that everything works at high level} { safe::interpDelete $i set v } 1.0 -test safe-7.2 {tests specific path and interpFind/AddToAccessPath} { +test safe-7.2 {tests specific path and interpFind/AddToAccessPath} -body { set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]]; # should not add anything (p0) set token1 [safe::interpAddToAccessPath $i [info library]] @@ -213,7 +213,7 @@ test safe-7.2 {tests specific path and interpFind/AddToAccessPath} { [catch {interp eval $i {package require http 1}} msg] $msg \ [safe::interpConfigure $i]\ [safe::interpDelete $i] -} "{\$p(:0:)} {\$p(:1:)} 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 source control on file name @@ -224,7 +224,7 @@ test safe-8.1 {safe source control on file} { list [catch {$i eval {source}} msg] \ $msg \ [safe::interpDelete $i] ; -} {1 {wrong # args: should be "source fileName"} {}} +} {1 {wrong # args: should be "source ?-encoding E? fileName"} {}} test safe-8.2 {safe source control on file} { set i "a"; catch {safe::interpDelete $i} @@ -232,7 +232,7 @@ test safe-8.2 {safe source control on file} { list [catch {$i eval {source}} msg] \ $msg \ [safe::interpDelete $i] ; -} {1 {wrong # args: should be "source fileName"} {}} +} {1 {wrong # args: should be "source ?-encoding E? fileName"} {}} test safe-8.3 {safe source control on file} { set i "a"; catch {safe::interpDelete $i} @@ -315,7 +315,7 @@ test safe-8.8 {safe source forbids -rsrc} { list [catch {$i eval {source -rsrc Init}} msg] \ $msg \ [safe::interpDelete $i] ; -} {1 {wrong # args: should be "source fileName"} {}} +} {1 {wrong # args: should be "source ?-encoding E? fileName"} {}} test safe-9.1 {safe interps' deleteHook} { set i "a"; @@ -364,7 +364,7 @@ test safe-9.5 {dual specification of nested} { list [catch {safe::interpCreate -nested 0 -nestedload} msg] $msg } {1 {conflicting values given for -nested and -nestedLoadOk}} -test safe-9.6 {interpConfigure widget like behaviour} { +test safe-9.6 {interpConfigure widget like behaviour} -body { # this test shall work, don't try to "fix it" unless # you *really* know what you are doing (ie you are me :p) -- dl list [set i [safe::interpCreate \ @@ -381,7 +381,7 @@ test safe-9.6 {interpConfigure widget like behaviour} { safe::interpConfigure $i]\ [safe::interpConfigure $i -deleteHook toto -nosta -nested 0; safe::interpConfigure $i] -} {{-accessPath /foo/bar -statics 0 -nested 1 -deleteHook {foo bar}} {-accessPath /foo/bar} {-nested 1} {-statics 0} {-deleteHook {foo bar}} {-accessPath /blah -statics 1 -nested 1 -deleteHook {foo bar}} {-accessPath /blah -statics 0 -nested 0 -deleteHook toto}} +} -match glob -result {{-accessPath * -statics 0 -nested 1 -deleteHook {foo bar}} {-accessPath *} {-nested 1} {-statics 0} {-deleteHook {foo bar}} {-accessPath * -statics 1 -nested 1 -deleteHook {foo bar}} {-accessPath * -statics 0 -nested 0 -deleteHook toto}} # testing that nested and statics do what is advertised # (we use a static package : Tcltest) diff --git a/tools/tcl.wse.in b/tools/tcl.wse.in index bf28241..c7eb858 100644 --- a/tools/tcl.wse.in +++ b/tools/tcl.wse.in @@ -12,7 +12,7 @@ item: Global Log Pathname=%MAINDIR%\INSTALL.LOG Message Font=MS Sans Serif Font Size=8 - Disk Label=tcl8.5.1 + Disk Label=tcl8.5.3 Disk Filename=setup Patch Flags=0000000000000001 Patch Threshold=85 diff --git a/unix/configure b/unix/configure index 018276f..fb58897 100755 --- a/unix/configure +++ b/unix/configure @@ -1335,7 +1335,7 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu TCL_VERSION=8.5 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=5 -TCL_PATCH_LEVEL=".3b1" +TCL_PATCH_LEVEL=".3" VERSION=${TCL_VERSION} #------------------------------------------------------------------------ diff --git a/unix/configure.in b/unix/configure.in index 69ffb39..6ef49f4 100644 --- a/unix/configure.in +++ b/unix/configure.in @@ -3,7 +3,7 @@ dnl This file is an input file used by the GNU "autoconf" program to dnl generate the file "configure", which is run during Tcl installation dnl to configure the system for the local environment. # -# RCS: @(#) $Id: configure.in,v 1.157.2.18 2008/06/25 15:56:26 dgp Exp $ +# RCS: @(#) $Id: configure.in,v 1.157.2.19 2008/06/25 17:18:49 dgp Exp $ AC_INIT([tcl],[8.5]) AC_PREREQ(2.59) @@ -27,7 +27,7 @@ m4_ifdef([SC_USE_CONFIG_HEADERS], [ TCL_VERSION=8.5 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=5 -TCL_PATCH_LEVEL=".3b1" +TCL_PATCH_LEVEL=".3" VERSION=${TCL_VERSION} #------------------------------------------------------------------------ diff --git a/unix/tcl.spec b/unix/tcl.spec index ee05ed9..92fd580 100644 --- a/unix/tcl.spec +++ b/unix/tcl.spec @@ -1,11 +1,11 @@ -# $Id: tcl.spec,v 1.27.2.8 2008/06/25 15:56:27 dgp Exp $ +# $Id: tcl.spec,v 1.27.2.9 2008/06/25 17:18:49 dgp Exp $ # This file is the basis for a binary Tcl RPM for Linux. %{!?directory:%define directory /usr/local} Name: tcl Summary: Tcl scripting language development environment -Version: 8.5.3b1 +Version: 8.5.3 Release: 2 License: BSD Group: Development/Languages diff --git a/win/configure b/win/configure index 78c8160..c9d65dc 100755 --- a/win/configure +++ b/win/configure @@ -1272,7 +1272,7 @@ SHELL=/bin/sh TCL_VERSION=8.5 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=5 -TCL_PATCH_LEVEL=".3b1" +TCL_PATCH_LEVEL=".3" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.3 diff --git a/win/configure.in b/win/configure.in index 1ebd570..abee5b0 100644 --- a/win/configure.in +++ b/win/configure.in @@ -3,7 +3,7 @@ # generate the file "configure", which is run during Tcl installation # to configure the system for the local environment. # -# RCS: @(#) $Id: configure.in,v 1.92.2.9 2008/06/25 15:56:27 dgp Exp $ +# RCS: @(#) $Id: configure.in,v 1.92.2.10 2008/06/25 17:18:50 dgp Exp $ AC_INIT(../generic/tcl.h) AC_PREREQ(2.59) @@ -16,7 +16,7 @@ SHELL=/bin/sh TCL_VERSION=8.5 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=5 -TCL_PATCH_LEVEL=".3b1" +TCL_PATCH_LEVEL=".3" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.3 |