1: ## 2: ## Convert an integer-seconds-since-1970 click value to RFC850 format, 3: ## with the additional requirement that it be GMT only. 4: ## 5: proc clock_to_rfc850_gmt {seconds} { 6: return [clock format $seconds -format "%a, %d-%b-%y %T GMT" -gmt 1] 7: } 8: 9: proc make_cookie_attributes {paramsArray} { 10: upvar 1 $paramsArray params 11: 12: set cookieParams "" 13: set expiresIn 0 14: 15: if { [info exists params(expires)] } { 16: append cookieParams "; expires=$params(expires)" 17: } else { 18: foreach {time num} [list days 86400 hours 3600 minutes 60] { 19: if [info exists params($time)] { 20: incr expiresIn [expr $params($time) * $num] 21: } 22: } 23: if {$expiresIn != 0} { 24: set secs [expr [clock seconds] + $expiresIn] 25: append cookieParams "; expires=[clock_to_rfc850_gmt $secs]" 26: } 27: } 28: if { [info exists params(path)] } { 29: append cookieParams "; path=$params(path)" 30: } 31: if { [info exists params(domain)] } { 32: append cookieParams "; domain=$params(domain)" 33: } 34: if { [info exists params(secure)] && $params(secure) == 1} { 35: append cookieParams "; secure" 36: } 37: 38: return $cookieParams 39: } 40: 41: ## cookie [set|get] cookieName ?cookieValue? [-days expireInDays] 42: ## [-hours expireInHours] [-minutes expireInMinutes] 43: ## [-expires Wdy, DD-Mon-YYYY HH:MM:SS GMT] 44: ## [-path uriPathCookieAppliesTo] 45: ## [-secure 1|0] 46: ## 47: proc cookie {cmd name args} { 48: set badchars "\[ \t;\]" 49: 50: switch -- $cmd { 51: "set" { 52: set value [lindex $args 0] 53: set args [lrange $args 1 end] 54: import_keyvalue_pairs params $args 55: 56: if {[regexp $badchars $name]} { 57: return -code error \ 58: "name may not contain semicolons, spaces, or tabs" 59: } 60: if {[regexp $badchars $value]} { 61: return -code error \ 62: "value may not contain semicolons, spaces, or tabs" 63: } 64: 65: set cookieKey "Set-Cookie" 66: set cookieValue "$name=$value" 67: 68: append cookieValue [make_cookie_attributes params] 69: 70: headers add $cookieKey $cookieValue 71: } 72: 73: "get" { 74: ::request::global RivetCookies 75: 76: if {![array exists RivetCookies]} { load_cookies RivetCookies } 77: if {![info exists RivetCookies($name)]} { return } 78: return $RivetCookies($name) 79: } 80: 81: "delete" { 82: ## In order to delete a cookie, we just need to set a cookie 83: ## with a time that has already expired. 84: cookie set $name "" -minutes -1 85: } 86: } 87: } |