-
Notifications
You must be signed in to change notification settings - Fork 12
/
undertow.clj
167 lines (149 loc) · 7.62 KB
/
undertow.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
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
(ns ring.adapter.undertow
"Adapter for the Undertow webserver."
(:require
[ring.adapter.undertow.request :refer [build-exchange-map]]
[ring.adapter.undertow.response :refer [set-exchange-response]]
[ring.adapter.undertow.ssl :refer [keystore->ssl-context]]
[ring.adapter.undertow.websocket :as ws])
(:import
[io.undertow Undertow Undertow$Builder UndertowOptions]
[org.xnio Options SslClientAuthMode]
[io.undertow.server HttpHandler]
[io.undertow.server.handlers BlockingHandler]
[io.undertow.server.session SessionAttachmentHandler
SessionCookieConfig
SessionManager InMemorySessionManager]))
#_(set! *warn-on-reflection* true)
(defn handle-request [websocket? exchange response-map]
(if websocket?
(if-let [ws-config (:undertow/websocket response-map)]
(->> ws-config (ws/ws-callback) (ws/ws-request exchange (:headers response-map)))
(set-exchange-response exchange response-map))
(set-exchange-response exchange response-map)))
(defn wrap-with-session-handler
[^SessionManager session-manager ^HttpHandler handler]
(SessionAttachmentHandler. handler session-manager (SessionCookieConfig.)))
(defn ^:no-doc undertow-handler
"Returns an function that returns Undertow HttpHandler implementation for the given Ring handler."
[{:keys [dispatch? websocket?]
:or {dispatch? true
websocket? true}}]
(fn [handler]
(reify HttpHandler
(handleRequest [_ exchange]
(when-not dispatch? (.startBlocking exchange))
(let [request-map (build-exchange-map exchange)
response-map (handler request-map)]
(handle-request websocket? exchange response-map))))))
(defn ^:no-doc async-undertow-handler
[{:keys [websocket?]
:or {websocket? true}}]
(fn [handler]
(reify HttpHandler
(handleRequest [_ exchange]
(.dispatch exchange
^Runnable
(fn []
(handler
(build-exchange-map exchange)
(fn [response-map]
(handle-request websocket? exchange response-map))
(fn [^Throwable exception]
(set-exchange-response exchange {:status 500
:body (.getMessage exception)})))))))))
(defn ^:no-doc handler!
[handler ^Undertow$Builder builder {:keys [dispatch? handler-proxy websocket? async? session-manager?
max-sessions server-name custom-manager]
:or {dispatch? true
websocket? true
async? false
session-manager? true
max-sessions -1
server-name "ring-undertow"}
:as options}]
(let [target-handler-proxy (cond
(some? handler-proxy) handler-proxy
async? (async-undertow-handler options)
:else (undertow-handler options))]
(cond->> (target-handler-proxy handler)
session-manager?
(wrap-with-session-handler (or custom-manager
(InMemorySessionManager. (str server-name "-session-manager") max-sessions)))
(and (nil? handler-proxy)
dispatch?)
(BlockingHandler.)
true
(.setHandler builder))))
(defn ^:no-doc tune!
[^Undertow$Builder builder {:keys [io-threads worker-threads buffer-size direct-buffers? max-entity-size]}]
(cond-> builder
max-entity-size (.setServerOption UndertowOptions/MAX_ENTITY_SIZE (long max-entity-size))
io-threads (.setIoThreads io-threads)
worker-threads (.setWorkerThreads worker-threads)
buffer-size (.setBufferSize buffer-size)
(not (nil? direct-buffers?)) (.setDirectBuffers direct-buffers?)))
(defn ^:no-doc listen!
[^Undertow$Builder builder {:keys [host port ssl-port ssl-context key-managers trust-managers]
:as options
:or {host "localhost"
port 80}}]
(let [ssl-context (or ssl-context (keystore->ssl-context options))]
(cond-> builder
(and ssl-port ssl-context) (.addHttpsListener ssl-port host ssl-context)
(and ssl-port (not ssl-context)) (.addHttpsListener ^int ssl-port ^String host ^"[Ljavax.net.ssl.KeyManager;" key-managers ^"[Ljavax.net.ssl.TrustManager;" trust-managers)
(and port) (.addHttpListener port host))))
(defn ^:no-doc client-auth! [^Undertow$Builder builder {:keys [client-auth]}]
(when client-auth
(case client-auth
(:want :requested)
(.setSocketOption builder Options/SSL_CLIENT_AUTH_MODE SslClientAuthMode/REQUESTED)
(:need :required)
(.setSocketOption builder Options/SSL_CLIENT_AUTH_MODE SslClientAuthMode/REQUIRED))))
(defn ^:no-doc http2! [^Undertow$Builder builder {:keys [http2?]}]
(when http2?
(.setServerOption builder UndertowOptions/ENABLE_HTTP2 true)
(.setServerOption builder UndertowOptions/ENABLE_SPDY true)))
(defn ^Undertow run-undertow
"Start an Undertow webserver using given handler and the supplied options:
:configurator - a function called with the Undertow Builder instance
:host - the hostname to listen on
:port - the port to listen on (defaults to 80)
:ssl-port - a number, requires either :ssl-context, :keystore, or :key-managers
:keystore - the filepath (a String) to the keystore
:key-password - the password for the keystore
:truststore - if separate from the keystore
:trust-password - if :truststore passed
:ssl-context - a valid javax.net.ssl.SSLContext
:key-managers - a valid javax.net.ssl.KeyManager []
:trust-managers - a valid javax.net.ssl.TrustManager []
:http2? - flag to enable http2
:io-threads - # threads handling IO, defaults to available processors
:worker-threads - # threads invoking handlers, defaults to (* io-threads 8)
:buffer-size - a number, defaults to 16k for modern servers
:direct-buffers? - boolean, defaults to true
:dispatch? - dispatch handlers off the I/O threads (default: true)
:websocket? - built-in handler support for websocket callbacks
:async? - ring async flag. When true, expect a ring async three arity handler function
:handler-proxy - an optional custom handler proxy function taking handler as single argument
:max-entity-size - maximum size of a request entity
:session-manager? - initialize undertow session manager (default: true)
:custom-manager - custom implementation that extends the io.undertow.server.session.SessionManager interface
:max-sessions - maximum number of undertow session, for use with InMemorySessionManager (default: -1)
:server-name - for use in session manager, for use with InMemorySessionManager (default: \"ring-undertow\")
Returns an Undertow server instance. To stop call (.stop server)."
[handler options]
(let [^Undertow$Builder builder (Undertow/builder)]
(handler! handler builder options)
(tune! builder options)
(http2! builder options)
(client-auth! builder options)
(listen! builder options)
(when-some [configurator (:configurator options)]
(configurator builder))
(let [^Undertow server (.build builder)]
(try
(.start server)
server
(catch Exception ex
(.stop server)
(throw ex))))))