From: Vince Darley <vincentdarley@sourceforge.net>
Date: Mon, 7 Jul 2003 07:21:19 +0000 (+0000)
Subject: tar, zip fixes
X-Git-Tag: vfs-1-3~12
X-Git-Url: https://privyetmir.co.uk/gitweb.cgi?a=commitdiff_plain;h=b8c62323557c018ecdb7444d9fcff8272764dd72;p=tclvfs

tar, zip fixes
---

diff --git a/ChangeLog b/ChangeLog
index 221abd7..c9344fc 100644
--- 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 e8ca4e0..9e5ffcf 100644
--- 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 df350c2..4f3ca4e 100644
--- 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