From 394ddb618cfc1d3c4815346cb592278ce3c01f95 Mon Sep 17 00:00:00 2001 From: Steve Huntley Date: Mon, 28 Nov 2011 19:26:13 +0000 Subject: [PATCH] 2011-11-28 Steve Huntley * zipvfs.tcl: Applied contributed patch for bug 3395782. Enables extraction of contents of zip files created using Fossil. --- ChangeLog | 6 ++++++ library/zipvfs.tcl | 6 +++++- 2 files changed, 11 insertions(+), 1 deletion(-) diff --git a/ChangeLog b/ChangeLog index e62eafb..4522f18 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2011-11-28 Steve Huntley + + * zipvfs.tcl: Applied contributed patch for bug 3395782. Enables + extraction of contents of zip files created using Fossil. + + 2011-11-28 Steve Huntley * 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 -- 2.23.0