diff --git a/ring-devel/src/ring/middleware/stacktrace.clj b/ring-devel/src/ring/middleware/stacktrace.clj index 63a8f535..b9a3bb22 100644 --- a/ring-devel/src/ring/middleware/stacktrace.clj +++ b/ring-devel/src/ring/middleware/stacktrace.clj @@ -5,49 +5,80 @@ This middleware is for debugging purposes, and should be limited to development environments." (:require [clojure.java.io :as io] + [clojure.string :as str] [hiccup.core :refer [html h]] [hiccup.page :refer [html5]] [clj-stacktrace.core :refer :all] [clj-stacktrace.repl :refer :all] [ring.util.response :refer [content-type response status]])) +(defn- swap-trace-elems + "Recursively replace :trace-elems with :trimmed-elems" + [exception] + (let [trimmed (or (:trimmed-elems exception) '()) + cause (:cause exception)] + (if cause + (assoc exception + :cause (swap-trace-elems cause) + :trace-elems trimmed) + (assoc exception :trace-elems trimmed)))) + +(defn- trim-error-elems [ex trimmed?] + (if trimmed? + (swap-trace-elems (parse-exception ex)) + (parse-exception ex))) + (defn wrap-stacktrace-log "Wrap a handler such that exceptions are logged to *err* and then rethrown. Accepts the following options: - :color? - if true, apply ANSI colors to stacktrace (default false)" + :color? - if true, apply ANSI colors to stacktrace (default false) + :trimmed? - if true, use trimmed-elems (default false)" ([handler] (wrap-stacktrace-log handler {})) ([handler options] - (let [color? (:color? options)] + (let [{:keys [color? trimmed?]} options] (fn ([request] (try (handler request) (catch Throwable ex - (pst-on *err* color? ex) + (pst-on *err* color? (trim-error-elems ex trimmed?)) (throw ex)))) ([request respond raise] (try - (handler request respond (fn [ex] (pst-on *err* color? ex) (raise ex))) + (handler request + respond + (fn [ex] + (pst-on *err* + color? + (trim-error-elems ex trimmed?)) + (raise ex))) (catch Throwable ex - (pst-on *err* color? ex) + (pst-on *err* color? (trim-error-elems ex trimmed?)) (throw ex)))))))) (defn- style-resource [path] (html [:style {:type "text/css"} (slurp (io/resource path))])) -(defn- elem-partial [elem] +(defn- color-style + "Returns a style tag with the color appropriate for the given trace elem. + Cyan is replaced with black for readability on the light background." + [elem] + {:style + {:color (str/replace (name (elem-color elem)) "cyan" "black")}}) + +(defn- elem-partial [elem color?] (if (:clojure elem) - [:tr.clojure + [:tr.clojure (when color? (color-style elem)) [:td.source (h (source-str elem))] [:td.method (h (clojure-method-str elem))]] - [:tr.java + [:tr.java (when color? (color-style elem)) [:td.source (h (source-str elem))] [:td.method (h (java-method-str elem))]])) -(defn- html-exception [ex] - (let [[ex & causes] (iterate :cause (parse-exception ex))] +(defn- html-exception [ex color? trimmed?] + (let [[ex & causes] (iterate :cause (trim-error-elems ex trimmed?))] (html5 [:head [:title "Ring: Stacktrace"] @@ -56,24 +87,26 @@ [:div#exception [:h1 (h (.getName ^Class (:class ex)))] [:div.message (h (:message ex))] + (when (pos? (count (:trace-elems ex))) [:div.trace [:table - [:tbody (map elem-partial (:trace-elems ex))]]] + [:tbody (map #(elem-partial % color?) (:trace-elems ex))]]]) (for [cause causes :while cause] [:div#causes [:h2 "Caused by " [:span.class (h (.getName ^Class (:class cause)))]] [:div.message (h (:message cause))] [:div.trace [:table - [:tbody (map elem-partial (:trace-elems cause))]]]])]]))) + [:tbody + (map #(elem-partial % color?) (:trace-elems cause))]]]])]]))) (defn- text-ex-response [e] (-> (response (with-out-str (pst e))) (status 500) (content-type "text/plain"))) -(defn- html-ex-response [ex] - (-> (response (html-exception ex)) +(defn- html-ex-response [ex color? trimmed?] + (-> (response (html-exception ex color? trimmed?)) (status 500) (content-type "text/html"))) @@ -82,27 +115,38 @@ Renders HTML if that's in the accept header (indicating that the URL was opened in a browser), but defaults to plain text." - [req ex] + [req ex color? trimmed?] (let [accept (get-in req [:headers "accept"])] (if (and accept (re-find #"^text/html" accept)) - (html-ex-response ex) + (html-ex-response ex color? trimmed?) (text-ex-response ex)))) (defn wrap-stacktrace-web "Wrap a handler such that exceptions are caught and a response containing - a HTML representation of the exception and stacktrace is returned." - [handler] - (fn - ([request] - (try - (handler request) - (catch Throwable ex - (ex-response request ex)))) - ([request respond raise] - (try - (handler request respond (fn [ex] (respond (ex-response request ex)))) - (catch Throwable ex - (respond (ex-response request ex))))))) + a HTML representation of the exception and stacktrace is returned. + + Accepts the following option: + + :color? - if true, apply ANSI colors to HTML stacktrace (default false) + :trimmed? - if true, use the trimmed-elems (default false)" + ([handler] + (wrap-stacktrace-web handler {})) + ([handler options] + (let [{:keys [color? trimmed?]} options] + (fn + ([request] + (try + (handler request) + (catch Throwable ex + (ex-response request ex color? trimmed?)))) + ([request respond raise] + (try + (handler request + respond + (fn [ex] + (respond (ex-response request ex color? trimmed?)))) + (catch Throwable ex + (respond (ex-response request ex color? trimmed?))))))))) (defn wrap-stacktrace "Wrap a handler such that exceptions are caught, a corresponding stacktrace is @@ -111,11 +155,12 @@ Accepts the following option: - :color? - if true, apply ANSI colors to terminal stacktrace (default false)" + :color? - if true, apply ANSI colors to stacktrace (default false) + :trimmed? - if true, use the trimmed-elems (default false)" {:arglists '([handler] [handler options])} ([handler] (wrap-stacktrace handler {})) ([handler options] (-> handler (wrap-stacktrace-log options) - (wrap-stacktrace-web)))) + (wrap-stacktrace-web options)))) diff --git a/ring-devel/test/ring/middleware/test/stacktrace.clj b/ring-devel/test/ring/middleware/test/stacktrace.clj index 5dc21dea..c8e9698e 100644 --- a/ring-devel/test/ring/middleware/test/stacktrace.clj +++ b/ring-devel/test/ring/middleware/test/stacktrace.clj @@ -31,29 +31,39 @@ (is (or (.startsWith body "java.lang.Exception") (.startsWith body "java.lang.AssertionError")))))))) +(def default-params {}) +(def non-default-params {:color? true :trimmed? true}) + (deftest wrap-stacktrace-cps-test - (testing "no exception" - (let [handler (wrap-stacktrace (fn [_ respond _] (respond :ok))) - response (promise) - exception (promise)] - (handler {} response exception) - (is (= :ok @response)) - (is (not (realized? exception))))) - - (testing "thrown exception" - (let [handler (wrap-stacktrace (fn [_ _ _] (throw (Exception. "fail")))) - response (promise) - exception (promise)] - (binding [*err* (java.io.StringWriter.)] - (handler {} response exception)) - (is (= 500 (:status @response))) - (is (not (realized? exception))))) - - (testing "raised exception" - (let [handler (wrap-stacktrace (fn [_ _ raise] (raise (Exception. "fail")))) - response (promise) - exception (promise)] - (binding [*err* (java.io.StringWriter.)] - (handler {} response exception)) - (is (= 500 (:status @response))) - (is (not (realized? exception)))))) + (doseq [params [default-params non-default-params]] + (testing "no exception" + (let [handler (wrap-stacktrace (fn [_ respond _] + (respond :ok)) + params) + response (promise) + exception (promise)] + (handler {} response exception) + (is (= :ok @response)) + (is (not (realized? exception))))) + + (testing "thrown exception" + (let [handler (wrap-stacktrace (fn [_ _ _] + (throw (Exception. "fail"))) + params) + response (promise) + exception (promise)] + (binding [*err* (java.io.StringWriter.)] + (handler {} response exception)) + (is (= 500 (:status @response))) + (is (not (realized? exception))))) + + (testing "raised exception" + (let [handler (wrap-stacktrace (fn [_ _ raise] + (raise (Exception. "fail"))) + params) + response (promise) + exception (promise)] + (binding [*err* (java.io.StringWriter.)] + (handler {} response exception)) + (is (= 500 (:status @response))) + (is (not (realized? exception)))))))