-
Notifications
You must be signed in to change notification settings - Fork 1
/
servlet.clj
73 lines (61 loc) · 2.24 KB
/
servlet.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
(ns slipway.servlet
(:require [clojure.string :as string]
[ring.util.servlet :as servlet]
[slipway.session :as session])
(:import (java.util Locale)
(javax.servlet SessionTrackingMode)
(javax.servlet.http HttpServletRequest HttpServletResponse)))
(defprotocol RequestMapDecoder
(build-request-map [r]))
(extend-protocol RequestMapDecoder
HttpServletRequest
(build-request-map [request]
(servlet/build-request-map request)))
(defmethod session/tracking-mode :cookie
[_]
SessionTrackingMode/COOKIE)
(defmethod session/tracking-mode :url
[_]
SessionTrackingMode/URL)
(defmethod session/tracking-mode :ssl
[_]
SessionTrackingMode/SSL)
(defn get-headers
"Creates a name/value map of all the request headers.
ring.util.servlet/get-headers is -private, so we copy here"
[^HttpServletRequest request]
(reduce
(fn [headers ^String name]
(assoc headers
(.toLowerCase name Locale/ENGLISH)
(->> (.getHeaders request name)
(enumeration-seq)
(string/join ","))))
{}
(enumeration-seq (.getHeaderNames request))))
(defn get-client-cert
"Returns the SSL client certificate of the request, if one exists.
ring.util.servlet/get-client-cert is -private, so we copy here"
[^HttpServletRequest request]
(first (.getAttribute request "javax.servlet.request.X509Certificate")))
(defn update-servlet-response
[^HttpServletResponse response response-map]
(servlet/update-servlet-response response response-map))
(defn updgrade-servlet-request-map
[^HttpServletRequest request]
{:server-port (.getServerPort request)
:server-name (.getServerName request)
:remote-addr (.getRemoteAddr request)
:uri (.getRequestURI request)
:query-string (.getQueryString request)
:scheme (keyword (.getScheme request))
:request-method (keyword (.toLowerCase (.getMethod request) Locale/ENGLISH))
:protocol (.getProtocol request)
:headers (get-headers request)
:ssl-client-cert (get-client-cert request)})
(defn get-context
[^HttpServletRequest req]
(.getServletContext req))
(defn send-error
[^HttpServletResponse response code message]
(.sendError response code message))