3pp-mirror/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-05-18 02:06:10 +02:00
Code Issues Projects Releases Packages Wiki Activity

♻️ Refactor logging subsystem and error reporting

Browse source
This commit is contained in:
Andrey Antukh 2023-02-02 10:57:54 +01:00
parent 50ee0ad3fd
commit bb055a3c84
30 changed files with 759 additions and 892 deletions
Download patch file Download diff file Expand all files Collapse all files

3
backend/deps.edn
View file

@ -3,9 +3,6 @@
org.clojure/clojure {:mvn/version "1.11.1"} org.clojure/clojure {:mvn/version "1.11.1"}
org.clojure/core.async {:mvn/version "1.6.673"} org.clojure/core.async {:mvn/version "1.6.673"}
;; Logging
org.zeromq/jeromq {:mvn/version "0.5.3"}
com.github.luben/zstd-jni {:mvn/version "1.5.2-5"} com.github.luben/zstd-jni {:mvn/version "1.5.2-5"}
org.clojure/data.fressian {:mvn/version "1.0.0"} org.clojure/data.fressian {:mvn/version "1.0.0"}

112
backend/resources/app/templates/error-report.v2.tmpl Normal file
View file

@ -0,0 +1,112 @@
{% extends "app/templates/base.tmpl" %}
{% block title %}
penpot - error report v2 {{id}}
{% endblock %}
{% block content %}
<nav>
<div>[<a href="/dbg/error">⮜</a>]</div>
<div>[<a href="#message">message</a>]</div>
<div>[<a href="#props">props</a>]</div>
<div>[<a href="#context">context</a>]</div>
{% if params %}
<div>[<a href="#params">request params</a>]</div>
{% endif %}
{% if data %}
<div>[<a href="#edata">error data</a>]</div>
{% endif %}
{% if spec-explain %}
<div>[<a href="#spec-explain">spec explain</a>]</div>
{% endif %}
{% if spec-problems %}
<div>[<a href="#spec-problems">spec problems</a>]</div>
{% endif %}
{% if spec-value %}
<div>[<a href="#spec-value">spec value</a>]</div>
{% endif %}
{% if trace %}
<div>[<a href="#trace">error trace</a>]</div>
{% endif %}
</nav>
<main>
<div class="table">
<div class="table-row multiline">
<div id="message" class="table-key">MESSAGE: </div>
<div class="table-val">
<h1>{{hint}}</h1>
</div>
</div>
<div class="table-row multiline">
<div id="props" class="table-key">LOG PROPS: </div>
<div class="table-val">
<pre>{{props}}</pre>
</div>
</div>
<div class="table-row multiline">
<div id="context" class="table-key">CONTEXT: </div>
<div class="table-val">
<pre>{{context}}</pre>
</div>
</div>
{% if params %}
<div class="table-row multiline">
<div id="params" class="table-key">REQUEST PARAMS: </div>
<div class="table-val">
<pre>{{params}}</pre>
</div>
</div>
{% endif %}
{% if data %}
<div class="table-row multiline">
<div id="edata" class="table-key">ERROR DATA: </div>
<div class="table-val">
<pre>{{data}}</pre>
</div>
</div>
{% endif %}
{% if spec-explain %}
<div class="table-row multiline">
<div id="spec-explain" class="table-key">SPEC EXPLAIN: </div>
<div class="table-val">
<pre>{{spec-explain}}</pre>
</div>
</div>
{% endif %}
{% if spec-problems %}
<div class="table-row multiline">
<div id="spec-problems" class="table-key">SPEC PROBLEMS: </div>
<div class="table-val">
<pre>{{spec-problems}}</pre>
</div>
</div>
{% endif %}
{% if spec-value %}
<div class="table-row multiline">
<div id="spec-value" class="table-key">SPEC VALUE: </div>
<div class="table-val">
<pre>{{spec-value}}</pre>
</div>
</div>
{% endif %}
{% if trace %}
<div class="table-row multiline">
<div id="trace" class="table-key">TRACE:</div>
<div class="table-val">
<pre>{{trace}}</pre>
</div>
</div>
{% endif %}
</div>
</main>
{% endblock %}

7
backend/src/app/config.clj
View file

@ -51,7 +51,6 @@
:database-password "penpot" :database-password "penpot"
:default-blob-version 5 :default-blob-version 5
:loggers-zmq-uri "tcp://localhost:45556"
:rpc-rlimit-config (fs/path "resources/rlimit.edn") :rpc-rlimit-config (fs/path "resources/rlimit.edn")
:rpc-climit-config (fs/path "resources/climit.edn") :rpc-climit-config (fs/path "resources/climit.edn")
@ -175,8 +174,6 @@
(s/def ::ldap-ssl ::us/boolean) (s/def ::ldap-ssl ::us/boolean)
(s/def ::ldap-starttls ::us/boolean) (s/def ::ldap-starttls ::us/boolean)
(s/def ::ldap-user-query ::us/string) (s/def ::ldap-user-query ::us/string)
(s/def ::loggers-loki-uri ::us/string)
(s/def ::loggers-zmq-uri ::us/string)
(s/def ::media-directory ::us/string) (s/def ::media-directory ::us/string)
(s/def ::media-uri ::us/string) (s/def ::media-uri ::us/string)
(s/def ::profile-bounce-max-age ::dt/duration) (s/def ::profile-bounce-max-age ::dt/duration)
@ -272,8 +269,6 @@
::ldap-starttls ::ldap-starttls
::ldap-user-query ::ldap-user-query
::local-assets-uri ::local-assets-uri
::loggers-loki-uri
::loggers-zmq-uri
::media-max-file-size ::media-max-file-size
::profile-bounce-max-age ::profile-bounce-max-age
::profile-bounce-threshold ::profile-bounce-threshold
@ -357,7 +352,7 @@
(merge defaults) (merge defaults)
(us/conform ::config)) (us/conform ::config))
(catch Throwable e (catch Throwable e
(when (ex/ex-info? e) (when (ex/error? e)
(println ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;") (println ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;")
(println "Error on validating configuration:") (println "Error on validating configuration:")
(println (some-> e ex-data ex/explain)) (println (some-> e ex-data ex/explain))

52
backend/src/app/http/debug.clj
View file

@ -205,45 +205,47 @@
(defn error-handler (defn error-handler
[{:keys [::db/pool]} request] [{:keys [::db/pool]} request]
(letfn [(parse-id [request] (letfn [(get-report [{:keys [path-params]}]
(let [id (get-in request [:path-params :id])
id (parse-uuid id)]
(when (uuid? id)
id)))
(retrieve-report [id]
(ex/ignoring (ex/ignoring
(some-> (db/get-by-id pool :server-error-report id) :content db/decode-transit-pgobject))) (let [report-id (some-> path-params :id parse-uuid)]
(some-> (db/get-by-id pool :server-error-report report-id)
(update :content db/decode-transit-pgobject)))))
(render-template [report] (render-template-v1 [{:keys [content]}]
(let [context (dissoc report (let [context (dissoc content
:trace :cause :params :data :spec-problems :message :trace :cause :params :data :spec-problems :message
:spec-explain :spec-value :error :explain :hint) :spec-explain :spec-value :error :explain :hint)
params {:context (pp/pprint-str context :width 200) params {:context (pp/pprint-str context :width 200)
:hint (:hint report) :hint (:hint content)
:spec-explain (:spec-explain report) :spec-explain (:spec-explain content)
:spec-problems (:spec-problems report) :spec-problems (:spec-problems content)
:spec-value (:spec-value report) :spec-value (:spec-value content)
:data (:data report) :data (:data content)
:trace (or (:trace report) :trace (or (:trace content)
(some-> report :error :trace)) (some-> content :error :trace))
:params (:params report)}] :params (:params content)}]
(-> (io/resource "app/templates/error-report.tmpl") (-> (io/resource "app/templates/error-report.tmpl")
(tmpl/render params))))] (tmpl/render params))))
(render-template-v2 [{report :content}]
(-> (io/resource "app/templates/error-report.v2.tmpl")
(tmpl/render report)))
]
(when-not (authorized? pool request) (when-not (authorized? pool request)
(ex/raise :type :authentication (ex/raise :type :authentication
:code :only-admins-allowed)) :code :only-admins-allowed))
(let [result (some-> (parse-id request) (if-let [report (get-report request)]
(retrieve-report) (let [result (if (= 1 (:version report))
(render-template))] (render-template-v1 report)
(if result (render-template-v2 report))]
(yrs/response :status 200 (yrs/response :status 200
:body result :body result
:headers {"content-type" "text/html; charset=utf-8" :headers {"content-type" "text/html; charset=utf-8"
"x-robots-tag" "noindex"}) "x-robots-tag" "noindex"}))
(yrs/response 404 "not found"))))) (yrs/response 404 "not found"))))
(def sql:error-reports (def sql:error-reports
"SELECT id, created_at, "SELECT id, created_at,

108
backend/src/app/http/errors.clj
View file

@ -7,7 +7,6 @@
(ns app.http.errors (ns app.http.errors
"A errors handling for the http server." "A errors handling for the http server."
(:require (:require
[app.common.data :as d]
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.logging :as l] [app.common.logging :as l]
[app.http :as-alias http] [app.http :as-alias http]
@ -18,30 +17,26 @@
[yetti.request :as yrq] [yetti.request :as yrq]
[yetti.response :as yrs])) [yetti.response :as yrs]))
(def ^:dynamic *context* {})
(defn- parse-client-ip (defn- parse-client-ip
[request] [request]
(or (some-> (yrq/get-header request "x-forwarded-for") (str/split ",") first) (or (some-> (yrq/get-header request "x-forwarded-for") (str/split ",") first)
(yrq/get-header request "x-real-ip") (yrq/get-header request "x-real-ip")
(yrq/remote-addr request))) (yrq/remote-addr request)))
(defn get-context (defn request->context
"Extracts error report relevant context data from request."
[request] [request]
(let [claims (-> {} (let [claims (-> {}
(into (::session/token-claims request)) (into (::session/token-claims request))
(into (::actoken/token-claims request)))] (into (::actoken/token-claims request)))]
(merge {:path (:path request)
*context* :method (:method request)
{:path (:path request) :params (:params request)
:method (:method request) :ip-addr (parse-client-ip request)
:params (:params request) :user-agent (yrq/get-header request "user-agent")
:ip-addr (parse-client-ip request)} :profile-id (:uid claims)
(d/without-nils :version (or (yrq/get-header request "x-frontend-version")
{:user-agent (yrq/get-header request "user-agent") "unknown")}))
:frontend-version (or (yrq/get-header request "x-frontend-version")
"unknown")
:profile-id (:uid claims)}))))
(defmulti handle-exception (defmulti handle-exception
(fn [err & _rest] (fn [err & _rest]
@ -87,15 +82,14 @@
[error request] [error request]
(let [edata (ex-data error) (let [edata (ex-data error)
explain (ex/explain edata)] explain (ex/explain edata)]
(l/error :hint (ex-message error) (binding [l/*context* (request->context request)]
:cause error (l/error :hint "Assertion error" :message (ex-message error) :cause error)
::l/context (get-context request)) (yrs/response :status 500
(yrs/response :status 500 :body {:type :server-error
:body {:type :server-error :code :assertion
:code :assertion :data (-> edata
:data (-> edata (dissoc ::s/problems ::s/value ::s/spec)
(dissoc ::s/problems ::s/value ::s/spec) (cond-> explain (assoc :explain explain)))}))))
(cond-> explain (assoc :explain explain)))})))
(defmethod handle-exception :not-found (defmethod handle-exception :not-found
[err _] [err _]
@ -109,10 +103,8 @@
(yrs/response 429) (yrs/response 429)
:else :else
(do (binding [l/*context* (request->context request)]
(l/error :hint (ex-message error) (l/error :hint "Internal error" :message (ex-message error) :cause error)
:cause error
::l/context (get-context request))
(yrs/response 500 {:type :server-error (yrs/response 500 {:type :server-error
:code :unhandled :code :unhandled
:hint (ex-message error) :hint (ex-message error)
@ -121,25 +113,24 @@
(defmethod handle-exception org.postgresql.util.PSQLException (defmethod handle-exception org.postgresql.util.PSQLException
[error request] [error request]
(let [state (.getSQLState ^java.sql.SQLException error)] (let [state (.getSQLState ^java.sql.SQLException error)]
(l/error :hint (ex-message error) (binding [l/*context* (request->context request)]
:cause error (l/error :hint "PSQL error" :message (ex-message error) :cause error)
::l/context (get-context request)) (cond
(cond (= state "57014")
(= state "57014") (yrs/response 504 {:type :server-error
(yrs/response 504 {:type :server-error :code :statement-timeout
:code :statement-timeout :hint (ex-message error)})
:hint (ex-message error)})
(= state "25P03") (= state "25P03")
(yrs/response 504 {:type :server-error (yrs/response 504 {:type :server-error
:code :idle-in-transaction-timeout :code :idle-in-transaction-timeout
:hint (ex-message error)}) :hint (ex-message error)})
:else :else
(yrs/response 500 {:type :server-error (yrs/response 500 {:type :server-error
:code :unexpected :code :unexpected
:hint (ex-message error) :hint (ex-message error)
:state state})))) :state state})))))
(defmethod handle-exception :default (defmethod handle-exception :default
[error request] [error request]
@ -147,10 +138,8 @@
(cond (cond
;; This means that exception is not a controlled exception. ;; This means that exception is not a controlled exception.
(nil? edata) (nil? edata)
(do (binding [l/*context* (request->context request)]
(l/error :hint (ex-message error) (l/error :hint "Unexpected error" :message (ex-message error) :cause error)
:cause error
::l/context (get-context request))
(yrs/response 500 {:type :server-error (yrs/response 500 {:type :server-error
:code :unexpected :code :unexpected
:hint (ex-message error)})) :hint (ex-message error)}))
@ -165,10 +154,8 @@
(handle-exception (:handling edata) request) (handle-exception (:handling edata) request)
:else :else
(do (binding [l/*context* (request->context request)]
(l/error :hint (ex-message error) (l/error :hint "Unhandled error" :message (ex-message error) :cause error)
:cause error
::l/context (get-context request))
(yrs/response 500 {:type :server-error (yrs/response 500 {:type :server-error
:code :unhandled :code :unhandled
:hint (ex-message error) :hint (ex-message error)
@ -176,16 +163,7 @@
(defn handle (defn handle
[cause request] [cause request]
(cond (if (or (instance? java.util.concurrent.CompletionException cause)
(or (instance? java.util.concurrent.CompletionException cause) (instance? java.util.concurrent.ExecutionException cause))
(instance? java.util.concurrent.ExecutionException cause)) (handle-exception (ex-cause cause) request)
(handle-exception (.getCause ^Throwable cause) request)
(ex/wrapped? cause)
(let [context (meta cause)
cause (deref cause)]
(binding [*context* context]
(handle-exception cause request)))
:else
(handle-exception cause request))) (handle-exception cause request)))

4
backend/src/app/http/middleware.clj
View file

@ -80,8 +80,8 @@
(fn [request respond raise] (fn [request respond raise]
(let [request (ex/try! (process-request request))] (let [request (ex/try! (process-request request))]
(if (ex/exception? request) (if (ex/exception? request)
(if (instance? RuntimeException request) (if (ex/runtime-exception? request)
(handle-error raise (or (ex/cause request) request)) (handle-error raise (or (ex-cause request) request))
(handle-error raise request)) (handle-error raise request))
(handler request respond raise)))))) (handler request respond raise))))))

24
backend/src/app/http/session.clj
View file

@ -8,6 +8,7 @@
(:refer-clojure :exclude [read]) (:refer-clojure :exclude [read])
(:require (:require
[app.common.data :as d] [app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.logging :as l] [app.common.logging :as l]
[app.common.spec :as us] [app.common.spec :as us]
[app.config :as cf] [app.config :as cf]
@ -230,17 +231,18 @@
(let [{:keys [::wrk/executor ::main/props]} (meta manager)] (let [{:keys [::wrk/executor ::main/props]} (meta manager)]
(fn [request respond raise] (fn [request respond raise]
(let [token (get-token request)] (let [token (ex/try! (get-token request))]
(->> (px/submit! executor (partial decode-token props token)) (if (ex/exception? token)
(p/fnly (fn [claims cause] (raise token)
(when cause (->> (px/submit! executor (partial decode-token props token))
(l/trace :hint "exception on decoding malformed token" :cause cause)) (p/fnly (fn [claims cause]
(when cause
(let [request (cond-> request (l/trace :hint "exception on decoding malformed token" :cause cause))
(map? claims) (let [request (cond-> request
(-> (assoc ::token-claims claims) (map? claims)
(assoc ::token token)))] (-> (assoc ::token-claims claims)
(handler request respond raise))))))))) (assoc ::token token)))]
(handler request respond raise))))))))))
(defn- wrap-authz (defn- wrap-authz
[handler {:keys [::manager]}] [handler {:keys [::manager]}]

109
backend/src/app/loggers/database.clj
View file

@ -7,16 +7,17 @@
(ns app.loggers.database (ns app.loggers.database
"A specific logger impl that persists errors on the database." "A specific logger impl that persists errors on the database."
(:require (:require
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.logging :as l] [app.common.logging :as l]
[app.common.uuid :as uuid] [app.common.pprint :as pp]
[app.common.spec :as us]
[app.config :as cf] [app.config :as cf]
[app.db :as db] [app.db :as db]
[app.loggers.zmq :as lzmq]
[clojure.core.async :as a]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[cuerdas.core :as str]
[integrant.core :as ig] [integrant.core :as ig]
[promesa.exec :as px])) [promesa.exec :as px]
[promesa.exec.csp :as sp]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Error Listener ;; Error Listener
@ -27,73 +28,79 @@
(defonce enabled (atom true)) (defonce enabled (atom true))
(defn- persist-on-database! (defn- persist-on-database!
[{:keys [::db/pool] :as cfg} {:keys [id] :as event}] [pool id report]
(when-not (db/read-only? pool) (when-not (db/read-only? pool)
(db/insert! pool :server-error-report {:id id :content (db/tjson event)}))) (db/insert! pool :server-error-report
{:id id
:version 2
:content (db/tjson report)})))
(defn- parse-event-data (defn record->report
[event] [{:keys [::l/context ::l/message ::l/props ::l/logger ::l/level ::l/cause] :as record}]
(reduce-kv (us/assert! ::l/record record)
(fn [acc k v]
(cond
(= k :id) (assoc acc k (uuid/uuid v))
(= k :profile-id) (assoc acc k (uuid/uuid v))
(str/blank? v) acc
:else (assoc acc k v)))
{}
event))
(defn parse-event (merge
[event] {:context (-> context
(-> (parse-event-data event) (assoc :tenant (cf/get :tenant))
(assoc :hint (or (:hint event) (:message event))) (assoc :host (cf/get :host))
(assoc :tenant (cf/get :tenant)) (assoc :public-uri (cf/get :public-uri))
(assoc :host (cf/get :host)) (assoc :version (:full cf/version))
(assoc :public-uri (cf/get :public-uri)) (assoc :logger-name logger)
(assoc :version (:full cf/version)) (assoc :logger-level level)
(update :id #(or % (uuid/next))))) (dissoc :params)
(pp/pprint-str :width 200))
:params (some-> (:params context)
(pp/pprint-str :width 200))
:props (pp/pprint-str props :width 200)
:hint (or (ex-message cause) @message)
:trace (ex/format-throwable cause :data? false :explain? false :header? false :summary? false)}
(when-let [data (ex-data cause)]
{:spec-value (some-> (::s/value data) (pp/pprint-str :width 200))
:spec-explain (ex/explain data)
:data (-> data
(dissoc ::s/problems ::s/value ::s/spec :hint)
(pp/pprint-str :width 200))})))
(defn- handle-event (defn- handle-event
[cfg event] [{:keys [::db/pool]} {:keys [::l/id] :as record}]
(try (try
(let [event (parse-event event) (let [uri (cf/get :public-uri)
uri (cf/get :public-uri)] report (-> record record->report d/without-nils)]
(l/debug :hint "registering error on database" :id id
:uri (str uri "/dbg/error/" id))
(l/debug :hint "registering error on database" :id (:id event) (persist-on-database! pool id report))
:uri (str uri "/dbg/error/" (:id event)))
(persist-on-database! cfg event))
(catch Throwable cause (catch Throwable cause
(l/warn :hint "unexpected exception on database error logger" :cause cause)))) (l/warn :hint "unexpected exception on database error logger" :cause cause))))
(defn- error-event? (defn error-record?
[event] [{:keys [::l/level ::l/cause]}]
(= "error" (:logger/level event))) (and (= :error level)
(ex/exception? cause)))
(defmethod ig/pre-init-spec ::reporter [_] (defmethod ig/pre-init-spec ::reporter [_]
(s/keys :req [::db/pool ::lzmq/receiver])) (s/keys :req [::db/pool]))
(defmethod ig/init-key ::reporter (defmethod ig/init-key ::reporter
[_ {:keys [::lzmq/receiver] :as cfg}] [_ cfg]
(px/thread (let [input (sp/chan (sp/sliding-buffer 32) (filter error-record?))]
{:name "penpot/database-reporter"} (add-watch l/log-record ::reporter #(sp/put! input %4))
(l/info :hint "initializing database error persistence") (px/thread
{:name "penpot/database-reporter" :virtual true}
(let [input (a/chan (a/sliding-buffer 5) (l/info :hint "initializing database error persistence")
(filter error-event?))]
(try (try
(lzmq/sub! receiver input)
(loop [] (loop []
(when-let [msg (a/<!! input)] (when-let [record (sp/take! input)]
(handle-event cfg msg)) (handle-event cfg record)
(recur)) (recur)))
(catch InterruptedException _ (catch InterruptedException _
(l/debug :hint "reporter interrupted")) (l/debug :hint "reporter interrupted"))
(catch Throwable cause (catch Throwable cause
(l/error :hint "unexpected error" :cause cause)) (l/error :hint "unexpected error" :cause cause))
(finally (finally
(a/close! input) (sp/close! input)
(remove-watch l/log-record ::reporter)
(l/info :hint "reporter terminated")))))) (l/info :hint "reporter terminated"))))))
(defmethod ig/halt-key! ::reporter (defmethod ig/halt-key! ::reporter

89
backend/src/app/loggers/loki.clj
View file

@ -1,89 +0,0 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS INC
(ns app.loggers.loki
"A Loki integration."
(:require
[app.common.logging :as l]
[app.config :as cf]
[app.http.client :as http]
[app.loggers.zmq :as lzmq]
[app.util.json :as json]
[clojure.core.async :as a]
[clojure.spec.alpha :as s]
[integrant.core :as ig]
[promesa.exec :as px]))
(declare ^:private handle-event)
(defmethod ig/pre-init-spec ::reporter [_]
(s/keys :req [::http/client
::lzmq/receiver]))
(defmethod ig/init-key ::reporter
[_ cfg]
(when-let [uri (cf/get :loggers-loki-uri)]
(px/thread
{:name "penpot/loki-reporter"}
(l/info :hint "reporter started" :uri uri)
(let [input (a/chan (a/dropping-buffer 2048))
cfg (assoc cfg ::uri uri)]
(try
(lzmq/sub! (::lzmq/receiver cfg) input)
(loop []
(when-let [msg (a/<!! input)]
(handle-event cfg msg)
(recur)))
(catch InterruptedException _
(l/debug :hint "reporter interrupted"))
(catch Throwable cause
(l/error :hint "unexpected exception"
:cause cause))
(finally
(a/close! input)
(l/info :hint "reporter terminated")))))))
(defmethod ig/halt-key! ::reporter
[_ thread]
(some-> thread px/interrupt!))
(defn- prepare-payload
[event]
(let [labels {:host (cf/get :host)
:tenant (cf/get :tenant)
:version (:full cf/version)
:logger (:logger/name event)
:level (:logger/level event)}]
{:streams
[{:stream labels
:values [[(str (* (inst-ms (:created-at event)) 1000000))
(str (:message event)
(when-let [error (:trace event)]
(str "\n" error)))]]}]}))
(defn- make-request
[{:keys [::uri] :as cfg} payload]
(http/req! cfg
{:uri uri
:timeout 3000
:method :post
:headers {"content-type" "application/json"}
:body (json/encode payload)}
{:sync? true}))
(defn- handle-event
[cfg event]
(try
(let [payload (prepare-payload event)
response (make-request cfg payload)]
(when-not (= 204 (:status response))
(l/error :hint "error on sending log to loki (unexpected response)"
:response (pr-str response))))
(catch Throwable cause
(l/error :hint "error on sending log to loki (unexpected exception)"
:cause cause))))

65
backend/src/app/loggers/mattermost.clj
View file

@ -7,24 +7,35 @@
(ns app.loggers.mattermost (ns app.loggers.mattermost
"A mattermost integration for error reporting." "A mattermost integration for error reporting."
(:require (:require
[app.common.exceptions :as ex]
[app.common.logging :as l] [app.common.logging :as l]
[app.common.spec :as us]
[app.config :as cf] [app.config :as cf]
[app.http.client :as http] [app.http.client :as http]
[app.loggers.database :as ldb] [app.loggers.database :as ldb]
[app.loggers.zmq :as lzmq]
[app.util.json :as json] [app.util.json :as json]
[clojure.core.async :as a]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[integrant.core :as ig] [integrant.core :as ig]
[promesa.exec :as px])) [promesa.exec :as px]
[promesa.exec.csp :as sp]))
(defonce enabled (atom true)) (defonce enabled (atom false))
(defn- send-mattermost-notification! (defn- send-mattermost-notification!
[cfg {:keys [host id public-uri] :as event}] [cfg {:keys [id public-uri] :as report}]
(let [text (str "Exception on (host: " host ", url: " public-uri "/dbg/error/" id ")\n" (let [text (str "Exception: " public-uri "/dbg/error/" id " "
(when-let [pid (:profile-id event)] (when-let [pid (:profile-id report)]
(str "- profile-id: #uuid-" pid "\n"))) (str "(pid: #uuid-" pid ")"))
"\n"
"```\n"
"- host: `" (:host report) "`\n"
"- tenant: `" (:tenant report) "`\n"
"- version: `" (:version report) "`\n"
"\n"
"Trace:\n"
(:trace report)
"```")
resp (http/req! cfg resp (http/req! cfg
{:uri (cf/get :error-report-webhook) {:uri (cf/get :error-report-webhook)
:method :post :method :post
@ -36,32 +47,41 @@
(l/warn :hint "error on sending data" (l/warn :hint "error on sending data"
:response (pr-str resp))))) :response (pr-str resp)))))
(defn record->report
[{:keys [::l/context ::l/id ::l/cause] :as record}]
(us/assert! ::l/record record)
{:id id
:tenant (cf/get :tenant)
:host (cf/get :host)
:public-uri (cf/get :public-uri)
:version (:full cf/version)
:profile-id (:profile-id context)
:trace (ex/format-throwable cause :detail? false :header? false)})
(defn handle-event (defn handle-event
[cfg event] [cfg record]
(when @enabled (when @enabled
(try (try
(let [event (ldb/parse-event event)] (let [report (record->report record)]
(send-mattermost-notification! cfg event)) (send-mattermost-notification! cfg report))
(catch Throwable cause (catch Throwable cause
(l/warn :hint "unhandled error" (l/warn :hint "unhandled error" :cause cause)))))
:cause cause)))))
(defmethod ig/pre-init-spec ::reporter [_] (defmethod ig/pre-init-spec ::reporter [_]
(s/keys :req [::http/client (s/keys :req [::http/client]))
::lzmq/receiver]))
(defmethod ig/init-key ::reporter (defmethod ig/init-key ::reporter
[_ cfg] [_ cfg]
(when-let [uri (cf/get :error-report-webhook)] (when-let [uri (cf/get :error-report-webhook)]
(px/thread (px/thread
{:name "penpot/mattermost-reporter"} {:name "penpot/mattermost-reporter"
(l/info :msg "initializing error reporter" :uri uri) :virtual true}
(let [input (a/chan (a/sliding-buffer 128) (l/info :hint "initializing error reporter" :uri uri)
(filter #(= (:logger/level %) "error")))] (let [input (sp/chan (sp/sliding-buffer 128) (filter ldb/error-record?))]
(add-watch l/log-record ::reporter #(sp/put! input %4))
(try (try
(lzmq/sub! (::lzmq/receiver cfg) input)
(loop [] (loop []
(when-let [msg (a/<!! input)] (when-let [msg (sp/take! input)]
(handle-event cfg msg) (handle-event cfg msg)
(recur))) (recur)))
(catch InterruptedException _ (catch InterruptedException _
@ -69,7 +89,8 @@
(catch Throwable cause (catch Throwable cause
(l/error :hint "unexpected error" :cause cause)) (l/error :hint "unexpected error" :cause cause))
(finally (finally
(a/close! input) (sp/close! input)
(remove-watch l/log-record ::reporter)
(l/info :hint "reporter terminated"))))))) (l/info :hint "reporter terminated")))))))
(defmethod ig/halt-key! ::reporter (defmethod ig/halt-key! ::reporter

130
backend/src/app/loggers/zmq.clj
View file

@ -1,130 +0,0 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS INC
(ns app.loggers.zmq
"A generic ZMQ listener."
(:require
[app.common.exceptions :as ex]
[app.common.logging :as l]
[app.config :as cf]
[app.loggers.zmq.receiver :as-alias receiver]
[app.util.json :as json]
[app.util.time :as dt]
[clojure.core.async :as a]
[clojure.spec.alpha :as s]
[cuerdas.core :as str]
[integrant.core :as ig]
[promesa.exec :as px])
(:import
org.zeromq.SocketType
org.zeromq.ZMQ$Socket
org.zeromq.ZContext))
(declare prepare)
(declare start-rcv-loop)
(defmethod ig/init-key ::receiver
[_ cfg]
(let [uri (cf/get :loggers-zmq-uri)
buffer (a/chan 1)
output (a/chan 1 (comp (filter map?)
(keep prepare)))
mult (a/mult output)
thread (when uri
(px/thread
{:name "penpot/zmq-receiver"
:daemon false}
(l/info :hint "receiver started")
(try
(start-rcv-loop buffer uri)
(catch InterruptedException _
(l/debug :hint "receiver interrupted"))
(catch java.lang.IllegalStateException cause
(if (= "errno 4" (ex-message cause))
(l/debug :hint "receiver interrupted")
(l/error :hint "unhandled error" :cause cause)))
(catch Throwable cause
(l/error :hint "unhandled error" :cause cause))
(finally
(l/info :hint "receiver terminated")))))]
(a/pipe buffer output)
(-> cfg
(assoc ::receiver/mult mult)
(assoc ::receiver/thread thread)
(assoc ::receiver/output output)
(assoc ::receiver/buffer buffer))))
(s/def ::receiver/mult some?)
(s/def ::receiver/thread #(instance? Thread %))
(s/def ::receiver/output some?)
(s/def ::receiver/buffer some?)
(s/def ::receiver
(s/keys :req [::receiver/mult
::receiver/thread
::receiver/output
::receiver/buffer]))
(defn sub!
[{:keys [::receiver/mult]} ch]
(a/tap mult ch))
(defmethod ig/halt-key! ::receiver
[_ {:keys [::receiver/buffer ::receiver/thread]}]
(some-> thread px/interrupt!)
(some-> buffer a/close!))
(def ^:private json-mapper
(json/mapper
{:encode-key-fn str/camel
:decode-key-fn (comp keyword str/kebab)}))
(defn- start-rcv-loop
[output endpoint]
(let [zctx (ZContext. 1)
socket (.. zctx (createSocket SocketType/SUB))]
(try
(.. socket (connect ^String endpoint))
(.. socket (subscribe ""))
(.. socket (setReceiveTimeOut 5000))
(loop []
(let [msg (.recv ^ZMQ$Socket socket)
msg (ex/ignoring (json/decode msg json-mapper))
msg (if (nil? msg) :empty msg)]
(when (a/>!! output msg)
(recur))))
(finally
(.close ^java.lang.AutoCloseable socket)
(.destroy ^ZContext zctx)))))
(s/def ::logger-name string?)
(s/def ::level string?)
(s/def ::thread string?)
(s/def ::time-millis integer?)
(s/def ::message string?)
(s/def ::context-map map?)
(s/def ::thrown map?)
(s/def ::log4j-event
(s/keys :req-un [::logger-name ::level ::thread ::time-millis ::message]
:opt-un [::context-map ::thrown]))
(defn- prepare
[event]
(if (s/valid? ::log4j-event event)
(merge {:message (:message event)
:created-at (dt/instant (:time-millis event))
:logger/name (:logger-name event)
:logger/level (str/lower (:level event))}
(when-let [trace (-> event :thrown :extended-stack-trace)]
{:trace trace})
(:context-map event))
(do
(l/warn :hint "invalid event" :event event)
nil)))

14
backend/src/app/main.clj
View file

@ -23,7 +23,6 @@
[app.loggers.audit :as-alias audit] [app.loggers.audit :as-alias audit]
[app.loggers.audit.tasks :as-alias audit.tasks] [app.loggers.audit.tasks :as-alias audit.tasks]
[app.loggers.webhooks :as-alias webhooks] [app.loggers.webhooks :as-alias webhooks]
[app.loggers.zmq :as-alias lzmq]
[app.metrics :as-alias mtx] [app.metrics :as-alias mtx]
[app.metrics.definition :as-alias mdef] [app.metrics.definition :as-alias mdef]
[app.msgbus :as-alias mbus] [app.msgbus :as-alias mbus]
@ -430,9 +429,6 @@
{:pool (ig/ref ::db/pool) {:pool (ig/ref ::db/pool)
:key (cf/get :secret-key)} :key (cf/get :secret-key)}
::lzmq/receiver
{}
::audit/collector ::audit/collector
{::db/pool (ig/ref ::db/pool) {::db/pool (ig/ref ::db/pool)
::wrk/executor (ig/ref ::wrk/executor) ::wrk/executor (ig/ref ::wrk/executor)
@ -454,17 +450,11 @@
{::db/pool (ig/ref ::db/pool) {::db/pool (ig/ref ::db/pool)
::http.client/client (ig/ref ::http.client/client)} ::http.client/client (ig/ref ::http.client/client)}
:app.loggers.loki/reporter
{::lzmq/receiver (ig/ref ::lzmq/receiver)
::http.client/client (ig/ref ::http.client/client)}
:app.loggers.mattermost/reporter :app.loggers.mattermost/reporter
{::lzmq/receiver (ig/ref ::lzmq/receiver) {::http.client/client (ig/ref ::http.client/client)}
::http.client/client (ig/ref ::http.client/client)}
:app.loggers.database/reporter :app.loggers.database/reporter
{::lzmq/receiver (ig/ref :app.loggers.zmq/receiver) {::db/pool (ig/ref ::db/pool)}
::db/pool (ig/ref ::db/pool)}
::sto/storage ::sto/storage
{:pool (ig/ref ::db/pool) {:pool (ig/ref ::db/pool)

3
backend/src/app/migrations.clj
View file

@ -308,6 +308,9 @@
{:name "0100-mod-profile-indexes" {:name "0100-mod-profile-indexes"
:fn (mg/resource "app/migrations/sql/0100-mod-profile-indexes.sql")} :fn (mg/resource "app/migrations/sql/0100-mod-profile-indexes.sql")}
{:name "0101-mod-server-error-report-table"
:fn (mg/resource "app/migrations/sql/0101-mod-server-error-report-table.sql")}
]) ])

2
backend/src/app/migrations/sql/0101-mod-server-error-report-table.sql Normal file
View file

@ -0,0 +1,2 @@
ALTER TABLE server_error_report
ADD COLUMN version integer DEFAULT 1;

6
backend/src/app/msgbus.clj
View file

@ -79,7 +79,7 @@
(us/verify! ::msgbus msgbus) (us/verify! ::msgbus msgbus)
(set-error-handler! state #(l/error :cause % :hint "unexpected error on agent" ::l/async false)) (set-error-handler! state #(l/error :cause % :hint "unexpected error on agent" ::l/sync? true))
(set-error-mode! state :continue) (set-error-mode! state :continue)
(start-io-loop! msgbus) (start-io-loop! msgbus)
@ -133,7 +133,7 @@
[nsubs cfg topic chan] [nsubs cfg topic chan]
(let [nsubs (if (nil? nsubs) #{chan} (conj nsubs chan))] (let [nsubs (if (nil? nsubs) #{chan} (conj nsubs chan))]
(when (= 1 (count nsubs)) (when (= 1 (count nsubs))
(l/trace :hint "open subscription" :topic topic ::l/async false) (l/trace :hint "open subscription" :topic topic ::l/sync? true)
(redis-sub cfg topic)) (redis-sub cfg topic))
nsubs)) nsubs))
@ -144,7 +144,7 @@
[nsubs cfg topic chan] [nsubs cfg topic chan]
(let [nsubs (disj nsubs chan)] (let [nsubs (disj nsubs chan)]
(when (empty? nsubs) (when (empty? nsubs)
(l/trace :hint "close subscription" :topic topic ::l/async false) (l/trace :hint "close subscription" :topic topic ::l/sync? true)
(redis-unsub cfg topic)) (redis-unsub cfg topic))
nsubs)) nsubs))

6
backend/src/app/rpc.clj
View file

@ -93,7 +93,7 @@
(p/mcat (partial handle-response request)) (p/mcat (partial handle-response request))
(p/fnly (fn [response cause] (p/fnly (fn [response cause]
(if cause (if cause
(raise (ex/wrap-with-context cause {:profile-id profile-id})) (raise cause)
(respond response))))))) (respond response)))))))
(defn- rpc-mutation-handler (defn- rpc-mutation-handler
@ -117,7 +117,7 @@
(p/mcat (partial handle-response request)) (p/mcat (partial handle-response request))
(p/fnly (fn [response cause] (p/fnly (fn [response cause]
(if cause (if cause
(raise (ex/wrap-with-context cause {:profile-id profile-id})) (raise cause)
(respond response))))))) (respond response)))))))
(defn- rpc-command-handler (defn- rpc-command-handler
@ -144,7 +144,7 @@
(p/mcat (partial handle-response request)) (p/mcat (partial handle-response request))
(p/fnly (fn [response cause] (p/fnly (fn [response cause]
(if cause (if cause
(raise (ex/wrap-with-context cause {:profile-id profile-id})) (raise cause)
(respond response)))))))) (respond response))))))))
(defn- wrap-metrics (defn- wrap-metrics

2
backend/src/app/rpc/climit.clj
View file

@ -32,7 +32,7 @@
(defn- capacity-exception? (defn- capacity-exception?
[o] [o]
(and (ex/ex-info? o) (and (ex/error? o)
(let [data (ex-data o)] (let [data (ex-data o)]
(and (= :bulkhead-error (:type data)) (and (= :bulkhead-error (:type data))
(= :capacity-limit-reached (:code data)))))) (= :capacity-limit-reached (:code data))))))

74
backend/src/app/rpc/commands/binfile.clj
View file

@ -109,20 +109,20 @@
(defn write-byte! (defn write-byte!
[^DataOutputStream output data] [^DataOutputStream output data]
(l/trace :fn "write-byte!" :data data :position @*position* ::l/async false) (l/trace :fn "write-byte!" :data data :position @*position* ::l/sync? true)
(.writeByte output (byte data)) (.writeByte output (byte data))
(swap! *position* inc)) (swap! *position* inc))
(defn read-byte! (defn read-byte!
[^DataInputStream input] [^DataInputStream input]
(let [v (.readByte input)] (let [v (.readByte input)]
(l/trace :fn "read-byte!" :val v :position @*position* ::l/async false) (l/trace :fn "read-byte!" :val v :position @*position* ::l/sync? true)
(swap! *position* inc) (swap! *position* inc)
v)) v))
(defn write-long! (defn write-long!
[^DataOutputStream output data] [^DataOutputStream output data]
(l/trace :fn "write-long!" :data data :position @*position* ::l/async false) (l/trace :fn "write-long!" :data data :position @*position* ::l/sync? true)
(.writeLong output (long data)) (.writeLong output (long data))
(swap! *position* + 8)) (swap! *position* + 8))
@ -130,14 +130,14 @@
(defn read-long! (defn read-long!
[^DataInputStream input] [^DataInputStream input]
(let [v (.readLong input)] (let [v (.readLong input)]
(l/trace :fn "read-long!" :val v :position @*position* ::l/async false) (l/trace :fn "read-long!" :val v :position @*position* ::l/sync? true)
(swap! *position* + 8) (swap! *position* + 8)
v)) v))
(defn write-bytes! (defn write-bytes!
[^DataOutputStream output ^bytes data] [^DataOutputStream output ^bytes data]
(let [size (alength data)] (let [size (alength data)]
(l/trace :fn "write-bytes!" :size size :position @*position* ::l/async false) (l/trace :fn "write-bytes!" :size size :position @*position* ::l/sync? true)
(.write output data 0 size) (.write output data 0 size)
(swap! *position* + size))) (swap! *position* + size)))
@ -145,7 +145,7 @@
[^InputStream input ^bytes buff] [^InputStream input ^bytes buff]
(let [size (alength buff) (let [size (alength buff)
readed (.readNBytes input buff 0 size)] readed (.readNBytes input buff 0 size)]
(l/trace :fn "read-bytes!" :expected (alength buff) :readed readed :position @*position* ::l/async false) (l/trace :fn "read-bytes!" :expected (alength buff) :readed readed :position @*position* ::l/sync? true)
(swap! *position* + readed) (swap! *position* + readed)
readed)) readed))
@ -153,7 +153,7 @@
(defn write-uuid! (defn write-uuid!
[^DataOutputStream output id] [^DataOutputStream output id]
(l/trace :fn "write-uuid!" :position @*position* :WRITTEN? (.size output) ::l/async false) (l/trace :fn "write-uuid!" :position @*position* :WRITTEN? (.size output) ::l/sync? true)
(doto output (doto output
(write-byte! (get-mark :uuid)) (write-byte! (get-mark :uuid))
@ -162,7 +162,7 @@
(defn read-uuid! (defn read-uuid!
[^DataInputStream input] [^DataInputStream input]
(l/trace :fn "read-uuid!" :position @*position* ::l/async false) (l/trace :fn "read-uuid!" :position @*position* ::l/sync? true)
(let [m (read-byte! input)] (let [m (read-byte! input)]
(assert-mark m :uuid) (assert-mark m :uuid)
(let [a (read-long! input) (let [a (read-long! input)
@ -171,7 +171,7 @@
(defn write-obj! (defn write-obj!
[^DataOutputStream output data] [^DataOutputStream output data]
(l/trace :fn "write-obj!" :position @*position* ::l/async false) (l/trace :fn "write-obj!" :position @*position* ::l/sync? true)
(let [^bytes data (fres/encode data)] (let [^bytes data (fres/encode data)]
(doto output (doto output
(write-byte! (get-mark :obj)) (write-byte! (get-mark :obj))
@ -180,7 +180,7 @@
(defn read-obj! (defn read-obj!
[^DataInputStream input] [^DataInputStream input]
(l/trace :fn "read-obj!" :position @*position* ::l/async false) (l/trace :fn "read-obj!" :position @*position* ::l/sync? true)
(let [m (read-byte! input)] (let [m (read-byte! input)]
(assert-mark m :obj) (assert-mark m :obj)
(let [size (read-long! input)] (let [size (read-long! input)]
@ -191,14 +191,14 @@
(defn write-label! (defn write-label!
[^DataOutputStream output label] [^DataOutputStream output label]
(l/trace :fn "write-label!" :label label :position @*position* ::l/async false) (l/trace :fn "write-label!" :label label :position @*position* ::l/sync? true)
(doto output (doto output
(write-byte! (get-mark :label)) (write-byte! (get-mark :label))
(write-obj! label))) (write-obj! label)))
(defn read-label! (defn read-label!
[^DataInputStream input] [^DataInputStream input]
(l/trace :fn "read-label!" :position @*position* ::l/async false) (l/trace :fn "read-label!" :position @*position* ::l/sync? true)
(let [m (read-byte! input)] (let [m (read-byte! input)]
(assert-mark m :label) (assert-mark m :label)
(read-obj! input))) (read-obj! input)))
@ -208,7 +208,7 @@
(l/trace :fn "write-header!" (l/trace :fn "write-header!"
:version version :version version
:position @*position* :position @*position*
::l/async false) ::l/sync? true)
(let [vers (-> version name (subs 1) parse-long) (let [vers (-> version name (subs 1) parse-long)
output (io/data-output-stream output)] output (io/data-output-stream output)]
(doto output (doto output
@ -218,7 +218,7 @@
(defn read-header! (defn read-header!
[^InputStream input] [^InputStream input]
(l/trace :fn "read-header!" :position @*position* ::l/async false) (l/trace :fn "read-header!" :position @*position* ::l/sync? true)
(let [input (io/data-input-stream input) (let [input (io/data-input-stream input)
mark (read-byte! input) mark (read-byte! input)
mnum (read-long! input) mnum (read-long! input)
@ -235,13 +235,13 @@
(defn copy-stream! (defn copy-stream!
[^OutputStream output ^InputStream input ^long size] [^OutputStream output ^InputStream input ^long size]
(let [written (io/copy! input output :size size)] (let [written (io/copy! input output :size size)]
(l/trace :fn "copy-stream!" :position @*position* :size size :written written ::l/async false) (l/trace :fn "copy-stream!" :position @*position* :size size :written written ::l/sync? true)
(swap! *position* + written) (swap! *position* + written)
written)) written))
(defn write-stream! (defn write-stream!
[^DataOutputStream output stream size] [^DataOutputStream output stream size]
(l/trace :fn "write-stream!" :position @*position* ::l/async false :size size) (l/trace :fn "write-stream!" :position @*position* ::l/sync? true :size size)
(doto output (doto output
(write-byte! (get-mark :stream)) (write-byte! (get-mark :stream))
(write-long! size)) (write-long! size))
@ -250,7 +250,7 @@
(defn read-stream! (defn read-stream!
[^DataInputStream input] [^DataInputStream input]
(l/trace :fn "read-stream!" :position @*position* ::l/async false) (l/trace :fn "read-stream!" :position @*position* ::l/sync? true)
(let [m (read-byte! input) (let [m (read-byte! input)
s (read-long! input) s (read-long! input)
p (tmp/tempfile :prefix "penpot.binfile.")] p (tmp/tempfile :prefix "penpot.binfile.")]
@ -264,7 +264,7 @@
(if (> s temp-file-threshold) (if (> s temp-file-threshold)
(with-open [^OutputStream output (io/output-stream p)] (with-open [^OutputStream output (io/output-stream p)]
(let [readed (io/copy! input output :offset 0 :size s)] (let [readed (io/copy! input output :offset 0 :size s)]
(l/trace :fn "read-stream*!" :expected s :readed readed :position @*position* ::l/async false) (l/trace :fn "read-stream*!" :expected s :readed readed :position @*position* ::l/sync? true)
(swap! *position* + readed) (swap! *position* + readed)
[s p])) [s p]))
[s (io/read-as-bytes input :size s)]))) [s (io/read-as-bytes input :size s)])))
@ -465,7 +465,7 @@
(with-open [output (io/data-output-stream output)] (with-open [output (io/data-output-stream output)]
(binding [*state* (volatile! {})] (binding [*state* (volatile! {})]
(run! (fn [section] (run! (fn [section]
(l/debug :hint "write section" :section section ::l/async false) (l/debug :hint "write section" :section section ::l/sync? true)
(write-label! output section) (write-label! output section)
(let [options (-> options (let [options (-> options
(assoc ::output output) (assoc ::output output)
@ -499,7 +499,7 @@
(l/debug :hint "write penpot file" (l/debug :hint "write penpot file"
:id file-id :id file-id
:media (count media) :media (count media)
::l/async false) ::l/sync? true)
(doto output (doto output
(write-obj! file) (write-obj! file)
@ -511,7 +511,7 @@
[{:keys [::db/pool ::output ::include-libraries?]}] [{:keys [::db/pool ::output ::include-libraries?]}]
(let [rels (when include-libraries? (let [rels (when include-libraries?
(retrieve-library-relations pool (-> *state* deref :files)))] (retrieve-library-relations pool (-> *state* deref :files)))]
(l/debug :hint "found rels" :total (count rels) ::l/async false) (l/debug :hint "found rels" :total (count rels) ::l/sync? true)
(write-obj! output rels))) (write-obj! output rels)))
(defmethod write-section :v1/sobjects (defmethod write-section :v1/sobjects
@ -520,14 +520,14 @@
storage (media/configure-assets-storage storage)] storage (media/configure-assets-storage storage)]
(l/debug :hint "found sobjects" (l/debug :hint "found sobjects"
:items (count sids) :items (count sids)
::l/async false) ::l/sync? true)
;; Write all collected storage objects ;; Write all collected storage objects
(write-obj! output sids) (write-obj! output sids)
(doseq [id sids] (doseq [id sids]
(let [{:keys [size] :as obj} @(sto/get-object storage id)] (let [{:keys [size] :as obj} @(sto/get-object storage id)]
(l/debug :hint "write sobject" :id id ::l/async false) (l/debug :hint "write sobject" :id id ::l/sync? true)
(doto output (doto output
(write-uuid! id) (write-uuid! id)
(write-obj! (meta obj))) (write-obj! (meta obj)))
@ -587,7 +587,7 @@
(db/exec-one! conn ["SET CONSTRAINTS ALL DEFERRED;"]) (db/exec-one! conn ["SET CONSTRAINTS ALL DEFERRED;"])
(binding [*state* (volatile! {:media [] :index {}})] (binding [*state* (volatile! {:media [] :index {}})]
(run! (fn [section] (run! (fn [section]
(l/debug :hint "reading section" :section section ::l/async false) (l/debug :hint "reading section" :section section ::l/sync? true)
(assert-read-label! input section) (assert-read-label! input section)
(let [options (-> options (let [options (-> options
(assoc ::section section) (assoc ::section section)
@ -605,7 +605,7 @@
(defmethod read-section :v1/metadata (defmethod read-section :v1/metadata
[{:keys [::input]}] [{:keys [::input]}]
(let [{:keys [version files]} (read-obj! input)] (let [{:keys [version files]} (read-obj! input)]
(l/debug :hint "metadata readed" :version (:full version) :files files ::l/async false) (l/debug :hint "metadata readed" :version (:full version) :files files ::l/sync? true)
(vswap! *state* update :index update-index files) (vswap! *state* update :index update-index files)
(vswap! *state* assoc :version version :files files))) (vswap! *state* assoc :version version :files files)))
@ -633,14 +633,14 @@
:hint "the penpot file seems corrupt, found unexpected uuid (file-id)")) :hint "the penpot file seems corrupt, found unexpected uuid (file-id)"))
;; Update index using with media ;; Update index using with media
(l/debug :hint "update index with media" ::l/async false) (l/debug :hint "update index with media" ::l/sync? true)
(vswap! *state* update :index update-index (map :id media')) (vswap! *state* update :index update-index (map :id media'))
;; Store file media for later insertion ;; Store file media for later insertion
(l/debug :hint "update media references" ::l/async false) (l/debug :hint "update media references" ::l/sync? true)
(vswap! *state* update :media into (map #(update % :id lookup-index)) media') (vswap! *state* update :media into (map #(update % :id lookup-index)) media')
(l/debug :hint "processing file" :file-id file-id ::features features ::l/async false) (l/debug :hint "processing file" :file-id file-id ::features features ::l/sync? true)
(binding [ffeat/*current* features (binding [ffeat/*current* features
ffeat/*wrap-with-objects-map-fn* (if (features "storage/objects-map") omap/wrap identity) ffeat/*wrap-with-objects-map-fn* (if (features "storage/objects-map") omap/wrap identity)
@ -666,7 +666,7 @@
:created-at timestamp :created-at timestamp
:modified-at timestamp}] :modified-at timestamp}]
(l/debug :hint "create file" :id file-id' ::l/async false) (l/debug :hint "create file" :id file-id' ::l/sync? true)
(if overwrite? (if overwrite?
(create-or-update-file conn params) (create-or-update-file conn params)
@ -689,7 +689,7 @@
(l/debug :hint "create file library link" (l/debug :hint "create file library link"
:file-id (:file-id rel) :file-id (:file-id rel)
:lib-id (:library-file-id rel) :lib-id (:library-file-id rel)
::l/async false) ::l/sync? true)
(db/insert! conn :file-library-rel rel))))) (db/insert! conn :file-library-rel rel)))))
(defmethod read-section :v1/sobjects (defmethod read-section :v1/sobjects
@ -706,7 +706,7 @@
:code :inconsistent-penpot-file :code :inconsistent-penpot-file
:hint "the penpot file seems corrupt, found unexpected uuid (storage-object-id)")) :hint "the penpot file seems corrupt, found unexpected uuid (storage-object-id)"))
(l/debug :hint "readed storage object" :id id ::l/async false) (l/debug :hint "readed storage object" :id id ::l/sync? true)
(let [[size resource] (read-stream! input) (let [[size resource] (read-stream! input)
hash (sto/calculate-hash resource) hash (sto/calculate-hash resource)
@ -720,18 +720,18 @@
sobject @(sto/put-object! storage params)] sobject @(sto/put-object! storage params)]
(l/debug :hint "persisted storage object" :id id :new-id (:id sobject) ::l/async false) (l/debug :hint "persisted storage object" :id id :new-id (:id sobject) ::l/sync? true)
(vswap! *state* update :index assoc id (:id sobject))))) (vswap! *state* update :index assoc id (:id sobject)))))
(doseq [item (:media @*state*)] (doseq [item (:media @*state*)]
(l/debug :hint "inserting file media object" (l/debug :hint "inserting file media object"
:id (:id item) :id (:id item)
:file-id (:file-id item) :file-id (:file-id item)
::l/async false) ::l/sync? true)
(let [file-id (lookup-index (:file-id item))] (let [file-id (lookup-index (:file-id item))]
(if (= file-id (:file-id item)) (if (= file-id (:file-id item))
(l/warn :hint "ignoring file media object" :file-id (:file-id item) ::l/async false) (l/warn :hint "ignoring file media object" :file-id (:file-id item) ::l/sync? true)
(db/insert! conn :file-media-object (db/insert! conn :file-media-object
(-> item (-> item
(assoc :file-id file-id) (assoc :file-id file-id)
@ -742,7 +742,7 @@
(defn- lookup-index (defn- lookup-index
[id] [id]
(let [val (get-in @*state* [:index id])] (let [val (get-in @*state* [:index id])]
(l/trace :fn "lookup-index" :id id :val val ::l/async false) (l/trace :fn "lookup-index" :id id :val val ::l/sync? true)
(when (and (not (::ignore-index-errors? *options*)) (not val)) (when (and (not (::ignore-index-errors? *options*)) (not val))
(ex/raise :type :validation (ex/raise :type :validation
:code :incomplete-index :code :incomplete-index
@ -755,7 +755,7 @@
index index] index index]
(if-let [id (first items)] (if-let [id (first items)]
(let [new-id (if (::overwrite? *options*) id (uuid/next))] (let [new-id (if (::overwrite? *options*) id (uuid/next))]
(l/trace :fn "update-index" :id id :new-id new-id ::l/async false) (l/trace :fn "update-index" :id id :new-id new-id ::l/sync? true)
(recur (rest items) (recur (rest items)
(assoc index id new-id))) (assoc index id new-id)))
index))) index)))
@ -803,7 +803,7 @@
(try (try
(process-map-form form) (process-map-form form)
(catch Throwable cause (catch Throwable cause
(l/warn :hint "failed form" :form (pr-str form) ::l/async false) (l/warn :hint "failed form" :form (pr-str form) ::l/sync? true)
(throw cause))) (throw cause)))
form)) form))
data))) data)))

1
backend/src/app/rpc/commands/fonts.clj
View file

@ -41,7 +41,6 @@
(s/def ::project-id ::us/uuid) (s/def ::project-id ::us/uuid)
(s/def ::style valid-style) (s/def ::style valid-style)
(s/def ::team-id ::us/uuid) (s/def ::team-id ::us/uuid)
(s/def ::team-id ::us/uuid)
(s/def ::weight valid-weight) (s/def ::weight valid-weight)
;; --- QUERY: Get font variants ;; --- QUERY: Get font variants

6
backend/src/app/rpc/rlimit.clj
View file

@ -363,7 +363,7 @@
(let [state (read-config path)] (let [state (read-config path)]
(l/info :hint "config refreshed" (l/info :hint "config refreshed"
:loaded-limits (count (::limits state)) :loaded-limits (count (::limits state))
::l/async false) ::l/sync? true)
state))))) state)))))
(schedule-next [state] (schedule-next [state]
@ -380,10 +380,10 @@
(when-not (instance? java.util.concurrent.RejectedExecutionException cause) (when-not (instance? java.util.concurrent.RejectedExecutionException cause)
(if-let [explain (-> cause ex-data ex/explain)] (if-let [explain (-> cause ex-data ex/explain)]
(l/warn ::l/raw (str "unable to refresh config, invalid format:\n" explain) (l/warn ::l/raw (str "unable to refresh config, invalid format:\n" explain)
::l/async false) ::l/sync? true)
(l/warn :hint "unexpected exception on loading config" (l/warn :hint "unexpected exception on loading config"
:cause cause :cause cause
::l/async false)))) ::l/sync? true))))
(defn- get-config-path (defn- get-config-path
[] []

2
backend/src/app/util/websocket.clj
View file

@ -242,7 +242,7 @@
(let [result (a/<! (handler wsp v))] (let [result (a/<! (handler wsp v))]
;; (l/trace :hint "message received" :message v) ;; (l/trace :hint "message received" :message v)
(cond (cond
(ex/ex-info? result) (ex/error? result)
(a/>! output-ch {:type :error :error (ex-data result)}) (a/>! output-ch {:type :error :error (ex-data result)})
(ex/exception? result) (ex/exception? result)

8
backend/test/backend_tests/helpers.clj
View file

@ -80,9 +80,9 @@
:path (-> "backend_tests/test_files/template.penpot" io/resource fs/path)}] :path (-> "backend_tests/test_files/template.penpot" io/resource fs/path)}]
system (-> (merge main/system-config main/worker-config) system (-> (merge main/system-config main/worker-config)
(assoc-in [:app.redis/redis :app.redis/uri] (:redis-uri config)) (assoc-in [:app.redis/redis :app.redis/uri] (:redis-uri config))
(assoc-in [:app.db/pool :uri] (:database-uri config)) (assoc-in [::db/pool ::db/uri] (:database-uri config))
(assoc-in [:app.db/pool :username] (:database-username config)) (assoc-in [::db/pool ::db/username] (:database-username config))
(assoc-in [:app.db/pool :password] (:database-password config)) (assoc-in [::db/pool ::db/password] (:database-password config))
(assoc-in [:app.rpc/methods :templates] templates) (assoc-in [:app.rpc/methods :templates] templates)
(dissoc :app.srepl/server (dissoc :app.srepl/server
:app.http/server :app.http/server
@ -390,7 +390,7 @@
(defn ex-info? (defn ex-info?
[v] [v]
(instance? clojure.lang.ExceptionInfo v)) (ex/error? v))
(defn ex-type (defn ex-type
[e] [e]

6
common/deps.edn
View file

@ -11,13 +11,13 @@
org.apache.logging.log4j/log4j-core {:mvn/version "2.19.0"} org.apache.logging.log4j/log4j-core {:mvn/version "2.19.0"}
org.apache.logging.log4j/log4j-web {:mvn/version "2.19.0"} org.apache.logging.log4j/log4j-web {:mvn/version "2.19.0"}
org.apache.logging.log4j/log4j-jul {:mvn/version "2.19.0"} org.apache.logging.log4j/log4j-jul {:mvn/version "2.19.0"}
org.apache.logging.log4j/log4j-slf4j18-impl {:mvn/version "2.18.0"} org.apache.logging.log4j/log4j-slf4j2-impl {:mvn/version "2.19.0"}
org.slf4j/slf4j-api {:mvn/version "2.0.0-alpha1"} org.slf4j/slf4j-api {:mvn/version "2.0.6"}
pl.tkowalcz.tjahzi/log4j2-appender {:mvn/version "0.9.26"}
selmer/selmer {:mvn/version "1.12.55"} selmer/selmer {:mvn/version "1.12.55"}
criterium/criterium {:mvn/version "0.4.6"} criterium/criterium {:mvn/version "0.4.6"}
expound/expound {:mvn/version "0.9.0"} expound/expound {:mvn/version "0.9.0"}
com.cognitect/transit-clj {:mvn/version "1.0.329"} com.cognitect/transit-clj {:mvn/version "1.0.329"}
com.cognitect/transit-cljs {:mvn/version "0.8.280"} com.cognitect/transit-cljs {:mvn/version "0.8.280"}

19
common/src/app/common/data.cljc
View file

@ -13,18 +13,19 @@
(:require-macros [app.common.data])) (:require-macros [app.common.data]))
(:require (:require
[app.common.math :as mth]
[clojure.set :as set]
[cuerdas.core :as str]
#?(:cljs [cljs.reader :as r] #?(:cljs [cljs.reader :as r]
:clj [clojure.edn :as r]) :clj [clojure.edn :as r])
#?(:cljs [cljs.core :as c] #?(:cljs [cljs.core :as c]
:clj [clojure.core :as c]) :clj [clojure.core :as c])
[app.common.math :as mth]
[clojure.set :as set]
[cuerdas.core :as str]
[linked.map :as lkm]
[linked.set :as lks]) [linked.set :as lks])
#?(:clj #?(:clj
(:import (:import
linked.set.LinkedSet linked.set.LinkedSet
linked.map.LinkedMap
java.lang.AutoCloseable))) java.lang.AutoCloseable)))
(def boolean-or-nil? (def boolean-or-nil?
@ -39,11 +40,21 @@
([a] (conj lks/empty-linked-set a)) ([a] (conj lks/empty-linked-set a))
([a & xs] (apply conj lks/empty-linked-set a xs))) ([a & xs] (apply conj lks/empty-linked-set a xs)))
(defn ordered-map
([] lkm/empty-linked-map)
([a] (conj lkm/empty-linked-map a))
([a & xs] (apply conj lkm/empty-linked-map a xs)))
(defn ordered-set? (defn ordered-set?
[o] [o]
#?(:cljs (instance? lks/LinkedSet o) #?(:cljs (instance? lks/LinkedSet o)
:clj (instance? LinkedSet o))) :clj (instance? LinkedSet o)))
(defn ordered-map?
[o]
#?(:cljs (instance? lkm/LinkedMap o)
:clj (instance? LinkedMap o)))
#?(:clj #?(:clj
(defmethod print-method clojure.lang.PersistentQueue [q, w] (defmethod print-method clojure.lang.PersistentQueue [q, w]
;; Overload the printer for queues so they look like fish ;; Overload the printer for queues so they look like fish

134
common/src/app/common/exceptions.cljc
View file

@ -12,7 +12,12 @@
[app.common.pprint :as pp] [app.common.pprint :as pp]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[cuerdas.core :as str] [cuerdas.core :as str]
[expound.alpha :as expound])) [expound.alpha :as expound])
#?(:clj
(:import
clojure.lang.IPersistentMap)))
#?(:clj (set! *warn-on-reflection* true))
(defmacro error (defmacro error
[& {:keys [type hint] :as params}] [& {:keys [type hint] :as params}]
@ -41,44 +46,22 @@
[& exprs] [& exprs]
`(try* (^:once fn* [] ~@exprs) identity)) `(try* (^:once fn* [] ~@exprs) identity))
(defn cause
"Retrieve chained cause if available of the exception."
[^Throwable throwable]
(.getCause throwable))
(defn ex-info? (defn ex-info?
[v] [v]
(instance? #?(:clj clojure.lang.ExceptionInfo :cljs cljs.core.ExceptionInfo) v)) (instance? #?(:clj clojure.lang.IExceptionInfo :cljs cljs.core.ExceptionInfo) v))
(defn error?
[v]
(instance? #?(:clj clojure.lang.IExceptionInfo :cljs cljs.core.ExceptionInfo) v))
(defn exception? (defn exception?
[v] [v]
(instance? #?(:clj java.lang.Throwable :cljs js/Error) v)) (instance? #?(:clj java.lang.Throwable :cljs js/Error) v))
#?(:cljs #?(:clj
(deftype WrappedException [cause meta] (defn runtime-exception?
cljs.core/IMeta [v]
(-meta [_] meta) (instance? RuntimeException v)))
cljs.core/IDeref
(-deref [_] cause))
:clj
(deftype WrappedException [cause meta]
clojure.lang.IMeta
(meta [_] meta)
clojure.lang.IDeref
(deref [_] cause)))
#?(:clj (ns-unmap 'app.common.exceptions '->WrappedException))
#?(:clj (ns-unmap 'app.common.exceptions 'map->WrappedException))
(defn wrapped?
[o]
(instance? WrappedException o))
(defn wrap-with-context
[cause context]
(WrappedException. cause context))
(defn explain (defn explain
([data] (explain data nil)) ([data] (explain data nil))
@ -97,15 +80,17 @@
(s/explain-out (update data ::s/problems #(take max-problems %)))))))) (s/explain-out (update data ::s/problems #(take max-problems %))))))))
#?(:clj #?(:clj
(defn print-throwable (defn format-throwable
[^Throwable cause [^Throwable cause & {:keys [summary? detail? header? data? explain? chain? data-level data-length trace-length]
& {:keys [trace? data? chain? data-level data-length trace-length explain-length] :or {summary? true
:or {trace? true detail? true
data? true header? true
chain? true data? true
explain-length 10 explain? true
data-length 10 chain? true
data-level 3}}] data-length 10
data-level 3}}]
(letfn [(print-trace-element [^StackTraceElement e] (letfn [(print-trace-element [^StackTraceElement e]
(let [class (.getClassName e) (let [class (.getClassName e)
method (.getMethodName e)] method (.getMethodName e)]
@ -132,28 +117,29 @@
(doseq [line lines] (doseq [line lines]
(println " " line))))) (println " " line)))))
(print-trace-title [cause] (print-trace-title [^Throwable cause]
(print " → ") (print " → ")
(printf "%s: %s" (.getName (class cause)) (first (str/lines (ex-message cause)))) (printf "%s: %s" (.getName (class cause)) (first (str/lines (ex-message cause))))
(when-let [e (first (.getStackTrace cause))] (when-let [^StackTraceElement e (first (.getStackTrace ^Throwable cause))]
(printf " (%s:%d)" (or (.getFileName e) "") (.getLineNumber e))) (printf " (%s:%d)" (or (.getFileName e) "") (.getLineNumber e)))
(newline)) (newline))
(print-summary [cause] (print-summary [^Throwable cause]
(let [causes (loop [cause (.getCause cause) (let [causes (loop [cause (ex-cause cause)
result []] result []]
(if cause (if cause
(recur (.getCause cause) (recur (ex-cause cause)
(conj result cause)) (conj result cause))
result))] result))]
(println "TRACE:") (when header?
(println "SUMMARY:"))
(print-trace-title cause) (print-trace-title cause)
(doseq [cause causes] (doseq [cause causes]
(print-trace-title cause)))) (print-trace-title cause))))
(print-trace [cause] (print-trace [^Throwable cause]
(print-trace-title cause) (print-trace-title cause)
(let [st (.getStackTrace cause)] (let [st (.getStackTrace cause)]
(print " at: ") (print " at: ")
@ -167,35 +153,35 @@
(print-trace-element e) (print-trace-element e)
(newline)))) (newline))))
(print-all [cause] (print-detail [^Throwable cause]
(print-summary cause) (print-trace cause)
(println "DETAIL:") (when-let [data (ex-data cause)]
(when trace? (when data?
(print-trace cause)) (print-data (dissoc data ::s/problems ::s/spec ::s/value)))
(when explain?
(when data?
(when-let [data (ex-data cause)]
(if-let [explain (explain data)] (if-let [explain (explain data)]
(print-explain explain) (print-explain explain)))))
(print-data data))))
(when chain? (print-all [^Throwable cause]
(loop [cause cause] (when summary?
(when-let [cause (.getCause cause)] (print-summary cause))
(newline)
(print-trace cause)
(when data? (when detail?
(when-let [data (ex-data cause)] (when header?
(if-let [explain (explain data)] (println "DETAIL:"))
(print-explain explain)
(print-data data))))
(recur cause))))) (print-detail cause)
(when chain?
(loop [cause cause]
(when-let [cause (ex-cause cause)]
(newline)
(print-detail cause)
(recur cause))))))
] ]
(with-out-str
(print-all cause)))))
(println #?(:clj
(with-out-str (defn print-throwable
(print-all cause)))))) [cause & {:as opts}]
(println (format-throwable cause opts))))

651
common/src/app/common/logging.cljc
View file

@ -5,375 +5,362 @@
;; Copyright (c) KALEIDOS INC ;; Copyright (c) KALEIDOS INC
(ns app.common.logging (ns app.common.logging
"A lightweight and multiplaform (clj & cljs) asynchronous by default
logging API.
On the CLJ side it backed by SLF4J API, so the user can route
logging output to any implementation that SLF4J supports. And on the
CLJS side, it is backed by printing logs using console.log.
Simple example of logging API:
(require '[funcool.tools.logging :as l])
(l/info :hint \"hello funcool logging\"
:tname (.getName (Thread/currentThread)))
The log records are ordered key-value pairs (instead of plain
strings) and by default are formatted usin custom, human readable
but also easy parseable format; but it can be extended externally
to use JSON or whatever format user prefers.
The format can be set at compile time (externaly), passing a JVM
property or closure compiler compile-time constant. Example:
-Dpenpot.logging.props-format=':default'
The exception formating is customizable in the same way as the props
formatter.
All messages are evaluated lazily, in a different thread, only if
the message can be logged (logger level is loggable). This means
that you should take care of lazy values on loging props. For cases
where you strictly need syncrhonous message evaluation, you can use
the special `::sync?` prop.
The formatting of the message and the exception is handled on this
library and it doesn't rely on the underlying implementation (aka
SLF4J).
"
#?(:cljs (:require-macros [app.common.logging :as l]))
(:require (:require
#?(:clj [clojure.edn :as edn]
:cljs [cljs.reader :as edn])
[app.common.data :as d] [app.common.data :as d]
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.uuid :as uuid] [app.common.pprint :as pp]
[app.common.spec :as us] [app.common.spec :as us]
[cuerdas.core :as str] [app.common.uuid :as uuid]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[fipp.edn :as fpp] [cuerdas.core :as str]
#?(:cljs [goog.log :as glog])) [promesa.exec :as px]
#?(:cljs (:require-macros [app.common.logging]) [promesa.util :as pu])
:clj (:import #?(:clj
org.apache.logging.log4j.Level (:import
org.apache.logging.log4j.LogManager org.slf4j.LoggerFactory
org.apache.logging.log4j.Logger org.slf4j.Logger)))
org.apache.logging.log4j.ThreadContext
org.apache.logging.log4j.CloseableThreadContext
org.apache.logging.log4j.spi.LoggerContext)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (def ^:dynamic *context* nil)
;; CLJ Specific
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
#?(:clj (set! *warn-on-reflection* true)) #?(:clj (set! *warn-on-reflection* true))
(def ^:private reserved-props (defonce ^{:doc "A global log-record atom instance; stores last logged record."}
#{:level :cause ::logger ::async ::raw ::context}) log-record
(atom nil))
(defn build-message-kv (defonce
[props] ^{:doc "Default executor instance used for processing logs."
(loop [pairs (remove (fn [[k]] (contains? reserved-props k)) props) :dynamic true}
result []] *default-executor*
(if-let [[k v] (first pairs)] (delay
(recur (rest pairs) #?(:clj (px/single-executor :factory (px/thread-factory :name "penpot/logger"))
(conj result (str/concat (d/name k) "=" (pr-str v)))) :cljs (px/microtask-executor))))
(str/join ", " result))))
(defn build-message-cause #?(:cljs
[props] (defonce loggers (js/Map.)))
#?(:clj (when-let [[_ cause] (d/seek (fn [[k]] (= k :cause)) props)]
(when cause #?(:cljs
(with-out-str (declare level->int))
(ex/print-throwable cause))))
:cljs nil)) #?(:cljs
(defn- get-parent-logger
[^string logger]
(let [lindex (.lastIndexOf logger ".")]
(.slice logger 0 (max lindex 0)))))
#?(:cljs
(defn- get-logger-level
"Get the current level set for the specified logger. Returns int."
[^string logger]
(let [val (.get ^js/Map loggers logger)]
(if (pos? val)
val
(loop [logger' (get-parent-logger logger)]
(let [val (.get ^js/Map loggers logger')]
(if (some? val)
(do
(.set ^js/Map loggers logger val)
val)
(if (= "" logger')
(do
(.set ^js/Map loggers logger 100)
100)
(recur (get-parent-logger logger'))))))))))
(defn enabled?
"Check if logger has enabled logging for given level."
[logger level]
#?(:clj
(let [logger (LoggerFactory/getLogger ^String logger)]
(case level
:trace (and (.isTraceEnabled ^Logger logger) logger)
:debug (and (.isDebugEnabled ^Logger logger) logger)
:info (and (.isInfoEnabled ^Logger logger) logger)
:warn (and (.isWarnEnabled ^Logger logger) logger)
:error (and (.isErrorEnabled ^Logger logger) logger)
:fatal (and (.isErrorEnabled ^Logger logger) logger)
(throw (IllegalArgumentException. (str "invalid level:" level)))))
:cljs
(>= (level->int level)
(get-logger-level logger))))
(defn- level->color
[level]
(case level
:error "#c82829"
:warn "#f5871f"
:info "#4271ae"
:debug "#969896"
:trace "#8e908c"))
(defn- level->name
[level]
(case level
:debug "DBG"
:trace "TRC"
:info "INF"
:warn "WRN"
:error "ERR"))
(defn level->int
[level]
(case level
:debug 10
:trace 20
:info 30
:warn 40
:error 50))
(defn build-message (defn build-message
[props] [props]
(let [props (sequence (comp (partition-all 2) (map vec)) props) (loop [props (seq props)
message-kv (build-message-kv props) result []]
message-ex (build-message-cause props)] (if-let [[k v] (first props)]
(cond-> message-kv (if (simple-ident? k)
(some? message-ex) (recur (next props)
(str "\n" message-ex)))) (conj result (str (name k) "=" (pr-str v))))
(recur (next props)
result))
(str/join ", " result))))
#?(:clj (defn build-stack-trace
(def logger-context [cause]
(LogManager/getContext false))) #?(:clj (ex/format-throwable cause)
:cljs (.-stack ^js cause)))
#?(:clj #?(:cljs
(def logging-agent (defn- get-special-props
(agent nil :error-mode :continue))) [props]
(->> (seq props)
(keep (fn [[k v]]
(when (qualified-ident? k)
(cond
(= "js" (namespace k))
[:js (name k) (if (object? v) v (clj->js v))]
#?(:clj (= "error" (namespace k))
(defn stringify-data [:error (name k) v])))))))
[val]
(cond
(string? val)
val
(instance? clojure.lang.Named val) (def ^:private reserved-props
(name val) #{::level :cause ::logger ::sync? ::context})
(coll? val) (def ^:no-doc msg-props-xf
(binding [*print-level* 8 (comp (partition-all 2)
*print-length* 25] (map vec)
(with-out-str (fpp/pprint val {:width 200}))) (remove (fn [[k _]] (contains? reserved-props k)))))
:else (s/def ::id ::us/uuid)
(str val)))) (s/def ::props any? #_d/ordered-map?)
(s/def ::context (s/nilable (s/map-of keyword? any?)))
(s/def ::level #{:trace :debug :info :warn :error :fatal})
(s/def ::logger string?)
(s/def ::timestamp ::us/integer)
(s/def ::cause (s/nilable ex/exception?))
(s/def ::message delay?)
(s/def ::record
(s/keys :req [::id ::props ::logger ::level]
:opt [::cause ::context]))
#?(:clj (defn current-timestamp
(defn data->context-map []
^java.util.Map #?(:clj (inst-ms (java.time.Instant/now))
[data] :cljs (js/Date.now)))
(into {}
(comp (filter second)
(map (fn [[key val]]
[(stringify-data key)
(stringify-data val)])))
data)))
#?(:clj (defmacro log!
(defmacro with-context "Emit a new log record to the global log-record state (asynchronously). "
[data & body]
`(let [data# (data->context-map ~data)]
(with-open [closeable# (CloseableThreadContext/putAll data#)]
~@body))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Common
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn get-logger
[lname]
#?(:clj (.getLogger ^LoggerContext logger-context ^String lname)
:cljs (glog/getLogger
(cond
(string? lname) lname
(= lname :root) ""
(simple-ident? lname) (name lname)
(qualified-ident? lname) (str (namespace lname) "." (name lname))
:else (str lname)))))
(defn get-level
[level]
#?(:clj
(case level
:trace Level/TRACE
:debug Level/DEBUG
:info Level/INFO
:warn Level/WARN
:error Level/ERROR
:fatal Level/FATAL)
:cljs
(case level
:off (.-OFF ^js glog/Level)
:shout (.-SHOUT ^js glog/Level)
:error (.-SEVERE ^js glog/Level)
:severe (.-SEVERE ^js glog/Level)
:warning (.-WARNING ^js glog/Level)
:warn (.-WARNING ^js glog/Level)
:info (.-INFO ^js glog/Level)
:config (.-CONFIG ^js glog/Level)
:debug (.-FINE ^js glog/Level)
:fine (.-FINE ^js glog/Level)
:finer (.-FINER ^js glog/Level)
:trace (.-FINER ^js glog/Level)
:finest (.-FINEST ^js glog/Level)
:all (.-ALL ^js glog/Level))))
(defn write-log!
[logger level exception message]
#?(:clj
(let [message (if (string? message) message (str/join ", " message))]
(if exception
(.log ^Logger logger
^Level level
^Object message
^Throwable exception)
(.log ^Logger logger
^Level level
^Object message)))
:cljs
(when glog/ENABLED
(let [logger (get-logger logger)
level (get-level level)]
(when (and logger (glog/isLoggable logger level))
(let [message (if (fn? message) (message) message)
message (if (string? message) message (str/join ", " message))
record (glog/LogRecord. level message (.getName ^js logger))]
(when exception (.setException record exception))
(glog/publishLogRecord logger record)))))))
#?(:clj
(defn enabled?
[logger level]
(.isEnabled ^Logger logger ^Level level)))
#?(:clj
(defn get-error-context
[error]
(merge
{:hint (ex-message error)}
(when-let [data (ex-data error)]
(merge
{:spec-problems (some->> data ::s/problems (take 10) seq vec)
:spec-value (some->> data ::s/value)
:data (some-> data (dissoc ::s/problems ::s/value ::s/spec))}
(when-let [explain (ex/explain data)]
{:spec-explain explain}))))))
(defmacro log
[& props] [& props]
(if (:ns &env) ; CLJS (let [{:keys [::level ::logger ::context ::sync? cause] :or {sync? false}} props
(let [{:keys [level cause ::logger ::raw]} props] props (into [] msg-props-xf props)]
`(write-log! ~(or logger (str *ns*)) ~level ~cause (or ~raw (fn [] (build-message ~(vec props)))))) `(when (enabled? ~logger ~level)
(let [props# (cond-> (delay ~props) ~sync? deref)
ts# (current-timestamp)
context# *context*]
(px/run! *default-executor*
(fn []
(let [props# (if ~sync? props# (deref props#))
props# (into (d/ordered-map) props#)
cause# ~cause
context# (d/without-nils
(merge context# ~context))
lrecord# {::id (uuid/next)
::timestamp ts#
::message (delay (build-message props#))
::props props#
::context context#
::level ~level
::logger ~logger}
lrecord# (cond-> lrecord#
(some? cause#)
(assoc ::cause cause#
::trace (delay (build-stack-trace cause#))))]
(swap! log-record (constantly lrecord#)))))))))
(let [{:keys [level cause ::logger ::async ::raw ::context] :or {async true}} props #?(:clj
logger (or logger (str *ns*)) (defn slf4j-log-handler
logger-sym (gensym "log") {:no-doc true}
level-sym (gensym "log")] [_ _ _ {:keys [::logger ::level ::props ::cause ::trace ::message]}]
`(let [~logger-sym (get-logger ~logger) (when-let [logger (enabled? logger level)]
~level-sym (get-level ~level)] (let [message (cond-> @message
(when (enabled? ~logger-sym ~level-sym) (some? trace)
~(if async (str "\n" @trace))]
`(do (case level
(send-off logging-agent :trace (.trace ^Logger logger ^String message ^Throwable cause)
(fn [_#] :debug (.debug ^Logger logger ^String message ^Throwable cause)
(let [message# (or ~raw (build-message ~(vec props)))] :info (.info ^Logger logger ^String message ^Throwable cause)
(with-context (-> {:id (uuid/next)} :warn (.warn ^Logger logger ^String message ^Throwable cause)
(into ~context) :error (.error ^Logger logger ^String message ^Throwable cause)
(into (get-error-context ~cause))) :fatal (.error ^Logger logger ^String message ^Throwable cause)
(try (throw (IllegalArgumentException. (str "invalid level:" level))))))))
(write-log! ~logger-sym ~level-sym ~cause message#)
(catch Throwable cause# #?(:cljs
(write-log! ~logger-sym (get-level :error) cause# (defn console-log-handler
"unexpected error on writing log"))))))) {:no-doc true}
nil) [_ _ _ {:keys [::logger ::props ::level ::cause ::trace ::message]}]
`(let [message# (or ~raw (build-message ~(vec props)))] (when (enabled? logger level)
(write-log! ~logger-sym ~level-sym ~cause message#) (let [hstyles (str/ffmt "font-weight: 600; color: %" (level->color level))
nil))))))) mstyles (str/ffmt "font-weight: 300; color: %" "#282a2e")
header (str/concat "%c" (level->name level) " [" logger "] ")
message (str/concat header "%c" @message)]
(js/console.group message hstyles mstyles)
(doseq [[type n v] (get-special-props props)]
(case type
:js (js/console.log n v)
:error (if (ex/error? v)
(js/console.error n (pr-str v))
(js/console.error n v))))
(when cause
(let [data (ex-data cause)
explain (ex/explain data)]
(when explain
(js/console.log "Explain:")
(js/console.log explain))
(when (and data (not explain))
(js/console.log "Data:")
(js/console.log (pp/pprint-str data)))
(js/console.log @trace #_(.-stack cause))))
(js/console.groupEnd message)))))
#?(:clj (add-watch log-record ::default slf4j-log-handler)
:cljs (add-watch log-record ::default console-log-handler))
(defmacro set-level!
"A CLJS-only macro for set logging level to current (that matches the
current namespace) or user specified logger."
([level]
(when (:ns &env)
`(.set ^js/Map loggers ~(str *ns*) (level->int ~level))))
([name level]
(when (:ns &env)
`(.set ^js/Map loggers ~name (level->int ~level)))))
#?(:cljs
(defn setup!
[{:as config}]
(run! (fn [[logger level]]
(let [logger (if (keyword? logger) (name logger) logger)]
(l/set-level! logger level)))
config)))
(defmacro info (defmacro info
[& params] [& params]
`(log :level :info ~@params)) `(do
(log! ::logger ~(str *ns*) ::level :info ~@params)
nil))
(defmacro inf
[& params]
`(do
(log! ::logger ~(str *ns*) ::level :info ~@params)
nil))
(defmacro error (defmacro error
[& params] [& params]
`(log :level :error ~@params)) `(do
(log! ::logger ~(str *ns*) ::level :error ~@params)
nil))
(defmacro err
[& params]
`(do
(log! ::logger ~(str *ns*) ::level :error ~@params)
nil))
(defmacro warn (defmacro warn
[& params] [& params]
`(log :level :warn ~@params)) `(do
(log! ::logger ~(str *ns*) ::level :warn ~@params)
nil))
(defmacro wrn
[& params]
`(do
(log! ::logger ~(str *ns*) ::level :warn ~@params)
nil))
(defmacro debug (defmacro debug
[& params] [& params]
`(log :level :debug ~@params)) `(do
(log! ::logger ~(str *ns*) ::level :debug ~@params)
nil))
(defmacro dbg
[& params]
`(do
(log! ::logger ~(str *ns*) ::level :debug ~@params)
nil))
(defmacro trace (defmacro trace
[& params] [& params]
`(log :level :trace ~@params)) `(do
(log! ::logger ~(str *ns*) ::level :trace ~@params)
nil))
(defmacro set-level! (defmacro trc
([level] [& params]
(when (:ns &env) `(do
`(set-level* ~(str *ns*) ~level))) (log! ::logger ~(str *ns*) ::level :trace ~@params)
([n level] nil))
(when (:ns &env)
`(set-level* ~n ~level))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; CLJS Specific
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
#?(:cljs
(def ^:private colors
{:gray3 "#8e908c"
:gray4 "#969896"
:gray5 "#4d4d4c"
:gray6 "#282a2e"
:black "#1d1f21"
:red "#c82829"
:blue "#4271ae"
:orange "#f5871f"}))
#?(:cljs
(defn- level->color
[level]
(letfn [(get-level-value [l] (.-value ^js (get-level l)))]
(condp <= (get-level-value level)
(get-level-value :error) (get colors :red)
(get-level-value :warn) (get colors :orange)
(get-level-value :info) (get colors :blue)
(get-level-value :debug) (get colors :gray4)
(get-level-value :trace) (get colors :gray3)
(get colors :gray2)))))
#?(:cljs
(defn- level->short-name
[l]
(case l
:fine "DBG"
:debug "DBG"
:finer "TRC"
:trace "TRC"
:info "INF"
:warn "WRN"
:warning "WRN"
:error "ERR"
(subs (.-name ^js (get-level l)) 0 3))))
#?(:cljs
(defn set-level*
"Set the level (a keyword) of the given logger, identified by name."
[name lvl]
(some-> (get-logger name)
(glog/setLevel (get-level lvl)))))
#?(:cljs
(defn set-levels!
[lvls]
(doseq [[logger level] lvls
:let [level (if (string? level) (keyword level) level)]]
(set-level* logger level))))
#?(:cljs
(defn- prepare-message
[message]
(loop [kvpairs (seq message)
message []
specials []]
(if (nil? kvpairs)
[message specials]
(let [[k v] (first kvpairs)]
(cond
(= k :err)
(recur (next kvpairs)
message
(conj specials [:error nil v]))
(and (qualified-ident? k)
(= "js" (namespace k)))
(recur (next kvpairs)
message
(conj specials [:js (name k) (if (object? v) v (clj->js v))]))
:else
(recur (next kvpairs)
(conj message (str/concat (d/name k) "=" (pr-str v)))
specials)))))))
#?(:cljs
(defn default-handler
[{:keys [message level logger-name exception] :as params}]
(let [header-styles (str "font-weight: 600; color: " (level->color level))
normal-styles (str "font-weight: 300; color: " (get colors :gray6))
level-name (level->short-name level)
header (str "%c" level-name " [" logger-name "] ")]
(if (string? message)
(let [message (str header "%c" message)]
(js/console.log message header-styles normal-styles))
(let [[message specials] (prepare-message message)]
(if (seq specials)
(let [message (str header "%c" message)]
(js/console.group message header-styles normal-styles)
(doseq [[type n v] specials]
(case type
:js (js/console.log n v)
:error (if (ex/ex-info? v)
(js/console.error (pr-str v))
(js/console.error v))))
(js/console.groupEnd message))
(let [message (str header "%c" message)]
(js/console.log message header-styles normal-styles)))))
(when exception
(when-let [data (ex-data exception)]
(js/console.error "cause data:" (pr-str data)))
(js/console.error (.-stack exception))))))
#?(:cljs
(defn record->map
[^js record]
{:seqn (.-sequenceNumber_ record)
:time (.-time_ record)
:level (keyword (str/lower (.-name (.-level_ record))))
:message (.-msg_ record)
:logger-name (.-loggerName_ record)
:exception (.-exception_ record)}))
#?(:cljs
(defonce default-console-handler
(comp default-handler record->map)))
#?(:cljs
(defn initialize!
[]
(let [l (get-logger :root)]
(glog/removeHandler l default-console-handler)
(glog/addHandler l default-console-handler)
nil)))

2
common/src/app/common/spec.cljc
View file

@ -435,6 +435,6 @@
[cause] [cause]
(if (and (map? cause) (= :spec-validation (:type cause))) (if (and (map? cause) (= :spec-validation (:type cause)))
cause cause
(when (ex/ex-info? cause) (when (ex/error? cause)
(validation-error? (ex-data cause))))) (validation-error? (ex-data cause)))))

4
frontend/src/app/main.cljs
View file

@ -30,9 +30,7 @@
[potok.core :as ptk] [potok.core :as ptk]
[rumext.v2 :as mf])) [rumext.v2 :as mf]))
(log/initialize!) (log/setup! {:app :info})
(log/set-level! :root :warn)
(log/set-level! :app :info)
(when (= :browser @cf/target) (when (= :browser @cf/target)
(log/info :message "Welcome to penpot" (log/info :message "Welcome to penpot"

4
frontend/src/app/render.cljs
View file

@ -29,9 +29,7 @@
;; SETUP ;; SETUP
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(l/initialize!) (l/setup! {:app :info})
(l/set-level! :root :warn)
(l/set-level! :app :info)
(declare ^:private render-single-object) (declare ^:private render-single-object)
(declare ^:private render-components) (declare ^:private render-components)

4
frontend/src/app/worker.cljs
View file

@ -19,9 +19,7 @@
[cljs.spec.alpha :as s] [cljs.spec.alpha :as s]
[promesa.core :as p])) [promesa.core :as p]))
(log/initialize!) (log/setup! {:app :info})
(log/set-level! :root :warn)
(log/set-level! :app :info)
;; --- Messages Handling ;; --- Messages Handling