Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Changes In Branch toad-mimefix
Excluding Merge-Ins
This is equivalent to a diff from
c0c1f0de61
to a202a3b3ac
2018-12-06
| | |
20:29 |
|
check-in: e338b5bee7 user: hypnotoad tags: hypnotoad
|
04:00 |
|
Closed-Leaf
check-in: a202a3b3ac user: hypnotoad tags: toad-mimefix
|
03:40 |
|
check-in: 37595e2619 user: hypnotoad tags: toad-mimefix
|
03:32 |
|
check-in: b45ea48529 user: hypnotoad tags: toad-mimefix
|
03:32 |
|
check-in: c0c1f0de61 user: hypnotoad tags: hypnotoad
|
03:01 |
|
check-in: 4c7e4bc7e7 user: hypnotoad tags: hypnotoad
|
| | |
Changes to modules/chan/base.tcl.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
|
-
-
-
+
+
+
|
#! /usr/bin/env tclsh
# # ## ### ##### ######## #############
# copyright
#
# 2018
#
# Poor Yorick
# # ## ### ##### ######## #############
package require ego
tcllib::ego .new ::tcllib::chan::base
::tcllib::chan::base .eval {
proc .init {_ channame args} {
$_ .vars chan close
if {$channame ni [::chan names]} {
error [list {unknown channel} $channame]
}
set chan $channame
|
︙ | | |
107
108
109
110
111
112
113
114
115
|
107
108
109
110
111
112
113
114
115
116
117
118
119
|
-
-
+
+
+
+
+
+
|
proc $name {_ args} [string map [
list @name@ [list $name]] {
::chan @name@ [$_ $ chan] {*}$args
}]
.my .method $name
}
} [namespace current]]
}
namespace eval ::tcllib::chan {
namespace export base
}
package provide {chan base} 0.1
|
Changes to modules/chan/coroutine.tcl.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
|
-
+
+
|
#! /usr/bin/tclsh
# # ## ### ##### ######## #############
# copyright
#
# 2018
#
# Poor Yorick
# # ## ### ##### ######## #############
package require coroutine
package require ego
namespace eval ::tcllib::chan::coroutine {
proc [namespace current] chan {
if {![string match ::* $chan]} {
set chan [uplevel 1 [list ::namespace which $chan]]
}
$chan .specialize
foreach name {
|
︙ | | |
31
32
33
34
35
36
37
|
32
33
34
35
36
37
38
39
40
41
42
43
44
|
+
+
+
+
+
+
|
}
proc read {_ args} {
$_ .vars chan
tailcall ::coroutine::util::read $chan {*}$args
}
}
package provide {chan coroutine} 0.1
namespace eval ::tcllib::chan {
namespace export coroutine
}
|
Changes to modules/chan/getslimit.tcl.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
|
-
-
-
+
+
|
#! /usr/bin/env tclsh
# # ## ### ##### ######## #############
# copyright
#
# 2018
#
# Poor Yorick
# # ## ### ##### ######## #############
package require ego
namespace eval ::tcllib::chan::getslimit {
variable buf bufcount eof getslimit
proc [namespace current] chan {
if {![string match ::* $chan]} {
set chan [uplevel 1 [list ::namespace which $chan]]
}
$chan .specialize
|
︙ | | |
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
|
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
|
-
+
|
}
}
} elseif {[llength $args]} {
dict size $args
foreach {key val} $args[set args {}] {
if {$key eq {-getslimit}} {
set getslimit $val
} else {
} else {
lappend args $key $val
}
}
if {[llength $args]} {
uplevel 1 [list $_ .prototype configure {*}$args]
}
set res {}
|
︙ | | |
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
|
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
|
-
+
|
proc eof _ {
$_ .vars bufcount eof
return [expr {$eof || ( [$_ .prototype eof] && $bufcount == 0 )}]
}
proc gets {_ args} {
$_ .vars buf bufcount chan eof getslimit
$_ .vars buf bufcount chan eof getslimit
switch [llength $args] {
1 {
lassign $args varname
upvar 1 $varname resvar
}
0 {}
default {
|
︙ | | |
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
|
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
|
-
+
|
} else {
return $res
}
}
proc read {_ args} {
$_ .vars buf eof bufcount
$_ .vars buf eof bufcount
if {$eof} {
return {}
}
if {$bufcount} {
if {[llength $args]} {
lassign $args size
if {$size <= $bufcount} {
|
︙ | | |
151
152
153
154
155
156
157
158
159
160
|
150
151
152
153
154
155
156
157
158
159
160
161
162
163
|
-
+
+
+
+
+
|
set res $buf[set buf {}][$_ .prototype read {*}$args]
}
} else {
set res [$_ .prototype read {*}$args]
}
return $res
}
}
package provide tcllib::chan::getslimit 1
package provide {chan getslimit} 0.1
namespace eval ::tcllib::chan {
namespace export getslimit
}
|
Changes to modules/chan/pkgIndex.tcl.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
|
1
2
3
4
5
|
-
-
-
+
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
|
#! /usr/bin/env tclsh
if {![package vsatisfies [package provide Tcl] 8.6]} {return}
package ifneeded {chan getslimit} 0.1 [list ::apply {dir {
package ifneeded {chan getslimit} 0.1 [list ::source [file join $dir getslimit.tcl]]
package require ego
namespace eval ::tcllib::chan::getslimit [list ::source $dir/getslimit.tcl]
package provide {chan getslimit} 0.1
namespace eval ::tcllib::chan {
namespace export getslimit
}
}} $dir]
package ifneeded {chan base} 0.1 [list ::apply {dir {
package ifneeded {chan base} 0.1 [list ::source [file join $dir base.tcl]]
package require ego
tcllib::ego .new ::tcllib::chan::base
::tcllib::chan::base .eval [list ::source $dir/base.tcl]
namespace eval ::tcllib::chan {
namespace export base
}
package provide {chan base} 0.1
}} $dir]
package ifneeded {chan coroutine} 0.1 [list ::apply {dir {
package ifneeded {chan coroutine} 0.1 [list ::source [file join $dir coroutine.tcl]]
package require ego
namespace eval ::tcllib::chan::coroutine [list ::source $dir/coroutine.tcl]
package provide {chan coroutine} 0.1
namespace eval ::tcllib::chan {
namespace export coroutine
}
}} $dir]
|
Changes to modules/ego/ego.tcl.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
|
-
-
+
-
+
|
#! /bin/env tclsh
# # ## ### ##### ######## #############
# copyright
#
# 2018
#
# Poor Yorick
# # ## ### ##### ######## #############
namespace eval ::tcllib::ego {
namespace ensemble create
namespace export *
proc .method {_ name args} {
if {![llength $args]} {
lappend args $name
}
set args [linsert $args[set args {}] 1 $_]
set map [namespace ensemble configure $_ -map]
dict set map $name $args
dict set map $name $args
uplevel 1 [list ::namespace ensemble configure $_ -map $map]
return
}
.method [namespace current] .method
proc $ {_ name args} {
|
︙ | | |
48
49
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
|
47
48
49
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
|
-
+
-
+
-
+
-
+
|
}
.method [namespace current] .as
proc .eval {_ args} {
::tailcall ::namespace eval [$_ .namespace] {*}$args
}
.method [namespace current] .eval
.method [namespace current] .eval
proc .insert {_ name} {
set unknown1 [namespace ensemble configure $_ -unknown]
set prototype1 [namespace ensemble configure $_ -prototype]
if {[llength $unknown1]} {
namespace ensemble configure $name -prototype $prototype1 \
-unknown $unknown1
-unknown $unknown1
}
namespace enemble configure $_ -prototype [list ::lindex $name] -unknown $unknown1
return
}
proc .name _ {
return $_
}
.method [namespace current] .name
.method [namespace current] .name
proc .namespace _ {
namespace ensemble configure $_ -namespace
}
.method [namespace current] .namespace
.method [namespace current] .namespace
proc .new {_ name args} {
global env
set ns [uplevel 1 [list ::namespace eval $name {
::namespace ensemble create
::variable configured 0
|
︙ | | |
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
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
|
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
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
|
-
+
-
+
-
+
-
+
-
+
-
+
|
set prototype $_
set map [namespace ensemble configure $_ -map]
set prototypes {}
while {[dict exists $map .prototype]} {
set prototypes [list $map {*}$prototypes[set prototypes {}]]
lassign [dict get $map .prototype] prototype
lassign [dict get $map .prototype] prototype
set map [namespace ensemble configure $prototype -map]
}
set map {}
foreach {key val} [namespace ensemble configure $prototype -map] {
foreach {key val} [namespace ensemble configure $prototype -map] {
if {$key ne {.prototype}} {
if {[lindex $val 1] eq $_} {
set val [lreplace $val[set val {}] 1 1 $ns]
}
} else {
error [list {how did we get to here?}]
}
lappend map $key $val
lappend map $key $val
}
namespace ensemble configure $ns -map $map
set prototype $ns
foreach map $prototypes {
$ns .specialize
dict unset map .prototype
dict for {name cmd} $map {
if {[lindex $cmd 1] eq $_} {
# remove the original name from index 1 because .method is
# going to add it back
# going to add it back
$ns .method $name {*}[lreplace $cmd[set cmd {}] 1 1]
} else {
$ns .routine $name {*}$cmd
}
}
}
interp alias {} ${ns}::.my {} $ns
interp alias {} ${ns}::.my {} $ns
if {[llength $args]} {
tailcall $ns .init {*}$args
} else {
return $ns
}
}
.method [namespace current] .new
.method [namespace current] .new
proc .ondelete {_ trace args} {
if {[llength $args] == 1} {
lassign $args script
trace remove command $_ delete $trace
set trace {}
|
︙ | | |
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
|
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
|
-
+
-
+
-
+
-
+
-
+
-
+
+
+
|
lappend args $name
}
set map [namespace ensemble configure $_ -map]
dict set map $name $args
uplevel 1 [list ::namespace ensemble configure $_ -map $map]
return
}
.method [namespace current] .routine
.method [namespace current] .routine
proc .specialize {_ args} {
set ns [$_ .namespace]
set ns [$_ .namespace]
while {[namespace which [set name ${ns}::[
info cmdcount]_prototype]] ne {}} {}
rename $_ $name
set new [namespace eval ${ns} [
list namespace ensemble create -command $_ -map [list \
.prototype [list $name]
] -unknown [
list ::apply {{_ name args} {
set prototype [lindex [dict get [namespace ensemble configure $_ -map] .prototype] 0]
list $prototype $name
}}]]]
::trace add command $new delete [list ::apply {{ns oldname newname op} {
if {[namespace exists $ns]} {
namespace delete $ns
}
}} $ns]
return
}
.method [namespace current] .specialize
.method [namespace current] .specialize
proc .vars {_ args} {
set vars {}
foreach arg $args {
lassign $arg source target
if {[llength $arg] == 1} {
set target $source
}
lappend vars $source $target
}
uplevel 1 [list ::namespace upvar $_ {*}$vars]
}
.method [namespace current] .vars
.method [namespace current] .vars
proc = {_ name val} {
set [$_ .namespace]::$name $val
}
.method [namespace current] =
.method [namespace current] =
}
package provide ego 0.1
|
Changes to modules/ego/pkgIndex.tcl.
1
2
3
4
5
6
7
8
|
1
2
3
4
5
|
-
+
-
-
-
|
#! /usr/bin/env tclsh
if {![package vsatisfies [package provide Tcl] 8.6]} {return}
package ifneeded ego 0.1 [list ::apply {dir {
package ifneeded ego 0.1 [list ::source [file join $dir ego.tcl]]
namespace eval ::tcllib::ego [list ::source $dir/ego.tcl]
package provide ego 0.1
}} $dir]
|
Changes to modules/httpd/httpd.test.
︙ | | |
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
|
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
|
+
+
+
+
+
+
-
-
-
+
+
|
testsNeed TclOO 1
support {
use [file join ${TCLLIBMOD} cmdline cmdline.tcl] cmdline
use [file join ${TCLLIBMOD} fileutil fileutil.tcl] fileutil
use [file join ${TCLLIBMOD} sha1 sha1.tcl] sha1
use [file join ${TCLLIBMOD} namespacex namespacex.tcl] namespacex
use [file join ${TCLLIBMOD} ego ego.tcl] ego
use [file join ${TCLLIBMOD} chan base.tcl] {chan base}
use [file join ${TCLLIBMOD} chan getslimit.tcl] {chan getslimit}
use [file join ${TCLLIBMOD} mime qp.tcl] {mime qp}
use [file join ${TCLLIBMOD} mime mime.tcl] mime
use [file join ${TCLLIBMOD} uri uri.tcl] uri
use [file join ${TCLLIBMOD} ncgi ncgi.tcl] ncgi
use [file join ${TCLLIBMOD} dns ip.tcl] ip
use [file join ${TCLLIBMOD} nettool nettool.tcl] nettool
use [file join ${TCLLIBMOD} coroutine coroutine.tcl] coroutine
use [file join ${TCLLIBMOD} cron cron.tcl] cron
use [file join ${TCLLIBMOD} virtchannel_core core.tcl] tcl::chan::core
use [file join ${TCLLIBMOD} virtchannel_core events.tcl] tcl::chan::events
#use [file join ${TCLLIBMOD} virtchannel_core core.tcl] tcl::chan::core
#use [file join ${TCLLIBMOD} virtchannel_core events.tcl] tcl::chan::events
use [file join ${TCLLIBMOD} virtchannel_base memchan.tcl] tcl::chan::memchan
use [file join ${MODDIR} clay clay.tcl] clay
}
testing {
useLocal httpd.tcl httpd
}
|
︙ | | |
Changes to modules/mime/mime.test.
︙ | | |
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
|
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
|
-
+
-
+
+
+
-
+
+
+
|
# -------------------------------------------------------------------------
source [file join \
[file dirname [file dirname [file dirname [
file normalize [info script]/...]]]]/devtools/testutilities.tcl]
testsNeedTcl 8.5
testsNeedTcltest 2
testsNeedTcltest 2
support {
# This code loads md5x, i.e. md5 v2. Proper testing should do one
# run using md5 v1, aka md5.tcl as well.
use md5/md5x.tcl md5
use namespacex/namespacex.tcl namespacex
use ego/ego.tcl ego
use chan/base.tcl {chan base}
use chan/getslimit.tcl {chan getslimit}
}
}
testing {
useLocal qp.tcl {mime qp}
useLocal mime.tcl mime
}
package require {chan base}
# -------------------------------------------------------------------------
|
︙ | | |
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
|
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
|
-
+
|
part3
--bar--
}
set tok [.new {} -string $msg]
set partToks [$tok property parts]
set res {}
set res {}
foreach childTok $partToks {
lappend res [[$childTok body raw] read]
}
set res
}} [list part1 part2 part3]
|
︙ | | |
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
|
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
|
-
+
|
qp encode {How long is a piece of string ?} 1
}} How_long_is_a_piece_of_string_=3F
test mime-4.13 {Test qp::encode in no_softbreak mode} {cleanly {
qp encode {This is a very long string into which we do not want inserted softbreaks as we want one very long line returned even though that's probably not how we whould be doing it (see RFC2047) but we don't want to break backward compatibility} 0 1
}} {This is a very long string into which we do not want inserted softbreaks as we want one very long line returned even though that's probably not how we whould be doing it (see RFC2047) but we don't want to break backward compatibility}
test mime-5.1 {Test word_encode with quoted-printable method} {cleanly {
word_encode iso8859-1 quoted-printable {Test de contrôle effectué}
}} =?ISO-8859-1?Q?Test_de_contr=F4le_effectu=E9?=
|
︙ | | |
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
|
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
|
-
+
|
{(a b)}
10 {(=?ISO-8859-1?Q?a?= =?ISO-8859-2?Q?_b?=)}
{(a b)}
11 {(=?ISO-8859-1?Q?a?=x=?ISO-8859-2?Q?_b?=)}
{(ax b)}
12 {a b c}
{a b c}
13 {}
13 {}
{}
} {
test mime-6.$n {Test field_decode (from RFC 2047, part 8)} {cleanly {
field_decode $encoded
}} $expected ; # {}
}
|
︙ | | |
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
|
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
|
-
+
|
test mime-9.0.$name {Test chunk handling of serialize and helpers} {cleanly {
set in [makeFile [set data [string repeat [string repeat {123456789 } 10]\n 350]] input.txt]
set mi [makeFile {} mime.txt]
with.$name $in -canonical text/plain {
::tcllib::chan::base .new chan1 [open $mi w]
chan1 configure -translation binary
$tok serialize -chan chan1
$tok serialize -chan chan1
chan1 close
with.$name $mi {
set newdata [[$tok body raw] read]
set res [string compare $data $newdata]
removeFile input.txt
|
︙ | | |
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
|
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
|
-
+
-
+
|
set msg "MIME-Version: 1.0
Content-Type: text/plain\r
\r
so plain
"
set tok [.new {} -string $msg]
[$tok body raw] read
[$tok body raw] read
} "so plain\n"
# -------------------------------------------------------------------------
test mime-14.0 {cleanly {
hostname argument to parseaddress
}} {
set parsed [parseaddress hostname fakedomain.fake {Here <h>}]
set parsed [parseaddress hostname fakedomain.fake {Here <h>}]
list [llength $parsed] [lindex $parsed 0]
} [list 1 [list address [email protected] comment {} domain {} error {} \
friendly Here group {} local h memberP 0 phrase Here \
proper {Here <[email protected]>} route {}]]
|
︙ | | |
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
|
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
|
-
+
-
+
|
} {test/test {foo {}}}
test mime-17.9 {
header supplied by a component message, retrieved by lowercase name
} {
set mime [.new {} -string {Content-Disposition: form-data; name="field2"}]
$mime header get content-disposition
$mime header get content-disposition
} {form-data {name field2}}
test mime-17.10 {
Content-Type is not automatically added to a subordinate
} {
set mime [.new {} -string {Content-Disposition: form-data; name="field2"}]
$mime header get content-disposition
$mime header get content-disposition
} {form-data {name field2}}
test mime-18.1 {
non-seekable channel
} {
set script [list puts -nonewline $message1]
|
︙ | | |
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
|
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
|
-
+
-
+
|
cookie serialization
} {
set mime [.new {} -spec http -string {}]
$mime cookie set one two
set res [$mime serialize]
$mime .destroy
return $res
} "Set-Cookie: one=two\r
\t; HttpOnly\r
\r
"
test mime-19.2 {
cookie serialization
} {
set mime [.new {} -spec http -string {}]
$mime cookie set one two path /three/four
set res [$mime serialize]
$mime .destroy
return $res
} "Set-Cookie: one=two\r
\t; path=/three/four\r
\t; HttpOnly\r
\r
"
|
︙ | | |