Skip to content

Commit 6379fee

Browse files
DerGuteMoritzDerGuteMoritz
committed
Run all HTTP SSL tests against both HTTP versions, too
To that end, introduce a new `with-http-ssl-servers` macro which works like `with-http-servers` but with SSL enabled for both versions. It also sets `*use-tls* true` by default. This also fixes some tests which were passing `http1-ssl-server-options` to `with-http-servers`. This resulted in them running only against HTTP/1 (twice) because the `:ssl-context` of `with-http2-server` would get overridden.
1 parent 00a6e12 commit 6379fee

File tree

1 file changed

+80
-80
lines changed

1 file changed

+80
-80
lines changed

‎test/aleph/http_test.clj

Lines changed: 80 additions & 80 deletions
Original file line numberDiff line numberDiff line change
@@ -268,6 +268,15 @@
268268
(with-http2-server handler# server-options# ~@body)
269269
(with-http1-server handler# server-options# ~@body)))
270270

271+
(defmacro with-http-ssl-servers
272+
"Run the same body of tests for each HTTP version with SSL enabled"
273+
[handler server-options & body]
274+
`(with-redefs [*use-tls?* true]
275+
(let [handler# ~handler
276+
server-options# ~server-options]
277+
(with-http2-server handler# server-options# ~@body)
278+
(with-http1-server handler# (merge http1-ssl-server-options server-options#) ~@body))))
279+
271280
(defmacro with-handler [handler & body]
272281
`(with-http-servers ~handler {}
273282
~@body))
@@ -391,15 +400,14 @@
391400

392401

393402
(deftest test-ssl-response-formats
394-
(with-redefs [*use-tls?* true]
395-
(with-http-servers basic-handler http1-ssl-server-options
396-
(doseq [[path result] expected-results]
397-
(is
398-
(= result
399-
(bs/to-string
400-
(:body
401-
@(http-get (str "/" path)))))
402-
(str path "path failed"))))))
403+
(with-http-ssl-servers basic-handler {}
404+
(doseq [[path result] expected-results]
405+
(is
406+
(= result
407+
(bs/to-string
408+
(:body
409+
@(http-get (str "/" path)))))
410+
(str path "path failed")))))
403411

404412
(deftest test-files
405413
(with-handler echo-handler
@@ -413,96 +421,88 @@
413421
bs/to-string)))))
414422

415423
(deftest test-ssl-files
416-
(with-redefs [*use-tls?* true]
417-
(let [client-path "/"
418-
client-options {:connection-options {:ssl-context test-ssl/client-ssl-context}}
419-
client-pool (http/connection-pool client-options)]
420-
(with-http-servers echo-handler
421-
(merge http1-ssl-server-options {:ssl-context test-ssl/server-ssl-context})
422-
(is (str/blank?
423-
(-> @(http-put client-path
424-
{:body (io/file "test/empty.txt")
425-
:pool client-pool})
426-
:body
427-
bs/to-string)))
428-
(is (= (slurp "test/file.txt" :encoding "UTF-8")
429-
(-> @(http-put client-path
430-
{:body (io/file "test/file.txt")
431-
:pool client-pool})
432-
:body
433-
bs/to-string)))))))
424+
(let [client-path "/"
425+
client-options {:connection-options {:ssl-context test-ssl/client-ssl-context}}
426+
client-pool (http/connection-pool client-options)]
427+
(with-http-ssl-servers echo-handler {:ssl-context test-ssl/server-ssl-context}
428+
(is (str/blank?
429+
(-> @(http-put client-path
430+
{:body (io/file "test/empty.txt")
431+
:pool client-pool})
432+
:body
433+
bs/to-string)))
434+
(is (= (slurp "test/file.txt" :encoding "UTF-8")
435+
(-> @(http-put client-path
436+
{:body (io/file "test/file.txt")
437+
:pool client-pool})
438+
:body
439+
bs/to-string))))))
434440

435441
(defn ssl-session-capture-handler [ssl-session-atom]
436442
(fn [req]
437443
(reset! ssl-session-atom (http.core/ring-request-ssl-session req))
438444
{:status 200 :body "ok"}))
439445

440446
(deftest test-ssl-session-access
441-
(with-redefs [*use-tls?* true]
442-
(let [ssl-session (atom nil)]
443-
(with-http1-server
444-
(ssl-session-capture-handler ssl-session)
445-
http1-ssl-server-options
446-
(is (= 200 (:status @(http-get "/"))))
447-
(is (some? @ssl-session))
448-
(when-let [^SSLSession s @ssl-session]
449-
(is (.isValid s))
450-
(is (not (str/includes? "NULL" (.getCipherSuite s)))))))))
447+
(let [ssl-session (atom nil)]
448+
(with-http-ssl-servers (ssl-session-capture-handler ssl-session) {}
449+
(reset! ssl-session nil)
450+
(is (= 200 (:status @(http-get "/"))))
451+
(is (some? @ssl-session))
452+
(when-let [^SSLSession s @ssl-session]
453+
(is (.isValid s))
454+
(is (not (str/includes? "NULL" (.getCipherSuite s))))))))
451455

452456
(deftest test-ssl-with-plain-client-request
453-
(with-redefs [*use-tls?* false] ; intentionally wrong
454-
(let [ssl-session (atom nil)]
455-
(with-http1-server
456-
(ssl-session-capture-handler ssl-session)
457-
http1-ssl-server-options
458-
;; Note the intentionally wrong "http" scheme here
457+
(let [ssl-session (atom nil)]
458+
(with-http-ssl-servers (ssl-session-capture-handler ssl-session) {}
459+
(reset! ssl-session nil)
460+
(with-redefs [*use-tls?* false] ; will make http-get use http instead of https
459461
(is (some-> (http-get "/")
460462
(d/catch identity)
461463
deref
462464
ex-message
463-
(str/includes? "connection was closed")))
464-
(is (nil? @ssl-session))))))
465+
(str/includes? "connection was closed"))))
466+
(is (nil? @ssl-session)))))
465467

466468
(deftest test-ssl-endpoint-identification
467-
(with-redefs [*use-tls?* true] ; with-redefs for non-clj threads
468-
(binding [*connection-options* {:insecure? false
469-
:ssl-context test-ssl/wrong-hostname-client-ssl-context-opts}]
470-
(let [ssl-session (atom nil)]
471-
(with-http1-server
469+
(binding [*connection-options* {:insecure? false
470+
:ssl-context test-ssl/wrong-hostname-client-ssl-context-opts}]
471+
(let [ssl-session (atom nil)]
472+
(with-http-ssl-servers
472473
(ssl-session-capture-handler ssl-session)
473-
(assoc http-server-options :ssl-context test-ssl/wrong-hostname-server-ssl-context-opts)
474-
475-
(try
476-
@(http-get "/")
477-
(is (= true false) "Should have thrown an exception")
478-
479-
(catch Exception e
480-
(is (= SSLHandshakeException
481-
(class e)))
482-
483-
;; Should have a hostname mismatch cause in the ex chain
484-
(is (loop [^Exception ex e]
485-
(if ex
486-
(if (re-find #"(?i:No name matching localhost found)"
487-
(.getMessage ex))
488-
true
489-
(recur (.getCause ex)))
490-
false))
491-
"No hostname mismatch cause found in exception chain")))
492-
(is (nil? @ssl-session)))))))
474+
{:ssl-context test-ssl/wrong-hostname-server-ssl-context-opts}
475+
(reset! ssl-session nil)
476+
(try
477+
@(http-get "/")
478+
(is (= true false) "Should have thrown an exception")
479+
480+
(catch Exception e
481+
(is (= SSLHandshakeException
482+
(class e)))
483+
484+
;; Should have a hostname mismatch cause in the ex chain
485+
(is (loop [^Exception ex e]
486+
(if ex
487+
(if (re-find #"(?i:No name matching localhost found)"
488+
(.getMessage ex))
489+
true
490+
(recur (.getCause ex)))
491+
false))
492+
"No hostname mismatch cause found in exception chain")))
493+
(is (nil? @ssl-session))))))
493494

494495
(deftest test-disabling-ssl-endpoint-identification
495-
(with-redefs [*use-tls?* true] ; with-redefs for non-clj threads
496-
(binding [*connection-options* {:insecure? false
497-
:ssl-context test-ssl/wrong-hostname-client-ssl-context-opts
498-
:ssl-endpoint-id-alg nil}]
499-
(let [ssl-session (atom nil)]
500-
(with-http1-server
496+
(binding [*connection-options* {:insecure? false
497+
:ssl-context test-ssl/wrong-hostname-client-ssl-context-opts
498+
:ssl-endpoint-id-alg nil}]
499+
(let [ssl-session (atom nil)]
500+
(with-http-ssl-servers
501501
(ssl-session-capture-handler ssl-session)
502-
(assoc http-server-options :ssl-context test-ssl/wrong-hostname-server-ssl-context-opts)
503-
504-
(is (= 200 (:status @(http-get "/"))))
505-
(is (some? @ssl-session)))))))
502+
{:ssl-context test-ssl/wrong-hostname-server-ssl-context-opts}
503+
(reset! ssl-session nil)
504+
(is (= 200 (:status @(http-get "/"))))
505+
(is (some? @ssl-session))))))
506506

507507
(deftest test-invalid-body
508508
(let [client-url "/"]

0 commit comments

Comments
 (0)