Tcl Library Source Code

Check-in [ff79b7401f]
Login

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

Overview
Comment:mime: For cookies, add HttpOnly parameter and make it the default.
Timelines: family | ancestors | descendants | both | pooryorick
Files: files | file ages | folders
SHA3-256: ff79b7401f694c8a4e6f201136a985f785a4571971a82d6c27752c3b8c542e08
User & Date: pooryorick 2018-12-03 14:40:02
Context
2021-05-01
11:55
mime: For cookies, add HttpOnly parameter and make it the default. check-in: a31412a310 user: pooryorick tags: mime
2018-12-03
15:17
Closing a fork check-in: 627347c712 user: hypnotoad tags: pooryorick
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
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to modules/mime/mime.man.

159
160
161
162
163
164
165

166
167
168
169
170
171
172
[arg args] is a dictionary options:

[list_begin definitions]

[def "[option expires] [arg date]"]
[def "[option path] [arg {path restriction}]"]
[def "[option domain] [arg {domain restriction}]"]

[list_end]


[call [arg message] [method .destroy] [opt "[option -subordinates] [const all] | [const dynamic] | [const none]"]]

Destroys the message and returns the empty string.








>







159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
[arg args] is a dictionary options:

[list_begin definitions]

[def "[option expires] [arg date]"]
[def "[option path] [arg {path restriction}]"]
[def "[option domain] [arg {domain restriction}]"]
[def "[option httponly] [arg boolean]"]
[list_end]


[call [arg message] [method .destroy] [opt "[option -subordinates] [const all] | [const dynamic] | [const none]"]]

Destroys the message and returns the empty string.

Changes to modules/mime/mime.tcl.

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
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059






1060
1061
1062
1063
1064
1065
1066
# Arguments:
#	args	Name value pairs, where the names are:
#		name		Cookie name
#		value		Cookie value
#		?path?		Path restriction
#		?domain?	domain restriction
#		?expires?	Time restriction


#
# Side Effects:
#	Formats and stores the Set-Cookie header for the reply.

proc ::mime::cookie_set {_ name value args} {
    dict size $args
    foreach {key val} $args {
	switch $key {
	    domain - expires - path {
		set $key $val
	    }
	    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 --







>
>








|




|
>





>


|









|


|


|
>
>
>
>
>
>







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
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
# Arguments:
#	args	Name value pairs, where the names are:
#		name		Cookie name
#		value		Cookie value
#		?path?		Path restriction
#		?domain?	domain restriction
#		?expires?	Time restriction
#		?httponly?	boolean, default true

#
# Side Effects:
#	Formats and stores the Set-Cookie header for the reply.

proc ::mime::cookie_set {_ name value args} {
    dict size $args
    foreach {key val} $args {
	switch $key {
	    domain - expires - httponly - path {
		set $key $val
	    }
	    default {
		error [list {wrong # args} {should be} \
		    [list name value ?path path? ?domain domain? \
			?expires date? ?httponly boolean?]]
	    }
	}
    }
    set line $name=$value
    set params {}
    set flags {}
    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]} {
	lappend flags secure
    }
    if {![info exists httponly] || $httponly} {
	lappend flags HttpOnly
    }
    if {[llength $flags]} {
	lappend params $flags
    }
    $_ header set Set-Cookie $line $params 
    return
}


# ::mime::datetime --

Changes to modules/mime/mime.test.

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
	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







>














>







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
	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
"



testsuiteCleanup
set [namespace current]::done 1