[Starkit] sdx.kit bugs

[Massimo Dal Zotto]

I found some bugs in sdx.kit:

1)  sdx.kit pollutes the global namespace. More specifically it creates
    two variables 'a' and 'b' at toplevel.

2)  ls lists some files as directories. See test2 and test4 in makefile.

3)  ls fails on dangling symlinks, for example lockfiles created
    by emacs.

4)  ls prints wrong permissions for files with u-rwx or g-rwx.
 
I found also another bug where a Makefile was treated as a directory
(mounted as vfs) by sdx.kit. After opening and closing the Makefile
from sdx.kit it had an empty mk4 db appended at the end.
Unfortunately I'm unable to reproduce it after I changed the makefile.

The following makefile can be used for reproducing the bugs:

all:	download test

download: sdx.kit tclkit 

sdx.kit:
	wget http://www.equi4.com/pub/sk/sdx.kit
	chmod +x sdx.kit

tclkit:
	wget http://www.equi4.com/pub/tk/8.5a4/tclkit-linux-x86.gz
	gunzip -f tclkit-linux-x86.gz
	mv -f tclkit-linux-x86 tclkit
	chmod +x tclkit

test:	test1 test2 test3 test4

test1:
	### test1: sdx.kit pollutes global namespace
	./tclkit sdx.kit eval eval "file stat . c; parray c"
	./tclkit sdx.kit eval eval "file stat . a; parray a"
	./tclkit sdx.kit eval eval "file stat . b; parray b"
	./tclkit sdx.kit eval eval "puts a=[set a]; puts b=[set b]"

test2:
	### test2: ls lists some files as directories (see also test4 file d)
	ls -l
	./tclkit sdx.kit ls -l

test3:
	### test3: ls fails on dangling symlinks (like emacs lockfiles)
	ln -nfs user at host.domain:1111111111 ".#Makefile"
	ls -lA
	./tclkit sdx.kit ls -l || true
	@rm -f ".#Makefile"

test4:
	### test4: ls prints wrong permissions for files with u-rwx or g-rwx
	touch a b c d; mkdir e
	chmod 000 a
	chmod 004 b
	chmod 040 c
	chmod 400 d
	chmod 000 e
	ls -ld a b c d e
	./tclkit sdx.kit ls -l
	./tclkit sdx.kit ls -l a b c d e
	@chmod 755 a b c d e; rm -rf a b c d e


The following patch seems to fix the first bug:

--- sdx.tcl.orig	2005-10-19 13:55:43.000000000 +0200
+++ sdx.tcl	2005-11-07 12:50:20.475200728 +0100
@@ -37,17 +37,23 @@
     }
   }
 
-set a [lindex $argv 0]
-set b [file dirname [info script]]
-
-if {$a eq "" || $a eq "sdx"} {
-    set a help
-} elseif {[file exists [file join $b $a.tcl]]} {
-    set argv0 $a
-    set argv [lrange $argv 1 end]
-    incr argc -1
-} else {
-    set a help
-}
+proc run_sdx {} {
+    global argv0 argv argc
+
+    set a [lindex $argv 0]
+    set b [file dirname [info script]]
+
+    if {$a eq "" || $a eq "sdx"} {
+	set a help
+    } elseif {[file exists [file join $b $a.tcl]]} {
+	set argv0 $a
+	set argv [lrange $argv 1 end]
+	incr argc -1
+    } else {
+	set a help
+    }
+
+    uplevel #0 source [file join $b $a.tcl]
+}
 
-source [file join $b $a.tcl]
+run_sdx


-- 
Massimo Dal Zotto