TclVFS

Check-in [85db155664]
Login
Bounty program for improvements to Tcl and certain Tcl packages.

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

Overview
Comment: * zipvfs.tcl: Fix for streaming not working properly in certain zip files; refactoring of zip::Data to reuse header parsing code for streams
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 85db155664ceb352b921d59964e07930468e5a86
User & Date: zoro2 2012-07-04 12:40:29
Context
2012-07-12
13:36
2012-07-12 Wojciech Kocjan <[email protected]> * zipvfs.tcl: Fix for Tcl 8.6 not properly streaming large files with very big compression ratio, bug 3542959 check-in: 0a4cd90315 user: zoro2 tags: trunk
2012-07-04
12:40
* zipvfs.tcl: Fix for streaming not working properly in certain zip files; refactoring of zip::Data to reuse header parsing code for streams check-in: 85db155664 user: zoro2 tags: trunk
2012-03-15
18:51
2012-03-15 Wojciech Kocjan <[email protected]> * zipvfs.tcl: Fix for zip symlinks not supported anymore, bug 3505283 check-in: 4f53c24936 user: zoro2 tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.






1
2
3
4
5
6
7




2012-03-15  Wojciech Kocjan <[email protected]>

	* zipvfs.tcl: Fix for zip symlinks not supported anymore, bug 3505283

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

	* vfslib.tcl: Applied contributed patch for bug 3412801.  Clean up watch
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
2012-07-04  Wojciech Kocjan <[email protected]>

	* zipvfs.tcl: Fix for streaming not working properly in certain zip
	files; refactoring of zip::Data to reuse header parsing code for streams

2012-03-15  Wojciech Kocjan <[email protected]>

	* zipvfs.tcl: Fix for zip symlinks not supported anymore, bug 3505283

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

	* vfslib.tcl: Applied contributed patch for bug 3412801.  Clean up watch

Changes to library/zipvfs.tcl.

124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
...
327
328
329
330
331
332
333


334
335
336
337
338
339
340
341
342
...
360
361
362
363
364
365
366



367



368
369
370
371
372
373
374
...
375
376
377
378
379
380
381

382




383
384
385
386
387
388
389
#	    puts -nonewline $nfd $data

#	    fconfigure $nfd -translation auto
#	    seek $nfd 0
#	    return [list $nfd]
	    # use streaming for files larger than 1MB
	    if {$::zip::useStreaming && $sb(size) >= 1048576} {
		set buf [read $zipfd 30]
		set n [binary scan $buf A4sssssiiiss \
			    hdr sb(ver) sb(flags) sb(method) \
			    time date \
			    sb(crc) sb(csize) sb(size) flen elen]
	    
		if { ![string equal "PK\03\04" $hdr] } {
		    binary scan $hdr H* x
		    error "bad header: $x"
		}
	    
		set sb(name) [read $zipfd [::zip::u_short $flen]]
		set sb(extra) [read $zipfd [::zip::u_short $elen]]
	    
		if { $sb(flags) & 0x4 } {
		    # Data Descriptor used
		    set buf [read $zipfd 12]
		    binary scan $buf iii sb(crc) sb(csize) sb(size)
		}
	    
		if { $sb(method) != 0} {
		    set nfd [::zip::zstream $zipfd $sb(csize) $sb(size)]
		}  else  {
		    set nfd [::zip::rawstream $zipfd $sb(size)]
		}
		return [list $nfd]
	    }  else  {
................................................................................
		    $year $mon $mday $hour $min $sec]
	set res [clock scan $dt -gmt 1]
    }

    return $res
}




proc zip::Data {fd arr verify} {
    upvar 1 $arr sb

    # APPNOTE A: Local file header
    set buf [read $fd 30]
    set n [binary scan $buf A4sssssiiiss \
               hdr sb(ver) sb(flags) sb(method) time date \
               crc csize size namelen xtralen]
................................................................................
    if {$sb(flags) & (1 << 11)} {
        set sb(name) [encoding convertfrom utf-8 $sb(name)]
    }
    set sb(name) [string trimleft $sb(name) "./"]

    # APPNOTE B: File data
    #   if bit 3 of flags is set the csize comes from the central directory



    set data [read $fd $sb(csize)]




    # APPNOTE C: Data descriptor
    if { $sb(flags) & (1<<3) } {
        binary scan [read $fd 4] i ddhdr
        if {($ddhdr & 0xffffffff) == 0x08074b50} {
            binary scan [read $fd 12] iii sb(crc) sb(csize) sb(size)
        } else {
................................................................................
            set sb(crc) $ddhdr
            binary scan [read $fd 8] ii sb(csize) sb(size)
        }
        set sb(crc) [expr {$sb(crc) & 0xffffffff}]
        set sb(csize) [expr {$sb(csize) & 0xffffffff}]
        set sb(size) [expr {$sb(size) & 0xffffffff}]
    }

    




    switch -exact -- $sb(method) {
        0 {
            # stored; no compression
        }
        8 {
            # deflated
            if {[catch {






|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







 







>
>

<







 







>
>
>
|
>
>
>







 







>
|
>
>
>
>







124
125
126
127
128
129
130
131



















132
133
134
135
136
137
138
...
308
309
310
311
312
313
314
315
316
317

318
319
320
321
322
323
324
...
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
...
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
#	    puts -nonewline $nfd $data

#	    fconfigure $nfd -translation auto
#	    seek $nfd 0
#	    return [list $nfd]
	    # use streaming for files larger than 1MB
	    if {$::zip::useStreaming && $sb(size) >= 1048576} {
		seek $zipfd [zip::ParseDataHeader $zipfd sb] start



















		if { $sb(method) != 0} {
		    set nfd [::zip::zstream $zipfd $sb(csize) $sb(size)]
		}  else  {
		    set nfd [::zip::rawstream $zipfd $sb(size)]
		}
		return [list $nfd]
	    }  else  {
................................................................................
		    $year $mon $mday $hour $min $sec]
	set res [clock scan $dt -gmt 1]
    }

    return $res
}

proc zip::ParseDataHeader {fd arr {dataVar ""}} {
    upvar 1 $arr sb


    upvar 1 $arr sb

    # APPNOTE A: Local file header
    set buf [read $fd 30]
    set n [binary scan $buf A4sssssiiiss \
               hdr sb(ver) sb(flags) sb(method) time date \
               crc csize size namelen xtralen]
................................................................................
    if {$sb(flags) & (1 << 11)} {
        set sb(name) [encoding convertfrom utf-8 $sb(name)]
    }
    set sb(name) [string trimleft $sb(name) "./"]

    # APPNOTE B: File data
    #   if bit 3 of flags is set the csize comes from the central directory
    set offset [tell $fd]
    if {$dataVar != ""} {
	upvar 1 $dataVar data
	set data [read $fd $sb(csize)]
    }  else  {
	seek $fd $sb(csize) current
    }

    # APPNOTE C: Data descriptor
    if { $sb(flags) & (1<<3) } {
        binary scan [read $fd 4] i ddhdr
        if {($ddhdr & 0xffffffff) == 0x08074b50} {
            binary scan [read $fd 12] iii sb(crc) sb(csize) sb(size)
        } else {
................................................................................
            set sb(crc) $ddhdr
            binary scan [read $fd 8] ii sb(csize) sb(size)
        }
        set sb(crc) [expr {$sb(crc) & 0xffffffff}]
        set sb(csize) [expr {$sb(csize) & 0xffffffff}]
        set sb(size) [expr {$sb(size) & 0xffffffff}]
    }
    return $offset
}

proc zip::Data {fd arr verify} {
    upvar 1 $arr sb
    ParseDataHeader $fd $arr data
    switch -exact -- $sb(method) {
        0 {
            # stored; no compression
        }
        8 {
            # deflated
            if {[catch {