tar, zip fixes

diff --git a/ChangeLog b/ChangeLog
index 221abd7431a5e93ba20f5bf7aabcdbc75c2f791c..c9344fcba0f0fae2b9675a25b86e984e964e3280 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -4,6 +4,9 @@
         fixes a variety of problems (e.g. recurisve 'file copy' in a 
         directory).  Thanks to msofer for the detailed bug report and
         test script.
+       * library/zipvfs.tcl:
+       * library/tarvfs.tcl: ensure archive channel is closed if an
+       error is encountered while trying to open it.
        
 2003-07-03  Vince Darley <vincentdarley@sourceforge.net>
 

diff --git a/library/tarvfs.tcl b/library/tarvfs.tcl
index e8ca4e032a3275364d9688082996b7856788bae5..9e5ffcfd456c2771eb9dbce8be38a42baa00aef0 100644 (file)
--- a/library/tarvfs.tcl
+++ b/library/tarvfs.tcl
@@ -340,11 +340,18 @@ proc tar::TOC {fd arr toc} {
 
 proc tar::open {path} {
     set fd [::open $path]
-    upvar #0 tar::$fd.toc toc
-
-    fconfigure $fd -translation binary ;#-buffering none
-
-    tar::TOC $fd sb toc
+    
+    if {[catch {
+       upvar #0 tar::$fd.toc toc
+       
+       fconfigure $fd -translation binary ;#-buffering none
+       
+       tar::TOC $fd sb toc
+    } err]} {
+       close $fd
+       return -code error $err
+    }
+    
     return $fd
 }
 

diff --git a/library/zipvfs.tcl b/library/zipvfs.tcl
index df350c264c096ead325f432c3482eca23ca2ffc3..4f3ca4ec1787dd683644092d2b893231eddfdcc5 100644 (file)
--- a/library/zipvfs.tcl
+++ b/library/zipvfs.tcl
@@ -375,25 +375,31 @@ proc zip::TOC {fd arr} {
 
 proc zip::open {path} {
     set fd [::open $path]
-    upvar #0 zip::$fd cb
-    upvar #0 zip::$fd.toc toc
-
-    fconfigure $fd -translation binary ;#-buffering none
-
-    zip::EndOfArchive $fd cb
-
-    seek $fd $cb(coff) start
-
-    set toc(_) 0; unset toc(_); #MakeArray
+    
+    if {[catch {
+       upvar #0 zip::$fd cb
+       upvar #0 zip::$fd.toc toc
 
-    for { set i 0 } { $i < $cb(nitems) } { incr i } {
-       zip::TOC $fd sb
+       fconfigure $fd -translation binary ;#-buffering none
+       
+       zip::EndOfArchive $fd cb
 
-       set sb(depth) [llength [file split $sb(name)]]
+       seek $fd $cb(coff) start
 
-       set name [string tolower $sb(name)]
-       set toc($name) [array get sb]
-       FAKEDIR toc [file dirname $name]
+       set toc(_) 0; unset toc(_); #MakeArray
+       
+       for { set i 0 } { $i < $cb(nitems) } { incr i } {
+           zip::TOC $fd sb
+           
+           set sb(depth) [llength [file split $sb(name)]]
+           
+           set name [string tolower $sb(name)]
+           set toc($name) [array get sb]
+           FAKEDIR toc [file dirname $name]
+       }
+    } err]} {
+       close $fd
+       return -code error $err
     }
 
     return $fd