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 e62eafb2dee857dce5932e31e8f88df98105dad7..4522f18e55907b20c1a2c5fadc00caf11ec2b13e 100644 (file)
--- 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 ae603c2c5c4b03525e44357c29f0f96856ba8e6c..7e55af4cdcaf53a8e9f8eebc558880f99818815c 100644 (file)
--- 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