|
| 1 | +(ns ring.util.jakarta.servlet |
| 2 | + "Compatibility functions for turning a ring handler into a Java servlet." |
| 3 | + (:require [clojure.string :as string] |
| 4 | + [ring.core.protocols :as protocols]) |
| 5 | + (:import [java.util Locale] |
| 6 | + [jakarta.servlet AsyncContext] |
| 7 | + [jakarta.servlet.http |
| 8 | + HttpServlet |
| 9 | + HttpServletRequest |
| 10 | + HttpServletResponse])) |
| 11 | + |
| 12 | +(defn- get-headers [^HttpServletRequest request] |
| 13 | + (reduce |
| 14 | + (fn [headers ^String name] |
| 15 | + (assoc headers |
| 16 | + (.toLowerCase name Locale/ENGLISH) |
| 17 | + (->> (.getHeaders request name) |
| 18 | + (enumeration-seq) |
| 19 | + (string/join ",")))) |
| 20 | + {} |
| 21 | + (enumeration-seq (.getHeaderNames request)))) |
| 22 | + |
| 23 | +(defn- get-content-length [^HttpServletRequest request] |
| 24 | + (let [length (.getContentLength request)] |
| 25 | + (when (>= length 0) length))) |
| 26 | + |
| 27 | +(defn- get-client-cert [^HttpServletRequest request] |
| 28 | + (first (.getAttribute request "jakarta.servlet.request.X509Certificate"))) |
| 29 | + |
| 30 | +(defn build-request-map |
| 31 | + "Create the request map from the HttpServletRequest object." |
| 32 | + [^HttpServletRequest request] |
| 33 | + {:server-port (.getServerPort request) |
| 34 | + :server-name (.getServerName request) |
| 35 | + :remote-addr (.getRemoteAddr request) |
| 36 | + :uri (.getRequestURI request) |
| 37 | + :query-string (.getQueryString request) |
| 38 | + :scheme (keyword (.getScheme request)) |
| 39 | + :request-method (keyword (.toLowerCase (.getMethod request) Locale/ENGLISH)) |
| 40 | + :protocol (.getProtocol request) |
| 41 | + :headers (get-headers request) |
| 42 | + :content-type (.getContentType request) |
| 43 | + :content-length (get-content-length request) |
| 44 | + :character-encoding (.getCharacterEncoding request) |
| 45 | + :ssl-client-cert (get-client-cert request) |
| 46 | + :body (.getInputStream request)}) |
| 47 | + |
| 48 | +(defn merge-servlet-keys |
| 49 | + "Associate servlet-specific keys with the request map for use with legacy |
| 50 | + systems." |
| 51 | + [request-map |
| 52 | + ^HttpServlet servlet |
| 53 | + ^HttpServletRequest request |
| 54 | + ^HttpServletResponse response] |
| 55 | + (merge request-map |
| 56 | + {:servlet servlet |
| 57 | + :servlet-request request |
| 58 | + :servlet-response response |
| 59 | + :servlet-context (.getServletContext servlet) |
| 60 | + :servlet-context-path (.getContextPath request)})) |
| 61 | + |
| 62 | +(defn- set-headers [^HttpServletResponse response, headers] |
| 63 | + (doseq [[key val-or-vals] headers] |
| 64 | + (if (string? val-or-vals) |
| 65 | + (.setHeader response key val-or-vals) |
| 66 | + (doseq [val val-or-vals] |
| 67 | + (.addHeader response key val)))) |
| 68 | + ; Some headers must be set through specific methods |
| 69 | + (when-let [content-type (get headers "Content-Type")] |
| 70 | + (.setContentType response content-type))) |
| 71 | + |
| 72 | +(defn- make-output-stream |
| 73 | + [^HttpServletResponse response ^AsyncContext context] |
| 74 | + (let [os (.getOutputStream response)] |
| 75 | + (if (nil? context) |
| 76 | + os |
| 77 | + (proxy [java.io.FilterOutputStream] [os] |
| 78 | + (write |
| 79 | + ([b] (.write os b)) |
| 80 | + ([b off len] (.write os b off len))) |
| 81 | + (close [] |
| 82 | + (.close os) |
| 83 | + (.complete context)))))) |
| 84 | + |
| 85 | +(defn update-servlet-response |
| 86 | + "Update the HttpServletResponse using a response map. Takes an optional |
| 87 | + AsyncContext." |
| 88 | + ([response response-map] |
| 89 | + (update-servlet-response response nil response-map)) |
| 90 | + ([^HttpServletResponse response context response-map] |
| 91 | + (let [{:keys [status headers body]} response-map] |
| 92 | + (when (nil? response) |
| 93 | + (throw (NullPointerException. "HttpServletResponse is nil"))) |
| 94 | + (when (nil? response-map) |
| 95 | + (throw (NullPointerException. "Response map is nil"))) |
| 96 | + (when status |
| 97 | + (.setStatus response status)) |
| 98 | + (set-headers response headers) |
| 99 | + (let [output-stream (make-output-stream response context)] |
| 100 | + (protocols/write-body-to-stream body response-map output-stream))))) |
| 101 | + |
| 102 | +(defn- make-blocking-service-method [handler] |
| 103 | + (fn [servlet request response] |
| 104 | + (-> request |
| 105 | + (build-request-map) |
| 106 | + (merge-servlet-keys servlet request response) |
| 107 | + (handler) |
| 108 | + (->> (update-servlet-response response))))) |
| 109 | + |
| 110 | +(defn- make-async-service-method [handler] |
| 111 | + (fn [servlet ^HttpServletRequest request ^HttpServletResponse response] |
| 112 | + (let [^AsyncContext context (.startAsync request)] |
| 113 | + (handler |
| 114 | + (-> request |
| 115 | + (build-request-map) |
| 116 | + (merge-servlet-keys servlet request response)) |
| 117 | + (fn [response-map] |
| 118 | + (update-servlet-response response context response-map)) |
| 119 | + (fn [^Throwable exception] |
| 120 | + (.sendError response 500 (.getMessage exception)) |
| 121 | + (.complete context)))))) |
| 122 | + |
| 123 | +(defn make-service-method |
| 124 | + "Turns a handler into a function that takes the same arguments and has the |
| 125 | + same return value as the service method in the HttpServlet class." |
| 126 | + ([handler] |
| 127 | + (make-service-method handler {})) |
| 128 | + ([handler options] |
| 129 | + (if (:async? options) |
| 130 | + (make-async-service-method handler) |
| 131 | + (make-blocking-service-method handler)))) |
| 132 | + |
| 133 | +(defn servlet |
| 134 | + "Create a servlet from a Ring handler." |
| 135 | + ([handler] |
| 136 | + (servlet handler {})) |
| 137 | + ([handler options] |
| 138 | + (let [service-method (make-service-method handler options)] |
| 139 | + (proxy [HttpServlet] [] |
| 140 | + (service [request response] |
| 141 | + (service-method this request response)))))) |
| 142 | + |
| 143 | +(defmacro defservice |
| 144 | + "Defines a service method with an optional prefix suitable for being used by |
| 145 | + genclass to compile a HttpServlet class. |
| 146 | +
|
| 147 | + For example: |
| 148 | +
|
| 149 | + (defservice my-handler) |
| 150 | + (defservice \"my-prefix-\" my-handler)" |
| 151 | + ([handler] |
| 152 | + `(defservice "-" ~handler)) |
| 153 | + ([prefix handler] |
| 154 | + (if (map? handler) |
| 155 | + `(defservice "-" ~prefix ~handler) |
| 156 | + `(defservice ~prefix ~handler {}))) |
| 157 | + ([prefix handler options] |
| 158 | + `(let [service-method# (make-service-method ~handler ~options)] |
| 159 | + (defn ~(symbol (str prefix "service")) |
| 160 | + [servlet# request# response#] |
| 161 | + (service-method# servlet# request# response#))))) |
0 commit comments