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
34
35
36
37
38
39
40
41
42
43
44
45
46
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
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
|
##
## cookie [set|get] and supporting functions
##
## $Id: cookie.tcl 1337564 2012-05-12 15:20:22Z mxmanghi $
##
namespace eval ::rivet {
## clock_to_rfc850_gmt seconds -- Convert an integer-seconds-since-1970
## click value to RFC850 format, with the additional requirement that it
## be GMT only.
##
proc clock_to_rfc850_gmt {seconds} {
return [clock format $seconds -format "%a, %d-%b-%y %T GMT" -gmt 1]
}
## make_cookie_attributes paramsArray -- Build up cookie parameters.
##
## If an expires element appears in the array, it's appended to the
## result as "; expires=value"
##
## If an element is present named "days", "hours", or "minutes", the
## corresponding value is converted to seconds, added to the current
## time, converted to RFC850 time format, and appended to the result
## as, for example, "; expires=Sun, 25-Sep-05 23:09:52 GMT"
##
## If any other elements named "path", "domain", or "secure" are present,
## they too are appended to the result.
##
## The resut is returned.
##
proc make_cookie_attributes {paramsArray} {
upvar 1 $paramsArray params
set cookieParams ""
set expiresIn 0
if { [info exists params(expires)] } {
append cookieParams "; expires=$params(expires)"
} else {
foreach {time num} [list days 86400 hours 3600 minutes 60] {
if {[info exists params($time)]} {
incr expiresIn [expr {$params($time) * $num}]
}
}
if {$expiresIn != 0} {
set secs [expr [clock seconds] + $expiresIn]
append cookieParams "; expires=[clock_to_rfc850_gmt $secs]"
}
}
if { [info exists params(path)] } {
append cookieParams "; path=$params(path)"
}
if { [info exists params(domain)] } {
append cookieParams "; domain=$params(domain)"
}
if { [info exists params(secure)] && $params(secure) == 1} {
append cookieParams "; secure"
}
if { [info exists params(HttpOnly)] && $params(HttpOnly)} {
append cookieParams "; HttpOnly"
}
return $cookieParams
}
## cookie [set|get] cookieName ?cookieValue? [-days expireInDays]
## [-hours expireInHours] [-minutes expireInMinutes]
## [-expires Wdy, DD-Mon-YYYY HH:MM:SS GMT]
## [-path uriPathCookieAppliesTo]
## [-secure 1|0]
##
proc cookie {cmd name args} {
set badchars "\[ \t;\]"
switch -- $cmd {
"set" {
set value [lindex $args 0]
set args [lrange $args 1 end]
import_keyvalue_pairs params $args
if {[regexp $badchars $name]} {
return -code error \
"name may not contain semicolons, spaces, or tabs"
}
if {[regexp $badchars $value]} {
return -code error \
"value may not contain semicolons, spaces, or tabs"
}
set cookieKey "Set-Cookie"
set cookieValue "$name=$value"
append cookieValue [make_cookie_attributes params]
headers add $cookieKey $cookieValue
}
"get" {
::request::global RivetCookies
if {![array exists RivetCookies]} { load_cookies RivetCookies }
if {![info exists RivetCookies($name)]} { return }
return $RivetCookies($name)
}
"delete" {
## In order to delete a cookie, we just need to set a cookie
## with a time that has already expired.
cookie set $name "" -minutes -1
}
"unset" {
::request::global RivetCookies
if {![array exists RivetCookies]} { load_cookies RivetCookies }
if {![info exists RivetCookies($name)]} { return }
unset RivetCookies($name)
}
}
}
}
|
