* doc/dde.n: Committed TIP #120 which provides the

	* win/tclWinDde.c:           dde package for safe interpreters.
	* tests/winDde.test:         Incremented package version to 1.2.4
	* library/dde/pkgIndex.tcl:

1 files changed, 254 insertions, 10 deletions

diff --git a/tests/winDde.test b/tests/winDde.test
index 06dab25..a23650d 100644
--- a/tests/winDde.test
+++ b/tests/winDde.test
@@ -2,17 +2,18 @@
 #
 # This file contains a collection of tests for one or more of the Tcl
 # built-in commands.  Sourcing this file into Tcl runs the tests and
-# generates output for errors.  No output means no errors were found.
+# generates output for errors. No output means no errors were found.
 #
 # Copyright (c) 1999 by Scriptics Corporation.
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: winDde.test,v 1.16 2003/05/16 22:00:47 patthoyts Exp $
+# RCS: @(#) $Id: winDde.test,v 1.17 2003/06/23 21:27:56 patthoyts Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
+    #tcltest::configure -verbose {pass start}
     namespace import -force ::tcltest::*
 }
 
@@ -34,10 +35,11 @@ if {$tcl_platform(platform) == "windows"} {
 
 set scriptName [makeFile {} script1.tcl]
 
-proc createChildProcess { ddeServerName } {
+proc createChildProcess { ddeServerName {handler {}}} {
     file delete -force $::scriptName
 
     set f [open $::scriptName w+]
+    puts $f [list set ddeServerName $ddeServerName]
     puts $f {
         # DDE child server -
         #
@@ -59,15 +61,37 @@ proc createChildProcess { ddeServerName } {
         
         # If an error occurs during the tests, this process may end up not
         # being closed down. To deal with this we create a 30s timeout.
-        proc DoTimeout {} {
-            global done
-            puts stderr "winDde.test child process $ddeServerName timed out."
+        proc ::DoTimeout {} {
+            global done ddeServerName
             set done 1
+            puts "winDde.test child process $ddeServerName timed out."
+            flush stdout
+        }
+        set timeout [after 30000 ::DoTimeout]
+        
+        # Define a restricted handler.
+        proc Handler1 {cmd} {
+            if {$cmd eq "stop"} {set ::done 1}
+            puts $cmd ; flush stdout 
+            return
+        }
+        proc Handler2 {cmd} {
+            if {$cmd eq "stop"} {set ::done 1}
+            puts [uplevel \#0 $cmd] ; flush stdout 
+            return
+        }
+        proc Handler3 {prefix cmd} {
+            if {$cmd eq "stop"} {set ::done 1}
+            puts [list $prefix $cmd] ; flush stdout
+            return
         }
-        set timeout [after 30000 DoTimeout]
     }
     # set the dde server name to the supplied argument.
-    puts $f [list dde servername $ddeServerName]
+    if {$handler == {}} {
+        puts $f [list dde servername $ddeServerName]
+    } else {
+        puts $f [list dde servername -handler $handler -- $ddeServerName]
+    }        
     puts $f {
         # run the server and handle final cleanup.
         after 200;# give dde a chance to get going.
@@ -212,7 +236,7 @@ test winDde-5.4 {DDE eval bad arguments} {pcOnly} {
 test winDde-6.1 {DDE servername bad arguments} \
     -constraints pcOnly \
     -body {list [catch {dde servername -z -z -z} msg] $msg} \
-    -result {1 {wrong # args: should be "dde servername ?-exact? ?--? ?serverName?"}}
+    -result {1 {wrong # args: should be "dde servername ?-exact? ?-handler proc? ?--? ?serverName?"}}
 
 test winDde-6.2 {DDE servername set name} \
     -constraints pcOnly \
@@ -338,11 +362,231 @@ test winDde-7.5 {interp name collision without -exact} \
     } \
     -result "dde-interp-7.5 #2"
 
+# -------------------------------------------------------------------------
+
+test winDde-8.1 {Safe DDE load} \
+    -constraints pcOnly \
+    -setup {
+        interp create -safe slave
+        slave invokehidden load $lib dde
+    } \
+    -body {
+        list [catch {slave eval dde servername slave} msg] $msg
+    } \
+    -cleanup {interp delete slave} \
+    -result {1 {invalid command name "dde"}}
+
+test winDde-8.2 {Safe DDE set servername} \
+    -constraints pcOnly \
+    -setup {
+        interp create -safe slave
+        slave invokehidden load $lib dde
+    } \
+    -body {
+        slave invokehidden dde servername slave
+    } \
+    -cleanup {interp delete slave} \
+    -result {slave}
+
+test winDde-8.3 {Safe DDE check handler required for eval} \
+    -constraints pcOnly \
+    -setup {
+        interp create -safe slave
+        slave invokehidden load $lib dde
+        slave invokehidden dde servername slave
+    } \
+    -body {
+        catch {dde eval slave set a 1} msg
+    } \
+    -cleanup {interp delete slave} \
+    -result {1}
+
+test winDde-8.4 {Safe DDE check that execute is denied} \
+    -constraints pcOnly \
+    -setup {
+        interp create -safe slave
+        slave invokehidden load $lib dde
+        slave invokehidden dde servername slave
+    } \
+    -body {
+        slave eval set a 1
+        list [catch {
+            dde execute TclEval slave {set a 2}
+            slave eval set a
+        } msg] $msg
+    } \
+    -cleanup {interp delete slave} \
+    -result {0 1}
+
+test winDde-8.5 {Safe DDE check that request is denied} \
+    -constraints pcOnly \
+    -setup {
+        interp create -safe slave
+        slave invokehidden load $lib dde
+        slave invokehidden dde servername slave
+    } \
+    -body {
+        slave eval set a 1
+        list [catch {dde request TclEval slave a} msg] $msg
+    } \
+    -cleanup {interp delete slave} \
+    -result {1 {remote server cannot handle this command}}
+
+test winDde-8.6 {Safe DDE assign handler procedure} \
+    -constraints pcOnly \
+    -setup {
+        interp create -safe slave
+        slave invokehidden load $lib dde
+        slave eval {proc DDEACCEPT {cmd} {set ::DDECMD $cmd}}
+    } \
+    -body {
+        slave invokehidden dde servername -handler DDEACCEPT slave
+    } \
+    -cleanup {interp delete slave} \
+    -result slave
+
+test winDde-8.7 {Safe DDE check simple command} \
+    -constraints pcOnly \
+    -setup {
+        interp create -safe slave
+        slave invokehidden load $lib dde
+        slave eval {proc DDEACCEPT {cmd} {set ::DDECMD $cmd}}
+        slave invokehidden dde servername -handler DDEACCEPT slave
+    } \
+    -body {
+        list [catch {
+            dde eval slave set x 1
+        } msg] $msg        
+    } \
+    -cleanup {interp delete slave} \
+    -result {0 {set x 1}}
+
+test winDde-8.8 {Safe DDE check non-list command} \
+    -constraints pcOnly \
+    -setup {
+        interp create -safe slave
+        slave invokehidden load $lib dde
+        slave eval {proc DDEACCEPT {cmd} {set ::DDECMD $cmd}}
+        slave invokehidden dde servername -handler DDEACCEPT slave
+    } \
+    -body {
+        list [catch {
+            set s "c:\\Program Files\\Microsoft Visual Studio\\"
+            dde eval slave $s
+            string compare [slave eval set DDECMD] $s
+        } msg] $msg        
+    } \
+    -cleanup {interp delete slave} \
+    -result {0 0}
+
+test winDde-8.9 {Safe DDE check command evaluation} \
+    -constraints pcOnly \
+    -setup {
+        interp create -safe slave
+        slave invokehidden load $lib dde
+        slave eval {proc DDEACCEPT {cmd} {set ::DDECMD [uplevel #0 $cmd]}}
+        slave invokehidden dde servername -handler DDEACCEPT slave
+    } \
+    -body {
+        list [catch {
+            dde eval slave set x 1
+            slave eval set x
+        } msg] $msg        
+    } \
+    -cleanup {interp delete slave} \
+    -result {0 1}
+
+test winDde-8.10 {Safe DDE check command evaluation (2)} \
+    -constraints pcOnly \
+    -setup {
+        interp create -safe slave
+        slave invokehidden load $lib dde
+        slave eval {proc DDEACCEPT {cmd} {set ::DDECMD [uplevel #0 $cmd]}}
+        slave invokehidden dde servername -handler DDEACCEPT slave
+    } \
+    -body {
+        list [catch {
+            dde eval slave [list set x 1]
+            slave eval set x
+        } msg] $msg        
+    } \
+    -cleanup {interp delete slave} \
+    -result {0 1}
+
+test winDde-8.11 {Safe DDE check command evaluation (3)} \
+    -constraints pcOnly \
+    -setup {
+        interp create -safe slave
+        slave invokehidden load $lib dde
+        slave eval {proc DDEACCEPT {cmd} {set ::DDECMD [uplevel #0 $cmd]}}
+        slave invokehidden dde servername -handler DDEACCEPT slave
+    } \
+    -body {
+        list [catch {
+            dde eval slave [list [list set x 1]]
+            slave eval set x
+        } msg] $msg
+    } \
+    -cleanup {interp delete slave} \
+    -result {1 {invalid command name "set x 1"}}
+
+# -------------------------------------------------------------------------
+
+test winDde-9.1 {External safe DDE check string passing} \
+    -constraints {pcOnly stdio} \
+    -setup {
+        set name child-9.1
+        set child [createChildProcess $name Handler1]
+        file copy -force script1.tcl dde-script.tcl
+    } \
+    -body {
+        list [catch {
+            dde eval $name set x 1
+            gets $child line
+            set line
+        } msg] $msg
+    } \
+    -cleanup {dde execute TclEval $name stop ; update} \
+    -result {0 {set x 1}}
+
+test winDde-9.2 {External safe DDE check command evaluation} \
+    -constraints {pcOnly stdio} \
+    -setup {
+        set name child-9.2
+        set child [createChildProcess $name Handler2]
+        file copy -force script1.tcl dde-script.tcl
+    } \
+    -body {
+        list [catch {
+            dde eval $name set x 1
+            gets $child line
+            set line
+        } msg] $msg
+    } \
+    -cleanup {dde execute TclEval $name stop ; update} \
+    -result {0 1}
+
+test winDde-9.3 {External safe DDE check prefixed arguments} \
+    -constraints {pcOnly stdio} \
+    -setup {
+        set name child-9.3
+        set child [createChildProcess $name [list Handler3 ARG]]
+        file copy -force script1.tcl dde-script.tcl
+    } \
+    -body {
+        list [catch {
+            dde eval $name set x 1
+            gets $child line
+            set line
+        } msg] $msg
+    } \
+    -cleanup {dde execute TclEval $name stop ; update} \
+    -result {0 {ARG {set x 1}}}
 
 # -------------------------------------------------------------------------
 
 #cleanup
-catch {interp delete $slave};           # ensure we clean up the slave.
+#catch {interp delete $slave};           # ensure we clean up the slave.
 file delete -force $::scriptName
 ::tcltest::cleanupTests
 return