From: Pat Thoyts <patthoyts@users.sourceforge.net>
Date: Thu, 22 Jan 2009 01:34:04 +0000 (+0000)
Subject: Applied patch from [Bug 1011492] to ensure we handle zipfiles with a prefix block... 
X-Git-Url: http://privyetmir.co.uk/gitweb.cgi?a=commitdiff_plain;h=bd02edd6e31cbf3e5db3920d9249b87072bd0e02;p=tclvfs

Applied patch from [Bug 1011492] to ensure we handle zipfiles with a prefix block robustly.
---

diff --git a/ChangeLog b/ChangeLog
index 8bfb418..16dcd59 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2009-01-22  Pat Thoyts  <patthoyts@users.sourceforge.net>
+
+	* library/zipvfs.tcl: Applied patch from [Bug 1011492] to ensure
+	we handle zipfiles with a prefix block robustly.
+
 2009-01-21  Andreas Kupries  <andreask@activestate.com>
 
 	* pkgIndex.tcl.in: Incremented version of vfs::zip
diff --git a/library/zipvfs.tcl b/library/zipvfs.tcl
index 14c3ab6..84a64d1 100644
--- a/library/zipvfs.tcl
+++ b/library/zipvfs.tcl
@@ -434,6 +434,9 @@ proc zip::TOC {fd arr} {
 	return -code error "bad central header: $x"
     }
 
+    upvar #0 zip::$fd cb
+    incr sb(ino) $cb(base) ;# adjust ino for start of archive offset
+
     foreach v {vem ver flags method disk attr} {
 	set sb($v) [expr {$sb($v) & 0xffff}]
     }
@@ -469,7 +472,7 @@ proc zip::open {path} {
 	
 	zip::EndOfArchive $fd cb
 
-	seek $fd $cb(coff) start
+	seek $fd [expr {$cb(coff) + $cb(base)}] start
 
 	set toc(_) 0; unset toc(_); #MakeArray