From 172d3ce410041595620a2b65a6d480f0b2c25a84 Mon Sep 17 00:00:00 2001 From: Andrey Antukh Date: Mon, 12 Oct 2026 16:16:40 +0000 Subject: [PATCH] :bug: Decide the storage object bucket by the reference The bucket of a storage object is decided by the reference that uses it, not by the label that the object carries in the file. An object serves exactly one bucket: when two references of different buckets share an object, it is split in two, one per bucket. The touched-gc check is per bucket, so a cross-bucket reference is invisible to it: the object is marked for deletion and the delete fails on the foreign key, which is what blocked the gc queue in production. app.binfile.v3 (export): every reference is resolved before it is written. An object of the wrong bucket is replaced by an alive object with the same hash and the required bucket, or by a copy emitted in the bundle when there is no twin. Objects marked for deletion are readable now: app.storage got {:include-deleted? true} in get-object, get-object-data and get-object-bytes, plus get-object-by-hash. A file whose media thumbnail pointed to a deleted object could not be exported at all. app.binfile.v1 and v3 (import): the bucket is taken from the reference, so an object shared by two buckets is stored once per bucket. Objects that no reference uses are not persisted, and a reference to an object that the bundle does not contain is rejected instead of dangling or pointing to an object of another file. library (the .penpot builder): object entries are validated and encoded with the storage object schema, and :hash is optional, as in the backend. AI-assisted-by: deepseek-v4.1-flash --- .serena/memories/backend/storage.md | 12 + .serena/memories/library/core.md | 1 + backend/src/app/binfile/common.clj | 128 ++++++++ backend/src/app/binfile/v1.clj | 50 +-- backend/src/app/binfile/v3.clj | 142 +++++--- backend/src/app/storage.clj | 80 +++-- backend/test/backend_tests/binfile_test.clj | 340 ++++++++++++++++++++ backend/test/backend_tests/storage_test.clj | 35 ++ library/src/lib/export.cljs | 14 +- library/test/export.test.js | 110 +++++++ 10 files changed, 823 insertions(+), 89 deletions(-) create mode 100644 library/test/export.test.js diff --git a/.serena/memories/backend/storage.md b/.serena/memories/backend/storage.md index f2e582c826..c341edd6f5 100644 --- a/.serena/memories/backend/storage.md +++ b/.serena/memories/backend/storage.md @@ -22,6 +22,11 @@ - A failed backend write can leave an unreferenced database row. - Callers often set `:touched-at` so garbage collection can remove such rows. - `get-object` excludes rows with `deleted_at`. +- `get-object`, `get-object-data`, and `get-object-bytes` accept `{:include-deleted? true}`. + It returns a row marked for deletion anyway. Use it when the content must be read + before the gc removes it: the export of a file, and the repair of a reference. +- `get-object-by-hash` returns an alive object by hash and bucket. Pass `:backend` to look + in the backend of a known object instead of the storage default. - Existing object values can remain readable until physical deletion. - `:expired-at` blocks reads after the expiration time. - `del-object!` sets `deleted_at` on live rows only (`deleted_at IS NULL`): a repeated call returns `false`. It does not remove backend content. @@ -99,6 +104,13 @@ Since `put-object!` uses backend-specific operations (`impl/resolve-backend` + ` | `job-resource` | Storage objects owned by job rows (`job.resource_id`), written by `app.jobs.storage`. | No | Authentication required, owner-scoped | jobs-GC touch → reference scan. | - The valid bucket set is `app.storage.schema/metadata-buckets` (derived from `bucket-requirements`, where a new bucket and its required metadata keys are one entry); `app.storage/valid-buckets` aliases it. +- The bucket is decided by the reference, not by the object. Every reference requires the + bucket of its row, and a storage object serves exactly one bucket: if two references of + different buckets share an object, the object is split in two, one per bucket. +- A cross-bucket reference is a bug, and the per-bucket gc check does not see it: the + object gets marked for deletion and the delete fails on the foreign key. +- `app.binfile.common/storage-bucket-by-kind` holds the reference table that the importer + and the exporter use; `bfc/reference-storage-id` resolves a reference to its object. - `file-media-object` is the default bucket for old rows without bucket metadata. - Do not assign a new bucket without adding its access and cleanup behavior. - The touched-object collector raises an internal error for an unknown bucket. diff --git a/.serena/memories/library/core.md b/.serena/memories/library/core.md index 7ff57c74b2..fbb6cb91c0 100644 --- a/.serena/memories/library/core.md +++ b/.serena/memories/library/core.md @@ -24,6 +24,7 @@ ## Export package - `.penpot` ZIPs include `manifest.json`, file/page/shape JSON, components/colors/typographies/tokens, media metadata, and media object blobs. +- Storage object entries (`objects/.json`) are validated against `schema:storage-object` and encoded through `encode-storage-object` before writing, so the library cannot emit an incoherent object entry. `:hash` is optional (the builder computes no hash and the importer only checks it when present); `:bucket` must be one of the file buckets (`valid-buckets`, a subset of the backend's — `organization`/`tempfile` never travel in a file). - Path/bool shape `:content` is converted to vectors before JSON encoding. - File export intentionally includes only selected top-level attrs plus data options; color export removes `:file-id` and drops empty paths. - Manifest type is `penpot/export-files`, version 1, generated by `penpot-library/%version%`, with optional referer and file relations. diff --git a/backend/src/app/binfile/common.clj b/backend/src/app/binfile/common.clj index f9cb23cdef..b18a4a8a68 100644 --- a/backend/src/app/binfile/common.clj +++ b/backend/src/app/binfile/common.clj @@ -142,6 +142,134 @@ [state key items] (update state key into xf-map-media-id items)) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; STORAGE REFERENCES +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; The bucket of a storage object is decided by the reference that uses +;; it, not by the label that the object carries in the file. If two +;; references of different buckets share the same object, the object has +;; to be separated in two objects, one per bucket. + +(def storage-bucket-by-kind + {:media "file-media-object" + :thumbnail "file-object-thumbnail"}) + +(def ^:private storage-reference-columns + {:media [:media-id :thumbnail-id] + :thumbnail [:media-id]}) + +(defn collect-storage-references + "Fold rows of `kind` into a map that associates every storage object id + with the set of buckets required by its references." + [references kind rows] + (let [bucket (get storage-bucket-by-kind kind) + columns (get storage-reference-columns kind)] + (reduce + (fn [references row] + (reduce (fn [references column] + (if-let [id (get row column)] + (update references id (fnil conj #{}) bucket) + references)) + references + columns)) + references + rows))) + +(defn assoc-storage-id + "Register the object id that resolves a reference, keyed by the object id + as it comes in the file and the bucket that the reference requires." + [state id bucket new-id] + (update state :index assoc [id bucket] new-id)) + +(defn lookup-storage-id + [id bucket] + (get-in @*state* [:index [id bucket]])) + +(defn reference-storage-id + "Like `lookup-storage-id` but raises when the file does not provide an + object for that reference." + [id bucket] + (when id + (or (lookup-storage-id id bucket) + (ex/raise :type :validation + :code :inconsistent-penpot-file + :hint "the penpot file references a storage object that it does not contain" + :storage-object-id (str id) + :bucket bucket)))) + +(defn- register-storage-alias + [alias-id source-id bucket] + (vswap! *state* update :storage-aliases assoc alias-id {:source-id source-id + :bucket bucket})) + +(defn resolve-storage-reference + "Export side. Return the object id to use for a reference that requires + `bucket`: + + - if the object already has that bucket, the object itself; + - if not, an alive object with the same hash and that bucket, if any; + - if not, a copy of the object with the required bucket, which is emitted + in the bundle under a new object id. + + Returns nil when the object can not be read at all, so the caller can + drop the reference and keep exporting." + [storage id bucket] + (when id + (let [object (sto/get-object storage id {:include-deleted? true})] + (cond + (nil? object) + (do + (l/warn :hint "referenced storage object not found; dropping the reference" + :storage-object-id (str id) + :bucket bucket + ::l/sync? true) + nil) + + (= bucket (:bucket (meta object))) + (do + (vswap! *state* update :storage-objects conj id) + id) + + :else + (if-let [twin (->> {:hash (:hash (meta object)) + :bucket bucket + :backend (:backend object)} + (sto/get-object-by-hash storage))] + (do + (l/warn :hint "storage object with unexpected bucket; using the alive object with the same content" + :storage-object-id (str id) + :bucket bucket + :replacement-id (str (:id twin)) + ::l/sync? true) + (vswap! *state* update :storage-objects conj (:id twin)) + (:id twin)) + + (let [alias-id (uuid/next)] + (l/warn :hint "storage object with unexpected bucket; emitting a copy with the required bucket" + :storage-object-id (str id) + :bucket bucket + :copy-id (str alias-id) + ::l/sync? true) + (register-storage-alias alias-id id bucket) + (vswap! *state* update :storage-objects conj alias-id) + alias-id)))))) + +(defn resolve-storage-references + "Export side. Return `rows` with every storage reference of `kind` + pointing to an object of the required bucket." + [storage kind rows] + (let [bucket (get storage-bucket-by-kind kind) + columns (get storage-reference-columns kind)] + (mapv (fn [row] + (reduce (fn [row column] + (if (contains? row column) + (update row column #(resolve-storage-reference storage % bucket)) + row)) + row + columns)) + rows))) + (defn lookup-index [id] (when id diff --git a/backend/src/app/binfile/v1.clj b/backend/src/app/binfile/v1.clj index 83423e771a..613720e731 100644 --- a/backend/src/app/binfile/v1.clj +++ b/backend/src/app/binfile/v1.clj @@ -601,9 +601,15 @@ (defmethod read-section :v1/sobjects [{:keys [::db/conn ::bfc/input ::bfc/timestamp] :as cfg}] - (let [storage (sto/resolve cfg) - ids (read-obj! input) - thumb? (into #{} (map :media-id) (:thumbnails @bfc/*state*))] + (let [storage (sto/resolve cfg) + ids (read-obj! input) + + ;; The bucket of every object is decided by the reference that uses + ;; it: an object shared by references of different buckets is stored + ;; once per bucket. + references (-> {} + (bfc/collect-storage-references :media (:media @bfc/*state*)) + (bfc/collect-storage-references :thumbnail (:thumbnails @bfc/*state*)))] (doseq [expected-storage-id ids] (let [id (read-uuid! input) @@ -627,28 +633,30 @@ {:keys [bytes size]} (bfc/sanitize-imported-svg mdata raw)] [bytes size]) [resource size]) - hash (sto/calculate-hash resource) - content (-> (sto/content resource size) - (sto/wrap-with-hash hash)) + buckets (get references id)] - params (-> mdata + ;; Objects that no reference uses are not persisted. + (when (seq buckets) + (let [hash (sto/calculate-hash resource) + content (-> (sto/content resource size) + (sto/wrap-with-hash hash))] + + (doseq [bucket buckets] + (let [params (-> mdata + (assoc :bucket bucket) (assoc ::sto/content content) (assoc ::sto/deduplicate? true) (assoc ::sto/touched-at timestamp)) - params (if (thumb? id) - (assoc params :bucket "file-object-thumbnail") - (assoc params :bucket "file-media-object")) + sobject (sto/put-object! storage params)] - sobject (sto/put-object! storage params)] + (l/dbg :hint "persisted storage object" + :old-id (str id) + :new-id (str (:id sobject)) + :bucket bucket + ::l/sync? true) - (l/dbg :hint "persisted storage object" - :old-id (str id) - :new-id (str (:id sobject)) - :is-thumbnail (boolean (thumb? id)) - ::l/sync? true) - - (vswap! bfc/*state* update :index assoc id (:id sobject))))) + (vswap! bfc/*state* bfc/assoc-storage-id id bucket (:id sobject))))))))) (doseq [item (:media @bfc/*state*)] (l/dbg :hint "inserting file media object" @@ -662,11 +670,11 @@ (db/insert! conn :file-media-object (-> item (assoc :file-id file-id) - (d/update-when :media-id bfc/lookup-index) - (d/update-when :thumbnail-id bfc/lookup-index)))))) + (d/update-when :media-id #(bfc/reference-storage-id % (:media bfc/storage-bucket-by-kind))) + (d/update-when :thumbnail-id #(bfc/reference-storage-id % (:media bfc/storage-bucket-by-kind)))))))) (doseq [item (:thumbnails @bfc/*state*)] - (let [item (update item :media-id bfc/lookup-index)] + (let [item (update item :media-id #(bfc/reference-storage-id % (:thumbnail bfc/storage-bucket-by-kind)))] (l/dbg :hint "inserting file object thumbnail" :file-id (str (:file-id item)) :media-id (str (:media-id item)) diff --git a/backend/src/app/binfile/v3.clj b/backend/src/app/binfile/v3.clj index 3ddcc0c1df..24d0ab420a 100644 --- a/backend/src/app/binfile/v3.clj +++ b/backend/src/app/binfile/v3.clj @@ -295,35 +295,53 @@ (defn- export-storage-objects [{:keys [::output] :as cfg}] (let [storage (sto/resolve cfg) + aliases (-> bfc/*state* deref :storage-aliases) ids (-> bfc/*state* deref :storage-objects not-empty) total (count ids)] (doseq [[index id] (d/enumerate ids)] - (let [sobject (sto/get-object storage id) - smeta (meta sobject) - ext (cmedia/mtype->extension (:content-type smeta)) - path (str "objects/" id ".json") - params (-> (meta sobject) - (assoc :id (:id sobject)) - (assoc :size (:size sobject)) - (encode-storage-object))] + (let [alias (get aliases id) + ;; Aliases are copies of an object that is emitted with the + ;; bucket that a reference requires instead of the bucket that + ;; the object carries in the database. + source (if alias (:source-id alias) id) + sobject (sto/get-object storage source {:include-deleted? true})] + (when-not sobject + (ex/raise :type :internal + :code :storage-object-not-found + :hint "the file references a storage object that can not be read" + :storage-object-id (str source))) - (write-entry! output path params) + (let [smeta (meta sobject) + ext (cmedia/mtype->extension (:content-type smeta)) + path (str "objects/" id ".json") + params (-> smeta + (assoc :id id) + (assoc :size (:size sobject)) + (cond-> alias (assoc :bucket (:bucket alias))) + (encode-storage-object))] - (tap-progress cfg {:section :storage-object :id id - :current (inc index) :total total}) + (write-entry! output path params) - (with-open [input (sto/get-object-data storage sobject)] - (.putNextEntry ^ZipOutputStream output (ZipEntry. (str "objects/" id ext))) - (io/copy input output :size (:size sobject)) - (.closeEntry ^ZipOutputStream output)))))) + (tap-progress cfg {:section :storage-object :id id + :current (inc index) :total total}) + + (with-open [input (sto/get-object-data storage sobject {:include-deleted? true})] + (.putNextEntry ^ZipOutputStream output (ZipEntry. (str "objects/" id ext))) + (io/copy input output :size (:size sobject)) + (.closeEntry ^ZipOutputStream output))))))) (defn- export-file [{:keys [::file-id ::output] :as cfg}] - (let [file (get-file cfg file-id) + (let [file (get-file cfg file-id) + storage (sto/resolve cfg) - media (->> (bfc/get-file-media cfg file) - (map (fn [media] - (dissoc media :file-id)))) + ;; The bucket of every referenced object is decided by the + ;; reference, so the references are resolved here, before they are + ;; written, and the objects to emit are collected in the state. + media (->> (bfc/get-file-media cfg file) + (map (fn [media] + (dissoc media :file-id))) + (bfc/resolve-storage-references storage :media)) data (:data file) typographies (:typographies data) @@ -336,7 +354,8 @@ pages (:pages data) pages-index (:pages-index data) - thumbnails (bfc/get-file-object-thumbnails cfg file-id)] + thumbnails (->> (bfc/get-file-object-thumbnails cfg file-id) + (bfc/resolve-storage-references storage :thumbnail))] (tap-progress cfg {:section :file :id file-id :name (:name file)}) @@ -381,9 +400,6 @@ shape (encode-shape shape)] (write-entry! output path shape))))) - (vswap! bfc/*state* bfc/collect-storage-objects media) - (vswap! bfc/*state* bfc/collect-storage-objects thumbnails) - (doseq [[index {:keys [id] :as item}] (d/enumerate media)] (let [path (str "files/" file-id "/media/" id ".json") encoded (encode-media item)] @@ -947,6 +963,36 @@ :components components :plugin-data plugin-data})) +(defn- read-storage-references + "Pre-scan the bundle references and return a map that associates every + storage object id with the set of buckets that its references require. + The bucket of an object is decided by the reference, so an object shared + by references of different buckets is stored once per bucket." + [{:keys [::bfc/input ::entries-index] :as cfg}] + (let [media (->> (:media entries-index) + vals + (apply concat) + (keep (fn [{:keys [id entry]}] + (let [object (->> (read-entry cfg input entry) + (decode-media) + (validate-media))] + (when (= id (:id object)) + object))))) + thumbnails (->> (:thumbnails entries-index) + vals + (apply concat) + (keep (fn [{:keys [entry tag page-id frame-id]}] + (let [object (->> (read-entry cfg input entry) + (decode-file-thumbnail) + (validate-file-thumbnail))] + (when (and (= tag (:tag object)) + (= page-id (:page-id object)) + (= frame-id (:frame-id object))) + object)))))] + (-> {} + (bfc/collect-storage-references :media media) + (bfc/collect-storage-references :thumbnail thumbnails)))) + (defn- import-file [{:keys [::db/conn ::bfc/project-id ::manifest] :as cfg} {file-id :id file-name :name} @@ -972,8 +1018,8 @@ (let [params (-> item (update :id bfc/lookup-index) (assoc :file-id file-id') - (d/update-when :media-id bfc/lookup-index) - (d/update-when :thumbnail-id bfc/lookup-index))] + (d/update-when :media-id #(bfc/reference-storage-id % (:media bfc/storage-bucket-by-kind))) + (d/update-when :thumbnail-id #(bfc/reference-storage-id % (:media bfc/storage-bucket-by-kind))))] (tap-progress cfg {:section :media :id (:id params) :file-id file-id :current (inc index) :total (count media)}) @@ -990,7 +1036,7 @@ ::db/on-conflict-do-nothing? (::bfc/overwrite cfg)))) (doseq [[index item] (d/enumerate thumbnails)] - (let [media-id (bfc/lookup-index (:media-id item)) + (let [media-id (bfc/reference-storage-id (:media-id item) (:thumbnail bfc/storage-bucket-by-kind)) object-id (-> (assoc item :file-id file-id') (cth/fmt-object-id)) params {:file-id file-id' @@ -1064,11 +1110,18 @@ ;; we will lose all registry of the pending to reconcile blobs ;; what the storage subsystem registers in other parallel ;; transaction - (let [storage (sto/resolve cfg) - entries (:objects entries-index) - total (count entries)] + (let [storage (sto/resolve cfg) + references (read-storage-references cfg) + entries (:objects entries-index) + total (count entries)] - (doseq [[index {:keys [id entry]}] (d/enumerate entries)] + (doseq [[index {:keys [id entry]}] (d/enumerate entries) + :let [buckets (get references id)] + ;; Only the objects that some reference uses are persisted, and the + ;; bucket of each of them is decided by the reference: an object + ;; shared by references of different buckets is stored once per + ;; bucket. + :when buckets] (tap-progress cfg {:section :storage-objects :current (inc index) :total total}) (let [object (-> (read-entry cfg input entry) @@ -1118,21 +1171,24 @@ content (if-let [{:keys [bytes hash]} clean] (-> (sto/content bytes) (sto/wrap-with-hash hash)) - content) - params (-> object - (dissoc :id :size) - (assoc ::sto/content content) - (assoc ::sto/deduplicate? true) - (assoc ::sto/touched-at timestamp)) - sobject (sto/put-object! storage params)] + content)] - (l/dbg :hint "persisted storage object" - :id (str (:id sobject)) - :prev-id (str id) - :bucket (:bucket params) - ::l/sync? true) + (doseq [bucket buckets] + (let [params (-> object + (dissoc :id :size) + (assoc :bucket bucket) + (assoc ::sto/content content) + (assoc ::sto/deduplicate? true) + (assoc ::sto/touched-at timestamp)) + sobject (sto/put-object! storage params)] - (vswap! bfc/*state* update :index assoc id (:id sobject))))))) + (l/dbg :hint "persisted storage object" + :id (str (:id sobject)) + :prev-id (str id) + :bucket bucket + ::l/sync? true) + + (vswap! bfc/*state* bfc/assoc-storage-id id bucket (:id sobject))))))))) (defn- add-to-file "Add a resolved library entry to a file in the file-grouped resolution. diff --git a/backend/src/app/storage.clj b/backend/src/app/storage.clj index f73fd3557e..90216bb6a0 100644 --- a/backend/src/app/storage.clj +++ b/backend/src/app/storage.clj @@ -181,10 +181,30 @@ AND (deleted_at IS NULL) AND status = 'valid'") +(def ^:private sql:get-storage-object-any + "SELECT * + FROM storage_object + WHERE id = ?") + (defn- get-database-object - [conn id] - (some-> (db/exec-one! conn [sql:get-storage-object id]) - (row->storage-object))) + ([conn id] + (get-database-object conn id nil)) + ([conn id options] + (let [sql (if (:include-deleted? options) + sql:get-storage-object-any + sql:get-storage-object)] + (some-> (db/exec-one! conn [sql id]) + (row->storage-object))))) + +(defn- readable? + "An object is readable when it is not marked as deleted, or when the + caller explicitly asks for deleted objects. Objects marked for + deletion (`deleted_at` set) still have their content in the backend + until the gc task removes them." + [object options] + (or (:include-deleted? options) + (nil? (:expired-at object)) + (ct/is-after? (:expired-at object) (ct/now)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; API @@ -224,10 +244,23 @@ :labels [(name result) (mtx/label bucket "unknown")])) (defn get-object - [storage id] + ([storage id] + (get-object storage id nil)) + ([storage id options] + (assert (valid-storage? storage)) + (let [ds (db/get-connectable storage)] + (get-database-object ds id options)))) + +(defn get-object-by-hash + "Return an alive object with the given hash and bucket, if any. The + backend can be passed explicitly; by default the storage backend is used." + [{:keys [::backend] :as storage} {:keys [hash bucket] :as params}] (assert (valid-storage? storage)) - (let [ds (db/get-connectable storage)] - (get-database-object ds id))) + (let [backend (or (:backend params) backend) + ds (db/get-connectable storage) + row (get-database-object-by-hash ds backend bucket hash)] + (when row + (row->storage-object row)))) (defn put-object! "Creates a new object with the provided content." @@ -337,26 +370,27 @@ (defn get-object-data "Return an input stream instance of the object content." - ^InputStream - [storage object] - (assert (valid-storage? storage)) - (when (or (nil? (:expired-at object)) - (ct/is-after? (:expired-at object) (ct/now))) - (let [result (-> (impl/resolve-backend storage (:backend object)) - (impl/get-object-data object))] - (emit-op! storage "get-data" (-> object meta :bucket) object) - result))) + (^InputStream [storage object] + (get-object-data storage object nil)) + (^InputStream [storage object options] + (assert (valid-storage? storage)) + (when (readable? object options) + (let [result (-> (impl/resolve-backend storage (:backend object)) + (impl/get-object-data object))] + (emit-op! storage "get-data" (-> object meta :bucket) object) + result)))) (defn get-object-bytes "Returns a byte array of object content." - [storage object] - (assert (valid-storage? storage)) - (when (or (nil? (:expired-at object)) - (ct/is-after? (:expired-at object) (ct/now))) - (let [result (-> (impl/resolve-backend storage (:backend object)) - (impl/get-object-bytes object))] - (emit-op! storage "get-bytes" (-> object meta :bucket) object) - result))) + ([storage object] + (get-object-bytes storage object nil)) + ([storage object options] + (assert (valid-storage? storage)) + (when (readable? object options) + (let [result (-> (impl/resolve-backend storage (:backend object)) + (impl/get-object-bytes object))] + (emit-op! storage "get-bytes" (-> object meta :bucket) object) + result)))) (defn get-object-url ([storage object] diff --git a/backend/test/backend_tests/binfile_test.clj b/backend/test/backend_tests/binfile_test.clj index ff42106519..aeb69b7e2f 100644 --- a/backend/test/backend_tests/binfile_test.clj +++ b/backend/test/backend_tests/binfile_test.clj @@ -15,6 +15,7 @@ [app.common.files.changes-builder :as pcb] [app.common.files.tokens :as cfo] [app.common.files.validate :as cfv] + [app.common.json :as json] [app.common.thumbnails :as thc] [app.common.time :as ct] [app.common.types.shape :as cts] @@ -2899,3 +2900,342 @@ (t/is (= (str (first result) "/" thumb-page-id "/" thumb-frame-id "/" thumb-tag) (:object-id thumb))) (t/is (some? (:media-id thumb))))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; STORAGE OBJECT REFERENCES +;; +;; The bucket of a storage object is decided by the reference that uses +;; it, not by the label that the object carries in the file. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defn- read-zip-entries + "Return a map of entry name to bytes for the given zip file." + [path] + (with-open [zip (java.util.zip.ZipFile. (jio/file path))] + (into {} + (map (fn [^java.util.zip.ZipEntry entry] + [(.getName entry) + (with-open [stream (.getInputStream zip entry)] + (io/read stream))])) + (enumeration-seq (.entries zip))))) + +(defn- write-zip-entries + "Write a new zip file with the given entries (name -> bytes or string)." + [entries] + (let [path (tmp/tempfile :suffix ".zip")] + (with-open [output (java.util.zip.ZipOutputStream. (io/output-stream path))] + (doseq [[name data] entries] + (.putNextEntry output (java.util.zip.ZipEntry. ^String name)) + (.write output ^bytes (if (bytes? data) data (.getBytes ^String data "UTF-8"))) + (.closeEntry output))) + path)) + +(defn- read-json-entry + [data] + (json/decode (String. ^bytes data "UTF-8") :key-fn json/read-kebab-key)) + +(defn- map-json-entries + "Apply `f` to the decoded json of every entry whose name matches `path?`. + Entries that do not match are copied as they are; when `f` returns nil the + entry is dropped." + [entries path? f] + (into {} + (keep (fn [[name data]] + (if (path? name) + (when-let [result (f (read-json-entry data))] + [name (json/encode result)]) + [name data]))) + entries)) + +(defn- media-entry? + [name] + (some? (re-matches #"files/[^/]+/media/[^/]+\.json" name))) + +(defn- object-entry? + [name] + (some? (re-matches #"objects/[^/]+\.json" name))) + +(defn- thumbnail-entry? + [name] + (some? (re-matches #"files/[^/]+/thumbnails/[^/]+/[^/]+/[^/]+\.json" name))) + +(def ^:private real-penpot-export + "A real penpot export: file, pages, shapes, object thumbnails and their + png blobs." + "backend_tests/test_files/svg-attrs-camel-case.penpot") + +(defn- bundle-file-id + "Return the id (as string) of the first file of the bundle." + [entries] + (->> entries + keys + (keep #(second (re-matches #"files/([^/]+)\.json" %))) + first)) + +(defn- prepare-bundle! + "Copy the bundle at `input`, apply `f` to the decoded json of every entry + whose name matches `path?` and add the `extra` entries (name -> data)." + [input path? f extra] + (-> (read-zip-entries input) + (map-json-entries path? f) + (merge extra) + (write-zip-entries))) + +(defn- export-to-zip! + [file-id] + (let [output (tmp/tempfile :suffix ".zip")] + (v3/export-files! + (-> th/*system* + (assoc ::bfc/ids #{file-id}) + (assoc ::bfc/export-type :detach-libraries)) + (io/output-stream output)) + output)) + +(defn- import-zip! + [profile input] + (-> th/*system* + (assoc ::bfc/project-id (:default-project-id profile)) + (assoc ::bfc/profile-id (:id profile)) + (assoc ::bfc/team-id (:default-team-id profile)) + (assoc ::bfc/input input) + (v3/import-files!))) + +(defn- put-image-object! + "Store a real image from the test files as a storage object." + [storage bucket resource] + (let [source (th/tempfile resource) + content (-> (sto/content source) + (sto/wrap-with-hash (sto/calculate-hash source)))] + (sto/put-object! storage {::sto/content content + :content-type "image/jpeg" + :bucket bucket}))) + +(defn- prepare-file-with-media-object + "Like `prepare-file-with-media` but also returns the media row and the + storage object it points to." + [profile] + (let [storage (-> (:app.storage/storage th/*system*) + (stt/configure-storage-backend)) + + sobject (put-image-object! storage "file-media-object" + "backend_tests/test_files/sample.jpg") + + file (th/create-file* 1 {:profile-id (:id profile) + :project-id (:default-project-id profile) + :is-shared false}) + + mobj (th/create-file-media-object* {:file-id (:id file) + :is-local true + :media-id (:id sobject)})] + + (update-file! + :file-id (:id file) + :profile-id (:id profile) + :revn 0 + :vern 0 + :changes [{:type :add-media :object mobj}]) + + {:file (dissoc file :data) + :row mobj + :sobject sobject + :storage storage})) + +(t/deftest export-binfile-v3-normalizes-cross-bucket-reference + ;; A reference that points to an object of the wrong bucket is exported + ;; pointing to the alive object with the same content, so the bundle does + ;; not carry the incoherence. + (let [profile (th/create-profile* 1) + {:keys [file row sobject storage]} (prepare-file-with-media-object profile) + + ;; the same real image, stored with the wrong bucket + foreign (put-image-object! storage "file-object-thumbnail" + "backend_tests/test_files/sample.jpg") + + _ (th/db-update! :file-media-object {:thumbnail-id (:id foreign)} {:id (:id row)}) + entries (read-zip-entries (export-to-zip! (:id file))) + media (->> entries + (keep (fn [[name data]] + (when (media-entry? name) + (read-json-entry data)))) + first)] + + (t/is (some? media)) + (t/is (not= (str (:id foreign)) (:thumbnail-id media))) + (t/is (= (str (:id sobject)) (:thumbnail-id media))) + (t/is (not (contains? entries (str "objects/" (:id foreign) ".json")))))) + +(t/deftest export-binfile-v3-emits-a-copy-without-twin + ;; When there is no alive object with the same content and the required + ;; bucket, the export emits a copy of the object with that bucket. + (let [profile (th/create-profile* 1) + {:keys [file row storage]} (prepare-file-with-media-object profile) + + ;; a different real image, stored with the wrong bucket + foreign (put-image-object! storage "file-object-thumbnail" + "backend_tests/test_files/sample2.jpg") + + _ (th/db-update! :file-media-object {:thumbnail-id (:id foreign)} {:id (:id row)}) + entries (read-zip-entries (export-to-zip! (:id file))) + media (->> entries + (keep (fn [[name data]] + (when (media-entry? name) + (read-json-entry data)))) + first) + thumb (:thumbnail-id media) + params (read-json-entry (get entries (str "objects/" thumb ".json")))] + + (t/is (some? media)) + (t/is (not= (str (:id foreign)) thumb)) + (t/is (= "file-media-object" (:bucket params))) + (t/is (= (alength ^bytes (io/read (io/input-stream (th/tempfile "backend_tests/test_files/sample2.jpg")))) + (alength ^bytes (get entries (str "objects/" thumb ".jpg"))))))) + +(t/deftest import-binfile-v3-rejects-undefined-storage-reference + ;; A reference to an object that the bundle does not contain must be + ;; rejected: it would end up dangling or pointing to an object of another + ;; file. + (let [profile (th/create-profile* 1) + input (th/tempfile real-penpot-export) + file-id (bundle-file-id (read-zip-entries input)) + media-id (uuid/random) + entry {:id media-id + :name "sample" + :width 100 + :height 100 + :mtype "image/png" + :is-local true + :media-id (uuid/random)} + bundle (prepare-bundle! input media-entry? identity + {(str "files/" file-id "/media/" media-id ".json") + (json/encode entry)}) + out (try + (import-zip! profile bundle) + :no-error + (catch Throwable e + (or (ex-data e) (some-> (ex-cause e) ex-data))))] + + (t/is (= :validation (:type out))) + (t/is (= :inconsistent-penpot-file (:code out))))) + +(t/deftest import-binfile-v3-does-not-store-unreferenced-objects + ;; Objects that no reference uses are not persisted. + (let [profile (th/create-profile* 1) + input (th/tempfile real-penpot-export) + png (th/tempfile "backend_tests/test_files/sample.png") + blob (io/read (io/input-stream png)) + junk-id (uuid/random) + bundle (prepare-bundle! input (constantly false) identity + {(str "objects/" junk-id ".json") + (json/encode {:id junk-id + :size (alength ^bytes blob) + :content-type "image/png" + :bucket "file-thumbnail" + :hash (sto/calculate-hash png)}) + (str "objects/" junk-id ".png") + blob})] + + (import-zip! profile bundle) + + (t/is (empty? (th/db-exec! ["select id from storage_object where metadata->>'bucket' = ? or metadata->>'~:bucket' = ?" + "file-thumbnail" "file-thumbnail"]))))) + +(t/deftest import-binfile-v1-stores-objects-per-reference + ;; The legacy importer stores every object with the bucket required by the + ;; reference that uses it, and resolves each reference with its own object. + ;; The legacy format carries no bucket labels, so one object shared by a + ;; media thumbnail and by an object thumbnail has to be split in two. + (let [profile (th/create-profile* 1) + {:keys [file row sobject]} (prepare-file-with-media-object profile) + + _ (th/db-update! :file-media-object + {:thumbnail-id (:id sobject)} + {:id (:id row)}) + + _ (th/db-insert! :file-tagged-object-thumbnail + {:file-id (:id file) + :object-id (thc/fmt-object-id {:file-id (:id file) + :page-id (uuid/random) + :frame-id (uuid/random)}) + :tag "frame" + :media-id (:id sobject)}) + + output (tmp/tempfile :suffix ".penpot")] + + (v1/export-files! + (-> th/*system* + (assoc ::bfc/ids #{(:id file)}) + (assoc ::bfc/embed-assets false) + (assoc ::bfc/include-libraries false)) + (io/output-stream output)) + + (let [result (-> th/*system* + (assoc ::bfc/project-id (:default-project-id profile)) + (assoc ::bfc/profile-id (:id profile)) + (assoc ::bfc/input output) + (v1/import-files!)) + new-id (first result) + media (first (th/db-query :file-media-object {:file-id new-id :deleted-at nil})) + thumb (first (bfc/get-file-object-thumbnails th/*system* new-id)) + storage (-> (:app.storage/storage th/*system*) + (stt/configure-storage-backend)) + obj1 (sto/get-object storage (:media-id media)) + obj2 (sto/get-object storage (:media-id thumb))] + + (t/is (= 1 (count result))) + (t/is (some? media)) + (t/is (some? thumb)) + (t/is (not= (:id obj1) (:id obj2))) + (t/is (= "file-media-object" (:bucket (meta obj1)))) + (t/is (= "file-object-thumbnail" (:bucket (meta obj2)))) + (t/is (= (seq (sto/get-object-bytes storage obj1)) + (seq (sto/get-object-bytes storage obj2))))))) + +(t/deftest import-binfile-v3-splits-object-shared-by-two-buckets + ;; A media object that references an object of the `file-object-thumbnail` + ;; bucket (the shape found in production) is imported storing the object + ;; once per bucket, and each reference points to its own object. + (let [profile (th/create-profile* 1) + input (th/tempfile real-penpot-export) + entries (read-zip-entries input) + file-id (bundle-file-id entries) + + ;; a storage object that is already referenced by an object thumbnail + shared (->> entries + (keep (fn [[name data]] + (when (thumbnail-entry? name) + (read-json-entry data)))) + first + :media-id) + + media-id (uuid/random) + entry {:id media-id + :name "sample" + :width 100 + :height 100 + :mtype "image/png" + :is-local true + :media-id shared} + bundle (prepare-bundle! input media-entry? identity + {(str "files/" file-id "/media/" media-id ".json") + (json/encode entry)}) + + result (import-zip! profile bundle) + new-id (first (:file-ids result)) + media (first (th/db-query :file-media-object {:file-id new-id :deleted-at nil})) + storage (-> (:app.storage/storage th/*system*) + (stt/configure-storage-backend)) + obj1 (sto/get-object storage (:media-id media)) + obj2 (sto/get-object-by-hash storage {:hash (:hash (meta obj1)) + :bucket "file-object-thumbnail" + :backend (:backend obj1)})] + + (t/is (some? shared)) + (t/is (= 1 (count (:file-ids result)))) + (t/is (some? media)) + (t/is (some? obj1)) + (t/is (some? obj2)) + (t/is (not= (:id obj1) (:id obj2))) + (t/is (= "file-media-object" (:bucket (meta obj1)))) + (t/is (= "file-object-thumbnail" (:bucket (meta obj2)))) + (t/is (= (seq (sto/get-object-bytes storage obj1)) + (seq (sto/get-object-bytes storage obj2)))))) diff --git a/backend/test/backend_tests/storage_test.clj b/backend/test/backend_tests/storage_test.clj index 9146255a09..60629752e9 100644 --- a/backend/test/backend_tests/storage_test.clj +++ b/backend/test/backend_tests/storage_test.clj @@ -165,6 +165,41 @@ (t/is (ct/is-after? (:expired-at object) (ct/now))) (t/is (nil? (sto/get-object storage (:id object)))))) +(t/deftest put-and-retrieve-deleted-object + (let [storage (-> (:app.storage/storage th/*system*) + (configure-storage-backend)) + content (sto/content "content") + object (sto/put-object! storage {::sto/content content + :bucket "file-media-object" + :content-type "text/plain"})] + + (t/is (true? (sto/del-object! storage (:id object)))) + + ;; by default an object marked for deletion is not readable + (t/is (nil? (sto/get-object storage (:id object)))) + + ;; but it can still be read when the caller asks for it: the content is + ;; there until the gc task removes it + (let [deleted (sto/get-object storage (:id object) {:include-deleted? true})] + (t/is (some? deleted)) + (t/is (= (:id object) (:id deleted))) + (t/is (nil? (sto/get-object-data storage deleted))) + (t/is (= "content" (slurp (sto/get-object-data storage deleted {:include-deleted? true}))))))) + +(t/deftest get-object-by-hash + (let [storage (-> (:app.storage/storage th/*system*) + (configure-storage-backend)) + object (sto/put-object! storage {::sto/content (-> (sto/content "content") + (sto/wrap-with-hash "given-hash")) + :bucket "file-media-object" + :content-type "text/plain"})] + + (t/is (= (:id object) + (:id (sto/get-object-by-hash storage {:hash "given-hash" + :bucket "file-media-object"})))) + (t/is (nil? (sto/get-object-by-hash storage {:hash "given-hash" + :bucket "file-object-thumbnail"}))))) + (t/deftest put-and-delete-object (let [storage (-> (:app.storage/storage th/*system*) (configure-storage-backend)) diff --git a/library/src/lib/export.cljs b/library/src/lib/export.cljs index bfb9a2c778..40eb5690da 100644 --- a/library/src/lib/export.cljs +++ b/library/src/lib/export.cljs @@ -56,6 +56,9 @@ (def encode-plugin-data (sm/encoder ctpg/schema:plugin-data sm/json-transformer)) +;; Buckets that can appear inside a `.penpot` file. It is a subset of the +;; backend `app.storage/valid-buckets`: `organization` and `tempfile` are +;; runtime-only and never travel inside a file. (def ^:private valid-buckets #{"file-media-object" "team-font-variant" @@ -72,11 +75,17 @@ [:size ::sm/int] [:content-type :string] [:bucket [::sm/one-of {:format :string} valid-buckets]] - [:hash :string]]) + ;; `:hash` is optional: the builder does not compute a hash for file media, + ;; and the importer only verifies it when it is present + ;; (`app.binfile.v3/import-storage-objects`). + [:hash {:optional true} :string]]) (def encode-storage-object (sm/encoder schema:storage-object sm/json-transformer)) +(def ^:private check-storage-object + (sm/check-fn schema:storage-object :hint "invalid storage object")) + (def ^:private file-attrs #{:id :name @@ -173,7 +182,8 @@ [(str "objects/" media-id ".json") (delay (-> media - ;; FIXME: proper encode? + (check-storage-object) + (encode-storage-object) (json/encode)))] [(str "files/" (:file-id file-media) "/media/" file-media-id ".json") (delay (-> file-media diff --git a/library/test/export.test.js b/library/test/export.test.js new file mode 100644 index 0000000000..761b1c5116 --- /dev/null +++ b/library/test/export.test.js @@ -0,0 +1,110 @@ +import assert from "node:assert/strict"; +import test from "node:test"; +import * as fs from "node:fs"; +import path from "node:path"; +import { fileURLToPath } from "node:url"; + +import { Uint8ArrayReader, ZipReader, TextWriter } from "@zip.js/zip.js"; + +import * as penpot from "#self"; + + +const __filename = fileURLToPath(import.meta.url); +const __dirname = path.dirname(__filename); + +// Buckets that can appear inside a `.penpot` file. Mirrors `lib.export/valid-buckets`. +const ALLOWED_BUCKETS = new Set([ + "file-media-object", + "team-font-variant", + "file-object-thumbnail", + "file-thumbnail", + "profile", + "file-data", + "file-data-fragment", + "file-change", +]); + +async function readEntries(bytes) { + const reader = new ZipReader(new Uint8ArrayReader(bytes)); + const entries = await reader.getEntries(); + return new Map(entries.map((entry) => [entry.filename, entry])); +} + +async function readJson(entry) { + return JSON.parse(await entry.getData(new TextWriter())); +} + +test("export a file with media writes one coherent object per media", async () => { + const context = penpot.createBuildContext(); + + const fileId = context.addFile({ name: "file with media" }); + context.addPage({ name: "page" }); + + const jpeg = fs.readFileSync( + path.join(__dirname, "..", "playground", "sample.jpg") + ); + context.addFileMedia( + { name: "photo.jpg", width: 32, height: 16 }, + new Blob([jpeg], { type: "image/jpeg" }) + ); + context.addFileMedia( + { name: "icon.png", width: 8, height: 8 }, + new Blob([new Uint8Array([137, 80, 78, 71])], { type: "image/png" }) + ); + + context.closeFile(); + + const bytes = await penpot.exportAsBytes(context); + const entries = await readEntries(bytes); + + const manifest = await readJson(entries.get("manifest.json")); + assert.equal(manifest.type, "penpot/export-files"); + assert.ok( + manifest.files.some((file) => file.id === fileId), + "the manifest should list the exported file" + ); + + const fileMedia = []; + for (const [name, entry] of entries) { + const match = /^files\/([^/]+)\/media\/([^/]+)\.json$/.exec(name); + if (match) { + fileMedia.push(await readJson(entry)); + } + } + assert.equal(fileMedia.length, 2, "one metadata entry per added media"); + + const objectJsonEntries = [...entries.entries()].filter(([name]) => + /^objects\/[^/]+\.json$/.test(name) + ); + + // (a) one `objects/.json` entry per media referenced by the file. + const referencedMediaIds = new Set(fileMedia.map((item) => item.mediaId)); + const objectIds = new Set( + objectJsonEntries.map(([name]) => name.slice("objects/".length, -".json".length)) + ); + assert.equal(objectIds.size, 2); + assert.deepEqual(objectIds, referencedMediaIds); + + for (const [name, entry] of objectJsonEntries) { + const object = await readJson(entry); + const id = name.slice("objects/".length, -".json".length); + + assert.equal(object.id, id, "the object id should match its entry name"); + // (b) media objects always live in the `file-media-object` bucket. + assert.equal(object.bucket, "file-media-object"); + // (c) no object may use a bucket outside the allowed file buckets. + assert.ok(ALLOWED_BUCKETS.has(object.bucket), `unexpected bucket: ${object.bucket}`); + // The builder does not compute a hash, and the importer accepts its absence. + assert.equal(object.hash, undefined); + assert.equal(typeof object.size, "number"); + assert.equal(typeof object.contentType, "string"); + } + + // The object blob (not only its metadata) is part of the bundle. + const objectBlobs = new Set( + [...entries.keys()] + .filter((name) => /^objects\/[^/]+\.[a-z0-9]+$/.test(name) && !name.endsWith(".json")) + .map((name) => name.slice("objects/".length).replace(/\.[^.]+$/, "")) + ); + assert.deepEqual(objectBlobs, referencedMediaIds); +});