/
server.clj
360 lines (288 loc) · 14 KB
/
server.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
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
(ns org.httpkit.server
(:require
[clojure.string :as str]
[org.httpkit.encode :refer [base64-encode]])
(:import
[org.httpkit.server AsyncChannel HttpServer RingHandler ProxyProtocolOption HttpServer$AddressFinder HttpServer$ServerChannelFactory]
[org.httpkit.logger ContextLogger EventLogger EventNames]
[java.net InetSocketAddress]
[java.nio.channels ServerSocketChannel]
java.security.MessageDigest))
(set! *warn-on-reflection* true)
;;;; Ring server
(defprotocol IHttpServer
(server-port [http-server] "Given an HttpServer, returns server's local port.")
(server-status [http-server] "Given an HttpServer, returns server's status e/o #{:stopped :running :stopping}.")
(-server-stop! [http-server opts]))
(extend-type HttpServer
IHttpServer
(server-port [s] (.getPort s))
(server-status [s] (keyword (str/lower-case (.name (.getStatus s)))))
(-server-stop! [s {:keys [timeout] :or {timeout 100}}]
(let [p_ (promise)]
(when (.stop s timeout #(deliver p_ true))
p_))))
(defn server-stop!
"Signals given HttpServer to stop.
If already stopping: returns nil.
If not already stopping: returns a Promise that will be delivered once
server thread actually completes.
Options:
:timeout ; Max msecs to allow existing requests to complete before attempting
; interrupt (default 100)."
([http-server ] (-server-stop! http-server nil))
([http-server opts] (-server-stop! http-server opts)))
(defn run-server
"Starts a mostly[1] Ring-compatible HttpServer with options:
:ip ; Which IP to bind (default: 0.0.0.0)
:port ; Which port to listen to for incoming requests
:thread ; HTTP worker thread count (default: 4)
:queue-size ; Max jobs to queue before rejecting requests to protect self
:max-body ; Max HTTP body size in bytes (default: 8MB)
:max-ws ; Max WebSocket message size in bytes (default: 4MB)
:max-line ; Max HTTP header line size in bytes (default: 8KB)
:proxy-protocol ; Proxy protocol e/o #{:disable :enable :optional}
:worker-pool ; `ExecutorService` to use for request-handling.
; If set, the following opts will be ignored:
; :thread, :worker-name-prefix, :queue-size
:worker-name-prefix ; Worker thread name prefix
:server-header ; The \"Server\" header, disabled if nil. Default: \"http-kit\".
:error-logger ; (fn [msg ex]) -> log errors
:warn-logger ; (fn [msg ex]) -> log warnings
:event-logger ; (fn [ev-name]) -> log events
:event-names ; Map of http-kit event names to loggable event names
;; These opts may be used for Unix Domain Socket (UDS) support, see README:
:address-finder ; (fn []) -> `java.net.SocketAddress` (ip/port ignored)
:channel-factory ; (fn [java.net.SocketAddress]) -> `java.nio.channels.SocketChannel`
If :legacy-return-value? is
true (default) ; Returns a (fn stop-server [& {:keys [timeout] :or {timeout 100}}])
false (recommended) ; Returns the `HttpServer` which can be used with `server-port`,
; `server-status`, `server-stop!`, etc.
The server also supports the following JVM properties:
`org.http-kit.memmap-file-threshold`
Files above this size (in MB) are mapped into memory for efficiency when served.
Memory mapping could result to file locking. Defaults to 20 (MB).
[1] Ref. http://http-kit.org/migration.html for differences."
[handler
& [{:keys [ip port thread queue-size max-body max-ws max-line
proxy-protocol worker-name-prefix worker-pool
error-logger warn-logger event-logger event-names
legacy-return-value? server-header address-finder
channel-factory]
:or {ip "0.0.0.0"
port 8090
thread 4
queue-size 20480
max-body 8388608
max-ws 4194304
max-line 8192
proxy-protocol :disable
worker-name-prefix "worker-"
legacy-return-value? true
server-header "http-kit"}}]]
(let [^ContextLogger err-logger
(if error-logger
(reify ContextLogger (log [this message error] (error-logger message error)))
(do ContextLogger/ERROR_PRINTER))
^ContextLogger warn-logger
(if warn-logger
(reify ContextLogger (log [this message error] (warn-logger message error)))
HttpServer/DEFAULT_WARN_LOGGER)
^EventLogger evt-logger
(if event-logger
(reify EventLogger (log [this event] (event-logger event)))
(do EventLogger/NOP))
^EventNames evt-names
(cond
(nil? event-names) EventNames/DEFAULT
(map? event-names) (EventNames. event-names)
(instance? EventNames event-names) event-names
:else
(throw
(IllegalArgumentException.
(format "Invalid event-names: (%s) %s"
(class event-names) (pr-str event-names)))))
^org.httpkit.server.IHandler h
(if worker-pool
(RingHandler. handler worker-pool err-logger evt-logger evt-names server-header)
(RingHandler. thread handler worker-name-prefix queue-size server-header err-logger evt-logger evt-names))
^ProxyProtocolOption proxy-enum
(case proxy-protocol
:enable ProxyProtocolOption/ENABLED
:disable ProxyProtocolOption/DISABLED
:optional ProxyProtocolOption/OPTIONAL)
^HttpServer$AddressFinder address-finder
(if address-finder
(reify HttpServer$AddressFinder (findAddress [this] ^java.net.SocketAddress (address-finder)))
(reify HttpServer$AddressFinder (findAddress [this] (InetSocketAddress. ^String ip ^Long port))))
^HttpServer$ServerChannelFactory channel-factory
(if channel-factory
(reify HttpServer$ServerChannelFactory (createChannel [this addr] (channel-factory addr)))
(reify HttpServer$ServerChannelFactory (createChannel [this addr] (ServerSocketChannel/open))))
^ContextLogger warn-logger
(if warn-logger
(reify ContextLogger (log [this message error] (warn-logger message error)))
HttpServer/DEFAULT_WARN_LOGGER)
s (HttpServer. address-finder channel-factory h
^long max-body ^long max-line ^long max-ws proxy-enum ^String server-header
warn-logger
err-logger
evt-logger
evt-names)]
(.start s)
(if-not legacy-return-value?
s
(with-meta
(fn stop-server [& {:keys [timeout] :or {timeout 100}}]
(.stop s timeout)
nil)
{:local-port (.getPort s)
:server s}))))
;;;; WebSockets
(defn sec-websocket-accept [sec-websocket-key]
(let [md (MessageDigest/getInstance "SHA1")
websocket-13-guid "258EAFA5-E914-47DA-95CA-C5AB0DC85B11"]
(base64-encode
(.digest md (.getBytes (str sec-websocket-key websocket-13-guid))))))
(def ^{:deprecated "v2.4.0 (2020-07-30)"} accept
"DEPRECATED: prefer `sec-websocket-accept`" sec-websocket-accept)
(defn websocket-handshake-check
"Returns `sec-ws-accept` string iff given Ring request is a valid
WebSocket handshake."
[ring-req]
(when-let [sec-ws-key (get-in ring-req [:headers "sec-websocket-key"])]
(try
(sec-websocket-accept sec-ws-key)
(catch Exception _ nil))))
(defn send-checked-websocket-handshake!
"Given an AsyncChannel and `sec-ws-accept` string, unconditionally
sends handshake to upgrade given AsyncChannel to a WebSocket.
See also `websocket-handshake-check`."
[^AsyncChannel ch ^String sec-ws-accept]
(.sendHandshake ch
{"Upgrade" "websocket"
"Connection" "Upgrade"
"Sec-WebSocket-Accept" sec-ws-accept}))
(defn send-websocket-handshake!
"Returns true iff successfully upgraded a valid WebSocket request."
[^AsyncChannel ch ring-req]
(when-let [sec-ws-accept (websocket-handshake-check ring-req)]
(send-checked-websocket-handshake! ch sec-ws-accept)))
;;;; Channel API
(defprotocol Channel
"Unified asynchronous channel interface for HTTP (streaming or long-polling)
and WebSocket."
(open? [ch] "Returns true iff channel is open.")
(websocket? [ch] "Returns true iff channel is a WebSocket.")
(close [ch]
"Closes the channel. Idempotent: returns true if the channel was actually
closed, or false if it was already closed.")
(send! [ch data] [ch data close-after-send?]
"Sends data to client and returns true if the data was successfully sent,
or false if the channel is closed. Data is sent directly to the client,
NO RING MIDDLEWARE IS APPLIED.
When unspecified, `close-after-send?` defaults to true for HTTP channels
and false for WebSocket.
Data form: {:headers _ :status _ :body _} or just body. Note that :headers
and :status will be stripped for WebSocket and for HTTP streaming responses
after the first.
For WebSocket, a text frame is sent to client if data is String,
a binary frame when data is byte[] or InputStream. For for HTTP streaming
responses, data can be one of the type defined by Ring spec")
(on-receive [ch callback]
"Sets handler (fn [message]) for notification of client WebSocket
messages. Message ordering is guaranteed by server.
The message argument could be a string or a byte[].")
(on-ping [ch callback]
"Sets handler (fn [data]) for notification of client WebSocket pings. The
data param represents application data and will by a byte[].")
(on-close [ch callback]
"Sets handler (fn [status]) for notification of channel being closed by the
server or client. Handler will be invoked at most once. Useful for clean-up.
Callback status argument:
:server-close : Channel closed by sever
:client-close : HTTP channel closed by client
:normal : WebSocket closed by client (CLOSE_NORMAL)
:going-away : WebSocket closed by client (CLOSE_GOING_AWAY)
:protocol-error : WebSocket closed by client (CLOSE_PROTOCOL_ERROR)
:unsupported : WebSocket closed by client (CLOSE_UNSUPPORTED)
:unknown : WebSocket closed by client (unknown reason)"))
(extend-type AsyncChannel
Channel
(open? [ch] (not (.isClosed ch)))
(websocket? [ch] (.isWebSocket ch))
(close [ch] (.serverClose ch 1000))
(send!
([ch data ] (.send ch data (not (websocket? ch))))
([ch data close-after-send?] (.send ch data (boolean close-after-send?))))
(on-receive [ch callback] (.setReceiveHandler ch callback))
(on-ping [ch callback] (.setPingHandler ch callback))
(on-close [ch callback] (.setCloseHandler ch callback)))
(defmacro with-channel
"DEPRECATED: this macro has potential race conditions, Ref. #318.
Prefer `as-channel` instead."
{:deprecated "v2.4.0 (2020-07-30)"}
[ring-req ch-name & body]
`(let [ring-req# ~ring-req
~ch-name (:async-channel ring-req#)]
(if (:websocket? ring-req#)
(if-let [sec-ws-accept# (websocket-handshake-check ring-req#)]
(do
(send-checked-websocket-handshake! ~ch-name sec-ws-accept#)
~@body
{:body ~ch-name})
{:status 400 :body "Bad Sec-WebSocket-Key header"})
(do ~@body {:body ~ch-name}))))
(defn as-channel
"Returns `{:body ch}`, where `ch` is the request's underlying
asynchronous HTTP or WebSocket `AsyncChannel`.
Main options:
:init - (fn [ch]) for misc pre-handshake setup.
:on-receive - (fn [ch message]) called for client WebSocket messages.
:on-ping - (fn [ch data]) called for client WebSocket pings.
:on-close - (fn [ch status]) called when AsyncChannel is closed.
:on-open - (fn [ch]) called when AsyncChannel is ready for `send!`, etc.
See `Channel` protocol for more info on handlers and `AsyncChannel`s.
See `org.httpkit.timer` ns for optional timeout utils.
---
Example - Async HTTP response:
(def clients_ (atom #{}))
(defn my-async-handler [ring-req]
(as-channel ring-req
{:on-open (fn [ch] (swap! clients_ conj ch))}))
;; Somewhere else in your code
(doseq [ch @clients_]
(swap! clients_ disj ch)
(send! ch {:status 200 :headers {\"Content-Type\" \"text/html\"}
:body \"Your async response\"}
;; false ; Uncomment to use chunk encoding for HTTP streaming
))
Example - WebSocket response:
(defn my-chatroom-handler [ring-req]
(if-not (:websocket? ring-req)
{:status 200 :body \"Welcome to the chatroom! JS client connecting...\"}
(as-channel ring-req
{:on-receive (fn [ch message] (println \"on-receive:\" message))
:on-close (fn [ch status] (println \"on-close:\" status))
:on-open (fn [ch] (println \"on-open:\" ch))})))"
[ring-req {:keys [on-receive on-ping on-close on-open init on-handshake-error]
:or {on-handshake-error
(fn [ch]
(send! ch
{:status 400
:headers {"Content-Type" "text/plain"}
:body "Bad Sec-Websocket-Key header"}
true))}}]
(when-let [ch (:async-channel ring-req)]
(when-let [f init] (f ch))
(when-let [f on-close] (org.httpkit.server/on-close ch (partial f ch)))
(if (:websocket? ring-req)
(if-let [sec-ws-accept (websocket-handshake-check ring-req)]
(do
(when-let [f on-receive] (org.httpkit.server/on-receive ch (partial f ch)))
(when-let [f on-ping] (org.httpkit.server/on-ping ch (partial f ch)))
(send-checked-websocket-handshake! ch sec-ws-accept)
(when-let [f on-open] (f ch)))
(when-let [f on-handshake-error] (f ch)))
(when-let [f on-open] (f ch)))
{:body ch}))