From: Wojciech Kocjan <zoro2@users.sourceforge.net>
Date: Tue, 5 Feb 2013 13:18:48 +0000 (+0000)
Subject: 2013-02-05  Wojciech Kocjan <zoro2@users.sourceforge.net>
X-Git-Url: http://privyetmir.co.uk/gitweb.cgi?a=commitdiff_plain;h=9ebc5e82268378dca6b76908d4f68fb173a0f396;p=tclvfs

2013-02-05  Wojciech Kocjan <zoro2@users.sourceforge.net>

	* library/zipvfs.tcl: vfs::zip unable to read zip archives with wrong modes, bug 3603414
---

diff --git a/library/zipvfs.tcl b/library/zipvfs.tcl
index 7abc5a7..3d4b4ef 100644
--- a/library/zipvfs.tcl
+++ b/library/zipvfs.tcl
@@ -73,10 +73,22 @@ proc vfs::zip::stat {zipfd name} {
     #::vfs::log "stat $name"
     ::zip::stat $zipfd $name sb
     #::vfs::log [array get sb]
-    # remove socket mode bit (0xc000) to prevent Tcl from reporting Fossil archives as socket types
-    if {($sb(mode) & 0xc000) == 0xc000} {
+    # remove socket mode file type (0xc000) to prevent Tcl from reporting Fossil archives as socket types
+    if {($sb(mode) & 0xf000) == 0xc000} {
         set sb(mode) [expr {$sb(mode) ^ 0xc000}]
     }
+    # remove block device bit file type (0x6000)
+    if {($sb(mode) & 0xf000) == 0x6000} {
+        set sb(mode) [expr {$sb(mode) ^ 0x6000}]
+    }
+    # remove FIFO mode file type (0x1000)
+    if {($sb(mode) & 0xf000) == 0x1000} {
+        set sb(mode) [expr {$sb(mode) ^ 0x1000}]
+    }
+    # remove character device mode file type (0x2000)
+    if {($sb(mode) & 0xf000) == 0x2000} {
+        set sb(mode) [expr {$sb(mode) ^ 0x2000}]
+    }
     array get sb
 }