From 267045e1132eb0b16c2a8daf9122ddb4fe0c800d Mon Sep 17 00:00:00 2001 From: Andrey Antukh Date: Tue, 6 Feb 2024 17:21:34 +0100 Subject: [PATCH 1/6] :sparkles: Improve migration scripts --- backend/resources/log4j2-experiments.xml | 6 - backend/src/app/features/components_v2.clj | 92 +++--- .../src/app/rpc/commands/files_snapshot.clj | 8 +- backend/src/app/srepl/components_v2.clj | 270 ++++++++++++++++-- 4 files changed, 300 insertions(+), 76 deletions(-) diff --git a/backend/resources/log4j2-experiments.xml b/backend/resources/log4j2-experiments.xml index 88542c277..3357aae31 100644 --- a/backend/resources/log4j2-experiments.xml +++ b/backend/resources/log4j2-experiments.xml @@ -48,12 +48,6 @@ - - - - - - diff --git a/backend/src/app/features/components_v2.clj b/backend/src/app/features/components_v2.clj index 71b0c538a..8b3cd1da1 100644 --- a/backend/src/app/features/components_v2.clj +++ b/backend/src/app/features/components_v2.clj @@ -77,10 +77,6 @@ internal functions without the need to explicitly pass it top down." nil) -(def ^:dynamic ^:private *team-id* - "A dynamic var that holds the current processing team-id." - nil) - (def ^:dynamic ^:private *file-stats* "An internal dynamic var for collect stats by file." nil) @@ -1194,12 +1190,11 @@ ;; The media processing adds the data to the ;; input map and returns it. (media/run {:cmd :info :input item})) + (catch Throwable _ - (let [team-id *team-id*] - (l/wrn :hint "unable to process embedded images on svg file" - :team-id (str team-id) - :file-id (str file-id) - :media-id (str media-id))) + (l/wrn :hint "unable to process embedded images on svg file" + :file-id (str file-id) + :media-id (str media-id)) nil))) (persist-image [acc {:keys [path size width height mtype href] :as item}] @@ -1332,24 +1327,20 @@ (catch Throwable cause (vreset! err true) (let [cause (pu/unwrap-exception cause) - edata (ex-data cause) - team-id *team-id*] + edata (ex-data cause)] (cond (instance? org.xml.sax.SAXParseException cause) (l/inf :hint "skip processing media object: invalid svg found" - :team-id (str team-id) :file-id (str (:id fdata)) :id (str (:id mobj))) (instance? org.graalvm.polyglot.PolyglotException cause) (l/inf :hint "skip processing media object: invalid svg found" - :team-id (str team-id) :file-id (str (:id fdata)) :id (str (:id mobj))) (= (:type edata) :not-found) (l/inf :hint "skip processing media object: underlying object does not exist" - :team-id (str team-id) :file-id (str (:id fdata)) :id (str (:id mobj))) @@ -1357,7 +1348,6 @@ (let [skip? *skip-on-graphic-error*] (l/wrn :hint "unable to process file media object" :skiped skip? - :team-id (str team-id) :file-id (str (:id fdata)) :id (str (:id mobj)) :cause cause) @@ -1524,7 +1514,9 @@ (defn migrate-file! [system file-id & {:keys [validate? skip-on-graphic-error? label]}] - (let [tpoint (dt/tpoint)] + (let [tpoint (dt/tpoint) + err (volatile! false)] + (binding [*file-stats* (atom {}) *skip-on-graphic-error* skip-on-graphic-error?] (try @@ -1533,40 +1525,50 @@ :validate validate? :skip-on-graphic-error skip-on-graphic-error?) - (let [system (update system ::sto/storage media/configure-assets-storage)] - (db/tx-run! system - (fn [system] - (try - (binding [*system* system] - (when (string? label) - (fsnap/take-file-snapshot! system {:file-id file-id - :label (str "migration/" label)})) - (let [file (get-file system file-id)] - (events/tap :progress - {:op :migrate-file - :name (:name file) - :id (:id file)}) + (db/tx-run! (update system ::sto/storage media/configure-assets-storage) + (fn [system] + (binding [*system* system] + (when (string? label) + (fsnap/take-file-snapshot! system {:file-id file-id + :label (str "migration/" label)})) + (let [file (get-file system file-id)] + (events/tap :progress + {:op :migrate-file + :name (:name file) + :id (:id file)}) - (process-file system file :validate? validate?))) + (process-file system file :validate? validate?))))) - (catch Throwable cause - (let [team-id *team-id*] - (l/wrn :hint "error on processing file" - :team-id (str team-id) - :file-id (str file-id)) - (throw cause))))))) + (catch Throwable cause + (vreset! err true) + (l/wrn :hint "error on processing file" + :file-id (str file-id) + :cause cause) + (throw cause)) (finally (let [elapsed (tpoint) components (get @*file-stats* :processed-components 0) graphics (get @*file-stats* :processed-graphics 0)] - (l/dbg :hint "migrate:file:end" - :file-id (str file-id) - :graphics graphics - :components components - :validate validate? - :elapsed (dt/format-duration elapsed)) + (if (cache/cache? *cache*) + (let [cache-stats (cache/stats *cache*)] + (l/dbg :hint "migrate:file:end" + :file-id (str file-id) + :graphics graphics + :components components + :validate validate? + :crt (mth/to-fixed (:hit-rate cache-stats) 2) + :crq (str (:req-count cache-stats)) + :error @err + :elapsed (dt/format-duration elapsed))) + (l/dbg :hint "migrate:file:end" + :file-id (str file-id) + :graphics graphics + :components components + :validate validate? + :error @err + :elapsed (dt/format-duration elapsed))) (some-> *stats* (swap! update :processed-files (fnil inc 0))) (some-> *team-stats* (swap! update :processed-files (fnil inc 0))))))))) @@ -1607,13 +1609,15 @@ (update-team-features! conn id features)))))] - (binding [*team-stats* (atom {}) - *team-id* team-id] + (binding [*team-stats* (atom {})] (try (db/tx-run! system migrate-team team-id) (catch Throwable cause (vreset! err true) + (l/wrn :hint "error on processing team" + :team-id (str team-id) + :cause cause) (throw cause)) (finally diff --git a/backend/src/app/rpc/commands/files_snapshot.clj b/backend/src/app/rpc/commands/files_snapshot.clj index 68b3a017c..3b90023fb 100644 --- a/backend/src/app/rpc/commands/files_snapshot.clj +++ b/backend/src/app/rpc/commands/files_snapshot.clj @@ -70,8 +70,8 @@ (some? (:data snapshot))) (l/debug :hint "snapshot found" - :snapshot-id (:id snapshot) - :file-id file-id) + :snapshot-id (str (:id snapshot)) + :file-id (str file-id)) (db/update! conn :file {:data (:data snapshot)} @@ -112,7 +112,9 @@ (when-let [file (db/get* conn :file {:id file-id})] (let [id (uuid/next) label (or label (str "Snapshot at " (dt/format-instant (dt/now) :rfc1123)))] - (l/debug :hint "persisting file snapshot" :file-id file-id :label label) + (l/debug :hint "persisting file snapshot" + :file-id (str file-id) + :label label) (db/insert! conn :file-change {:id id :revn (:revn file) diff --git a/backend/src/app/srepl/components_v2.clj b/backend/src/app/srepl/components_v2.clj index 4adf55293..9bada320a 100644 --- a/backend/src/app/srepl/components_v2.clj +++ b/backend/src/app/srepl/components_v2.clj @@ -32,12 +32,20 @@ (defn- report-progress-files [tpoint] (fn [_ _ oldv newv] - (when (not= (:processed-files oldv) - (:processed-files newv)) - (let [elapsed (tpoint)] + (when (or (not= (:processed-files oldv) + (:processed-files newv)) + (not= (:errors oldv) + (:errors newv))) + (let [completed (:processed-files newv 0) + errors (:errors newv 0) + elapsed (dt/format-duration (tpoint))] + (events/tap :progress-report + {:elapsed elapsed + :completed completed + :errors errors}) (l/dbg :hint "progress" - :completed (:processed-files newv) - :elapsed (dt/format-duration elapsed)))))) + :completed completed + :elapsed elapsed))))) (defn- report-progress-teams [tpoint] @@ -101,13 +109,47 @@ (def ^:private sql:get-teams-by-report "WITH teams AS ( SELECT t.id t.features, mr.name - FROM migration_report AS mr + FROM migration_team_report AS mr JOIN team AS t ON (t.id = mr.team_id) WHERE t.deleted_at IS NULL AND mr.error IS NOT NULL ORDER BY mr.created_at ) SELECT id, features FROM teams %(pred)s") +(def ^:private sql:get-files-by-created-at + "SELECT id, features + FROM file + WHERE deleted_at IS NULL + ORDER BY created_at DESC") + +(def ^:private sql:get-files-by-modified-at + "SELECT id, features + FROM file + WHERE deleted_at IS NULL + ORDER BY modified_at DESC") + +(def ^:private sql:get-files-by-graphics + "WITH files AS ( + SELECT f.id, f.features, + (SELECT count(*) FROM file_media_object AS fmo + WHERE fmo.mtype = 'image/svg+xml' + AND fmo.is_local = false + AND fmo.file_id = f.id) AS graphics + FROM file AS f + WHERE f.deleted_at IS NULL + ORDER BY 3 ASC + ) SELECT * FROM files %(pred)s") + +(def ^:private sql:get-files-by-report + "WITH files AS ( + SELECT t.id t.features, mr.name + FROM migration_file_report AS mr + JOIN file AS t ON (t.id = mr.file_id) + WHERE t.deleted_at IS NULL + AND mr.error IS NOT NULL + ORDER BY mr.created_at + ) SELECT id, features FROM files %(pred)s") + (defn- read-pred [entries] (let [entries (if (and (vector? entries) @@ -140,7 +182,6 @@ :activity sql:get-teams-by-activity :graphics sql:get-teams-by-graphics :report sql:get-teams-by-report) - sql (if pred (let [[pred-sql & pred-params] (read-pred pred)] (apply vector @@ -154,34 +195,78 @@ (contains? features "components/v2"))) (map :id)))) -(def ^:private sql:report-table - "CREATE UNLOGGED TABLE IF NOT EXISTS migration_report ( +(defn- get-files + [conn query pred] + (let [query (d/nilv query :created-at) + sql (case query + :created-at sql:get-files-by-created-at + :modified-at sql:get-files-by-modified-at + :graphics sql:get-files-by-graphics + :report sql:get-files-by-report) + sql (if pred + (let [[pred-sql & pred-params] (read-pred pred)] + (apply vector + (str/format sql {:pred pred-sql}) + pred-params)) + [(str/format sql {:pred ""})])] + + (->> (db/cursor conn sql {:chunk-size 500}) + (map feat/decode-row) + (remove (fn [{:keys [features]}] + (contains? features "components/v2"))) + (map :id)))) + +(def ^:private sql:team-report-table + "CREATE UNLOGGED TABLE IF NOT EXISTS migration_team_report ( id bigserial NOT NULL, label text NOT NULL, team_id UUID NOT NULL, error text NULL, created_at timestamptz NOT NULL DEFAULT now(), elapsed bigint NOT NULL, - PRIMARY KEY (label, created_at, id) - )") + PRIMARY KEY (label, created_at, id))") -(defn- create-report-table! +(def ^:private sql:file-report-table + "CREATE UNLOGGED TABLE IF NOT EXISTS migration_file_report ( + id bigserial NOT NULL, + label text NOT NULL, + file_id UUID NOT NULL, + error text NULL, + created_at timestamptz NOT NULL DEFAULT now(), + elapsed bigint NOT NULL, + PRIMARY KEY (label, created_at, id))") + +(defn- create-report-tables! [system] - (db/exec-one! system [sql:report-table])) + (db/exec-one! system [sql:team-report-table]) + (db/exec-one! system [sql:file-report-table])) -(defn- clean-reports! +(defn- clean-team-reports! [system label] - (db/delete! system :migration-report {:label label})) + (db/delete! system :migration-team-report {:label label})) -(defn- report! +(defn- team-report! [system team-id label elapsed error] - (db/insert! system :migration-report + (db/insert! system :migration-team-report {:label label :team-id team-id :elapsed (inst-ms elapsed) :error error} {::db/return-keys false})) +(defn- clean-file-reports! + [system label] + (db/delete! system :migration-file-report {:label label})) + +(defn- file-report! + [system file-id label elapsed error] + (db/insert! system :migration-file-report + {:label label + :file-id file-id + :elapsed (inst-ms elapsed) + :error error} + {::db/return-keys false})) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; PUBLIC API @@ -318,12 +403,11 @@ :skip-on-graphic-error? skip-on-graphic-error?))) (when (string? label) - (report! main/system team-id label (tpoint) nil)) + (team-report! main/system team-id label (tpoint) nil)) (catch Throwable cause (l/wrn :hint "unexpected error on processing team (skiping)" - :team-id (str team-id) - :cause cause) + :team-id (str team-id)) (events/tap :error (ex-info "unexpected error on processing team (skiping)" @@ -333,7 +417,7 @@ (swap! stats update :errors (fnil inc 0)) (when (string? label) - (report! main/system team-id label (tpoint) (ex-message cause)))) + (team-report! main/system team-id label (tpoint) (ex-message cause)))) (finally (ps/release! sjobs))))) @@ -365,8 +449,8 @@ svgo/*semaphore* sprocs] (try (when (string? label) - (create-report-table! main/system) - (clean-reports! main/system label)) + (create-report-tables! main/system) + (clean-team-reports! main/system label)) (db/tx-run! main/system (fn [{:keys [::db/conn] :as system}] @@ -399,6 +483,146 @@ :rollback rollback? :elapsed elapsed))))))) + +(defn migrate-files! + "A REPL helper for migrate all files. + + This function starts multiple concurrent file migration processes + until thw maximum number of jobs is reached which by default has the + value of `1`. This is controled with the `:max-jobs` option. + + If you want to run this on multiple machines you will need to specify + the total number of partitions and the current partition. + + In order to get the report table populated, you will need to provide + a correct `:label`. That label is also used for persist a file + snaphot before continue with the migration." + [& {:keys [max-jobs max-items max-time rollback? validate? query + pred max-procs cache skip-on-graphic-error? + label partitions current-partition] + :or {validate? false + rollback? true + max-jobs 1 + current-partition 1 + skip-on-graphic-error? true + max-items Long/MAX_VALUE}}] + + (when (int? partitions) + (when-not (int? current-partition) + (throw (IllegalArgumentException. "missing `current-partition` parameter"))) + (when-not (<= 0 current-partition partitions) + (throw (IllegalArgumentException. "invalid value on `current-partition` parameter")))) + + (let [stats (atom {}) + tpoint (dt/tpoint) + mtime (some-> max-time dt/duration) + + factory (px/thread-factory :virtual false :prefix "penpot/migration/") + executor (px/cached-executor :factory factory) + + max-procs (or max-procs max-jobs) + sjobs (ps/create :permits max-jobs) + sprocs (ps/create :permits max-procs) + + cache (if (int? cache) + (cache/create :executor (::wrk/executor main/system) + :max-items cache) + nil) + + migrate-file + (fn [file-id] + (let [tpoint (dt/tpoint)] + (try + (db/tx-run! (assoc main/system ::db/rollback rollback?) + (fn [system] + (db/exec-one! system ["SET idle_in_transaction_session_timeout = 0"]) + (feat/migrate-file! system file-id + :label label + :validate? validate? + :skip-on-graphic-error? skip-on-graphic-error?))) + + (when (string? label) + (file-report! main/system file-id label (tpoint) nil)) + + (catch Throwable cause + (l/wrn :hint "unexpected error on processing file (skiping)" + :file-id (str file-id)) + + (events/tap :error + (ex-info "unexpected error on processing file (skiping)" + {:file-id file-id} + cause)) + + (swap! stats update :errors (fnil inc 0)) + + (when (string? label) + (file-report! main/system file-id label (tpoint) (ex-message cause)))) + + (finally + (ps/release! sjobs))))) + + process-file + (fn [file-id] + (ps/acquire! sjobs) + (let [ts (tpoint)] + (if (and mtime (neg? (compare mtime ts))) + (do + (l/inf :hint "max time constraint reached" + :file-id (str file-id) + :elapsed (dt/format-duration ts)) + (ps/release! sjobs) + (reduced nil)) + + (px/run! executor (partial migrate-file file-id)))))] + + (l/dbg :hint "migrate:start" + :label label + :rollback rollback? + :max-jobs max-jobs + :max-items max-items) + + (add-watch stats :progress-report (report-progress-files tpoint)) + + (binding [feat/*stats* stats + feat/*cache* cache + svgo/*semaphore* sprocs] + (try + (when (string? label) + (create-report-tables! main/system) + (clean-file-reports! main/system label)) + + (db/tx-run! main/system + (fn [{:keys [::db/conn] :as system}] + (db/exec! conn ["SET statement_timeout = 0"]) + (db/exec! conn ["SET idle_in_transaction_session_timeout = 0"]) + + (run! process-file + (->> (get-files conn query pred) + (filter (fn [file-id] + (if (int? partitions) + (= current-partition (-> (uuid/hash-int file-id) + (mod partitions) + (inc))) + true))) + (take max-items))) + + ;; Close and await tasks + (pu/close! executor))) + + (-> (deref stats) + (assoc :elapsed (dt/format-duration (tpoint)))) + + (catch Throwable cause + (l/dbg :hint "migrate:error" :cause cause) + (events/tap :error cause)) + + (finally + (let [elapsed (dt/format-duration (tpoint))] + (l/dbg :hint "migrate:end" + :rollback rollback? + :elapsed elapsed))))))) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; FILE PROCESS HELPERS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; From a71e7f79065906383fa2eb5a6ad2969df0db86cb Mon Sep 17 00:00:00 2001 From: Andrey Antukh Date: Tue, 6 Feb 2024 11:47:20 +0100 Subject: [PATCH 2/6] :sparkles: Remove partitioning from task table Which causes strange random delays when some row is moved from one partition to other. Also, there are evidences that partitioning is not aporting real value here. --- backend/src/app/migrations.clj | 5 ++++- .../src/app/migrations/sql/0118-mod-task-table.sql | 12 ++++++++++++ 2 files changed, 16 insertions(+), 1 deletion(-) create mode 100644 backend/src/app/migrations/sql/0118-mod-task-table.sql diff --git a/backend/src/app/migrations.clj b/backend/src/app/migrations.clj index 900ef75f5..9cfcf9fe2 100644 --- a/backend/src/app/migrations.clj +++ b/backend/src/app/migrations.clj @@ -370,7 +370,10 @@ :fn (mg/resource "app/migrations/sql/0116-mod-file-table.sql")} {:name "0117-mod-file-object-thumbnail-table" - :fn (mg/resource "app/migrations/sql/0117-mod-file-object-thumbnail-table.sql")}]) + :fn (mg/resource "app/migrations/sql/0117-mod-file-object-thumbnail-table.sql")} + + {:name "0118-mod-task-table" + :fn (mg/resource "app/migrations/sql/0118-mod-task-table.sql")}]) (defn apply-migrations! [pool name migrations] diff --git a/backend/src/app/migrations/sql/0118-mod-task-table.sql b/backend/src/app/migrations/sql/0118-mod-task-table.sql new file mode 100644 index 000000000..d6ede0e97 --- /dev/null +++ b/backend/src/app/migrations/sql/0118-mod-task-table.sql @@ -0,0 +1,12 @@ +-- Removes the partitioning. +CREATE TABLE new_task (LIKE task INCLUDING ALL); +INSERT INTO new_task SELECT * FROM task; +ALTER TABLE task RENAME TO old_task; +ALTER TABLE new_task RENAME TO task; +DROP TABLE old_task; +ALTER INDEX new_task_label_name_queue_idx RENAME TO task__label_name_queue__idx; +ALTER INDEX new_task_scheduled_at_queue_idx RENAME TO task__scheduled_at_queue__idx; +ALTER TABLE task DROP CONSTRAINT new_task_pkey; +ALTER TABLE task ADD PRIMARY KEY (id); +ALTER TABLE task ALTER COLUMN created_at SET DEFAULT now(); +ALTER TABLE task ALTER COLUMN modified_at SET DEFAULT now(); From 7a50cb3ff9242d16fc589755fe1e3cd482aa15a7 Mon Sep 17 00:00:00 2001 From: Andrey Antukh Date: Tue, 6 Feb 2024 19:17:12 +0100 Subject: [PATCH 3/6] :bug: Fix broken restore snapshot function --- .../src/app/rpc/commands/files_snapshot.clj | 22 +++++++++++-------- 1 file changed, 13 insertions(+), 9 deletions(-) diff --git a/backend/src/app/rpc/commands/files_snapshot.clj b/backend/src/app/rpc/commands/files_snapshot.clj index 3b90023fb..0e902047c 100644 --- a/backend/src/app/rpc/commands/files_snapshot.clj +++ b/backend/src/app/rpc/commands/files_snapshot.clj @@ -63,34 +63,38 @@ [{:keys [::db/conn ::sto/storage] :as cfg} {:keys [file-id id]}] (let [storage (media/configure-assets-storage storage conn) params {:id id :file-id file-id} - options {:columns [:id :data :revn]} + options {:columns [:id :data :revn :features]} snapshot (db/get* conn :file-change params options)] (when (and (some? snapshot) (some? (:data snapshot))) - (l/debug :hint "snapshot found" - :snapshot-id (str (:id snapshot)) - :file-id (str file-id)) + (l/dbg :hint "restoring snapshot" + :file-id (str file-id) + :snapshot-id (str (:id snapshot))) (db/update! conn :file - {:data (:data snapshot)} + {:data (:data snapshot) + :revn (:revn snapshot) + :features (:features snapshot)} {:id file-id}) ;; clean object thumbnails - (let [sql (str "delete from file_object_thumbnail " + (let [sql (str "update file_tagged_object_thumbnail " + " set deleted_at = now() " " where file_id=? returning media_id") res (db/exec! conn [sql file-id])] (doseq [media-id (into #{} (keep :media-id) res)] - (sto/del-object! storage media-id))) + (sto/touch-object! storage media-id))) ;; clean object thumbnails - (let [sql (str "delete from file_thumbnail " + (let [sql (str "update file_thumbnail " + " set deleted_at = now() " " where file_id=? returning media_id") res (db/exec! conn [sql file-id])] (doseq [media-id (into #{} (keep :media-id) res)] - (sto/del-object! storage media-id))) + (sto/touch-object! storage media-id))) {:id (:id snapshot)}))) From 2331647ec6e0c2a3b561532feb26ce8edd10ef4d Mon Sep 17 00:00:00 2001 From: Andrey Antukh Date: Tue, 6 Feb 2024 19:18:22 +0100 Subject: [PATCH 4/6] :bug: Add missing team-profile rels cloning on duplicate-team srepl helper --- backend/src/app/srepl/main.clj | 21 ++++++++++++++------- 1 file changed, 14 insertions(+), 7 deletions(-) diff --git a/backend/src/app/srepl/main.clj b/backend/src/app/srepl/main.clj index 599afa646..97f3ab245 100644 --- a/backend/src/app/srepl/main.clj +++ b/backend/src/app/srepl/main.clj @@ -331,11 +331,18 @@ (defn duplicate-team [team-id & {:keys [name]}] - (let [team-id (if (string? team-id) (parse-uuid team-id) team-id) - name (or name (fn [prev-name] - (str/ffmt "Cloned: % (%)" prev-name (dt/format-instant (dt/now)))))] + (let [team-id (if (string? team-id) (parse-uuid team-id) team-id)] (db/tx-run! main/system - (fn [cfg] - (db/exec-one! cfg ["SET CONSTRAINTS ALL DEFERRED"]) - (-> (assoc cfg ::bfc/timestamp (dt/now)) - (mgmt/duplicate-team :team-id team-id :name name)))))) + (fn [{:keys [::db/conn] :as cfg}] + (db/exec-one! conn ["SET CONSTRAINTS ALL DEFERRED"]) + (let [team (-> (assoc cfg ::bfc/timestamp (dt/now)) + (mgmt/duplicate-team :team-id team-id :name name)) + rels (db/query conn :team-profile-rel {:team-id team-id})] + + (doseq [rel rels] + (let [params (-> rel + (assoc :id (uuid/next)) + (assoc :team-id (:id team)))] + (db/insert! conn :team-profile-rel params + {::db/return-keys false})))))))) + From 040b336ef98efba1c3326725a8520e3cf66319a0 Mon Sep 17 00:00:00 2001 From: Andrey Antukh Date: Tue, 6 Feb 2024 19:20:25 +0100 Subject: [PATCH 5/6] :sparkles: Add helper for restoring team after migration to comp-v2 --- backend/src/app/features/components_v2.clj | 23 ++++++------ backend/src/app/srepl/components_v2.clj | 42 ++++++++++++++++++++++ 2 files changed, 55 insertions(+), 10 deletions(-) diff --git a/backend/src/app/features/components_v2.clj b/backend/src/app/features/components_v2.clj index 8b3cd1da1..1aaa5e268 100644 --- a/backend/src/app/features/components_v2.clj +++ b/backend/src/app/features/components_v2.clj @@ -1442,7 +1442,7 @@ data))) (fmg/migrate-file)))) -(defn- get-team +(defn get-team [system team-id] (-> (db/get system :team {:id team-id} {::db/remove-deleted false @@ -1496,17 +1496,19 @@ AND f.deleted_at IS NULL FOR UPDATE") -(defn- get-and-lock-files +(defn get-and-lock-files [conn team-id] (->> (db/cursor conn [sql:get-and-lock-team-files team-id]) (map :id))) -(defn- update-team-features! - [conn team-id features] - (let [features (db/create-array conn "text" features)] +(defn update-team! + [conn team] + (let [params (-> team + (update :features db/encode-pgarray conn "text") + (dissoc :id))] (db/update! conn :team - {:features features} - {:id team-id}))) + params + {:id (:id team)}))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; PUBLIC API @@ -1590,7 +1592,7 @@ :skip-on-graphic-error? skip-on-graphic-error?)) migrate-team (fn [{:keys [::db/conn] :as system} team-id] - (let [{:keys [id features name]} (get-team system team-id)] + (let [{:keys [id features] :as team} (get-team system team-id)] (if (contains? features "components/v2") (l/inf :hint "team already migrated") (let [features (-> features @@ -1601,13 +1603,14 @@ (events/tap :progress {:op :migrate-team - :name name + :name (:name team) :id id}) (run! (partial migrate-file system) (get-and-lock-files conn id)) - (update-team-features! conn id features)))))] + (->> (assoc team :features features) + (update-team! conn))))))] (binding [*team-stats* (atom {})] (try diff --git a/backend/src/app/srepl/components_v2.clj b/backend/src/app/srepl/components_v2.clj index 9bada320a..3b145d1cd 100644 --- a/backend/src/app/srepl/components_v2.clj +++ b/backend/src/app/srepl/components_v2.clj @@ -12,6 +12,7 @@ [app.db :as db] [app.features.components-v2 :as feat] [app.main :as main] + [app.rpc.commands.files-snapshot :as rpc] [app.svgo :as svgo] [app.util.cache :as cache] [app.util.events :as events] @@ -636,3 +637,44 @@ :file-name (:name file)) (assoc file :deleted-at (dt/now))) file)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; RESTORE SNAPSHOT +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def ^:private sql:snapshots-with-file + "SELECT f.id AS file_id, + fc.id AS id + FROM file AS f + JOIN file_change AS fc ON (fc.file_id = f.id) + WHERE fc.label = ? AND f.id = ANY(?)") + +(defn restore-team! + [team-id label & {:keys [rollback?] :or {rollback? true}}] + (let [team-id (if (string? team-id) + (parse-uuid team-id) + team-id) + + get-file-snapshots + (fn [conn ids] + (let [label (str "migration/" label)] + (db/exec! conn [sql:snapshots-with-file label + (db/create-array conn "uuid" ids)]))) + + restore-snapshot + (fn [{:keys [::db/conn] :as system}] + (let [ids (into #{} (feat/get-and-lock-files conn team-id)) + snap (get-file-snapshots conn ids) + ids' (into #{} (map :file-id) snap) + team (-> (feat/get-team conn team-id) + (update :features disj "components/v2"))] + + (when (not= ids ids') + (throw (RuntimeException. "no uniform snapshot available"))) + + (feat/update-team! conn team) + (run! (partial rpc/restore-file-snapshot! system) snap)))] + + + (-> (assoc main/system ::db/rollback rollback?) + (db/tx-run! restore-snapshot)))) From d2626ead0b9605022019550a7a22c73a0e73b96d Mon Sep 17 00:00:00 2001 From: Andrey Antukh Date: Wed, 7 Feb 2024 09:14:07 +0100 Subject: [PATCH 6/6] :sparkles: Add better email cleaning mechanism This commit separates the email cleaning mechanism to a separated function, and enables a proper cleaning of `mailto:` prefix, usually found on invitations because users just copy and paste from external source. --- backend/src/app/auth/oidc.clj | 1 + backend/src/app/http/debug.clj | 5 +++- backend/src/app/rpc/commands/auth.clj | 13 ++++++---- backend/src/app/rpc/commands/ldap.clj | 4 +-- backend/src/app/rpc/commands/profile.clj | 21 ++++++++++----- backend/src/app/rpc/commands/teams.clj | 26 ++++++++++++------- backend/src/app/rpc/commands/verify_token.clj | 21 ++++++++------- backend/src/app/srepl/main.clj | 1 + 8 files changed, 57 insertions(+), 35 deletions(-) diff --git a/backend/src/app/auth/oidc.clj b/backend/src/app/auth/oidc.clj index a189b42e6..243c08da5 100644 --- a/backend/src/app/auth/oidc.clj +++ b/backend/src/app/auth/oidc.clj @@ -474,6 +474,7 @@ [{:keys [::db/pool] :as cfg} info] (dm/with-open [conn (db/open pool)] (some->> (:email info) + (profile/clean-email) (profile/get-profile-by-email conn)))) (defn- redirect-response diff --git a/backend/src/app/http/debug.clj b/backend/src/app/http/debug.clj index fe1fddc40..569e6d09d 100644 --- a/backend/src/app/http/debug.clj +++ b/backend/src/app/http/debug.clj @@ -347,7 +347,10 @@ :code :missing-force :hint "missing force checkbox")) - (let [profile (some->> params :email (profile/get-profile-by-email pool))] + (let [profile (some->> params + :email + (profile/clean-email) + (profile/get-profile-by-email pool))] (when-not profile (ex/raise :type :validation diff --git a/backend/src/app/rpc/commands/auth.clj b/backend/src/app/rpc/commands/auth.clj index 2e82e5640..66bec377d 100644 --- a/backend/src/app/rpc/commands/auth.clj +++ b/backend/src/app/rpc/commands/auth.clj @@ -82,7 +82,8 @@ profile) (login [{:keys [::db/conn] :as cfg}] - (let [profile (->> (profile/get-profile-by-email conn email) + (let [profile (->> (profile/clean-email email) + (profile/get-profile-by-email conn) (validate-profile cfg) (profile/strip-private-attrs)) @@ -202,11 +203,12 @@ (pos? (compare elapsed register-retry-threshold)))) (defn prepare-register - [{:keys [::db/pool] :as cfg} params] + [{:keys [::db/pool] :as cfg} {:keys [email] :as params}] (validate-register-attempt! cfg params) - (let [profile (when-let [profile (profile/get-profile-by-email pool (:email params))] + (let [email (profile/clean-email email) + profile (when-let [profile (profile/get-profile-by-email pool email)] (cond (:is-blocked profile) (ex/raise :type :restriction @@ -221,7 +223,7 @@ :code :email-already-exists :hint "profile already exists"))) - params {:email (:email params) + params {:email email :password (:password params) :invitation-token (:invitation-token params) :backend "penpot" @@ -447,7 +449,8 @@ nil))] (db/with-atomic [conn pool] - (when-let [profile (profile/get-profile-by-email conn email)] + (when-let [profile (->> (profile/clean-email email) + (profile/get-profile-by-email conn))] (when-not (eml/allow-send-emails? conn profile) (ex/raise :type :validation :code :profile-is-muted diff --git a/backend/src/app/rpc/commands/ldap.clj b/backend/src/app/rpc/commands/ldap.clj index afcb48420..bb86aec90 100644 --- a/backend/src/app/rpc/commands/ldap.clj +++ b/backend/src/app/rpc/commands/ldap.clj @@ -82,8 +82,8 @@ (db/tx-run! cfg (fn [{:keys [::db/conn] :as cfg}] (or (some->> (:email info) - (profile/get-profile-by-email conn) - (profile/decode-row)) + (profile/clean-email) + (profile/get-profile-by-email conn)) (->> (assoc info :is-active true :is-demo false) (auth/create-profile! conn) (auth/create-profile-rels! conn) diff --git a/backend/src/app/rpc/commands/profile.clj b/backend/src/app/rpc/commands/profile.clj index a2fa82ba4..6ef2ef90d 100644 --- a/backend/src/app/rpc/commands/profile.clj +++ b/backend/src/app/rpc/commands/profile.clj @@ -39,6 +39,15 @@ (declare strip-private-attrs) (declare verify-password) +(defn clean-email + "Clean and normalizes email address string" + [email] + (let [email (str/lower email) + email (if (str/starts-with? email "mailto:") + (subs email 7) + email)] + email)) + (def ^:private schema:profile (sm/define @@ -147,8 +156,7 @@ (let [profile (validate-password! cfg (assoc params :profile-id profile-id)) session-id (::session/id params)] - (when (= (str/lower (:email profile)) - (str/lower (:password params))) + (when (= (:email profile) (str/lower (:password params))) (ex/raise :type :validation :code :email-as-password :hint "you can't use your email as password")) @@ -270,7 +278,7 @@ cfg (assoc cfg ::conn conn) params (assoc params :profile profile - :email (str/lower email))] + :email (clean-email email))] (if (contains? cf/flags :smtp) (request-email-change! cfg params) (change-email-immediately! cfg params))))) @@ -409,10 +417,9 @@ where email = ? and deleted_at is null) as val") -(defn check-profile-existence! +(defn- check-profile-existence! [conn {:keys [email] :as params}] - (let [email (str/lower email) - result (db/exec-one! conn [sql:profile-existence email])] + (let [result (db/exec-one! conn [sql:profile-existence email])] (when (:val result) (ex/raise :type :validation :code :email-already-exists)) @@ -427,7 +434,7 @@ (defn get-profile-by-email "Returns a profile looked up by email or `nil` if not match found." [conn email] - (->> (db/exec! conn [sql:profile-by-email (str/lower email)]) + (->> (db/exec! conn [sql:profile-by-email (clean-email email)]) (map decode-row) (first))) diff --git a/backend/src/app/rpc/commands/teams.clj b/backend/src/app/rpc/commands/teams.clj index 381611f81..4b5f07700 100644 --- a/backend/src/app/rpc/commands/teams.clj +++ b/backend/src/app/rpc/commands/teams.clj @@ -709,7 +709,8 @@ (defn- create-invitation [{:keys [::db/conn] :as cfg} {:keys [team profile role email] :as params}] - (let [member (profile/get-profile-by-email conn email)] + (let [email (profile/clean-email email) + member (profile/get-profile-by-email conn email)] (when (and member (not (eml/allow-send-emails? conn member))) (ex/raise :type :validation @@ -803,7 +804,8 @@ (db/with-atomic [conn pool] (let [perms (get-permissions conn profile-id team-id) profile (db/get-by-id conn :profile profile-id) - team (db/get-by-id conn :team team-id)] + team (db/get-by-id conn :team team-id) + emails (into #{} (map profile/clean-email) emails)] (run! (partial quotes/check-quote! conn) (list {::quotes/id ::quotes/invitations-per-team @@ -834,7 +836,7 @@ ;; We don't re-send inviation to already existing members (remove (partial contains? members)) (map (fn [email] - {:email (str/lower email) + {:email email :team team :profile profile :role role})) @@ -869,14 +871,15 @@ (let [params (assoc params :profile-id profile-id) cfg (assoc cfg ::db/conn conn) team (create-team cfg params) - profile (db/get-by-id conn :profile profile-id)] + profile (db/get-by-id conn :profile profile-id) + emails (into #{} (map profile/clean-email) emails)] ;; Create invitations for all provided emails. (->> emails (map (fn [email] {:team team :profile profile - :email (str/lower email) + :email email :role role})) (run! (partial create-invitation cfg))) @@ -913,17 +916,20 @@ {::doc/added "1.17"} [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id email] :as params}] (check-read-permissions! pool profile-id team-id) - (let [invit (-> (db/get pool :team-invitation + (let [email (profile/clean-email email) + invit (-> (db/get pool :team-invitation {:team-id team-id - :email-to (str/lower email)}) + :email-to email}) (update :role keyword)) + member (profile/get-profile-by-email pool (:email-to invit)) token (create-invitation-token cfg {:team-id (:team-id invit) :profile-id profile-id :valid-until (:valid-until invit) :role (:role invit) :member-id (:id member) - :member-email (or (:email member) (:email-to invit))})] + :member-email (or (:email member) + (profile/clean-email (:email-to invit)))})] {:token token})) ;; --- Mutation: Update invitation role @@ -944,7 +950,7 @@ (db/update! conn :team-invitation {:role (name role) :updated-at (dt/now)} - {:team-id team-id :email-to (str/lower email)}) + {:team-id team-id :email-to (profile/clean-email email)}) nil))) ;; --- Mutation: Delete invitation @@ -965,6 +971,6 @@ (let [invitation (db/delete! conn :team-invitation {:team-id team-id - :email-to (str/lower email)} + :email-to (profile/clean-email email)} {::db/return-keys true})] (rph/wrap nil {::audit/props {:invitation-id (:id invitation)}}))))) diff --git a/backend/src/app/rpc/commands/verify_token.clj b/backend/src/app/rpc/commands/verify_token.clj index 559933a13..49c76c110 100644 --- a/backend/src/app/rpc/commands/verify_token.clj +++ b/backend/src/app/rpc/commands/verify_token.clj @@ -44,18 +44,19 @@ (defmethod process-token :change-email [{:keys [conn] :as cfg} _params {:keys [profile-id email] :as claims}] - (when (profile/get-profile-by-email conn email) - (ex/raise :type :validation - :code :email-already-exists)) + (let [email (profile/clean-email email)] + (when (profile/get-profile-by-email conn email) + (ex/raise :type :validation + :code :email-already-exists)) - (db/update! conn :profile - {:email email} - {:id profile-id}) + (db/update! conn :profile + {:email email} + {:id profile-id}) - (rph/with-meta claims - {::audit/name "update-profile-email" - ::audit/props {:email email} - ::audit/profile-id profile-id})) + (rph/with-meta claims + {::audit/name "update-profile-email" + ::audit/props {:email email} + ::audit/profile-id profile-id}))) (defmethod process-token :verify-email [{:keys [conn] :as cfg} _ {:keys [profile-id] :as claims}] diff --git a/backend/src/app/srepl/main.clj b/backend/src/app/srepl/main.clj index 97f3ab245..9539c79bc 100644 --- a/backend/src/app/srepl/main.clj +++ b/backend/src/app/srepl/main.clj @@ -78,6 +78,7 @@ [email] (let [sprops (:app.setup/props main/system) pool (:app.db/pool main/system) + email (profile/clean-email email) profile (profile/get-profile-by-email pool email)] (auth/send-email-verification! pool sprops profile)