TclVFS

Check-in [e391911bd2]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:2011-11-28 Steve Huntley <[email protected]> * zipvfs.tcl: Applied contributed patch for bug 3395782. Enables extraction of contents of zip files created using Fossil.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: e391911bd24b003297b6da08273f1a2221bab1b1
User & Date: blacksqr 2011-11-28 19:26:13
Context
2011-11-28
19:48
2011-11-28 Steve Huntley <[email protected]> * vfslib.tcl: Applied contributed patch for bug 3412801. Clean up watch timers for memchan vfs. check-in: d780b5303a user: blacksqr tags: trunk
19:26
2011-11-28 Steve Huntley <[email protected]> * zipvfs.tcl: Applied contributed patch for bug 3395782. Enables extraction of contents of zip files created using Fossil. check-in: e391911bd2 user: blacksqr tags: trunk
19:12
2011-11-28 Steve Huntley <[email protected]> * zipvfs.tcl: Reverted bug fix for 3224057. See bug ID 3303287. check-in: fdacfadbd2 user: blacksqr tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.







1
2
3
4
5
6
7





2011-11-28  Steve Huntley  <[email protected]>

	* zipvfs.tcl: Reverted bug fix for 3224057.  See bug ID 3303287.


2011-04-28  Steve Huntley  <[email protected]>

>
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
2011-11-28  Steve Huntley  <[email protected]>

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


2011-11-28  Steve Huntley  <[email protected]>

	* zipvfs.tcl: Reverted bug fix for 3224057.  See bug ID 3303287.


2011-04-28  Steve Huntley  <[email protected]>

Changes to library/zipvfs.tcl.

69
70
71
72
73
74
75



76
77
78
79
80
81
82
...
512
513
514
515
516
517
518

519
520
521
522
523
524
525
526
    return $newres
}

proc vfs::zip::stat {zipfd name} {
    #::vfs::log "stat $name"
    ::zip::stat $zipfd $name sb
    #::vfs::log [array get sb]



    array get sb
}

proc vfs::zip::access {zipfd name mode} {
    #::vfs::log "zip-access $name $mode"
    if {$mode & 2} {
	vfs::filesystem posixerror $::vfs::posix(EROFS)
................................................................................
	set sb($v) [expr {$sb($v) & 0xffff}]
    }
    set sb(crc) [expr {$sb(crc) & 0xffffffff}]
    set sb(csize) [expr {$sb(csize) & 0xffffffff}]
    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 } {
	set sb(type) directory
    } else {
	set sb(type) file
    }
    set sb(name) [read $fd [u_short $flen]]
    set sb(extra) [read $fd [u_short $elen]]
    set sb(comment) [read $fd [u_short $clen]]






>
>
>







 







>
|







69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
...
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
    return $newres
}

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
}

proc vfs::zip::access {zipfd name mode} {
    #::vfs::log "zip-access $name $mode"
    if {$mode & 2} {
	vfs::filesystem posixerror $::vfs::posix(EROFS)
................................................................................
	set sb($v) [expr {$sb($v) & 0xffff}]
    }
    set sb(crc) [expr {$sb(crc) & 0xffffffff}]
    set sb(csize) [expr {$sb(csize) & 0xffffffff}]
    set sb(size) [expr {$sb(size) & 0xffffffff}]
    set sb(mtime) [DosTime $date $time]
    set sb(mode) [expr { ($sb(atx) >> 16) & 0xffff }]
    # 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
    }
    set sb(name) [read $fd [u_short $flen]]
    set sb(extra) [read $fd [u_short $elen]]
    set sb(comment) [read $fd [u_short $clen]]