Register and uninstall incorrectly handle symlinks

[pat@…]

First, the uninstaller will refuse to remove a symbolic link to a directory that contains files. This makes it difficult (impossible if there are cycles) to create a contents list for a port that installs these types of links.

Second, the registry stores MD5 checksums for file symlinks, which the uninstaller tries to verify. This imposes an unnecessary order requirement on content lists. (Symlinks must be removed before the files they link to.)

The problem is due to the inability of the Tcl file isdirectory and isfile commands to recognize symlinks. I'm including a patch that fixes the two problems just described, but other problems of this type likely exist.

Index: portregistry.tcl
===================================================================
RCS file: /Volumes/src/cvs/od/proj/darwinports/base/src/port1.0/portregistry.tcl,v
retrieving revision 1.52
diff -u -r1.52 portregistry.tcl
--- portregistry.tcl    6 Nov 2002 00:15:25 -0000       1.52
+++ portregistry.tcl    11 Nov 2002 08:56:39 -0000
@@ -130,8 +130,8 @@
 proc fileinfo_for_file {fname} {
     global registry.nochecksum
 
-    if ![catch {file stat $fname statvar}] {
-       if {![tbool registry.nochecksum] && [file isfile $fname]} {
+    if ![catch {file lstat $fname statvar}] {
+       if {![tbool registry.nochecksum] && [string equal $statvar(type) file]} {
            set md5regex "^(MD5)\[ \]\\((.+)\\)\[ \]=\[ \](\[A-Za-z0-9\]+)\n$"
            set pipe [open "|md5 \"$fname\"" r]
            set line [read $pipe]
Index: portuninstall.tcl
===================================================================
RCS file: /Volumes/src/cvs/od/proj/darwinports/base/src/port1.0/portuninstall.tcl,v
retrieving revision 1.19
diff -u -r1.19 portuninstall.tcl
--- portuninstall.tcl   6 Nov 2002 00:15:25 -0000       1.19
+++ portuninstall.tcl   11 Nov 2002 08:56:39 -0000
@@ -103,7 +103,10 @@
                    }
                }
                ui_info "$UI_PREFIX   Uninstall is removing $fname"
-               if [file isdirectory $fname] {
+               if [catch {file lstat $fname statvar}] {
+                   ui_info "$UI_PREFIX  Uninstall unable to stat file $fname"
+                   set uninst_err 1
+               } elseif [string equal $statvar(type) directory] {
                    if [catch {exec rmdir $fname}] {
                        if ![tbool uninstall.force] {
                            ui_info "$UI_PREFIX  Uninstall unable to remove directory $fname (not empty?)"

[pguyot (Paul Guyot)]

Isn't this bug a little bit outdated with image code?

[wbb4@…]

And with Tcl 8.4, it seems... I'm going to mark this as FIXED, since all of the problems in the description are taken care of by images and Tcl 8.4.