; Written by Alan Shields <Alan-Shields@omrf.ouhsc.edu>, on time paid for ; by the Oklahoma Medical Research Foundation - Centola Lab ; ; Includes in whole RFC2109, and in part RFC2608 and the Netscape ; cookie spec - not written by me. ; ; NB: this package requires split-sequence, an excellent piece of software. ; ; Patches and commentary are appreciated. ; ; Here are some easy entry points into the code. As there's so much ; text in this file, just search for these strings and you'll find ; interesting code - for some value of interesting. ; ; (defpackage ; (defun cookie-string ; (defun cookie-string-from-cookie-struct ; (defun parse-cookies ; (defun safe-parse-cookies ; (define-condition cookie-error ; (define-condition cookie-warning ; (defstruct (cookie ; (defun domain-match-p ;; Copyright (c) 2005, Alan Shields ;;  All rights reserved. ;; Redistribution and use in source and binary forms, with or without ;; modification, are permitted provided that the following conditions are ;; met: ;; ;; * Redistributions of source code must retain the above copyright ;;   notice, this list of conditions and the following disclaimer. ;; ;; * Redistributions in binary form must reproduce the above copyright ;;   notice, this list of conditions and the following disclaimer in the ;;   documentation and/or other materials provided with the distribution. ;; ;; * Neither the name of the Oklahoma Medical Research Foundation nor the ;;   names of its contributors may be used to endorse or promote products ;;   derived from this software without specific prior written ;;   permission. ;; ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR ;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT ;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, ;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT ;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE ;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (defpackage "RFC2109"   (:use "COMMON-LISP" #+5am :it.bese.fiveam)   (:nicknames "COOKIE1")   (:export :cookie-string            :cookie-string-from-cookie-struct            :make-cookie :cookie-name :cookie-value :cookie-comment            :cookie-domain :cookie-max-age :cookie-path :cookie-secure            :cookie-p            :domain-match-p            :parse-cookies :safe-parse-cookies)   (:documentation "This package implements RFC2109 - the original cookie specification. Use it to generate (and eventually parse) cookies in an RFC-compliant way.")) (in-package :rfc2109) #+5am(def-suite :rfc2109) #+5am(in-suite :rfc2109) ; From section 2.2 - to keep the compiler from whining (defvar *ht* (code-char 9)) (defvar *cr* (code-char 13)) (defvar *lf* (code-char 10)) ; Included here verbatim is RFC2109, the original RFC for cookies. ; Yes, there is a newer RFC (2965), but for simplicity I've only implemented ; RFC2109. ; ; Code is inline ; Notes about the implementation: ; - Currently this bit of code is only for the generation of ; Set-Cookie: <this part> ;   and not about parsing it. In the future, parsing may be added as well. ; Network Working Group                                         D. Kristol ; Request for Comments: 2109        Bell Laboratories, Lucent Technologies ; Category: Standards Track                                    L. Montulli ;                                                  Netscape Communications ;                                                            February 1997 ; ; ;                     HTTP State Management Mechanism ; ; Status of this Memo ; ;    This document specifies an Internet standards track protocol for the ;    Internet community, and requests discussion and suggestions for ;    improvements.  Please refer to the current edition of the "Internet ;    Official Protocol Standards" (STD 1) for the standardization state ;    and status of this protocol.  Distribution of this memo is unlimited. ; ; 1.  ABSTRACT ; ;    This document specifies a way to create a stateful session with HTTP ;    requests and responses.  It describes two new headers, Cookie and ;    Set-Cookie, which carry state information between participating ;    origin servers and user agents.  The method described here differs ;    from Netscape's Cookie proposal, but it can interoperate with ;    HTTP/1.0 user agents that use Netscape's method.  (See the HISTORICAL ;    section.) ; ; 2.  TERMINOLOGY ; ;    The terms user agent, client, server, proxy, and origin server have ;    the same meaning as in the HTTP/1.0 specification. ; ;    Fully-qualified host name (FQHN) means either the fully-qualified ;    domain name (FQDN) of a host (i.e., a completely specified domain ;    name ending in a top-level domain such as .com or .uk), or the ;    numeric Internet Protocol (IP) address of a host.  The fully ;    qualified domain name is preferred; use of numeric IP addresses is ;    strongly discouraged. ; ;    The terms request-host and request-URI refer to the values the client ;    would send to the server as, respectively, the host (but not port) ;    and abs_path portions of the absoluteURI (http_URL) of the HTTP ;    request line.  Note that request-host must be a FQHN. ; ; ; ; ; ; ; ; ; Kristol & Montulli          Standards Track                     [Page 1] ; RFC 2109            HTTP State Management Mechanism        February 1997 ; ; ;    Hosts names can be specified either as an IP address or a FQHN ;    string.  Sometimes we compare one host name with another.  Host A's ;    name domain-matches host B's if ; ;    * both host names are IP addresses and their host name strings match ;      exactly; or ; ;    * both host names are FQDN strings and their host name strings match ;      exactly; or ; ;    * A is a FQDN string and has the form NB, where N is a non-empty name ;      string, B has the form .B', and B' is a FQDN string.  (So, x.y.com ;      domain-matches .y.com but not y.com.) ; ;    Note that domain-match is not a commutative operation: a.b.c.com ;    domain-matches .c.com, but not the reverse. ; Currently we do NOT check to see if the IP addresses or FQDNs are valid ; in fact, this predicate could easily be fooled by giving it "127.0.0.1" ".0.0.1" (defun domain-match-p (host-a host-b)   "Checks to see if host-a \"domain-matches\" host-b, per RFC2109 From the RFC:     Hosts names can be specified either as an IP address or a FQHN     string.  Sometimes we compare one host name with another.  Host A's     name domain-matches host B's if       * both host names are IP addresses and their host name strings match       exactly; or       * both host names are FQDN strings and their host name strings match       exactly; or       * A is a FQDN string and has the form NB, where N is a non-empty name       string, B has the form .B', and B' is a FQDN string.  (So, x.y.com       domain-matches .y.com but not y.com.)       Note that domain-match is not a commutative operation: a.b.c.com     domain-matches .c.com, but not the reverse."   (declare (type string host-a host-b))   (or (string-equal host-a host-b)       (if (eql #\. (elt host-b 0))           (let* ((b-prime (subseq host-b 1))                  (n (subseq host-a 0 (1- (search b-prime host-a)))))             (and (not (zerop (length n)))                  (string-equal host-a (concatenate 'string n "." b-prime)))))))                                        ;    Because it was used in Netscape's original implementation of state ;    management, we will use the term cookie to refer to the state ;    information that passes between an origin server and user agent, and ;    that gets stored by the user agent. ; ; 3.  STATE AND SESSIONS ; ;    This document describes a way to create stateful sessions with HTTP ;    requests and responses.  Currently, HTTP servers respond to each ;    client request without relating that request to previous or ;    subsequent requests; the technique allows clients and servers that ;    wish to exchange state information to place HTTP requests and ;    responses within a larger context, which we term a "session".  This ;    context might be used to create, for example, a "shopping cart", in ;    which user selections can be aggregated before purchase, or a ;    magazine browsing system, in which a user's previous reading affects ;    which offerings are presented. ; ;    There are, of course, many different potential contexts and thus many ;    different potential types of session.  The designers' paradigm for ;    sessions created by the exchange of cookies has these key attributes: ; ;       1.  Each session has a beginning and an end. ; ;       2.  Each session is relatively short-lived. ; ;       3.  Either the user agent or the origin server may terminate a ;           session. ; ;       4.  The session is implicit in the exchange of state information. ; ; ; ; ; Kristol & Montulli          Standards Track                     [Page 2] ; RFC 2109            HTTP State Management Mechanism        February 1997 ; ; ; 4.  OUTLINE ; ;    We outline here a way for an origin server to send state information ;    to the user agent, and for the user agent to return the state ;    information to the origin server.  The goal is to have a minimal ;    impact on HTTP and user agents.  Only origin servers that need to ;    maintain sessions would suffer any significant impact, and that ;    impact can largely be confined to Common Gateway Interface (CGI) ;    programs, unless the server provides more sophisticated state ;    management support.  (See Implementation Considerations, below.) ; ; 4.1  Syntax:  General ; ;    The two state management headers, Set-Cookie and Cookie, have common ;    syntactic properties involving attribute-value pairs.  The following ;    grammar uses the notation, and tokens DIGIT (decimal digits) and ;    token (informally, a sequence of non-special, non-white space ;    characters) from the HTTP/1.1 specification [RFC 2068] to describe ;    their syntax. ; ;    av-pairs        =       av-pair *(";" av-pair) ;    av-pair         =       attr ["=" value]        ; optional value ;    attr            =       token ;    value           =       word ;    word            =       token | quoted-string ; ;    Attributes (names) (attr) are case-insensitive.  White space is ;    permitted between tokens.  Note that while the above syntax ;    description shows value as optional, most attrs require them. ; ;    NOTE: The syntax above allows whitespace between the attribute and ;    the = sign. (defun attr? (element)   "Determine if element is an attr"   (token? element)) (defun value? (element)   "Determine if element is a value"   (word? element)) (defun word? (element)   "Determine if element is a word"   (or (token? element)       (quoted-string? element)))        ; RFC 2068 defines token and quoted string. The relevant section ; is included below this RFC.    ; ; 4.2  Origin Server Role ; ; 4.2.1  General ; ;    The origin server initiates a session, if it so desires.  (Note that ;    "session" here does not refer to a persistent network connection but ;    to a logical session created from HTTP requests and responses.  The ;    presence or absence of a persistent connection should have no effect ;    on the use of cookie-derived sessions).  To initiate a session, the ;    origin server returns an extra response header to the client, Set- ;    Cookie.  (The details follow later.) ; ;    A user agent returns a Cookie request header (see below) to the ;    origin server if it chooses to continue a session.  The origin server ;    may ignore it or use it to determine the current state of the ; ; ; ; Kristol & Montulli          Standards Track                     [Page 3] ; RFC 2109            HTTP State Management Mechanism        February 1997 ; ; ;    session.  It may send back to the client a Set-Cookie response header ;    with the same or different information, or it may send no Set-Cookie ;    header at all.  The origin server effectively ends a session by ;    sending the client a Set-Cookie header with Max-Age=0. ; ;    Servers may return a Set-Cookie response headers with any response. ;    User agents should send Cookie request headers, subject to other ;    rules detailed below, with every request. ; ;    An origin server may include multiple Set-Cookie headers in a ;    response.  Note that an intervening gateway could fold multiple such ;    headers into a single header. ; ; 4.2.2  Set-Cookie Syntax ; ;    The syntax for the Set-Cookie response header is ; ;    set-cookie      =       "Set-Cookie:" cookies ;    cookies         =       1#cookie ;    cookie          =       NAME "=" VALUE *(";" cookie-av) ;    NAME            =       attr ;    VALUE           =       value ;    cookie-av       =       "Comment" "=" value ;                    |       "Domain" "=" value ;                    |       "Max-Age" "=" value ;                    |       "Path" "=" value ;                    |       "Secure" ;                    |       "Version" "=" 1*DIGIT ; ;    Informally, the Set-Cookie response header comprises the token Set- ;    Cookie:, followed by a comma-separated list of one or more cookies. ;    Each cookie begins with a NAME=VALUE pair, followed by zero or more ;    semi-colon-separated attribute-value pairs.  The syntax for ;    attribute-value pairs was shown earlier.  The specific attributes and ;    the semantics of their values follows.  The NAME=VALUE attribute- ;    value pair must come first in each cookie.  The others, if present, ;    can occur in any order.  If an attribute appears more than once in a ;    cookie, the behavior is undefined. ; ;    NAME=VALUE ;       Required.  The name of the state information ("cookie") is NAME, ;       and its value is VALUE.  NAMEs that begin with $ are reserved for ;       other uses and must not be used by applications. (defun valid-name? (name)   "Verifies that NAME is a valid name"   (declare (type string name))   (and (attr? name)        (not (eql #\$ (elt name 0))))) ; ; ; ; ; ; ; ; ; Kristol & Montulli          Standards Track                     [Page 4] ; RFC 2109            HTTP State Management Mechanism        February 1997 ; ; ;       The VALUE is opaque to the user agent and may be anything the ;       origin server chooses to send, possibly in a server-selected ;       printable ASCII encoding.  "Opaque" implies that the content is of ;       interest and relevance only to the origin server.  The content ;       may, in fact, be readable by anyone that examines the Set-Cookie ;       header. ; ;    Comment=comment ;       Optional.  Because cookies can contain private information about a ;       user, the Cookie attribute allows an origin server to document its ;       intended use of a cookie.  The user can inspect the information to ;       decide whether to initiate or continue a session with this cookie. ; ;    Domain=domain ;       Optional.  The Domain attribute specifies the domain for which the ;       cookie is valid.  An explicitly specified domain must always start ;       with a dot. ; ;    Max-Age=delta-seconds ;       Optional.  The Max-Age attribute defines the lifetime of the ;       cookie, in seconds.  The delta-seconds value is a decimal non- ;       negative integer.  After delta-seconds seconds elapse, the client ;       should discard the cookie.  A value of zero means the cookie ;       should be discarded immediately. ; ;    Path=path ;       Optional.  The Path attribute specifies the subset of URLs to ;       which this cookie applies. ; ;    Secure ;       Optional.  The Secure attribute (with no value) directs the user ;       agent to use only (unspecified) secure means to contact the origin ;       server whenever it sends back this cookie. ; ;       The user agent (possibly under the user's control) may determine ;       what level of security it considers appropriate for "secure" ;       cookies.  The Secure attribute should be considered security ;       advice from the server to the user agent, indicating that it is in ;       the session's interest to protect the cookie contents. ; ;    Version=version ;       Required.  The Version attribute, a decimal integer, identifies to ;       which version of the state management specification the cookie ;       conforms.  For this specification, Version=1 applies. ; (define-condition cookie-error (error)   ()) (define-condition cookie-warning (warning)   ()) (define-condition invalid-cookie-parameter (cookie-error)   ((parameter :initarg :parameter               :reader invalid-cookie-parameter-parameter)    (value :initarg :value           :reader invalid-cookie-parameter-value)    (message :initarg :message             :initform nil             :reader invalid-cookie-parameter-message))   (:report (lambda (condition stream)              (format stream "Invalid value \"~A\" for cookie parameter \"~A\"~@[: ~A~]"                      (invalid-cookie-parameter-value condition)                      (invalid-cookie-parameter-parameter condition)                      (invalid-cookie-parameter-message condition))))) (define-condition cookie-string-exceeds-minimum-length (cookie-warning)   ((cookie-string :initarg :cookie-string                   :reader cookie-string-exceeds-minimum-length-cookie-string))   (:report (lambda (condition stream)              (format stream "Cookie string exceeds minimum length guaranteed by RFC.~%Cookie String: \"~S\""                      (cookie-string-exceeds-minimum-length-cookie-string condition)))))    (defmacro optional (element requirement)   `(if ,element ,requirement t)) (defmacro correct (slot test &optional failure-message)   "Checks to see if slot obeys test, or throws an invalid-cookie-parameter. If test is a simple function name it will be turned into (test slot)"   (if (listp test)       `(or ,test (error 'invalid-cookie-parameter :parameter ',slot :value ,slot :message ,failure-message))       `(or (,test ,slot) (error 'invalid-cookie-parameter :parameter ',slot :value ,slot :message ,failure-message)))) (defmacro try-quotes (slot test &body else)   "If slot doesn't match test, try adding quotes around it - if that doesn't work go to else"   (let ((new-string (gensym)))     `(if (,test ,slot)       ,slot       (let ((,new-string (quote-around ,slot)))         (if (,test ,new-string)             (setf ,slot ,new-string)             ,@else))))) (defun quote-around (string)   "Adds quotes around a string"   (declare (type string string))   (concatenate 'string "\"" string "\"")) (defun remove-quotes-around (string)   "If there are quotes, remove them"   (declare (type string string))   (if (and (eql (elt string 0) #\")            (eql (elt string (1- (length string))) #\"))       (subseq string 1 (1- (length string)))       string)) (defun cookie-string (name value &key comment domain max-age path secure)   "Creates a cookie named NAME of value VALUE The returned value is suitable for passing in (request-send-headers request :set-cookie cookie).  NAME, VALUE (strings)     Required.  The name of the state information (\"cookie\") is NAME,     and its value is VALUE.  NAMEs that begin with $ are reserved for     other uses and must not be used by applications.  Comment (a string)     Because cookies can contain private information about a     user, the Cookie attribute allows an origin server to document its     intended use of a cookie.  The user can inspect the information to     decide whether to initiate or continue a session with this cookie.  Domain (a string)     The Domain attribute specifies the domain for which the     cookie is valid.  An explicitly specified domain must always start     with a dot. [ed - this implementation requires an explicitly specified domain!]  Max-Age (a non-negative integer)     The Max-Age attribute defines the lifetime of the     cookie, in seconds.  The delta-seconds value is a decimal non-     negative integer.  After delta-seconds seconds elapse, the client     should discard the cookie.  A value of zero means the cookie     should be discarded immediately.  Path (a string)     The Path attribute specifies the subset of URLs to     which this cookie applies. NB: Mozilla (pre-Deer-Park), IE, and links all fail with RFC-compliant PATHs. As such, it is recommended to set the cookie in the root of your web app's URI, and not include a path argument.  Secure (true or false)     The Secure attribute directs the user     agent to use only (unspecified) secure means to contact the origin     server whenever it sends back this cookie.     The user agent (possibly under the user's control) may determine     what level of security it considers appropriate for \"secure\"     cookies.  The Secure attribute should be considered security     advice from the server to the user agent, indicating that it is in     the session's interest to protect the cookie contents." ;    NAME            =       attr ;    VALUE           =       value ;    cookie-av       =       "Comment" "=" value ;                    |       "Domain" "=" value ;                    |       "Max-Age" "=" value ;                    |       "Path" "=" value ;                    |       "Secure" ;                    |       "Version" "=" 1*DIGIT  (and (correct name valid-name? "must be a valid name")        (try-quotes value value? (correct value value? "must be a value"))        (optional comment (try-quotes comment value?                            (correct comment value? "must be a value")))        (optional domain (try-quotes domain valid-domain?                           (correct domain valid-domain? "must be an explicit valid domain")))        (optional max-age (correct max-age (and (integerp max-age) (> max-age 0)) "must be an integer greater than 0"))        (optional path (try-quotes path value?                         (correct path value? "must be a value")))        (correct secure (or (eql secure t) (eql secure nil)) "must be t or nil"))   (let ((cookie-string          (format nil "~A=~A~@[;comment=~A~]~@[;domain=~A~]~@[;max-age=~A~]~@[;path=~A~]~@[;secure~];version=1"           name value comment domain max-age path secure)))     (when (cookie-string-too-long? cookie-string)       (warn 'cookie-string-exceeds-minimum-length :cookie-string cookie-string))     cookie-string)) (defstruct (cookie (:print-function print-cookie))   "Cookie struct - useful for manipulating cookie values.  Please note that just because it's a valid cookie structure doesn't mean that it's a valid cookie.  See documentation for COOKIE-STRING for parameter information."   (name "" :type string)   (value "" :type string)   (comment nil :type (or string null))   (domain nil :type (or string null))   (max-age nil :type (or (integer 0) null))   (path nil :type (or string null))   (secure nil :type boolean)) (defun print-cookie (cookie stream depth)   "Prints a representation of cookie to stream. Note that this is NOT the equivalent of cookie-string-from-struct. As such, it explicity prints an invalid cookie."   (declare (ignore depth))   (format stream "Cookie(~A:\"~A\"~@[ comment=\"~A\"~]~@[ domain=\"~A\"~]~@[ max-age=\"~A\"~]~@[ path=\"~A\"~]~@[ secure~])"           (cookie-name cookie)           (cookie-value cookie)           (cookie-comment cookie)           (cookie-domain cookie)           (cookie-max-age cookie)           (cookie-path cookie)           (cookie-secure cookie))) (defun cookie-string-from-cookie-struct (cookie)   "Given a cookie struct, return an RFC-compliant cookie string"   (cookie-string (cookie-name cookie)                  (cookie-value cookie)                  :comment (cookie-comment cookie)                  :domain (cookie-domain cookie)                  :max-age (cookie-max-age cookie)                  :path (cookie-path cookie)                  :secure (cookie-secure cookie))) ; ; ; ; ; ; Kristol & Montulli          Standards Track                     [Page 5] ; RFC 2109            HTTP State Management Mechanism        February 1997 ; ; ; 4.2.3  Controlling Caching ; ;    An origin server must be cognizant of the effect of possible caching ;    of both the returned resource and the Set-Cookie header.  Caching ;    "public" documents is desirable.  For example, if the origin server ;    wants to use a public document such as a "front door" page as a ;    sentinel to indicate the beginning of a session for which a Set- ;    Cookie response header must be generated, the page should be stored ;    in caches "pre-expired" so that the origin server will see further ;    requests.  "Private documents", for example those that contain ;    information strictly private to a session, should not be cached in ;    shared caches. ; ;    If the cookie is intended for use by a single user, the Set-cookie ;    header should not be cached.  A Set-cookie header that is intended to ;    be shared by multiple users may be cached. ; ;    The origin server should send the following additional HTTP/1.1 ;    response headers, depending on circumstances: ; ;    * To suppress caching of the Set-Cookie header: Cache-control: no- ;      cache="set-cookie". ; ;    and one of the following: ; ;    * To suppress caching of a private document in shared caches: Cache- ;      control: private. ; ;    * To allow caching of a document and require that it be validated ;      before returning it to the client: Cache-control: must-revalidate. ; ;    * To allow caching of a document, but to require that proxy caches ;      (not user agent caches) validate it before returning it to the ;      client: Cache-control: proxy-revalidate. ; ;    * To allow caching of a document and request that it be validated ;      before returning it to the client (by "pre-expiring" it): ;      Cache-control: max-age=0.  Not all caches will revalidate the ;      document in every case. ; ;    HTTP/1.1 servers must send Expires: old-date (where old-date is a ;    date long in the past) on responses containing Set-Cookie response ;    headers unless they know for certain (by out of band means) that ;    there are no downsteam HTTP/1.0 proxies.  HTTP/1.1 servers may send ;    other Cache-Control directives that permit caching by HTTP/1.1 ;    proxies in addition to the Expires: old-date directive; the Cache- ;    Control directive will override the Expires: old-date for HTTP/1.1 ;    proxies. ; ; ; ; Kristol & Montulli          Standards Track                     [Page 6] ; RFC 2109            HTTP State Management Mechanism        February 1997 ; ; ; 4.3  User Agent Role ; ; 4.3.1  Interpreting Set-Cookie ; ;    The user agent keeps separate track of state information that arrives ;    via Set-Cookie response headers from each origin server (as ;    distinguished by name or IP address and port).  The user agent ;    applies these defaults for optional attributes that are missing: ; ;    VersionDefaults to "old cookie" behavior as originally specified by ;           Netscape.  See the HISTORICAL section. ; ;    Domain Defaults to the request-host.  (Note that there is no dot at ;           the beginning of request-host.) ; ;    Max-AgeThe default behavior is to discard the cookie when the user ;           agent exits. ; ;    Path   Defaults to the path of the request URL that generated the ;           Set-Cookie response, up to, but not including, the ;           right-most /. ; ;    Secure If absent, the user agent may send the cookie over an ;           insecure channel. ; ; 4.3.2  Rejecting Cookies ; ;    To prevent possible security or privacy violations, a user agent ;    rejects a cookie (shall not store its information) if any of the ;    following is true: ; ;    * The value for the Path attribute is not a prefix of the request- ;      URI. ; ;    * The value for the Domain attribute contains no embedded dots or ;      does not start with a dot. ; ;    * The value for the request-host does not domain-match the Domain ;      attribute. ; ;    * The request-host is a FQDN (not IP address) and has the form HD, ;      where D is the value of the Domain attribute, and H is a string ;      that contains one or more dots. ; This "valid-domain?" checks that the domain is valid in and of itself, not ; in relation to the request-host (see 4.3.2  Rejecting Cookies) (defun valid-domain? (domain)   (declare (type string domain))   (and (eql #\. (elt domain 0)) ; must start with a dot       (find #\. (subseq domain 1 (1- (length domain)))) ; must contain an embedded dot       (value? domain))) ; must be a value ;    Examples: ; ;    * A Set-Cookie from request-host y.x.foo.com for Domain=.foo.com ;      would be rejected, because H is y.x and contains a dot. ; ; ; ; Kristol & Montulli          Standards Track                     [Page 7] ; RFC 2109            HTTP State Management Mechanism        February 1997 ; ; ;    * A Set-Cookie from request-host x.foo.com for Domain=.foo.com would ;      be accepted. ; ;    * A Set-Cookie with Domain=.com or Domain=.com., will always be ;      rejected, because there is no embedded dot. ; ;    * A Set-Cookie with Domain=ajax.com will be rejected because the ;      value for Domain does not begin with a dot. #+5am(test reject-per-4.3.2           "Test domains for rejection per 4.3.2"           (is (valid-domain? ".foo.com"))           (is (not (valid-domain? ".com")))           (is (not (valid-domain? ".com.")))           (is (not (valid-domain? "ajax.com"))))                ; ; 4.3.3  Cookie Management ; ;    If a user agent receives a Set-Cookie response header whose NAME is ;    the same as a pre-existing cookie, and whose Domain and Path ;    attribute values exactly (string) match those of a pre-existing ;    cookie, the new cookie supersedes the old.  However, if the Set- ;    Cookie has a value for Max-Age of zero, the (old and new) cookie is ;    discarded.  Otherwise cookies accumulate until they expire (resources ;    permitting), at which time they are discarded. ; ;    Because user agents have finite space in which to store cookies, they ;    may also discard older cookies to make space for newer ones, using, ;    for example, a least-recently-used algorithm, along with constraints ;    on the maximum number of cookies that each origin server may set. ; ;    If a Set-Cookie response header includes a Comment attribute, the ;    user agent should store that information in a human-readable form ;    with the cookie and should display the comment text as part of a ;    cookie inspection user interface. ; ;    User agents should allow the user to control cookie destruction.  An ;    infrequently-used cookie may function as a "preferences file" for ;    network applications, and a user may wish to keep it even if it is ;    the least-recently-used cookie.  One possible implementation would be ;    an interface that allows the permanent storage of a cookie through a ;    checkbox (or, conversely, its immediate destruction). ; ;    Privacy considerations dictate that the user have considerable ;    control over cookie management.  The PRIVACY section contains more ;    information. ; ; 4.3.4  Sending Cookies to the Origin Server ; ;    When it sends a request to an origin server, the user agent sends a ;    Cookie request header to the origin server if it has cookies that are ;    applicable to the request, based on ; ;    * the request-host; ; ; ; ; ; Kristol & Montulli          Standards Track                     [Page 8] ; RFC 2109            HTTP State Management Mechanism        February 1997 ; ; ;    * the request-URI; ; ;    * the cookie's age. ; ;    The syntax for the header is: ; ;    cookie          =       "Cookie:" cookie-version ;                            1*((";" | ",") cookie-value) ;    cookie-value    =       NAME "=" VALUE [";" path] [";" domain] ;    cookie-version  =       "$Version" "=" value ;    NAME            =       attr ;    VALUE           =       value ;    path            =       "$Path" "=" value ;    domain          =       "$Domain" "=" value (defun split-along-lws (string)   "Chops up a string along linear whitespace, returns a list"   (declare (type string string))   (split-sequence:split-sequence-if (lambda (c)                                       (member c (list #\Space *cr* *lf* *ht* #\; #\,)))                                     string :remove-empty-subseqs t)) (defun split-along-quoted-lws (string)   "Chops up a string along linear whitespace, but this version knows about quote marks"   (declare (type string string))   (labels ((splitter (to-be-processed token-accumulator string-accumulator in-quotes)              (if (null to-be-processed)                  (reverse (if token-accumulator                               (cons (coerce (reverse token-accumulator) 'string) string-accumulator)                               string-accumulator))                  (let ((this-token (car to-be-processed)))                    (if in-quotes                        (cond                          ((eql this-token #\") (splitter (rest to-be-processed)                                                          (cons this-token token-accumulator)                                                          string-accumulator                                                          nil))                          ((and (eql this-token #\\)                                (eql (second to-be-processed) #\")) (splitter (cddr to-be-processed)                                                                              (cons (second to-be-processed)                                                                                    (cons this-token token-accumulator))                                                                              string-accumulator                                                                              t))                          (t (splitter (rest to-be-processed)                                       (cons this-token token-accumulator)                                       string-accumulator                                       t)))                        (if (member this-token (list #\Space *cr* *lf* *ht* #\; #\,))                            (splitter (rest to-be-processed)                                      nil                                      (if token-accumulator                                          (cons (coerce (reverse token-accumulator) 'string)                                                string-accumulator)                                          string-accumulator)                                      nil)                            (if (eql this-token #\")                                (splitter (rest to-be-processed)                                          (cons this-token token-accumulator)                                          string-accumulator                                          t)                                (splitter (rest to-be-processed)                                          (cons this-token token-accumulator)                                          string-accumulator                                          nil))))))))     (splitter (coerce string 'list) nil nil nil))) (define-condition unparseable-cookie (cookie-error)   ((version :initarg :version :reader unparseable-cookie-version)    (cookie-string :initarg :cookie-string :reader unparseable-cookie-cookie-string)    (message :initarg :message :reader unparseable-cookie-message))   (:report (lambda (condition stream)              (format stream "Could not parse cookie.~@[ Attempted as a version ~A.~]~@[~%~A~] Cookie text: ~A"                      (unparseable-cookie-version condition)                      (unparseable-cookie-message condition)                      (unparseable-cookie-cookie-string condition))))   (:documentation "Condition returned when all parsing attempts have failed.")) (eval-when (:compile-toplevel)   (defun assemble-matches (cookie-string cookie key value matches)     (when (not (null matches))       (destructuring-bind (match-against slot) (car matches)         (if (eql match-against 'otherwise)             slot             `(if (string-equal ,key ,match-against)               (if (cookie-p ,cookie)                   (setf (,slot ,cookie) (remove-quotes-around ,value))                   (error 'unparseable-cookie :version "RFC2109"