-
Notifications
You must be signed in to change notification settings - Fork 4
/
jetty10_core.clj
1205 lines (1086 loc) · 55.9 KB
/
jetty10_core.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
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
(ns puppetlabs.trapperkeeper.services.webserver.jetty10-core
(:require [clojure.string :as str]
[clojure.tools.logging :as log]
[me.raynes.fs :as fs]
[puppetlabs.i18n.core :as i18n]
[puppetlabs.trapperkeeper.services.protocols.filesystem-watch-service
:as watch-protocol]
[puppetlabs.trapperkeeper.services.webserver.jetty10-config :as config]
[puppetlabs.trapperkeeper.services.webserver.jetty10-websockets :as websockets]
[puppetlabs.trapperkeeper.services.webserver.normalized-uri-helpers
:as normalized-uri-helpers]
[ring.util.codec :as codec]
[ring.util.servlet :as servlet]
[schema.core :as schema])
(:import (clojure.lang Atom)
(com.puppetlabs.ssl_utils SSLUtils)
(com.puppetlabs.trapperkeeper.services.webserver.jetty10.utils InternalSslContextFactory)
(java.lang.management ManagementFactory)
(java.net URI)
(java.security Security)
(java.util.concurrent TimeoutException ExecutionException)
(javax.servlet Servlet ServletContextListener)
(javax.servlet.http HttpServletResponse)
(org.eclipse.jetty.client HttpClient RedirectProtocolHandler)
(org.eclipse.jetty.client.dynamic HttpClientTransportDynamic)
(org.eclipse.jetty.client.http HttpClientConnectionFactory)
(org.eclipse.jetty.http HttpMethod MimeTypes UriCompliance)
(org.eclipse.jetty.io ClientConnectionFactory$Info ClientConnector)
(org.eclipse.jetty.jmx MBeanContainer)
(org.eclipse.jetty.proxy ProxyServlet)
(org.eclipse.jetty.server AbstractConnectionFactory ConnectionFactory CustomRequestLog Handler HttpConfiguration
HttpConnectionFactory Request
Server ServerConnector Slf4jRequestLogWriter SymlinkAllowedResourceAliasChecker)
(org.eclipse.jetty.server.handler AbstractHandler ContextHandler
ContextHandlerCollection HandlerCollection
HandlerWrapper StatisticsHandler)
(org.eclipse.jetty.server.handler.gzip GzipHandler)
(org.eclipse.jetty.servlet DefaultServlet ServletContextHandler ServletHolder)
(org.eclipse.jetty.util BlockingArrayQueue URIUtil)
(org.eclipse.jetty.util.resource Resource)
(org.eclipse.jetty.util.ssl SslContextFactory$Client SslContextFactory$Server)
(org.eclipse.jetty.util.thread QueuedThreadPool)
(org.eclipse.jetty.webapp WebAppContext)
(org.eclipse.jetty.websocket.server.config JettyWebSocketServletContainerInitializer)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; JDK SecurityProvider Hack
;; Work around an issue with OpenJDK's PKCS11 implementation preventing TLSv1
;; connections from working correctly
;;
;; http://stackoverflow.com/questions/9586162/openjdk-and-php-ssl-connection-fails
;; https://bugs.launchpad.net/ubuntu/+source/openjdk-6/+bug/948875
(if (re-find #"OpenJDK" (System/getProperty "java.vm.name"))
(try
(let [klass (Class/forName "sun.security.pkcs11.SunPKCS11")
blacklist (filter #(instance? klass %) (Security/getProviders))]
(doseq [provider blacklist]
(log/info (i18n/trs "Removing buggy security provider {0}" provider))
(Security/removeProvider (.getName provider))))
(catch ClassNotFoundException e)
(catch Throwable e
(log/error e (i18n/trs "Could not remove security providers; HTTPS may not work!")))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Bouncy Castle logs via java.util.logging, and is noisy during our
;;; requests. Redirect this logging into SL4J, which lets us control
;;; it via logback.
(if-let [logging-resource (clojure.java.io/resource "logging-router.properties")]
(-> (java.util.logging.LogManager/getLogManager)
(.readConfiguration (.openStream logging-resource)))
(log/error (i18n/trs "logging-router.properties not found, extra logging will occur")))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Schemas
(def ProxyTarget
{:host schema/Str
:path schema/Str
:port schema/Int})
(def CommonOptions
{(schema/optional-key :server-id) schema/Keyword
(schema/optional-key :redirect-if-no-trailing-slash) schema/Bool
(schema/optional-key :normalize-request-uri) schema/Bool})
(def ContextHandlerOptions
(assoc CommonOptions (schema/optional-key :context-listeners) [ServletContextListener]
(schema/optional-key :follow-links) schema/Bool))
(def ServletHandlerOptions
(assoc CommonOptions (schema/optional-key :servlet-init-params) {schema/Str schema/Str}))
(def ProxySslConfig
(merge config/WebserverSslPemConfig
{(schema/optional-key :cipher-suites) [schema/Str]
(schema/optional-key :protocols) (schema/maybe [schema/Str])
(schema/optional-key :allow-renegotiation) (schema/maybe [schema/Bool])}))
(defn positive-integer?
[i]
(and (integer? i)
(pos? i)))
(def PosInt
"Any integer z in Z where z > 0."
(schema/pred positive-integer? 'positive-integer?))
(def ProxyOptions
(assoc CommonOptions
(schema/optional-key :scheme) (schema/enum :orig :http :https
"orig" "http" "https")
(schema/optional-key :ssl-config) (schema/conditional
keyword? (schema/eq :use-server-config)
map? ProxySslConfig)
(schema/optional-key :rewrite-uri-callback-fn) (schema/pred ifn?)
(schema/optional-key :callback-fn) (schema/pred ifn?)
(schema/optional-key :request-buffer-size) schema/Int
(schema/optional-key :follow-redirects) schema/Bool
(schema/optional-key :idle-timeout) PosInt))
(def ContextEndpoint
{:type (schema/eq :context)
:base-path schema/Str
(schema/optional-key :context-listeners) (schema/maybe [ServletContextListener])})
(def RingEndpoint
{:type (schema/eq :ring)})
(def WebsocketEndpoint
{:type (schema/eq :websocket)})
(def ServletEndpoint
{:type (schema/eq :servlet)
:servlet java.lang.Class})
(def WarEndpoint
{:type (schema/eq :war)
:war-path schema/Str})
(def ProxyEndpoint
{:type (schema/eq :proxy)
:target-host schema/Str
:target-port schema/Int
:target-path schema/Str})
(def Endpoint
(schema/conditional
#(-> % :type (= :context)) ContextEndpoint
#(-> % :type (= :ring)) RingEndpoint
#(-> % :type (= :websocket)) WebsocketEndpoint
#(-> % :type (= :servlet)) ServletEndpoint
#(-> % :type (= :war)) WarEndpoint
#(-> % :type (= :proxy)) ProxyEndpoint))
(def RegisteredEndpoints
{schema/Str [Endpoint]})
(def ServerContextState
{:mbean-container (schema/maybe MBeanContainer)
:overrides-read-by-webserver schema/Bool
:overrides (schema/maybe {schema/Keyword schema/Any})
:endpoints RegisteredEndpoints
:ssl-context-server-factory (schema/maybe SslContextFactory$Server)
:ssl-context-client-factory (schema/maybe SslContextFactory$Client)})
(def ServerContext
{:state (schema/atom ServerContextState)
:handlers ContextHandlerCollection
:server (schema/maybe Server)})
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Utility Functions
(defn- remove-leading-slash
[s]
(str/replace s #"^\/" ""))
(defn- with-leading-slash
[s]
(if (.startsWith s "/")
s
(str "/" s)))
(schema/defn ^:always-validate started? :- Boolean
"A predicate that indicates whether or not the webserver-context contains a Jetty
Server object."
[webserver-context :- ServerContext]
(instance? Server (:server webserver-context)))
(schema/defn ^:always-validate
merge-webserver-overrides-with-options :- config/WebserverRawConfig
"Merge any overrides made to the webserver config settings with the supplied
options."
[webserver-context :- ServerContext
options :- config/WebserverRawConfig]
(let [overrides (:overrides (swap! (:state webserver-context)
assoc
:overrides-read-by-webserver
true))]
(doseq [key (keys overrides)]
(log/info (i18n/trs "webserver config overridden for key ''{0}''" (name key))))
(merge options overrides)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; SSL Context Functions
(schema/defn ^:always-validate
ssl-context-client-factory :- SslContextFactory$Client
"Creates a new SslContextFactory instance from a map of SSL config options."
[{:keys [keystore-config ssl-crl-path cipher-suites protocols allow-renegotiation]}
:- config/WebserverClientSslContextFactory]
(let [context (doto (SslContextFactory$Client.)
(.setKeyStore (:keystore keystore-config))
(.setKeyStorePassword (:key-password keystore-config))
(.setTrustStore (:truststore keystore-config))
;; Need to clear out the default cipher suite exclude list so
;; that Jetty doesn't potentially remove one or more ciphers
;; that we want to be included.
(.setExcludeCipherSuites (into-array String []))
(.setIncludeCipherSuites (into-array String cipher-suites))
;; Need to clear out the default protocols exclude list so
;; that Jetty doesn't potentially remove one or more protocols
;; that we want to be included.
(.setExcludeProtocols (into-array String []))
(.setIncludeProtocols (into-array String (filter #(not= "sslv3" (str/lower-case %)) protocols))))]
(when (empty? (.getIncludeProtocols context))
(.setIncludeProtocols context (into-array String [SSLUtils/TLS_PROTOCOL])))
(when (SSLUtils/isFIPS)
(doto context
(.setKeyStoreType SSLUtils/BOUNCYCASTLE_FIPS_KEYSTORE)
(.setTrustStoreType SSLUtils/BOUNCYCASTLE_FIPS_KEYSTORE)
(.setKeyStoreProvider SSLUtils/FIPS_PROVIDER_CLASS)
(.setTrustStoreProvider SSLUtils/FIPS_PROVIDER_CLASS)
(.setKeyManagerFactoryAlgorithm SSLUtils/PKIX_KEYMANAGER_ALGO)
(.setTrustManagerFactoryAlgorithm SSLUtils/PKIX_KEYMANAGER_ALGO)))
(if (:trust-password keystore-config)
(.setTrustStorePassword context (:trust-password keystore-config)))
(if allow-renegotiation
(.setRenegotiationAllowed context true)
(.setRenegotiationAllowed context false))
(when ssl-crl-path
(.setCrlPath context ssl-crl-path)
; .setValidatePeerCerts needs to be called with a value of 'true' in
; order to force Jetty to actually use the CRL when validating client
; certificates for a connection.
(.setValidatePeerCerts context true))
context))
(schema/defn ^:always-validate
ssl-context-server-factory :- SslContextFactory$Server
"Creates a new SslContextFactory instance from a map of SSL config options."
[{:keys [keystore-config client-auth ssl-crl-path cipher-suites protocols allow-renegotiation]}
:- config/WebserverSslContextFactory]
(when (some #(= "sslv3" %) (map str/lower-case protocols))
(log/warn (i18n/trs "`ssl-protocols` contains SSLv3, a protocol with known vulnerabilities; ignoring")))
(let [context (doto (InternalSslContextFactory.)
(.setKeyStore (:keystore keystore-config))
(.setKeyStorePassword (:key-password keystore-config))
(.setTrustStore (:truststore keystore-config))
;; Need to clear out the default cipher suite exclude list so
;; that Jetty doesn't potentially remove one or more ciphers
;; that we want to be included.
(.setExcludeCipherSuites (into-array String []))
(.setIncludeCipherSuites (into-array String cipher-suites))
;; Need to clear out the default protocols exclude list so
;; that Jetty doesn't potentially remove one or more protocols
;; that we want to be included.
(.setExcludeProtocols (into-array String []))
(.setIncludeProtocols (into-array String (filter #(not= "sslv3" (str/lower-case %)) protocols))))]
(when (empty? (.getIncludeProtocols context))
(log/warn (i18n/trs "When `ssl-protocols` is empty, a default of {0} is assumed" SSLUtils/TLS_PROTOCOL))
(.setIncludeProtocols context (into-array String [SSLUtils/TLS_PROTOCOL])))
(when (SSLUtils/isFIPS)
(doto context
(.setKeyStoreType SSLUtils/BOUNCYCASTLE_FIPS_KEYSTORE)
(.setTrustStoreType SSLUtils/BOUNCYCASTLE_FIPS_KEYSTORE)
(.setKeyStoreProvider SSLUtils/FIPS_PROVIDER_CLASS)
(.setTrustStoreProvider SSLUtils/FIPS_PROVIDER_CLASS)
(.setKeyManagerFactoryAlgorithm SSLUtils/PKIX_KEYMANAGER_ALGO)
(.setTrustManagerFactoryAlgorithm SSLUtils/PKIX_KEYMANAGER_ALGO)))
(if (:trust-password keystore-config)
(.setTrustStorePassword context (:trust-password keystore-config)))
(case client-auth
:need (.setNeedClientAuth context true)
:want (.setWantClientAuth context true)
nil)
(if allow-renegotiation
(.setRenegotiationAllowed context true)
(.setRenegotiationAllowed context false))
(when ssl-crl-path
(.setCrlPath context ssl-crl-path)
; .setValidatePeerCerts needs to be called with a value of 'true' in
; order to force Jetty to actually use the CRL when validating client
; certificates for a connection.
(.setValidatePeerCerts context true))
context))
(schema/defn ^:always-validate
get-proxy-client-context-factory :- SslContextFactory$Client
[ssl-config :- ProxySslConfig]
(ssl-context-client-factory {:keystore-config
(config/pem-ssl-config->keystore-ssl-config
ssl-config)
:cipher-suites (or (:cipher-suites ssl-config) (if (SSLUtils/isFIPS)
config/acceptable-ciphers-fips
config/acceptable-ciphers))
:protocols (or (:protocols ssl-config) config/default-protocols)
:allow-renegotiation (or (:allow-renegotiation ssl-config)
config/default-allow-renegotiation)}))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Jetty Server / Connector Functions
(defn- http-configuration
[request-header-size]
(let [http-config (doto (HttpConfiguration.)
(.setSendDateHeader true)
(.setSendServerVersion false)
;; LEGACY uri compliance mode that models Jetty-9.4 behavior by allowing
;; UriCompliance.Violation.AMBIGUOUS_PATH_SEGMENT, UriCompliance.Violation.AMBIGUOUS_EMPTY_SEGMENT,
;; UriCompliance.Violation.AMBIGUOUS_PATH_SEPARATOR, UriCompliance.Violation.AMBIGUOUS_PATH_ENCODING
;; and UriCompliance.Violation.UTF16_ENCODINGS
;; https://www.eclipse.org/jetty/javadoc/jetty-10/org/eclipse/jetty/http/UriCompliance.html#LEGACY
(.setUriCompliance UriCompliance/LEGACY))]
(when request-header-size
(.setRequestHeaderSize http-config request-header-size))
http-config))
(defn- connection-factories
[request-header-size ^SslContextFactory$Server ssl-ctxt-factory]
(let [http-config (http-configuration request-header-size)
factories (into-array ConnectionFactory
[(HttpConnectionFactory. http-config)])]
(if ssl-ctxt-factory
(AbstractConnectionFactory/getFactories
ssl-ctxt-factory factories)
factories)))
(defn- thread-count
[setting]
(if setting setting -1))
(schema/defn ^:always-validate
connector* :- ServerConnector
[server :- Server
config :- (merge config/WebserverConnector
{schema/Keyword schema/Any})
ssl-ctxt-factory :- (schema/maybe SslContextFactory$Server)]
(let [request-size (:request-header-max-size config)
connector (doto (ServerConnector.
server
nil nil nil
(thread-count (:acceptor-threads config))
(thread-count (:selector-threads config))
(connection-factories request-size ssl-ctxt-factory))
(.setPort (:port config))
(.setHost (:host config)))]
(when-let [idle-timeout (:idle-timeout-milliseconds config)]
(.setIdleTimeout connector idle-timeout))
connector))
(schema/defn ^:always-validate
ssl-connector :- ServerConnector
"Creates a ssl ServerConnector instance."
[server :- Server
ssl-ctxt-factory :- SslContextFactory$Server
config :- config/WebserverSslConnector]
(connector* server config ssl-ctxt-factory))
(schema/defn ^:always-validate
plaintext-connector :- ServerConnector
[server :- Server
config :- config/WebserverConnector]
(connector* server config nil))
(schema/defn ^:always-validate
queue-thread-pool :- (schema/maybe QueuedThreadPool)
[max-threads :- (schema/maybe schema/Int)
queue-max-size :- (schema/maybe schema/Int)]
(if (or max-threads queue-max-size)
(let [thread-pool (if max-threads
(QueuedThreadPool. max-threads)
(QueuedThreadPool.))]
(if queue-max-size
;; The code below is definitely not ideal, but there isn't a way to set
;; the maximum capacity of the QueuedThreadPool's BlockingArrayQueue
;; after construction. We're trying to avoid hard-coding our own
;; defaults for other settings that we want Jetty to control, e.g., the
;; initial capacity of the queue and minimum number of threads. By
;; reconstructing the QueuedThreadPool here, we can use Jetty's defaults
;; for settings unrelated to `queue-max-size`.
;;
;; QueuedThreadPool and BlockingArrayQueue construction isn't too
;; expensive. It mostly involves some initial memory allocations. The
;; more expensive work - where threads are actually started and the
;; queue expands to fulfill new requests - would only happen after the
;; QueuedThreadPool were started. That won't happen for the
;; `thread-pool` instance from above, which just gets thrown away as
;; this function falls out of scope without ever having been started.
;; Also, this function would likely only be called once per server
;; startup where a `queue-max-size` were configured.
;;
;; The QueuedThreadPool constructor sets the `queue-capacity` and
;; `queue-grow-by` based on the minimum number of threads available
;; in the pool. See https://github.com/eclipse/jetty.project/blob/jetty-9.4.1.v20170120/jetty-util/src/main/java/org/eclipse/jetty/util/thread/QueuedThreadPool.java#L101-L105.
;; That algorithm is essentially duplicated here, with the only
;; difference being that if `queue-max-size` is smaller than the
;; minimum number of threads, the `queue-capacity` and `queue-grow-by`
;; are reduced to the `queue-max-size` in order to avoid the
;; BlockingArrayQueue constructor throwing an IllegalArgumentException.
(let [min-threads (.getMinThreads thread-pool)
queue-capacity (min queue-max-size min-threads)
queue-grow-by (min queue-max-size min-threads)]
(QueuedThreadPool. (.getMaxThreads thread-pool)
min-threads
(.getIdleTimeout thread-pool)
(BlockingArrayQueue.
queue-capacity
queue-grow-by
queue-max-size)))
thread-pool))))
(schema/defn ^:always-validate
create-server :- Server
"Construct a Jetty Server instance."
[webserver-context :- ServerContext
config :- config/WebserverConfig]
(let [server (if-let [^QueuedThreadPool pool (queue-thread-pool (:max-threads config)
(:queue-max-size config))]
(Server. pool)
(Server.))]
(when (:jmx-enable config)
(let [mb-container (MBeanContainer. (ManagementFactory/getPlatformMBeanServer))]
(doto server
(.addEventListener mb-container)
(.addBean mb-container))
(swap! (:state webserver-context) assoc :mbean-container mb-container)))
(when (:http config)
(let [connector (plaintext-connector server (:http config))]
(.addConnector server connector)))
(when-let [https (:https config)]
(let [ssl-ctxt-server-factory (ssl-context-server-factory
(select-keys https
[:keystore-config :client-auth
:ssl-crl-path :cipher-suites
:allow-renegotiation
:protocols]))
ssl-ctx-client-factory (ssl-context-client-factory
(select-keys https
[:keystore-config
:ssl-crl-path :cipher-suites
:allow-renegotiation
:protocols]))
connector (ssl-connector server ssl-ctxt-server-factory https)]
(.addConnector server connector)
(swap! (:state webserver-context)
assoc
:ssl-context-server-factory ssl-ctxt-server-factory
:ssl-context-client-factory ssl-ctx-client-factory)))
server))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; GZip Functions
;; TODO: make all of this gzip-mime-type stuff configurable
(defn- gzip-excluded-mime-types
"Build up a list of mime types that should not be candidates for
gzip compression in responses."
[]
(->
;; This code is ported from Jetty 9.0.5's GzipFilter class. In
;; Jetty 7, this behavior was the default for GzipHandler as well
;; as GzipFilter, but in Jetty 9.0.5 the GzipHandler no longer
;; includes this, so we need to do it by hand.
(filter #(or (.startsWith % "image/")
(.startsWith % "audio/")
(.startsWith % "video/"))
(MimeTypes/getKnownMimeTypes))
(conj "application/compress" "application/zip" "application/gzip" "text/event-stream")
(into-array)))
(defn- gzip-handler
"Given a handler, wrap it with a GzipHandler that will compress the response
when appropriate."
[handler]
(doto (GzipHandler.)
(.setHandler handler)
(.setExcludedMimeTypes (gzip-excluded-mime-types))
(.addIncludedMethods (into-array [(.asString HttpMethod/POST)]))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Handler Helper Functions
(schema/defn ^:always-validate
add-handler :- ContextHandler
[webserver-context :- ServerContext
^ContextHandler handler :- ContextHandler
enable-trailing-slash-redirect? :- schema/Bool]
(.setAllowNullPathInfo handler (not enable-trailing-slash-redirect?))
(.addHandler (:handlers webserver-context) handler)
;; If this handler is being added after the server has been started, we
;; need to mark the handler as "managed" so that the server will stop the
;; handler when the server is stopped. We also need to manually start the
;; handler. The server takes care of marking handlers as managed and starting
;; them if the handlers are already registered when the server is started.
(if-let [server (.getServer handler)]
(when (and (.isRunning server) (not (.isRunning handler)))
(.manage (:handlers webserver-context) handler)
(.start handler)))
handler)
(defn- ring-handler
"Returns an Jetty Handler implementation for the given Ring handler."
[handler]
(proxy [AbstractHandler] []
(handle [_ ^Request base-request request response]
(let [request-map (assoc (servlet/build-request-map request)
:response response)
response-map (handler request-map)]
(when response-map
(servlet/update-servlet-response response response-map)
(.setHandled base-request true))))))
(schema/defn ^:always-validate
proxy-servlet :- ProxyServlet
"Create an instance of Jetty's `ProxyServlet` that will proxy requests at
a given context to another host."
[webserver-context :- ServerContext
target :- ProxyTarget
options :- ProxyOptions]
(let [custom-ssl-ctxt-factory (if (map? (:ssl-config options))
^SslContextFactory$Client (get-proxy-client-context-factory (:ssl-config options))
(log/info (i18n/trs "Proxy not configured with custom ssl, using server default")))
{:keys [request-buffer-size idle-timeout]} options]
(proxy [ProxyServlet] []
(rewriteTarget [req]
(let [query (.getQueryString req)
scheme (let [target-scheme (:scheme options)]
(condp = target-scheme
nil (.getScheme req)
:orig (.getScheme req)
"orig" (.getScheme req)
:http "http"
:https "https"
"http" target-scheme
"https" target-scheme))
context-path (.getPathInfo req)]
(let [target-uri (URI. scheme
nil
(:host target)
(:port target)
(with-leading-slash
(URIUtil/addPaths (:path target) context-path))
(codec/url-decode (str query))
nil)]
(if-let [rewrite-uri-callback-fn (:rewrite-uri-callback-fn options)]
(str (rewrite-uri-callback-fn target-uri req))
(str target-uri)))))
(newHttpClient []
(let [client (if custom-ssl-ctxt-factory
(let [^ClientConnector connector (new ClientConnector)]
(.setSslContextFactory connector custom-ssl-ctxt-factory)
(new HttpClient (new HttpClientTransportDynamic connector (into-array ClientConnectionFactory$Info [HttpClientConnectionFactory/HTTP11]))))
(if-let [ssl-ctxt-factory (:ssl-context-client-factory
@(:state webserver-context))]
(do
(log/debug (i18n/trs "Proxy Using same config as server for ssl in proxy"))
(let [connector (new ClientConnector)]
(.setSslContextFactory connector ssl-ctxt-factory)
(new HttpClient (new HttpClientTransportDynamic connector (into-array ClientConnectionFactory$Info [HttpClientConnectionFactory/HTTP11])))))
(do
(log/debug (i18n/trs "Proxy using default http client with no SSL specification."))
(HttpClient.))))]
(when request-buffer-size
(.setRequestBufferSize client request-buffer-size))
client))
(createHttpClient []
(let [client (proxy-super createHttpClient)
timeout (when idle-timeout
(* 1000 idle-timeout))]
(if (:follow-redirects options)
(do
(.setFollowRedirects client true)
(.put (.getProtocolHandlers client) (RedirectProtocolHandler. client)))
(.setFollowRedirects client false))
(when timeout
(.setIdleTimeout client timeout))
client))
(sendProxyRequest [req proxy-response proxy-request]
(when-let [callback-fn (:callback-fn options)]
(callback-fn proxy-request req))
(proxy-super sendProxyRequest req proxy-response proxy-request)))))
(schema/defn ^:always-validate
register-endpoint!
[state :- Atom
endpoint-map :- Endpoint
endpoint :- schema/Str]
(swap! state update-in [:endpoints endpoint] #(if (nil? %)
[endpoint-map]
(conj % endpoint-map))))
(schema/defn ^:always-validate max-request-body-size-handler*
[handler :- Handler
max-size :- schema/Int]
(proxy [HandlerWrapper] []
(handle [target ^Request base-request request response]
(let [request-size (.getContentLength base-request)]
(if (> request-size max-size)
(do
(.setStatus response HttpServletResponse/SC_REQUEST_ENTITY_TOO_LARGE)
(.setHandled base-request true))
(.handle handler target base-request request response))))))
(schema/defn ^:always-validate max-request-body-size-handler
"Wrap a max-request-body-size handler around the supplied handler. The
handler returns a 413 (request entity too large) error if the Content-Length
HTTP header on the incoming request exceeds the value specified as the
max-size parameter."
[handler :- Handler
max-size :- schema/Int]
(doto (max-request-body-size-handler* handler max-size)
(.setHandler handler)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Public
(schema/defn ^:always-validate
initialize-context :- ServerContext
"Create a webserver-context which contains a HandlerCollection and a
ContextHandlerCollection which can accept the addition of new handlers
before the webserver is started."
[]
(let [^ContextHandlerCollection chc (ContextHandlerCollection.)]
{:handlers chc
:state (atom {:endpoints {}
:mbean-container nil
:overrides-read-by-webserver false
:overrides nil
:ssl-context-server-factory nil
:ssl-context-client-factory nil})
:server nil}))
; TODO move out of public
(schema/defn ^:always-validate
merge-webserver-overrides-with-options :- config/WebserverRawConfig
"Merge any overrides made to the webserver config settings with the supplied
options."
[webserver-context :- ServerContext
options :- config/WebserverRawConfig]
{:post [(map? %)]}
(let [overrides (:overrides (swap! (:state webserver-context)
assoc
:overrides-read-by-webserver
true))]
(doseq [key (keys overrides)]
(log/info (i18n/trs "webserver config overridden for key ''{0}''" (name key))))
(merge options overrides)))
(schema/defn ^:always-validate shutdown
[{:keys [^Server server] :as webserver-context} :- ServerContext]
(when-let [^MBeanContainer mbean-container (:mbean-container @(:state webserver-context))]
(log/debug (i18n/trs "Cleaning up JMX MBean container"))
(.destroy mbean-container)
(swap! (:state webserver-context) assoc :mbean-container nil))
(when (started? webserver-context)
(log/info (i18n/trs "Shutting down web server."))
(try
(.stop server)
(catch TimeoutException e
(log/error e (i18n/trs "Web server failed to shut down gracefully in configured timeout period ({0}); cancelling remaining requests."
(.getStopTimeout server))))
;; This exception handling was added since we currently manually stop handlers within pcp-broker
;; for debugging purposes there - on shutdown if Jetty 10 sees a STOPPED handler it throws an
;; ExecutionException with a IllegalStateException as it's cause and if unhandled shutdown
;; stops and the server goes into a FAILED state
(catch ExecutionException e
(log/error (.getCause e) (i18n/trs "Web server failed to shut down gracefully due to ExecutionException with inner exception of type {0}; cancelling remaining requests."
(type (.getCause e))))))
(log/info (i18n/trs "Web server shutdown"))))
(schema/defn ^:always-validate
create-webserver :- ServerContext
"Create a Jetty webserver according to the supplied options:
:host - the hostname to listen on
:port - the port to listen on (defaults to 8080)
:ssl-host - the hostname to listen on for SSL connections
:ssl-port - the SSL port to listen on (defaults to 8081)
:max-threads - the maximum number of threads to use (default 100)
:request-header-max-size - the maximum size of an HTTP request header (default 8192)
:gzip-enable - whether or not gzip compression can be applied
to the body of a response (default true)
SSL may be configured via PEM files by providing all three of the following
settings:
:ssl-key - a PEM file containing the host's private key
:ssl-cert - a PEM file containing the host's certificate or chain
:ssl-ca-cert - a PEM file containing the CA certificate
or via JKS keystore files by providing all four of the following settings:
:keystore - the keystore to use for SSL connections
:key-password - the password to the keystore
:truststore - a truststore to use for SSL connections
:trust-password - the password to the truststore
Note that if SSL is being configured via PEM files, an optional
:ssl-cert-chain setting may be included to specify a supplemental set
of certificates to be appended to the first certificate from the :ssl-cert
setting in order to construct the certificate chain.
Other SSL settings:
:client-auth - SSL client certificate authenticate, may be set to :need,
:want or :none (defaults to :need)
:cipher-suites - list of cryptographic ciphers to allow for incoming SSL connections
:ssl-protocols - list of protocols to allow for incoming SSL connections"
[webserver-context :- ServerContext
options :- config/WebserverRawConfig]
{:pre [(map? options)]
:post [(started? %)]}
(let [config (config/process-config
(merge-webserver-overrides-with-options
webserver-context
options))
^Server s (create-server webserver-context config)
^HandlerCollection hc (HandlerCollection.)
;; PE_37252 was (config/maybe-init-log-handler options)]
log-handler nil]
(.setHandlers hc (into-array Handler [(:handlers webserver-context)]))
(let [shutdown-timeout (* 1000 (:shutdown-timeout-seconds options config/default-shutdown-timeout-seconds))
maybe-zipped (if (:gzip-enable options true)
(gzip-handler hc)
hc)
maybe-size-restricted (if-let [max-size (:request-body-max-size
options)]
(max-request-body-size-handler
maybe-zipped
max-size)
maybe-zipped)
maybe-logged (if log-handler
(doto log-handler (.setHandler maybe-size-restricted))
maybe-size-restricted)
statistics-handler (if (or (nil? shutdown-timeout) (pos? shutdown-timeout))
(doto (StatisticsHandler.)
(.setHandler maybe-logged))
maybe-logged)
log-writer (Slf4jRequestLogWriter.)]
(.setHandler s statistics-handler)
(.setRequestLog s (CustomRequestLog. log-writer CustomRequestLog/EXTENDED_NCSA_FORMAT))
(when shutdown-timeout
(log/info (i18n/trs "Server shutdown timeout set to {0} milliseconds" shutdown-timeout))
(.setStopTimeout s shutdown-timeout))
(when-let [script (:post-config-script options)]
(config/execute-post-config-script! s script))
(assoc webserver-context :server s))))
(schema/defn ^:always-validate start-webserver! :- ServerContext
"Creates and starts a webserver. Returns an updated context map containing
the Server object."
[webserver-context :- ServerContext
config :- config/WebserverRawConfig]
(let [webserver-context (create-webserver webserver-context config)]
(log/info (i18n/trs "Starting web server."))
(try
(.start (:server webserver-context))
(catch Exception e
(log/error e (i18n/trs "Encountered error starting web server, so shutting down"))
(shutdown webserver-context)
(throw e)))
webserver-context))
(schema/defn ^:always-validate
add-context-handler :- ContextHandler
"Add a static content context handler (allow for customization of the context handler through javax.servlet.ServletContextListener implementations)"
([webserver-context base-path context-path]
(add-context-handler webserver-context base-path context-path nil {:follow-links? false
:enable-trailing-slash-redirect? false}))
([webserver-context :- ServerContext
base-path :- schema/Str
context-path :- schema/Str
context-listeners :- (schema/maybe [ServletContextListener])
options]
(let [handler (ServletContextHandler. nil context-path ServletContextHandler/NO_SESSIONS)
follow-links? (:follow-links? options)
enable-trailing-slash-redirect? (:enable-trailing-slash-redirect? options)
normalize-request-uri? (:normalize-request-uri? options)]
(.setBaseResource handler (Resource/newResource ^String base-path))
(if follow-links?
(.setAliasChecks handler (list (SymlinkAllowedResourceAliasChecker. handler)))
(.clearAliasChecks handler))
;; register servlet context listeners (if any)
(when-not (nil? context-listeners)
(dorun (map #(.addEventListener handler %) context-listeners)))
(.addServlet handler (ServletHolder. (DefaultServlet.)) "/")
(when normalize-request-uri?
(normalized-uri-helpers/add-normalized-uri-filter-to-servlet-handler!
handler))
(add-handler webserver-context handler enable-trailing-slash-redirect?))))
(schema/defn ^:always-validate
add-ring-handler :- ContextHandler
[webserver-context :- ServerContext
handler :- (schema/pred ifn? 'ifn?)
path :- schema/Str
enable-trailing-slash-redirect? :- schema/Bool
normalize-request-uri? :- schema/Bool]
(let [handler
(normalized-uri-helpers/handler-maybe-wrapped-with-normalized-uri
(ring-handler handler)
normalize-request-uri?)
path (if (= "" path) "/" path)
ctxt-handler (doto (ContextHandler. path)
(.setHandler handler))]
(add-handler webserver-context ctxt-handler enable-trailing-slash-redirect?)))
(schema/defn ^:always-validate
add-websocket-handler :- ContextHandler
[webserver-context :- ServerContext
handlers :- websockets/WebsocketHandlers
path :- schema/Str
enable-trailing-slash-redirect? :- schema/Bool
normalize-request-uri? :- schema/Bool]
(let [servlet (websockets/JettyWebSocketServletInstance handlers)
ctxt-handler (doto (ServletContextHandler. ServletContextHandler/SESSIONS)
(.setContextPath path)
(.setServer (:server webserver-context)))
holder (ServletHolder. servlet)]
(JettyWebSocketServletContainerInitializer/configure ctxt-handler nil)
(.addServlet ctxt-handler holder "/*")
(when normalize-request-uri?
(normalized-uri-helpers/add-normalized-uri-filter-to-servlet-handler!
ctxt-handler))
(add-handler webserver-context ctxt-handler enable-trailing-slash-redirect?)))
(schema/defn ^:always-validate
add-servlet-handler :- ContextHandler
[webserver-context :- ServerContext
servlet :- Servlet
path :- schema/Str
servlet-init-params :- {schema/Any schema/Any}
enable-trailing-slash-redirect? :- schema/Bool
normalize-request-uri? :- schema/Bool]
(let [holder (doto (ServletHolder. servlet)
(.setInitParameters servlet-init-params))
handler (doto (ServletContextHandler. ServletContextHandler/SESSIONS)
(.setContextPath path)
(.addServlet holder "/*"))]
(when normalize-request-uri?
(normalized-uri-helpers/add-normalized-uri-filter-to-servlet-handler!
handler))
(add-handler webserver-context handler enable-trailing-slash-redirect?)))
(schema/defn ^:always-validate
add-war-handler :- ContextHandler
"Registers a WAR to Jetty. It takes two arguments: `[war path]`.
- `war` is the file path or the URL to a WAR file
- `path` is the URL prefix at which the WAR will be registered"
[webserver-context :- ServerContext
war :- schema/Str
path :- schema/Str
disable-redirects-no-slash? :- schema/Bool
normalize-request-uri? :- schema/Bool]
(let [handler (doto (WebAppContext.)
(.setContextPath path)
(.setWar war))]
(when normalize-request-uri?
(normalized-uri-helpers/add-normalized-uri-filter-to-servlet-handler!
handler))
(add-handler webserver-context handler disable-redirects-no-slash?)))
(schema/defn ^:always-validate
add-proxy-route
"Configures the Jetty server to proxy a given URL path to another host.
`target` should be a map containing the keys :host, :port, and :path; where
:path specifies the URL prefix to proxy to on the target host.
`options` may contain the keys :scheme (legal values are :orig, :http, and
:https), :ssl-config (value may be :use-server-config or a map containing
:ssl-ca-cert, :ssl-cert, and :ssl-key), :rewrite-uri-callback-fn (a function
taking two arguments, `[target-uri req]`, see README.md/#rewrite-uri-callback-fn),
:callback-fn (a function taking two arguments, `[proxy-req req]`, see
README.md/#callback-fn).
"
[webserver-context :- ServerContext
target :- ProxyTarget
path :- schema/Str
options :- ProxyOptions
disable-redirects-no-slash? :- schema/Bool]
(let [target (update-in target [:path] remove-leading-slash)]
;; This call hardcodes a value of 'false' for the 'normalize-request-uri?'
;; parameter because the ProxyServlet already has its own logic for
;; normalizing request URIs as it proxies them through. Applying an
;; extra layer of normalization in front of the ProxyServlet might otherwise
;; cause requests to be proxied to an unintended URI.
(add-servlet-handler webserver-context
(proxy-servlet webserver-context target options)
path
{}
disable-redirects-no-slash?
false)))
(schema/defn ^:always-validate
get-registered-endpoints :- RegisteredEndpoints
"Returns a map of registered endpoints for the given ServerContext.
Each endpoint is registered as a key in the map, with its value
being an array of maps, each representing a handler registered
at that endpoint. Each of these maps contains the type of the
handler under the :type key, and may contain additional information
as well.
When the value of :type is :context, the endpoint information will
be an instance of ContextEndpoint.
When the value of :type is :ring, the endpoint information will be
an instance of RingEndpoint.
When the value of :type is :servlet, the endpoint information will
be an instance of ServletEndpoint.
When the value of :type is :war, the endpoint information will be
an instance of WarEndpoint.
When the value of :type is :proxy, the endpoint information will be
an instance of ProxyEndpoint."
[webserver-context :- ServerContext]
(:endpoints @(:state webserver-context)))
(schema/defn ^:always-validate
override-webserver-settings! :- config/WebserverRawConfig
"Override the settings in the webserver section of the service's config file
with the set of options in the supplied overrides map.
The map should contain a key/value pair for each setting to be overridden.
The name of the setting to override should be expressed as a Clojure keyword.
For any setting expressed in the service config which is not overridden, the
setting value from the config will be used.
For example, the webserver config may contain:
[webserver]
ssl-host = 0.0.0.0
ssl-port = 9001
ssl-cert = mycert.pem
ssl-key = mykey.pem
ssl-ca-cert = myca.pem
The following overrides map may be supplied as an argument to the function:
{:ssl-port 9002
:ssl-cert \"myoverriddencert.pem\"
:ssl-key \"myoverriddenkey.pem\"}
The effective settings used during webserver startup will be:
{:ssl-host \"0.0.0.0\"
:ssl-port 9002
:ssl-cert \"myoverriddencert.pem\"
:ssl-key \"myoverriddenkey.pem\"
:ssl-ca-cert \"myca.pem\"}
The overridden webserver settings will be considered only at the point the
webserver is being started -- during the start lifecycle phase of the
webserver service. For this reason, a call to this function must be made
during a service's init lifecycle phase in order for the overridden
settings to be considered.
Only one call from a service may be made to this function during application
startup.
If a call is made to this function after webserver startup or after another
call has already been made to this function (e.g., from other service),
a java.lang.IllegalStateException will be thrown."
[webserver-context :- ServerContext
overrides :- config/WebserverRawConfig]
; Might be worth considering an implementation that only fails if the caller
; is trying to override a specific option that has been overridden already
; rather than blindly failing if an attempt is made to override any option.
; Could allow different services to override options that don't conflict with
; one another or for the same service to make multiple calls to this function
; for different settings. Hard to know, though, when one setting has an
; adverse effect on another without putting a bunch of key-specific semantic
; setting parsing in this implementation.
(:overrides
(swap! (:state webserver-context)
#(cond
(:overrides-read-by-webserver %)