Run all HTTP SSL tests against both HTTP versions, too

src/aleph/http/core.clj

@@ -242,8 +242,10 @@
   :server-name (netty/channel-server-name ch)
   :server-port (netty/channel-server-port ch)
   :remote-addr (netty/channel-remote-address ch)
-  :aleph/request-arrived request-arrived
-  :protocol "HTTP/1.1")
+  :protocol "HTTP/1.1"
+  ;; These keys are internal to Aleph and should not be relied on
+  :aleph/channel ch
+  :aleph/request-arrived request-arrived)
 
 (p/def-derived-map NettyResponse [^HttpResponse rsp destroy-conn? body]
   :status (-> rsp .status .code)
@@ -267,8 +269,8 @@
   [rsp destroy-conn? body]
   (->NettyResponse rsp destroy-conn? body))
 
-(defn ring-request-ssl-session [^NettyRequest req]
-  (netty/channel-ssl-session (.ch req)))
+(defn ring-request-ssl-session [req]
+  (netty/channel-ssl-session (:aleph/channel req)))
 
 ;;;
 

src/aleph/http/http2.clj

@@ -822,6 +822,8 @@
 
      :protocol              "HTTP/2.0"
 
+     ;; These keys are internal to Aleph and should not be relied on
+     :aleph/channel         ch
      :aleph/writable?       writable?
      :aleph/h2-exception    h2-exception
      :aleph/keep-alive?     true                            ; not applicable to HTTP/2, but here for compatibility

src/aleph/netty.clj

@@ -1190,11 +1190,14 @@
   (partial coerce-ssl-context ssl-client-context))
 
 (defn ^:no-doc channel-ssl-session [^Channel ch]
-  (some-> ch
-          ^ChannelPipeline (.pipeline)
-          ^SslHandler (.get SslHandler)
-          .engine
-          .getSession))
+  (when ch
+    (or (some-> ch
+                ^ChannelPipeline (.pipeline)
+                ^SslHandler (.get SslHandler)
+                .engine
+                .getSession)
+        ;; Needed for multiplexed child channels (e.g. as present in HTTP/2)
+        (recur (.parent ch)))))
 
 (defn ^:no-doc ssl-handshake-error? [^Throwable ex]
   (and (instance? DecoderException ex)

test/aleph/http_test.clj

@@ -61,7 +61,7 @@
 (def ^:dynamic ^IPool *pool* nil)
 (def ^:dynamic *connection-options* nil)
 (def ^:dynamic ^String *response* nil)
-(def ^:dynamic *use-tls?* false)
+(def ^:dynamic *use-tls-requests* false)
 
 
 (def port 8082)
@@ -73,7 +73,7 @@
 
 (defn- make-url
   [path]
-  (if *use-tls?*
+  (if *use-tls-requests*
     (str "https://localhost:" port path)
     (str "http://localhost:" port path)))
 
@@ -170,7 +170,7 @@
     (if (zero? count)
       {:status 200 :body "ok"}
       {:status  302
-       :headers {"location" (str (if *use-tls?* "https://" "http://")
+       :headers {"location" (str (if *use-tls-requests* "https://" "http://")
                                  "localhost:" port
                                  "/redirect?count=" (dec count))}
        :body    "redirected!"})))
@@ -256,7 +256,7 @@
   [handler server-options & body]
   ;; with-redefs used so clj fns running on netty threads will work
   `(testing "- http2"
-     (with-redefs [*use-tls?* true]
+     (with-redefs [*use-tls-requests* true]
        (with-server (http/start-server ~handler (merge http2-server-options ~server-options))
          ~@body))))
 
@@ -268,6 +268,15 @@
      (with-http2-server handler# server-options# ~@body)
      (with-http1-server handler# server-options# ~@body)))
 
+(defmacro with-http-ssl-servers
+  "Run the same body of tests for each HTTP version with SSL enabled"
+  [handler server-options & body]
+  `(with-redefs [*use-tls-requests* true]
+     (let [handler# ~handler
+           server-options# ~server-options]
+       (with-http2-server handler# server-options# ~@body)
+       (with-http1-server handler# (merge http1-ssl-server-options server-options#) ~@body))))
+
 (defmacro with-handler [handler & body]
   `(with-http-servers ~handler {}
      ~@body))
@@ -391,15 +400,14 @@
 
 
 (deftest test-ssl-response-formats
-  (with-redefs [*use-tls?* true]
-    (with-http-servers basic-handler http1-ssl-server-options
-      (doseq [[path result] expected-results]
-        (is
-          (= result
-             (bs/to-string
-               (:body
-                 @(http-get (str "/" path)))))
-          (str path "path failed"))))))
+  (with-http-ssl-servers basic-handler {}
+    (doseq [[path result] expected-results]
+      (is
+       (= result
+          (bs/to-string
+           (:body
+            @(http-get (str "/" path)))))
+       (str path "path failed")))))
 
 (deftest test-files
   (with-handler echo-handler
@@ -413,96 +421,88 @@
                bs/to-string)))))
 
 (deftest test-ssl-files
-  (with-redefs [*use-tls?* true]
-    (let [client-path "/"
-          client-options {:connection-options {:ssl-context test-ssl/client-ssl-context}}
-          client-pool (http/connection-pool client-options)]
-      (with-http-servers echo-handler
-        (merge http1-ssl-server-options {:ssl-context test-ssl/server-ssl-context})
-        (is (str/blank?
-              (-> @(http-put client-path
-                             {:body (io/file "test/empty.txt")
-                              :pool client-pool})
-                  :body
-                  bs/to-string)))
-        (is (= (slurp "test/file.txt" :encoding "UTF-8")
-               (-> @(http-put client-path
-                              {:body (io/file "test/file.txt")
-                               :pool client-pool})
-                   :body
-                   bs/to-string)))))))
+  (let [client-path "/"
+        client-options {:connection-options {:ssl-context test-ssl/client-ssl-context}}
+        client-pool (http/connection-pool client-options)]
+    (with-http-ssl-servers echo-handler {:ssl-context test-ssl/server-ssl-context}
+      (is (str/blank?
+           (-> @(http-put client-path
+                          {:body (io/file "test/empty.txt")
+                           :pool client-pool})
+               :body
+               bs/to-string)))
+      (is (= (slurp "test/file.txt" :encoding "UTF-8")
+             (-> @(http-put client-path
+                            {:body (io/file "test/file.txt")
+                             :pool client-pool})
+                 :body
+                 bs/to-string))))))
 
 (defn ssl-session-capture-handler [ssl-session-atom]
   (fn [req]
     (reset! ssl-session-atom (http.core/ring-request-ssl-session req))
     {:status 200 :body "ok"}))
 
 (deftest test-ssl-session-access
-  (with-redefs [*use-tls?* true]
-    (let [ssl-session (atom nil)]
-      (with-http1-server
-          (ssl-session-capture-handler ssl-session)
-          http1-ssl-server-options
-        (is (= 200 (:status @(http-get "/"))))
-        (is (some? @ssl-session))
-        (when-let [^SSLSession s @ssl-session]
-          (is (.isValid s))
-          (is (not (str/includes? "NULL" (.getCipherSuite s)))))))))
+  (let [ssl-session (atom nil)]
+    (with-http-ssl-servers (ssl-session-capture-handler ssl-session) {}
+      (reset! ssl-session nil)
+      (is (= 200 (:status @(http-get "/"))))
+      (is (some? @ssl-session))
+      (when-let [^SSLSession s @ssl-session]
+        (is (.isValid s))
+        (is (not (str/includes? "NULL" (.getCipherSuite s))))))))
 
 (deftest test-ssl-with-plain-client-request
-  (with-redefs [*use-tls?* false]                           ; intentionally wrong
-    (let [ssl-session (atom nil)]
-      (with-http1-server
-        (ssl-session-capture-handler ssl-session)
-        http1-ssl-server-options
-        ;; Note the intentionally wrong "http" scheme here
+  (let [ssl-session (atom nil)]
+    (with-http-ssl-servers (ssl-session-capture-handler ssl-session) {}
+      (reset! ssl-session nil)
+      (with-redefs [*use-tls-requests* false] ; will make http-get use http instead of https
         (is (some-> (http-get "/")
                     (d/catch identity)
                     deref
                     ex-message
-                    (str/includes? "connection was closed")))
-        (is (nil? @ssl-session))))))
+                    (str/includes? "connection was closed"))))
+      (is (nil? @ssl-session)))))
 
 (deftest test-ssl-endpoint-identification
-  (with-redefs [*use-tls?* true]                            ; with-redefs for non-clj threads
-    (binding [*connection-options* {:insecure?   false
-                                    :ssl-context test-ssl/wrong-hostname-client-ssl-context-opts}]
-      (let [ssl-session (atom nil)]
-        (with-http1-server
+  (binding [*connection-options* {:insecure?   false
+                                  :ssl-context test-ssl/wrong-hostname-client-ssl-context-opts}]
+    (let [ssl-session (atom nil)]
+      (with-http-ssl-servers
           (ssl-session-capture-handler ssl-session)
-          (assoc http-server-options :ssl-context test-ssl/wrong-hostname-server-ssl-context-opts)
-
-          (try
-            @(http-get "/")
-            (is (= true false) "Should have thrown an exception")
-
-            (catch Exception e
-              (is (= SSLHandshakeException
-                     (class e)))
-
-              ;; Should have a hostname mismatch cause in the ex chain
-              (is (loop [^Exception ex e]
-                    (if ex
-                      (if (re-find #"(?i:No name matching localhost found)"
-                                   (.getMessage ex))
-                        true
-                        (recur (.getCause ex)))
-                      false))
-                  "No hostname mismatch cause found in exception chain")))
-          (is (nil? @ssl-session)))))))
+          {:ssl-context test-ssl/wrong-hostname-server-ssl-context-opts}
+        (reset! ssl-session nil)
+        (try
+          @(http-get "/")
+          (is (= true false) "Should have thrown an exception")
+
+          (catch Exception e
+            (is (= SSLHandshakeException
+                   (class e)))
+
+            ;; Should have a hostname mismatch cause in the ex chain
+            (is (loop [^Exception ex e]
+                  (if ex
+                    (if (re-find #"(?i:No name matching localhost found)"
+                                 (.getMessage ex))
+                      true
+                      (recur (.getCause ex)))
+                    false))
+                "No hostname mismatch cause found in exception chain")))
+        (is (nil? @ssl-session))))))
 
 (deftest test-disabling-ssl-endpoint-identification
-  (with-redefs [*use-tls?* true]                            ; with-redefs for non-clj threads
-    (binding [*connection-options* {:insecure?           false
-                                    :ssl-context         test-ssl/wrong-hostname-client-ssl-context-opts
-                                    :ssl-endpoint-id-alg nil}]
-      (let [ssl-session (atom nil)]
-        (with-http1-server
+  (binding [*connection-options* {:insecure?           false
+                                  :ssl-context         test-ssl/wrong-hostname-client-ssl-context-opts
+                                  :ssl-endpoint-id-alg nil}]
+    (let [ssl-session (atom nil)]
+      (with-http-ssl-servers
           (ssl-session-capture-handler ssl-session)
-          (assoc http-server-options :ssl-context test-ssl/wrong-hostname-server-ssl-context-opts)
-
-          (is (= 200 (:status @(http-get "/"))))
-          (is (some? @ssl-session)))))))
+          {:ssl-context test-ssl/wrong-hostname-server-ssl-context-opts}
+        (reset! ssl-session nil)
+        (is (= 200 (:status @(http-get "/"))))
+        (is (some? @ssl-session))))))
 
 (deftest test-invalid-body
   (let [client-url "/"]
@@ -642,7 +642,7 @@
 (deftest test-explicit-url
   (with-handler hello-handler
     (is (= "hello" (-> @(http/request {:method          :get
-                                       :scheme          (if *use-tls?* :https :http)
+                                       :scheme          (if *use-tls-requests* :https :http)
                                        :server-name     "localhost"
                                        :server-port     port
                                        :request-timeout 1e3