Tcl Library Source Code

Check-in [556271270a]
Login

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

Overview
Comment:mime: Remove unnecessary semicolon in a cookie header that contains no parameters. For a header value, add parameters are simple values rather than key/value pairs.
Timelines: family | ancestors | descendants | both | pooryorick
Files: files | file ages | folders
SHA3-256: 556271270a289ae185c3857298b60e75f3c71771ccb418dcc027c7c433b16d8b
User & Date: pooryorick 2018-12-03 12:57:22
Context
2021-05-01
11:52
mime: Remove unnecessary semicolon in a cookie header that contains no parameters. For a header value, add parameters are simple values rather than key/value pairs. check-in: 09e3856313 user: pooryorick tags: mime
2018-12-03
14:40
mime: For cookies, add HttpOnly parameter and make it the default. check-in: ff79b7401f user: pooryorick tags: pooryorick
12:57
mime: Remove unnecessary semicolon in a cookie header that contains no parameters. For a header value, add parameters are simple values rather than key/value pairs. check-in: 556271270a user: pooryorick tags: pooryorick
2018-11-30
06:29
mime: remove "-" from cookie options. check-in: 4018b6c269 user: pooryorick tags: pooryorick
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to modules/mime/mime.man.

202
203
204
205
206
207
208
209

210
211
212
213
214
215
216
If [option -names] is provided, returns a list of all header names.


[call [arg message] [method header] [method set] [arg {name value}] [ \
    opt "[arg parameters] [opt "[option -mode] [const write] | [\
	const append] | [const delete]"]"]]

[arg parameters] is a dictionary of parameters for the header.


If [const append] is provided, creates a new header named [arg name] with the
value of [arg value] and any provided [arg parameters].

If [const write] is provided, first deletes any existing headers matching 
[arg name].








|
>







202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
If [option -names] is provided, returns a list of all header names.


[call [arg message] [method header] [method set] [arg {name value}] [ \
    opt "[arg parameters] [opt "[option -mode] [const write] | [\
	const append] | [const delete]"]"]]

[arg parameters] is a dictionary of parameters for the header.  If parameters
contains an odd number of items, the last item is a list of flag parameters.

If [const append] is provided, creates a new header named [arg name] with the
value of [arg value] and any provided [arg parameters].

If [const write] is provided, first deletes any existing headers matching 
[arg name].

Changes to modules/mime/mime.tcl.

1032
1033
1034
1035
1036
1037
1038
1039

1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
	    }
	    default {
		error [list {wrong # args} {should be} \
		    {name value ?path path? ?domain domain? ?expires expires?}]
	    }
	}
    }
    set line "$name=$value ;"

    foreach extra {path domain} {
	if {[info exists $extra]} {
	    append line " $extra=[set $extra] ;"
	}
    }
    if {[info exists expires]} {
	switch -glob $expires {
	    *GMT {
		# do nothing
	    }
	    default {
		set expires [clock format [datetimescan $expires] \
		    -format "%A, %d-%b-%Y %H:%M:%S GMT" -gmt 1]
	    }
	}
	append line " expires=$expires ;"
    }
    if {[info exists secure]} {
	append line " secure "
    }
    $_ header set Set-Cookie $line {}
    return
}


# ::mime::datetime --
#
#    Fortunately the clock command in the Tcl 8.x core does all the heavy







|
>


|












|


|

|







1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
	    }
	    default {
		error [list {wrong # args} {should be} \
		    {name value ?path path? ?domain domain? ?expires expires?}]
	    }
	}
    }
    set line $name=$value
    set params {}
    foreach extra {path domain} {
	if {[info exists $extra]} {
	    lappend params $extra=[set $extra]
	}
    }
    if {[info exists expires]} {
	switch -glob $expires {
	    *GMT {
		# do nothing
	    }
	    default {
		set expires [clock format [datetimescan $expires] \
		    -format "%A, %d-%b-%Y %H:%M:%S GMT" -gmt 1]
	    }
	}
	lappend params expires=$expires
    }
    if {[info exists secure]} {
	lappens params secure
    }
    $_ header set Set-Cookie $line $params 
    return
}


# ::mime::datetime --
#
#    Fortunately the clock command in the Tcl 8.x core does all the heavy
2215
2216
2217
2218
2219
2220
2221






2222
2223
2224
2225
2226
2227
2228
2229
	content-id - message-id {
	    set value <$value>
	}
    }

    set res "$name: $value"







    dict for {key value} $params {
	if {[regexp $notattchar_re $key]} {
	    error [list {illegal character found in attribute name}]
	}
	set len [expr {[string length $key]} + 1 + [string length $value]]
	# save one byte for the folding white space continuation space
	# and two bytes for "; "
	if {$len > 73 || ![regexp {[^-!#$%&'*+,.\w`~^@{}|]+$} $value]} {







>
>
>
>
>
>
|







2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
	content-id - message-id {
	    set value <$value>
	}
    }

    set res "$name: $value"

    if {[llength $params] % 2} {
	set extra [lindex $params end]
	set params [lreplace $params[set params {}] end end]
    } else {
	set extra {}
    }
    foreach {key value} $params {
	if {[regexp $notattchar_re $key]} {
	    error [list {illegal character found in attribute name}]
	}
	set len [expr {[string length $key]} + 1 + [string length $value]]
	# save one byte for the folding white space continuation space
	# and two bytes for "; "
	if {$len > 73 || ![regexp {[^-!#$%&'*+,.\w`~^@{}|]+$} $value]} {
2253
2254
2255
2256
2257
2258
2259



2260
2261
2262
2263
2264
2265
2266
		    set param $key*$partnum=
		    incr partnum
		}
	    }
	} else {
	    append res "\n\t; $key=$value"
	}



    }
    return $res
}


# ::mime::header::set --
#







>
>
>







2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
		    set param $key*$partnum=
		    incr partnum
		}
	    }
	} else {
	    append res "\n\t; $key=$value"
	}
    }
    foreach item $extra {
	append res "\n\t; $item"
    }
    return $res
}


# ::mime::header::set --
#

Changes to modules/mime/mime.test.

1006
1007
1008
1009
1010
1011
1012



























1013
1014
1015
1016
1017
1018
1019
    -http
} {
    set mime [.new {} -spec http -string {}]
    $mime serialize
} "\r
"































testsuiteCleanup
set [namespace current]::done 1
return
}







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







1006
1007
1008
1009
1010
1011
1012
1013
1014
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
1044
1045
1046
    -http
} {
    set mime [.new {} -spec http -string {}]
    $mime serialize
} "\r
"


test mime-19.1 {
	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
\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
\r
"



testsuiteCleanup
set [namespace current]::done 1
return
}