|
8 | 8 | [clojure.string :as str]
|
9 | 9 | [ring.util.parsing :refer [re-token]]))
|
10 | 10 |
|
11 |
| -(def ^{:private true, :doc "RFC6265 cookie-octet"} |
12 |
| - re-cookie-octet |
| 11 | +;; RFC6265 regular expressions |
| 12 | +(def ^:private re-cookie-octet |
13 | 13 | #"[!#$%&'()*+\-./0-9:<=>?@A-Z\[\]\^_`a-z\{\|\}~]")
|
14 | 14 |
|
15 |
| -(def ^{:private true, :doc "RFC6265 cookie-value"} |
16 |
| - re-cookie-value |
| 15 | +(def ^:private re-cookie-value |
17 | 16 | (re-pattern (str "\"" re-cookie-octet "*\"|" re-cookie-octet "*")))
|
18 | 17 |
|
19 |
| -(def ^{:private true, :doc "RFC6265 set-cookie-string"} |
20 |
| - re-cookie |
| 18 | +(def ^:private re-cookie |
21 | 19 | (re-pattern (str "\\s*(" re-token ")=(" re-cookie-value ")\\s*[;,]?")))
|
22 | 20 |
|
23 |
| -(def ^{:private true |
24 |
| - :doc "Attributes defined by RFC6265 that apply to the Set-Cookie header."} |
25 |
| - set-cookie-attrs |
| 21 | +(def ^:private set-cookie-attrs |
26 | 22 | {:domain "Domain", :max-age "Max-Age", :path "Path"
|
27 | 23 | :secure "Secure", :expires "Expires", :http-only "HttpOnly"
|
28 | 24 | :same-site "SameSite"})
|
29 | 25 |
|
30 |
| -(def ^{:private true |
31 |
| - :doc "Values defined by RFC6265 that apply to the SameSite cookie attribute header."} |
32 |
| - same-site-values |
33 |
| - {:strict "Strict" |
34 |
| - :lax "Lax" |
35 |
| - :none "None"}) |
| 26 | +(def ^:private same-site-values |
| 27 | + {:strict "Strict", :lax "Lax", :none "None"}) |
36 | 28 |
|
37 |
| -(defn- parse-cookie-header |
38 |
| - "Turn a HTTP Cookie header into a list of name/value pairs." |
39 |
| - [header] |
| 29 | +(defn- parse-cookie-header [header] |
40 | 30 | (for [[_ name value] (re-seq re-cookie header)]
|
41 | 31 | [name value]))
|
42 | 32 |
|
43 |
| -(defn- strip-quotes |
44 |
| - "Strip quotes from a cookie value." |
45 |
| - [value] |
| 33 | +(defn- strip-quotes [value] |
46 | 34 | (str/replace value #"^\"|\"$" ""))
|
47 | 35 |
|
48 | 36 | (defn- decode-values [cookies decoder]
|
49 | 37 | (for [[name value] cookies]
|
50 |
| - (if-let [value (decoder (strip-quotes value))] |
| 38 | + (when-let [value (decoder (strip-quotes value))] |
51 | 39 | [name {:value value}])))
|
52 | 40 |
|
53 |
| -(defn- parse-cookies |
54 |
| - "Parse the cookies from a request map." |
55 |
| - [request encoder] |
| 41 | +(defn- parse-cookies [request encoder] |
56 | 42 | (if-let [cookie (get-in request [:headers "cookie"])]
|
57 | 43 | (->> cookie
|
58 | 44 | parse-cookie-header
|
|
61 | 47 | (into {}))
|
62 | 48 | {}))
|
63 | 49 |
|
64 |
| -(defn- write-value |
65 |
| - "Write the main cookie value." |
66 |
| - [key value encoder] |
| 50 | +(defn- write-value [key value encoder] |
67 | 51 | (encoder {key value}))
|
68 | 52 |
|
69 | 53 | (defprotocol CookieInterval
|
|
72 | 56 | (defprotocol CookieDateTime
|
73 | 57 | (rfc822-format [this]))
|
74 | 58 |
|
75 |
| -(defn- ^Class class-by-name [s] |
| 59 | +(defn- class-by-name ^Class [s] |
76 | 60 | (try (Class/forName s)
|
77 | 61 | (catch ClassNotFoundException _)))
|
78 | 62 |
|
|
81 | 65 | CookieDateTime
|
82 | 66 | {:rfc822-format
|
83 | 67 | (eval
|
84 |
| - '(let [fmtr (.. (org.joda.time.format.DateTimeFormat/forPattern "EEE, dd MMM yyyy HH:mm:ss Z") |
85 |
| - (withZone org.joda.time.DateTimeZone/UTC) |
86 |
| - (withLocale java.util.Locale/US))] |
87 |
| - (fn [interval] |
88 |
| - (.print fmtr ^org.joda.time.DateTime interval))))})) |
| 68 | + '(let [fmtr (.. (org.joda.time.format.DateTimeFormat/forPattern |
| 69 | + "EEE, dd MMM yyyy HH:mm:ss Z") |
| 70 | + (withZone org.joda.time.DateTimeZone/UTC) |
| 71 | + (withLocale java.util.Locale/US))] |
| 72 | + (fn [interval] |
| 73 | + (.print fmtr ^org.joda.time.DateTime interval))))})) |
89 | 74 |
|
90 | 75 | (when-let [interval (class-by-name "org.joda.time.Interval")]
|
91 | 76 | (extend interval
|
|
98 | 83 | (->seconds [this]
|
99 | 84 | (.get this ChronoUnit/SECONDS)))
|
100 | 85 |
|
101 |
| -(let [java-rfc822-formatter (.. (DateTimeFormatter/ofPattern "EEE, dd MMM yyyy HH:mm:ss Z") |
102 |
| - (withZone (ZoneId/of "UTC")) |
103 |
| - (withLocale Locale/US))] |
| 86 | +(let [java-rfc822-formatter |
| 87 | + (.. (DateTimeFormatter/ofPattern "EEE, dd MMM yyyy HH:mm:ss Z") |
| 88 | + (withZone (ZoneId/of "UTC")) |
| 89 | + (withLocale Locale/US))] |
104 | 90 | (extend-protocol CookieDateTime
|
105 | 91 | ZonedDateTime
|
106 | 92 | (rfc822-format [this]
|
107 | 93 | (.format java-rfc822-formatter this))))
|
108 | 94 |
|
109 |
| -(defn- valid-attr? |
110 |
| - "Is the attribute valid?" |
111 |
| - [[key value]] |
| 95 | +(defn- valid-attr? [[key value]] |
112 | 96 | (and (contains? set-cookie-attrs key)
|
113 | 97 | (not (.contains (str value) ";"))
|
114 | 98 | (case key
|
|
117 | 101 | :same-site (contains? same-site-values value)
|
118 | 102 | true)))
|
119 | 103 |
|
120 |
| -(defn- write-attr-map |
121 |
| - "Write a map of cookie attributes to a string." |
122 |
| - [attrs] |
| 104 | +(defn- write-attr-map [attrs] |
123 | 105 | {:pre [(every? valid-attr? attrs)]}
|
124 | 106 | (for [[key value] attrs]
|
125 |
| - (let [attr-name (name (set-cookie-attrs key))] |
| 107 | + (let [attr (name (set-cookie-attrs key))] |
126 | 108 | (cond
|
127 |
| - (satisfies? CookieInterval value) (str ";" attr-name "=" (->seconds value)) |
128 |
| - (satisfies? CookieDateTime value) (str ";" attr-name "=" (rfc822-format value)) |
129 |
| - (true? value) (str ";" attr-name) |
| 109 | + (satisfies? CookieInterval value) (str ";" attr "=" (->seconds value)) |
| 110 | + (satisfies? CookieDateTime value) (str ";" attr "=" (rfc822-format value)) |
| 111 | + (true? value) (str ";" attr) |
130 | 112 | (false? value) ""
|
131 |
| - (= :same-site key) (str ";" attr-name "=" (same-site-values value)) |
132 |
| - :else (str ";" attr-name "=" value))))) |
| 113 | + (= :same-site key) (str ";" attr "=" (same-site-values value)) |
| 114 | + :else (str ";" attr "=" value))))) |
133 | 115 |
|
134 |
| -(defn- write-cookies |
135 |
| - "Turn a map of cookies into a seq of strings for a Set-Cookie header." |
136 |
| - [cookies encoder] |
| 116 | +(defn- write-cookies [cookies encoder] |
137 | 117 | (for [[key value] cookies]
|
138 | 118 | (if (map? value)
|
139 | 119 | (apply str (write-value key (:value value) encoder)
|
140 | 120 | (write-attr-map (dissoc value :value)))
|
141 | 121 | (write-value key value encoder))))
|
142 | 122 |
|
143 |
| -(defn- set-cookies |
144 |
| - "Add a Set-Cookie header to a response if there is a :cookies key." |
145 |
| - [response encoder] |
| 123 | +(defn- set-cookies [response encoder] |
146 | 124 | (if-let [cookies (:cookies response)]
|
147 | 125 | (update-in response
|
148 | 126 | [:headers "Set-Cookie"]
|
|
0 commit comments