forked from ring-clojure/ring
/
cookies.clj
152 lines (132 loc) · 4.75 KB
/
cookies.clj
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
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
(ns ring.middleware.cookies
"Cookie manipulation."
(:require [ring.util.codec :as codec]))
(def ^{:private true
:doc "HTTP token: 1*<any CHAR except CTLs or tspecials>. See RFC2068"}
re-token
#"[!#$%&'*\-+.0-9A-Z\^_`a-z\|~]+")
(def ^{:private true
:doc "HTTP quoted-string: <\"> *<any TEXT except \"> <\">. See RFC2068."}
re-quoted
#"\"(\\\"|[^\"])*\"")
(def ^{:private true
:doc "HTTP value: token | quoted-string. See RFC2109"}
re-value
(str re-token "|" re-quoted))
(def ^{:private true
:doc "HTTP cookie-value: NAME \"=\" VALUE"}
re-cookie
(re-pattern (str "\\s*(" re-token ")=(" re-value ")\\s*[;,]?")))
(def ^{:private true
:doc "Special attributes defined by RFC2109 and RFC2965 that apply to the
Cookie header."}
cookie-attrs
{"$Path" :path, "$Domain" :domain, "$Port" :port})
(def ^{:private true
:doc "Attributes defined by RFC2109 and RFC2965 that apply to the
Set-Cookie header."}
set-cookie-attrs
{:comment "Comment", :comment-url "CommentURL", :discard "Discard",
:domain "Domain", :max-age "Max-Age", :path "Path", :port "Port",
:secure "Secure", :version "Version", :expires "Expires", :http-only "HttpOnly"})
(defn- parse-cookie-header
"Turn a HTTP Cookie header into a list of name/value pairs."
[header]
(for [[_ name value] (re-seq re-cookie header)]
[name value]))
(defn- normalize-quoted-strs
"Turn quoted strings into normal Clojure strings using read-string."
[cookies]
(for [[name value] cookies]
(let [value (codec/url-decode value)]
(if (.startsWith ^String value "\"")
[name (read-string value)]
[name value]))))
(defn- get-cookie
"Get a single cookie from a sequence of cookie-values"
[[[name value] & cookie-values]]
{name (reduce
(fn [m [k v]] (assoc m (cookie-attrs k) v))
{:value value}
(take-while (comp cookie-attrs first) cookie-values))})
(defn- to-cookie-map
"Turn a sequence of cookie-values into a cookie map."
[values]
(loop [values values, cookie-map {}]
(if (seq values)
(let [cookie (get-cookie values)]
(recur
(drop (-> cookie first val count) values)
(merge cookie-map cookie)))
cookie-map)))
(defn- parse-cookies
"Parse the cookies from a request map."
[request]
(if-let [cookie (get-in request [:headers "cookie"])]
(-> cookie
parse-cookie-header
normalize-quoted-strs
to-cookie-map
(dissoc "$Version"))
{}))
(defn- write-value
"Write the main cookie value."
[key value]
(str (name key) "=" (codec/url-encode value)))
(defn- valid-attr?
"Is the attribute valid?"
[[key value]]
(and (contains? set-cookie-attrs key)
(not (.contains (str value) ";"))))
(defn- write-attr-map
"Write a map of cookie attributes to a string."
[attrs]
{:pre [(every? valid-attr? attrs)]}
(for [[key value] attrs]
(let [attr-name (name (set-cookie-attrs key))]
(cond
(true? value) (str ";" attr-name)
(false? value) ""
:else (str ";" attr-name "=" value)))))
(defn- write-cookies
"Turn a map of cookies into a seq of strings for a Set-Cookie header."
[cookies]
(for [[key value] cookies]
(if (map? value)
(apply str (write-value key (:value value))
(write-attr-map (dissoc value :value)))
(write-value key value))))
(defn- set-cookies
"Add a Set-Cookie header to a response if there is a :cookies key."
[response]
(if-let [cookies (:cookies response)]
(update-in response
[:headers "Set-Cookie"]
concat
(doall (write-cookies cookies)))
response))
(defn wrap-cookies
"Parses the cookies in the request map, then assocs the resulting map
to the :cookies key on the request.
Each cookie is represented as a map, with its value being held in the
:value key. A cookie may optionally contain a :path, :domain or :port
attribute.
To set cookies, add a map to the :cookies key on the response. The values
of the cookie map can either be strings, or maps containing the following
keys:
:value - the new value of the cookie
:path - the subpath the cookie is valid for
:domain - the domain the cookie is valid for
:port - the port the cookie is valid for
:max-age - the maximum age in seconds of the cookie
:expires - a date string at which the cookie will expire
:secure - set to true if the cookie is valid for HTTPS only
:http-only - set to true if the cookie is valid for HTTP only"
[handler]
(fn [request]
(let [request (if (request :cookies)
request
(assoc request :cookies (parse-cookies request)))]
(-> (handler request)
(set-cookies)
(dissoc :cookies)))))