HTTP Cookie Library for AOLserver

Реализация таит в себе одну небольшую хитрость - кукисы, отправленные в текущей HTTP-сессии, также засчитываются как полученные от клиента. Такое усовершенствование позволяет существенно упростить код, в частности, авторизации.

#    HTTP Cookie Library for AOLserver
#    Copyright 2009, Mobile Business Group
#    This program is free software: you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation, either version 3 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program.  If not, see http://www.gnu.org/licenses/.

proc ns_cookiegetall {} {
    set jar [ns_set new]
    set allcookies [ns_set get [ns_conn headers] Cookie]
    if ![string equal $allcookies ""] {
        foreach cookie [split $allcookies ";"] {
            set pair [split $cookie "="]
            ns_set put $jar [string trim [lindex $pair 0]] [lindex $pair 1]
        }
    }
    # check unsent cookie too!
    set headers [ns_conn outputheaders]
    for {set i 0} {$i < [ns_set size $headers]} {incr i} {
        set key [ns_set key $headers $i]
        set value [ns_set value $headers $i]
        if [string equal $key "Set-Cookie"] {
            set cookie [lindex [split $value ";"] 0]
            set pair [split $cookie "="]
            ns_set update $jar [string trim [lindex $pair 0]] [lindex $pair 1]
        }
    }
    return $jar
}

proc ns_cookieget { name } {
    return [ns_urldecode [ns_set get [ns_cookiegetall] $name]]
}

proc ns_cookieset { name value path expires {domain ""} {secure ""}} {
  if [string equal $name ""] {
    return
  }
  set cookie "$name=[ns_urlencode $value]"
  if ![string equal $path ""] {
    append cookie "; path=$path"
  }
  if ![string equal $expires ""] {
    append cookie "; expires=[ns_fmttime $expires "%a, %d-%b-%Y %T GMT"]"
  }
  if ![string equal $domain ""] {
    append cookie "; domain=$domain"
  } else {
    append cookie "; domain=[ns_conn host]"
  }
  if ![string equal $secure ""] {
    append cookie "; secure"
  }
  set headerSet [ns_conn outputheaders]
  ns_set put $headerSet "Set-Cookie" $cookie
}


proc ns_cookieclean { name {domain ""} {secure ""}} {
  if [string equal $name ""] {
    return
  }
  set cookie "$name="
  append cookie "; path=/"
  append cookie "; expires=[ns_fmttime [expr [ns_time] - 31536000] "%a, %d-%b-%Y %T GMT"]"
  if ![string equal $domain ""] {
    append cookie "; domain=$domain"
  } else {
    append cookie "; domain=[ns_conn host]"
  }
  if ![string equal $secure ""] {
    append cookie "; secure"
  }
  set headerSet [ns_conn outputheaders]
  ns_set put $headerSet "Set-Cookie" $cookie
}