|
| 1 | +(ns orchard.stacktrace |
| 2 | + "Instruments for analyzing exceptions and stacktraces which process exception |
| 3 | + objects and attach extra data to them." |
| 4 | + {:added "0.31" |
| 5 | + :author "Jeff Valk, Oleksandr Yakushev"} |
| 6 | + (:require |
| 7 | + [clojure.java.io :as io] |
| 8 | + [clojure.pprint :as pp] |
| 9 | + [clojure.repl :as repl] |
| 10 | + [clojure.spec.alpha :as s] |
| 11 | + [clojure.string :as str] |
| 12 | + [orchard.info :as info] |
| 13 | + [orchard.java.resource :as resource]) |
| 14 | + (:import |
| 15 | + (java.io StringWriter) |
| 16 | + (java.net URL) |
| 17 | + (java.nio.file Path))) |
| 18 | + |
| 19 | +(def ^:private ^Path cwd-path (.toAbsolutePath (.toPath (io/file "")))) |
| 20 | + |
| 21 | +(defn- pprint-write |
| 22 | + "We don't use `clojure.pprint/pprint` directly because it appends a newline at |
| 23 | + the end which we don't want." |
| 24 | + [value writer] |
| 25 | + (pp/write value :stream writer)) |
| 26 | + |
| 27 | +;;; ## Stacktraces |
| 28 | + |
| 29 | +(defn- Throwable->map-with-traces |
| 30 | + "Like `Throwable->map` but attaches `:trace` key to all causes in `:via`." |
| 31 | + [^Throwable o] |
| 32 | + (let [m (Throwable->map o) |
| 33 | + causes (take-while some? (iterate #(.getCause ^Throwable %) o))] |
| 34 | + (update m :via |
| 35 | + (fn [via] |
| 36 | + (mapv (fn [v, ^Throwable t] |
| 37 | + (let [st (.getStackTrace t)] |
| 38 | + (if (pos? (alength st)) |
| 39 | + (assoc v :trace (mapv StackTraceElement->vec st)) |
| 40 | + v))) |
| 41 | + via causes))))) |
| 42 | + |
| 43 | +;; Java stacktraces don't expose column number. |
| 44 | +(defn- frame-tuple->map |
| 45 | + "Return a map describing the stack frame." |
| 46 | + [frame] |
| 47 | + (let [[class method file line] frame] |
| 48 | + (when (and class method file line) |
| 49 | + {:name (str (name class) "/" (name method)) |
| 50 | + :file file |
| 51 | + :line line |
| 52 | + :class (name class) |
| 53 | + :method (name method)}))) |
| 54 | + |
| 55 | +(defn- flag-frame |
| 56 | + "Update frame's flags vector to include the new flag." |
| 57 | + [frame flag] |
| 58 | + (update frame :flags (comp set conj) flag)) |
| 59 | + |
| 60 | +(defn- path->url |
| 61 | + "Return a url for the path, either relative to classpath, or absolute." |
| 62 | + [path] |
| 63 | + (or (info/file-path path) (second (resource/resource-path-tuple path)))) |
| 64 | + |
| 65 | +(defn- infer-clojure-source-file [munged-class-name] |
| 66 | + (let [path-wo-ext (-> munged-class-name |
| 67 | + (str/replace #"\$.*" "") |
| 68 | + (str/replace "." "/"))] |
| 69 | + (or (io/resource (str path-wo-ext ".clj")) |
| 70 | + (io/resource (str path-wo-ext ".cljc"))))) |
| 71 | + |
| 72 | +(defn- analyze-class |
| 73 | + "Add namespace, fn, and var to the frame map when the source is a Clojure |
| 74 | + function." |
| 75 | + [{:keys [type class method] :as frame}] |
| 76 | + (if (or (= :clj type) |
| 77 | + (= :cljc type)) |
| 78 | + (let [[ns fn & anons] (-> (repl/demunge class) |
| 79 | + (str/replace #"--\d+" "") |
| 80 | + (str/split #"/")) |
| 81 | + fn (or fn method)] ; protocol functions are not munged |
| 82 | + (assoc frame |
| 83 | + :ns ns |
| 84 | + :fn (str/join "/" (cons fn anons)) |
| 85 | + :var (str ns "/" fn) |
| 86 | + ;; File URL on the classpath |
| 87 | + :file-url (infer-clojure-source-file class))) |
| 88 | + frame)) |
| 89 | + |
| 90 | +(defn- analyze-file |
| 91 | + "Associate the file type (extension) of the source file to the frame map, and |
| 92 | + add it as a flag. If the name is `NO_SOURCE_FILE`, type `clj` is assumed." |
| 93 | + [{:keys [file] :as frame}] |
| 94 | + (let [[_ ext] (some->> file (re-find #"\.([^\.]+)$")) |
| 95 | + type (cond (nil? file) :unknown |
| 96 | + (= file "NO_SOURCE_FILE") :clj |
| 97 | + (str/blank? ext) :unknown |
| 98 | + :else (keyword ext))] |
| 99 | + (-> frame |
| 100 | + (assoc :type type) |
| 101 | + (flag-frame type)))) |
| 102 | + |
| 103 | +(defn- flag-repl |
| 104 | + "Flag the frame if its source is a REPL eval." |
| 105 | + [{:keys [file] :as frame}] |
| 106 | + (if (and file |
| 107 | + (or (= file "NO_SOURCE_FILE") |
| 108 | + (.startsWith ^String file "form-init"))) |
| 109 | + (flag-frame frame :repl) |
| 110 | + frame)) |
| 111 | + |
| 112 | +(defn- flag-project |
| 113 | + "Flag the frame if it is from the user project. The heuristic is this: if we |
| 114 | + found the source file, it is a file on the filesystem (not in the JAR), and it |
| 115 | + resides in CWD — it is a project frame, otherwise it's a dependency frame." |
| 116 | + [{:keys [^URL file-url] :as frame}] |
| 117 | + (if file-url |
| 118 | + (-> frame |
| 119 | + (flag-frame (if (and (= (.getProtocol file-url) "file") |
| 120 | + (-> file-url .getFile io/file .toPath |
| 121 | + (.startsWith cwd-path))) |
| 122 | + :project :dependency)) |
| 123 | + (update :file-url str)) ;; Stringify file-url for bencode transfer. |
| 124 | + ;; If file-url is absent, we can't flag it as neither. |
| 125 | + frame)) |
| 126 | + |
| 127 | +(defn- analyze-frame |
| 128 | + "Return the stacktrace as a sequence of maps, each describing a stack frame." |
| 129 | + [frame] |
| 130 | + (-> frame |
| 131 | + (frame-tuple->map) |
| 132 | + (analyze-file) |
| 133 | + (analyze-class) |
| 134 | + (flag-project) |
| 135 | + (flag-repl))) |
| 136 | + |
| 137 | +(defn- flag-duplicates |
| 138 | + "Where a parent and child frame represent substantially the same source |
| 139 | + location, flag the parent as a duplicate." |
| 140 | + [frames] |
| 141 | + (->> frames |
| 142 | + (partition 2 1) |
| 143 | + (map (fn [[frame parent]] |
| 144 | + (if (or (= (:name frame) (:name parent)) |
| 145 | + (and (= (:file frame) (:file parent)) |
| 146 | + (= (:line frame) (:line parent)))) |
| 147 | + (flag-frame parent :dup) |
| 148 | + parent))) |
| 149 | + (into [(first frames)]))) |
| 150 | + |
| 151 | +(def ^:private tooling-frame-re |
| 152 | + #"^clojure\.lang\.LazySeq|^clojure\.lang\.Var|^clojure\.lang\.MultiFn|^clojure\.lang\.AFn|^clojure\.lang\.RestFn|^clojure\.lang\.RT|clojure\.lang\.Compiler|^nrepl\.|^cider\.|^refactor-nrepl\.|^shadow.cljs\.|^clojure\.core/eval|^clojure\.core/apply|^clojure\.core/with-bindings|^clojure\.core\.protocols|^clojure\.core\.map/fn|^clojure\.core/binding-conveyor-fn|^clojure\.main/repl") |
| 153 | + |
| 154 | +(defn- tooling-frame-name? [frame-name] |
| 155 | + (let [demunged (repl/demunge frame-name)] |
| 156 | + (boolean (re-find tooling-frame-re demunged)))) |
| 157 | + |
| 158 | +(defn- flag-tooling |
| 159 | + "Given a collection of stack `frames`, marks the 'tooling' ones as such. |
| 160 | + A 'tooling' frame is one that generally represents Clojure, JVM, nREPL or CIDER |
| 161 | + internals, and that is therefore not relevant to application-level code." |
| 162 | + [frames] |
| 163 | + ;; Iterate frames from the end. Mark all consecutive Thread-like frames as |
| 164 | + ;; tooling, and also all frames that match `tooling-frame-name?`. |
| 165 | + (loop [frames (vec frames), i (dec (count frames)), all-tooling-so-far? true] |
| 166 | + (if (< i 0) |
| 167 | + frames |
| 168 | + (let [frame-name (:name (get frames i)) |
| 169 | + tooling? (or (tooling-frame-name? frame-name) |
| 170 | + ;; Everything runs from a Thread, so this frame, if at |
| 171 | + ;; the end, is irrelevant. However one can invoke this |
| 172 | + ;; method 'by hand', which is why we only skip |
| 173 | + ;; consecutive frames that match this. |
| 174 | + (and all-tooling-so-far? |
| 175 | + (re-find #"^java\.lang\.Thread/run|^java\.util\.concurrent" |
| 176 | + frame-name)))] |
| 177 | + (recur (cond-> frames |
| 178 | + tooling? (update i flag-frame :tooling)) |
| 179 | + (dec i) (and all-tooling-so-far? tooling?)))))) |
| 180 | + |
| 181 | +;;; ## Causes |
| 182 | + |
| 183 | +(defn- relative-path |
| 184 | + "If the path is under the project root, return the relative path; otherwise |
| 185 | + return the original path." |
| 186 | + [path] |
| 187 | + (let [child-path (.toPath (io/file path))] |
| 188 | + (if (.startsWith child-path cwd-path) |
| 189 | + (str (.relativize cwd-path child-path)) |
| 190 | + path))) |
| 191 | + |
| 192 | +(defn- extract-location |
| 193 | + "If the cause is a compiler exception, extract the useful location information |
| 194 | + from `:location`. Include relative path for simpler reporting." |
| 195 | + [{:keys [class location] :as cause}] |
| 196 | + (if (and (= class "clojure.lang.Compiler$CompilerException") location) |
| 197 | + ;; Post-1.9, CompilerExceptions always carry location data. |
| 198 | + (assoc cause |
| 199 | + :file (:clojure.error/source location) |
| 200 | + :file-url (some-> (:clojure.error/source location) |
| 201 | + path->url |
| 202 | + str) |
| 203 | + :path (relative-path (:clojure.error/source location)) |
| 204 | + :line (:clojure.error/line location) |
| 205 | + :column (:clojure.error/column location)) |
| 206 | + cause)) |
| 207 | + |
| 208 | +;; CLJS REPLs use :repl-env to store huge amounts of analyzer/compiler state |
| 209 | +(def ^:private ex-data-blocklist |
| 210 | + #{:repl-env}) |
| 211 | + |
| 212 | +(defn- filter-ex-data |
| 213 | + "Filter keys from the exception `data` which are blocklisted (generally for |
| 214 | + containing data not intended for reading by a human)." |
| 215 | + [data] |
| 216 | + (when data |
| 217 | + (into {} (remove #(ex-data-blocklist (key %))) data))) |
| 218 | + |
| 219 | +(defn- prepare-spec-data |
| 220 | + "Prepare spec problems for display in user stacktraces. Take in a map `ed` as |
| 221 | + returned by `clojure.spec.alpha/explain-data` and return a map of pretty |
| 222 | + printed problems. The content of the returned map is modeled after |
| 223 | + `clojure.spec.alpha/explain-printer`." |
| 224 | + [ed pprint-str] |
| 225 | + (let [problems (sort-by #(count (:path %)) (::s/problems ed))] |
| 226 | + {:spec (pr-str (::s/spec ed)) |
| 227 | + :value (pprint-str (::s/value ed)) |
| 228 | + :problems |
| 229 | + (mapv |
| 230 | + (fn [{:keys [in val pred reason via path] :as prob}] |
| 231 | + (->> {:in (some-> in not-empty pr-str) |
| 232 | + :val (pprint-str val) |
| 233 | + :predicate (pr-str (s/abbrev pred)) |
| 234 | + :reason reason |
| 235 | + :spec (some-> via not-empty last pr-str) |
| 236 | + :at (some-> path not-empty pr-str) |
| 237 | + :extra |
| 238 | + (let [extras (into {} |
| 239 | + (remove #(#{:in :val :pred :reason :via :path |
| 240 | + ::s/failure} (key %))) |
| 241 | + prob)] |
| 242 | + (when (seq extras) |
| 243 | + (pprint-str extras)))} |
| 244 | + (filter clojure.core/val) |
| 245 | + (into {}))) |
| 246 | + problems)})) |
| 247 | + |
| 248 | +(defn- analyze-stacktrace-data |
| 249 | + "Return the stacktrace as a sequence of maps, each describing a stack frame." |
| 250 | + [trace] |
| 251 | + (when (seq trace) |
| 252 | + (-> (pmap analyze-frame trace) |
| 253 | + (flag-duplicates) |
| 254 | + (flag-tooling)))) |
| 255 | + |
| 256 | +(defn- compile-like-exception? |
| 257 | + "'Compile-like' exceptions are those that happen at runtime (and therefore never |
| 258 | + include a `:phase`) which however, represent code that cannot possibly work, |
| 259 | + and thus are a compile-like exception (i.e. a linter could have caught them)." |
| 260 | + [{:keys [phase type message]}] |
| 261 | + (boolean |
| 262 | + (and (nil? phase) |
| 263 | + (= type 'java.lang.IllegalArgumentException) |
| 264 | + (some->> message (re-find #"^No matching (field|method)"))))) |
| 265 | + |
| 266 | +(defn- analyze-cause |
| 267 | + "Analyze the `cause-data` of an exception, in `Throwable->map` format." |
| 268 | + [cause-data print-fn] |
| 269 | + (let [pprint-str #(let [writer (StringWriter.)] |
| 270 | + (print-fn % writer) |
| 271 | + (str writer)) |
| 272 | + phase (-> cause-data :data :clojure.error/phase) |
| 273 | + m {:class (name (:type cause-data)) |
| 274 | + :phase phase |
| 275 | + :compile-like (str (compile-like-exception? cause-data)) |
| 276 | + :message (:message cause-data) |
| 277 | + :stacktrace (analyze-stacktrace-data |
| 278 | + (cond (seq (:trace cause-data)) (:trace cause-data) |
| 279 | + (:at cause-data) [(:at cause-data)]))}] |
| 280 | + (if-let [data (filter-ex-data (:data cause-data))] |
| 281 | + (if (::s/failure data) |
| 282 | + (assoc m |
| 283 | + :message "Spec assertion failed." |
| 284 | + :spec (prepare-spec-data data pprint-str)) |
| 285 | + (assoc m |
| 286 | + :data (pprint-str data) |
| 287 | + :location (select-keys data [:clojure.error/line |
| 288 | + :clojure.error/column |
| 289 | + :clojure.error/phase |
| 290 | + :clojure.error/source |
| 291 | + :clojure.error/symbol]))) |
| 292 | + m))) |
| 293 | + |
| 294 | +(defn- analyze-causes |
| 295 | + "Analyze the cause chain of the `exception-data` in `Throwable->map` format." |
| 296 | + [exception-data print-fn] |
| 297 | + (let [causes (vec (:via exception-data)) |
| 298 | + ;; If the first cause lacks :trace, add :trace of the exception there. |
| 299 | + causes (if (:trace (first causes)) |
| 300 | + causes |
| 301 | + (assoc-in causes [0 :trace] (:trace exception-data)))] |
| 302 | + (mapv #(extract-location (analyze-cause % print-fn)) causes))) |
| 303 | + |
| 304 | +(defn analyze |
| 305 | + "Return the analyzed cause chain for `exception` beginning with the |
| 306 | + thrown exception. `exception` can be an instance of `Throwable` or a |
| 307 | + map in the same format as `Throwable->map`. For `ex-info` |
| 308 | + exceptions, the response contains a `:data` slot with the pretty |
| 309 | + printed data. For clojure.spec asserts, the `:spec` slot contains a |
| 310 | + map of pretty printed components describing spec failures." |
| 311 | + ([exception] |
| 312 | + (analyze exception pprint-write)) |
| 313 | + ([exception print-fn] |
| 314 | + (cond (instance? Throwable exception) |
| 315 | + (analyze-causes (Throwable->map-with-traces exception) print-fn) |
| 316 | + (and (map? exception) (:trace exception)) |
| 317 | + (analyze-causes exception print-fn)))) |
0 commit comments