/usr/lib/tcltk/rivet2.3/rivet-tcl/cookie.tcl is in libapache2-mod-rivet 2.3.5-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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)
}
}
}
}
|