Tcl Library Source Code

Check-in [139dc57787]
Login
Core Home Blog Docs Downloads Tickets Timeline Branches Tags Wiki

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

Overview
Comment:fileutil::decode - Bumped to version 0.2.1 - Fixed conversion of values to [unsigned]. The clipping mask is dependent on the length of the value (in bytes). This tripped package "zipfile::decode" when trying to handle a zip file containing more than 32K files. Further extended to provide proper error codes when throwing an error.
Timelines: family | ancestors | descendants | both | decode-fixes
Files: files | file ages | folders
SHA1: 139dc577874aca7963070ee06fde64903b45fd56
User & Date: andreask 2016-08-12 17:44:01
Context
2016-08-12
17:57
zipfile::decode - Bumped to version 0.7.1. Importing fix to handling of [unsigned]. The bad [unsigned] handling tripped a bogus mismatch error for archives with more than 32K files (tnecd). Further fixed the error message at that place, and added proper error codes to all places throwing errors, and factored things into helper procedures for this. Regenerated the documentation. Closed-Leaf check-in: 1d31a22020 user: andreask tags: decode-fixes
17:44
fileutil::decode - Bumped to version 0.2.1 - Fixed conversion of values to [unsigned]. The clipping mask is dependent on the length of the value (in bytes). This tripped package "zipfile::decode" when trying to handle a zip file containing more than 32K files. Further extended to provide proper error codes when throwing an error. check-in: 139dc57787 user: andreask tags: decode-fixes
2016-08-10
11:43
Correct handling of case sensitivity specifiers in "string" tests. check-in: 83c630410e user: pooryorick tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to modules/fileutil/decode.tcl. 

1
2
3
4
5
6
7
8
9
10
11

# -*- tcl -*-
# ### ### ### ######### ######### #########
## Copyright (c) 2008-2009 ActiveState Software Inc.
##                         Andreas Kupries
## BSD License
##
# Package to help the writing of file decoders. Provides generic
# low-level support commands.

package require Tcl 8.4




|
|








1
2
3
4
5
6
7
8
9
10
11

# -*- tcl -*-
# ### ### ### ######### ######### #########
## Copyright (c) 2008-2009 ActiveState Software Inc., Andreas Kupries
##                    2016 Andreas Kupries
## BSD License
##
# Package to help the writing of file decoders. Provides generic
# low-level support commands.

package require Tcl 8.4
︙︙
50
51
52
53
54
55
56
57


58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73

74
75
76
77
78
79
80

81
82
83
84
85
86
87

88
89
90
91
92
93
94

95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111






112
113
114
115
116
117
118
119

    return
}

proc ::fileutil::decode::rewind {} {
    variable chan
    variable mark
    if {$mark == {}} {
	return -code error "No mark to rewind to"


    }
    seek $chan $mark start
    set mark {}
    return
}

proc ::fileutil::decode::at {} {
    variable chan
    return [tell $chan]
}

# ### ### ### ######### ######### #########
##

proc ::fileutil::decode::byte {} {
    variable chan

    variable val [read $chan 1]
    binary scan $val c val
    return
}

proc ::fileutil::decode::short-le {} {
    variable chan

    variable val [read $chan 2]
    binary scan $val s val
    return
}

proc ::fileutil::decode::long-le {} {
    variable chan

    variable val [read $chan 4]
    binary scan $val i val
    return
}

proc ::fileutil::decode::nbytes {n} {
    variable chan

    variable val [read $chan $n]
    return
}

proc ::fileutil::decode::skip {n} {
    variable chan
    #read $chan $n
    seek $chan $n current
    return
}

# ### ### ### ######### ######### #########
##

proc ::fileutil::decode::unsigned {} {
    variable val
    if {$val >= 0} return






    set val [format %u [expr {$val & 0xffffffff}]]
    return
}

proc ::fileutil::decode::match {eval} {
    variable val

    #puts "Match: Expected $eval, Got: [format 0x%08x $val]"








|
>
>
















>







>







>







>

















>
>
>
>
>
>
|








50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131

    return
}

proc ::fileutil::decode::rewind {} {
    variable chan
    variable mark
    if {$mark == {}} {
	return -code error \
	    -errorcode {FILE DECODE NO MARK} \
	    "No mark to rewind to"
    }
    seek $chan $mark start
    set mark {}
    return
}

proc ::fileutil::decode::at {} {
    variable chan
    return [tell $chan]
}

# ### ### ### ######### ######### #########
##

proc ::fileutil::decode::byte {} {
    variable chan
    variable mask 0xff
    variable val [read $chan 1]
    binary scan $val c val
    return
}

proc ::fileutil::decode::short-le {} {
    variable chan
    variable mask 0xffff
    variable val [read $chan 2]
    binary scan $val s val
    return
}

proc ::fileutil::decode::long-le {} {
    variable chan
    variable mask 0xffffffff
    variable val [read $chan 4]
    binary scan $val i val
    return
}

proc ::fileutil::decode::nbytes {n} {
    variable chan
    variable mask {}
    variable val [read $chan $n]
    return
}

proc ::fileutil::decode::skip {n} {
    variable chan
    #read $chan $n
    seek $chan $n current
    return
}

# ### ### ### ######### ######### #########
##

proc ::fileutil::decode::unsigned {} {
    variable val
    if {$val >= 0} return
    variable mask
    if {$mask eq {}} {
	return -code error \
	    -errorcode {FILE DECODE ILLEGAL UNSIGNED} \
	    "Unsigned not possible here"
    }
    set val [format %u [expr {$val & $mask}]]
    return
}

proc ::fileutil::decode::match {eval} {
    variable val

    #puts "Match: Expected $eval, Got: [format 0x%08x $val]"
︙︙
179
180
181
182
183
184
185




186
187
188
189
190
191

    variable val  {}

    # Remembered location in the stream
    variable mark {}

    # Buffer for accumulating structured results
    variable buf  {}




}

# ### ### ### ######### ######### #########
## Ready
package provide fileutil::decode 0.2
return








>
>
>
>




|


191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207

    variable val  {}

    # Remembered location in the stream
    variable mark {}

    # Buffer for accumulating structured results
    variable buf  {}

    # Mask for trimming a value to unsigned.
    # Size-dependent
    variable mask {}
}

# ### ### ### ######### ######### #########
## Ready
package provide fileutil::decode 0.2.1
return

Changes to modules/fileutil/pkgIndex.tcl. 

1
2
3
4
5
6
7
8
9
10

if {![package vsatisfies [package provide Tcl] 8.2]} {return}
package ifneeded fileutil 1.15 [list source [file join $dir fileutil.tcl]]

if {![package vsatisfies [package provide Tcl] 8.3]} {return}
package ifneeded fileutil::traverse 0.6 [list source [file join $dir traverse.tcl]]

if {![package vsatisfies [package provide Tcl] 8.4]} {return}
package ifneeded fileutil::multi     0.1   [list source [file join $dir multi.tcl]]
package ifneeded fileutil::multi::op 0.5.3 [list source [file join $dir multiop.tcl]]
package ifneeded fileutil::decode    0.2   [list source [file join $dir decode.tcl]]










|

1
2
3
4
5
6
7
8
9
10

if {![package vsatisfies [package provide Tcl] 8.2]} {return}
package ifneeded fileutil 1.15 [list source [file join $dir fileutil.tcl]]

if {![package vsatisfies [package provide Tcl] 8.3]} {return}
package ifneeded fileutil::traverse 0.6 [list source [file join $dir traverse.tcl]]

if {![package vsatisfies [package provide Tcl] 8.4]} {return}
package ifneeded fileutil::multi     0.1   [list source [file join $dir multi.tcl]]
package ifneeded fileutil::multi::op 0.5.3 [list source [file join $dir multiop.tcl]]
package ifneeded fileutil::decode    0.2.1 [list source [file join $dir decode.tcl]]

This page was generated in about 0.014s by Fossil 2.24 [f4ffefe708] 2024-04-17 14:02:19