From: Steve Huntley <stephen.huntley@alum.mit.edu>
Date: Mon, 28 Nov 2011 19:26:13 +0000 (+0000)
Subject: 2011-11-28  Steve Huntley  <stephen.huntley@alum.mit.edu>
X-Git-Url: https://privyetmir.co.uk/gitweb.cgi?a=commitdiff_plain;h=394ddb618cfc1d3c4815346cb592278ce3c01f95;p=tclvfs

2011-11-28  Steve Huntley  <stephen.huntley@alum.mit.edu>

	* zipvfs.tcl: Applied contributed patch for bug 3395782.  Enables
	extraction of contents of zip files created using Fossil.
---

diff --git a/ChangeLog b/ChangeLog
index e62eafb..4522f18 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2011-11-28  Steve Huntley  <stephen.huntley@alum.mit.edu>
+
+	* zipvfs.tcl: Applied contributed patch for bug 3395782.  Enables 
+	extraction of contents of zip files created using Fossil.
+
+
 2011-11-28  Steve Huntley  <stephen.huntley@alum.mit.edu>
 
 	* zipvfs.tcl: Reverted bug fix for 3224057.  See bug ID 3303287.
diff --git a/library/zipvfs.tcl b/library/zipvfs.tcl
index ae603c2..7e55af4 100644
--- a/library/zipvfs.tcl
+++ b/library/zipvfs.tcl
@@ -73,6 +73,9 @@ proc vfs::zip::stat {zipfd name} {
     #::vfs::log "stat $name"
     ::zip::stat $zipfd $name sb
     #::vfs::log [array get sb]
+    # remove additional mode bits to prevent Tcl from reporting Fossil archives
+    # as socket types
+    set sb(mode) [expr {$sb(mode) & 0x01ff}]
     array get sb
 }
 
@@ -516,7 +519,8 @@ proc zip::TOC {fd arr} {
     set sb(size) [expr {$sb(size) & 0xffffffff}]
     set sb(mtime) [DosTime $date $time]
     set sb(mode) [expr { ($sb(atx) >> 16) & 0xffff }]
-    if { ( $sb(atx) & 0xff ) & 16 } {
+    # check atx field or mode field if this is a directory
+    if { ((( $sb(atx) & 0xff ) & 16) != 0) || (($sb(mode) & 0x4000) != 0) } {
 	set sb(type) directory
     } else {
 	set sb(type) file