proxy-middleware.clj

(defn lowercase-keys
  [m]
  (into {} (for [[k v] m]
               [(.toLowerCase k) v])))

(defn remove-hop-by-hop-headers
  "Removes hop-by-hop headers from a ring request/response map.
Assumes header keys are lowercase strings.

See:
  http://www.mnot.net/blog/2011/07/11/what_proxies_must_do
  http://tools.ietf.org/html/draft-ietf-httpbis-p1-messaging-14#section-7.1.3"
  [req-or-res]
  (let [headers-to-remove (set (concat ["connection" "keep-alive" "proxy-authenticate" "proxy-authorization"
                                        "te" "trailer" "transfer-encoding" "upgrade"]
                                       (map #(.toLowerCase %)
                                            (str/split (get-in req-or-res [:headers "connection"] "")
                                                       #"\s*,\s*"))))]
    (-> req-or-res
        (update-in [:headers] (fn [headers]
                                (reduce-kv (fn [m k v]
                                             (if (headers-to-remove k)
                                               m
                                               (assoc m k v)))
                                           {} headers))))))

(defn proxy-non-localhost
  "Middleware that proxies any requests where server name isn't localhost.
Proxy response maps passed through optional rewriter fn."
  ([app] (proxy-non-localhost identity))
  ([app rewriter]
     (fn [req]
       (if (= "localhost" (:server-name req))
         (app req)
         (let [{:keys [scheme server-name server-port uri request-method headers body]} req
               res (http/request {:method (:request-method req)
                                  :url (str (name (or scheme :http)) "://" server-name ":" server-port uri)
                                  :headers (dissoc (:headers req)
                                                   "content-length"
                                                   "if-modified-since")
                                  :body (if (instance? java.io.InputStream body)
                                          (slurp body)
                                          body)
                                  :follow-redirects false
                                  :throw-exceptions false
                                  :decompress-body true
                                  :as :stream})]
           ;; (prn req)
           ;; (prn res)
           ;; (println "\n\n")
           (-> res
               (update-in [:headers] lowercase-keys)
               (update-in [:headers] dissoc "server" "date") ;;don't duplicate server or date headers

               (update-in [:headers] (fn [headers]
                                       (if-let [ct (get headers "content-type")]
                                         (assoc headers "content-type"
                                                (str ct ";charset=utf-8"))
                                         headers)))
               (update-in [:headers] assoc
                          "cache-control" "private, max-age=0, must-revalidate"
                          "pragma" "no-cache"
                          "expires" "0")
               remove-hop-by-hop-headers
               rewriter))))))