3pp-mirror/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-05-18 17:26:11 +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,

64
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
*context*
{:path (:path request) {:path (:path request)
:method (:method request) :method (:method request)
:params (:params request) :params (:params request)
:ip-addr (parse-client-ip request)} :ip-addr (parse-client-ip request)
(d/without-nils :user-agent (yrq/get-header request "user-agent")
{:user-agent (yrq/get-header request "user-agent") :profile-id (:uid claims)
:frontend-version (or (yrq/get-header request "x-frontend-version") :version (or (yrq/get-header request "x-frontend-version")
"unknown") "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,9 +113,8 @@
(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
@ -139,7 +130,7 @@
(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 (.getCause ^Throwable cause) request) (handle-exception (ex-cause 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))))))

8
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))]
(if (ex/exception? token)
(raise token)
(->> (px/submit! executor (partial decode-token props token)) (->> (px/submit! executor (partial decode-token props token))
(p/fnly (fn [claims cause] (p/fnly (fn [claims cause]
(when cause (when cause
(l/trace :hint "exception on decoding malformed token" :cause cause)) (l/trace :hint "exception on decoding malformed token" :cause cause))
(let [request (cond-> request (let [request (cond-> request
(map? claims) (map? claims)
(-> (assoc ::token-claims claims) (-> (assoc ::token-claims claims)
(assoc ::token token)))] (assoc ::token token)))]
(handler request respond raise))))))))) (handler request respond raise))))))))))
(defn- wrap-authz (defn- wrap-authz
[handler {:keys [::manager]}] [handler {:keys [::manager]}]

97
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 :hint (or (:hint event) (:message event)))
(assoc :tenant (cf/get :tenant)) (assoc :tenant (cf/get :tenant))
(assoc :host (cf/get :host)) (assoc :host (cf/get :host))
(assoc :public-uri (cf/get :public-uri)) (assoc :public-uri (cf/get :public-uri))
(assoc :version (:full cf/version)) (assoc :version (:full cf/version))
(update :id #(or % (uuid/next))))) (assoc :logger-name logger)
(assoc :logger-level level)
(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]
(let [input (sp/chan (sp/sliding-buffer 32) (filter error-record?))]
(add-watch l/log-record ::reporter #(sp/put! input %4))
(px/thread (px/thread
{:name "penpot/database-reporter"} {:name "penpot/database-reporter" :virtual true}
(l/info :hint "initializing database error persistence") (l/info :hint "initializing database error persistence")
(let [input (a/chan (a/sliding-buffer 5)
(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

120
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
header? true
data? true data? true
explain? true
chain? true chain? true
explain-length 10
data-length 10 data-length 10
data-level 3}}] 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 trace?
(print-trace cause))
(when data?
(when-let [data (ex-data cause)] (when-let [data (ex-data cause)]
(when data?
(print-data (dissoc data ::s/problems ::s/spec ::s/value)))
(when explain?
(if-let [explain (explain data)] (if-let [explain (explain data)]
(print-explain explain) (print-explain explain)))))
(print-data data))))
(print-all [^Throwable cause]
(when summary?
(print-summary cause))
(when detail?
(when header?
(println "DETAIL:"))
(print-detail cause)
(when chain? (when chain?
(loop [cause cause] (loop [cause cause]
(when-let [cause (.getCause cause)] (when-let [cause (ex-cause cause)]
(newline) (newline)
(print-trace cause) (print-detail cause)
(recur cause))))))
(when data?
(when-let [data (ex-data cause)]
(if-let [explain (explain data)]
(print-explain explain)
(print-data data))))
(recur cause)))))
] ]
(println
(with-out-str (with-out-str
(print-all cause)))))) (print-all cause)))))
#?(:clj
(defn print-throwable
[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
(with-out-str
(ex/print-throwable cause))))
:cljs nil))
(defn build-message #?(:cljs
[props] (declare level->int))
(let [props (sequence (comp (partition-all 2) (map vec)) props)
message-kv (build-message-kv props)
message-ex (build-message-cause props)]
(cond-> message-kv
(some? message-ex)
(str "\n" message-ex))))
#?(:clj #?(:cljs
(def logger-context (defn- get-parent-logger
(LogManager/getContext false))) [^string logger]
(let [lindex (.lastIndexOf logger ".")]
(.slice logger 0 (max lindex 0)))))
#?(:clj #?(:cljs
(def logging-agent (defn- get-logger-level
(agent nil :error-mode :continue))) "Get the current level set for the specified logger. Returns int."
[^string logger]
#?(:clj (let [val (.get ^js/Map loggers logger)]
(defn stringify-data (if (pos? val)
[val]
(cond
(string? val)
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'))))))))))
(instance? clojure.lang.Named val) (defn enabled?
(name val) "Check if logger has enabled logging for given level."
(coll? val)
(binding [*print-level* 8
*print-length* 25]
(with-out-str (fpp/pprint val {:width 200})))
:else
(str val))))
#?(:clj
(defn data->context-map
^java.util.Map
[data]
(into {}
(comp (filter second)
(map (fn [[key val]]
[(stringify-data key)
(stringify-data val)])))
data)))
#?(:clj
(defmacro with-context
[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] [logger level]
(.isEnabled ^Logger logger ^Level 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))))
#?(:clj (defn- level->color
(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]
(if (:ns &env) ; CLJS
(let [{:keys [level cause ::logger ::raw]} props]
`(write-log! ~(or logger (str *ns*)) ~level ~cause (or ~raw (fn [] (build-message ~(vec props))))))
(let [{:keys [level cause ::logger ::async ::raw ::context] :or {async true}} props
logger (or logger (str *ns*))
logger-sym (gensym "log")
level-sym (gensym "log")]
`(let [~logger-sym (get-logger ~logger)
~level-sym (get-level ~level)]
(when (enabled? ~logger-sym ~level-sym)
~(if async
`(do
(send-off logging-agent
(fn [_#]
(let [message# (or ~raw (build-message ~(vec props)))]
(with-context (-> {:id (uuid/next)}
(into ~context)
(into (get-error-context ~cause)))
(try
(write-log! ~logger-sym ~level-sym ~cause message#)
(catch Throwable cause#
(write-log! ~logger-sym (get-level :error) cause#
"unexpected error on writing log")))))))
nil)
`(let [message# (or ~raw (build-message ~(vec props)))]
(write-log! ~logger-sym ~level-sym ~cause message#)
nil)))))))
(defmacro info
[& params]
`(log :level :info ~@params))
(defmacro error
[& params]
`(log :level :error ~@params))
(defmacro warn
[& params]
`(log :level :warn ~@params))
(defmacro debug
[& params]
`(log :level :debug ~@params))
(defmacro trace
[& params]
`(log :level :trace ~@params))
(defmacro set-level!
([level]
(when (:ns &env)
`(set-level* ~(str *ns*) ~level)))
([n level]
(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] [level]
(letfn [(get-level-value [l] (.-value ^js (get-level l)))] (case level
(condp <= (get-level-value level) :error "#c82829"
(get-level-value :error) (get colors :red) :warn "#f5871f"
(get-level-value :warn) (get colors :orange) :info "#4271ae"
(get-level-value :info) (get colors :blue) :debug "#969896"
(get-level-value :debug) (get colors :gray4) :trace "#8e908c"))
(get-level-value :trace) (get colors :gray3)
(get colors :gray2)))))
#?(:cljs (defn- level->name
(defn- level->short-name [level]
[l] (case level
(case l
:fine "DBG"
:debug "DBG" :debug "DBG"
:finer "TRC"
:trace "TRC" :trace "TRC"
:info "INF" :info "INF"
:warn "WRN" :warn "WRN"
:warning "WRN" :error "ERR"))
:error "ERR"
(subs (.-name ^js (get-level l)) 0 3)))) (defn level->int
[level]
(case level
:debug 10
:trace 20
:info 30
:warn 40
:error 50))
(defn build-message
[props]
(loop [props (seq props)
result []]
(if-let [[k v] (first props)]
(if (simple-ident? k)
(recur (next props)
(conj result (str (name k) "=" (pr-str v))))
(recur (next props)
result))
(str/join ", " result))))
(defn build-stack-trace
[cause]
#?(:clj (ex/format-throwable cause)
:cljs (.-stack ^js cause)))
#?(:cljs #?(:cljs
(defn set-level* (defn- get-special-props
"Set the level (a keyword) of the given logger, identified by name." [props]
[name lvl] (->> (seq props)
(some-> (get-logger name) (keep (fn [[k v]]
(glog/setLevel (get-level lvl))))) (when (qualified-ident? k)
#?(: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 (cond
(= k :err) (= "js" (namespace k))
(recur (next kvpairs) [:js (name k) (if (object? v) v (clj->js v))]
message
(conj specials [:error nil v]))
(and (qualified-ident? k) (= "error" (namespace k))
(= "js" (namespace k))) [:error (name k) v])))))))
(recur (next kvpairs)
message
(conj specials [:js (name k) (if (object? v) v (clj->js v))]))
:else (def ^:private reserved-props
(recur (next kvpairs) #{::level :cause ::logger ::sync? ::context})
(conj message (str/concat (d/name k) "=" (pr-str v)))
specials))))))) (def ^:no-doc msg-props-xf
(comp (partition-all 2)
(map vec)
(remove (fn [[k _]] (contains? reserved-props k)))))
(s/def ::id ::us/uuid)
(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]))
(defn current-timestamp
[]
#?(:clj (inst-ms (java.time.Instant/now))
:cljs (js/Date.now)))
(defmacro log!
"Emit a new log record to the global log-record state (asynchronously). "
[& props]
(let [{:keys [::level ::logger ::context ::sync? cause] :or {sync? false}} props
props (into [] msg-props-xf 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#)))))))))
#?(:clj
(defn slf4j-log-handler
{:no-doc true}
[_ _ _ {:keys [::logger ::level ::props ::cause ::trace ::message]}]
(when-let [logger (enabled? logger level)]
(let [message (cond-> @message
(some? trace)
(str "\n" @trace))]
(case level
:trace (.trace ^Logger logger ^String message ^Throwable cause)
:debug (.debug ^Logger logger ^String message ^Throwable cause)
:info (.info ^Logger logger ^String message ^Throwable cause)
:warn (.warn ^Logger logger ^String message ^Throwable cause)
:error (.error ^Logger logger ^String message ^Throwable cause)
:fatal (.error ^Logger logger ^String message ^Throwable cause)
(throw (IllegalArgumentException. (str "invalid level:" level))))))))
#?(:cljs #?(:cljs
(defn default-handler (defn console-log-handler
[{:keys [message level logger-name exception] :as params}] {:no-doc true}
(let [header-styles (str "font-weight: 600; color: " (level->color level)) [_ _ _ {:keys [::logger ::props ::level ::cause ::trace ::message]}]
normal-styles (str "font-weight: 300; color: " (get colors :gray6)) (when (enabled? logger level)
level-name (level->short-name level) (let [hstyles (str/ffmt "font-weight: 600; color: %" (level->color level))
header (str "%c" level-name " [" logger-name "] ")] mstyles (str/ffmt "font-weight: 300; color: %" "#282a2e")
header (str/concat "%c" (level->name level) " [" logger "] ")
message (str/concat header "%c" @message)]
(if (string? message) (js/console.group message hstyles mstyles)
(let [message (str header "%c" message)] (doseq [[type n v] (get-special-props props)]
(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 (case type
:js (js/console.log n v) :js (js/console.log n v)
:error (if (ex/ex-info? v) :error (if (ex/error? v)
(js/console.error (pr-str v)) (js/console.error n (pr-str v))
(js/console.error v)))) (js/console.error n v))))
(js/console.groupEnd message))
(let [message (str header "%c" message)]
(js/console.log message header-styles normal-styles)))))
(when exception (when cause
(when-let [data (ex-data exception)] (let [data (ex-data cause)
(js/console.error "cause data:" (pr-str data))) explain (ex/explain data)]
(js/console.error (.-stack exception)))))) (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 #?(:cljs
(defn record->map (defn setup!
[^js record] [{:as config}]
{:seqn (.-sequenceNumber_ record) (run! (fn [[logger level]]
:time (.-time_ record) (let [logger (if (keyword? logger) (name logger) logger)]
:level (keyword (str/lower (.-name (.-level_ record)))) (l/set-level! logger level)))
:message (.-msg_ record) config)))
:logger-name (.-loggerName_ record)
:exception (.-exception_ record)}))
#?(:cljs (defmacro info
(defonce default-console-handler [& params]
(comp default-handler record->map))) `(do
(log! ::logger ~(str *ns*) ::level :info ~@params)
nil))
#?(:cljs (defmacro inf
(defn initialize! [& params]
[] `(do
(let [l (get-logger :root)] (log! ::logger ~(str *ns*) ::level :info ~@params)
(glog/removeHandler l default-console-handler) nil))
(glog/addHandler l default-console-handler)
nil))) (defmacro 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
[& params]
`(do
(log! ::logger ~(str *ns*) ::level :warn ~@params)
nil))
(defmacro wrn
[& params]
`(do
(log! ::logger ~(str *ns*) ::level :warn ~@params)
nil))
(defmacro 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
[& params]
`(do
(log! ::logger ~(str *ns*) ::level :trace ~@params)
nil))
(defmacro trc
[& params]
`(do
(log! ::logger ~(str *ns*) ::level :trace ~@params)
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