diff --git a/.serena/memories/backend/storage.md b/.serena/memories/backend/storage.md index c341edd6f5..a664b58b03 100644 --- a/.serena/memories/backend/storage.md +++ b/.serena/memories/backend/storage.md @@ -24,7 +24,7 @@ - `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. + before the gc removes it: the export of a file. - `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. diff --git a/backend/src/app/binfile/common.clj b/backend/src/app/binfile/common.clj index b18a4a8a68..192e2047be 100644 --- a/backend/src/app/binfile/common.clj +++ b/backend/src/app/binfile/common.clj @@ -130,6 +130,9 @@ (defn initial-state [] {:storage-objects #{} + :storage-aliases {} + :storage-alias-index {} + :input-cache {} :files #{} :teams #{} :projects #{}}) @@ -198,10 +201,28 @@ :storage-object-id (str id) :bucket bucket)))) +(defn resolve-storage-row + "Import side. Return `row` with every storage reference of `kind` + pointing at the object the bundle stored for it. Raises when the + bundle does not contain an object a reference uses." + [row kind] + (reduce (fn [row column] + (d/update-when row column #(reference-storage-id % (get storage-bucket-by-kind kind)))) + row + (get storage-reference-columns kind))) + (defn- register-storage-alias [alias-id source-id bucket] - (vswap! *state* update :storage-aliases assoc alias-id {:source-id source-id - :bucket bucket})) + (vswap! *state* (fn [state] + (-> state + (update :storage-aliases assoc alias-id {:source-id source-id + :bucket bucket}) + (assoc-in [:storage-alias-index [source-id bucket]] alias-id))))) + +(defn- lookup-storage-alias + "Return the alias already emitted for `[source-id bucket]`, if any." + [source-id bucket] + (get-in @*state* [:storage-alias-index [source-id bucket]])) (defn resolve-storage-reference "Export side. Return the object id to use for a reference that requires @@ -212,19 +233,19 @@ - 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." + Raises when the object can not be read at all, mirroring + `export-storage-objects`: a bundle that loses a reference must fail + loudly instead of carrying a null the import would reject." [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" + (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 id) - :bucket bucket - ::l/sync? true) - nil) + :bucket bucket) (= bucket (:bucket (meta object))) (do @@ -245,15 +266,16 @@ (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)))))) + (or (lookup-storage-alias id bucket) + (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` diff --git a/backend/src/app/binfile/v1.clj b/backend/src/app/binfile/v1.clj index 613720e731..fdf3081c6a 100644 --- a/backend/src/app/binfile/v1.clj +++ b/backend/src/app/binfile/v1.clj @@ -397,6 +397,11 @@ (defmethod write-section :v1/sobjects [{:keys [::output] :as cfg}] + ;; NOTE: unlike the v3 exporter, the legacy exporter writes the objects + ;; as collected, without resolving references: no twin reuse, no alias + ;; copies and no deleted-object reads. Reference resolution lives only + ;; in v3; keep it that way (this format is exercised by tests, production + ;; exports through `bf.v3/export-files!`). (let [sids (-> bfc/*state* deref :sids) storage (sto/resolve cfg)] @@ -670,11 +675,10 @@ (db/insert! conn :file-media-object (-> item (assoc :file-id file-id) - (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)))))))) + (bfc/resolve-storage-row :media)))))) (doseq [item (:thumbnails @bfc/*state*)] - (let [item (update item :media-id #(bfc/reference-storage-id % (:thumbnail bfc/storage-bucket-by-kind)))] + (let [item (bfc/resolve-storage-row item :thumbnail)] (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 24d0ab420a..8bb1f2760b 100644 --- a/backend/src/app/binfile/v3.clj +++ b/backend/src/app/binfile/v3.clj @@ -83,6 +83,9 @@ [:used-by {:optional true} [:vector ::sm/uuid]]]]]]) (def ^:private schema:storage-object + ;; The entry `:bucket` is an audit/compat label kept from the export; + ;; the bucket the object is stored with is decided by the reference + ;; that uses it, never by this label. [:map {:title "StorageObject"} [:id ::sm/uuid] [:size ::sm/int] @@ -776,13 +779,25 @@ (decode-plugin-data) (validate-plugin-data))))) +(defn- read-decoded-entry + "Read a bundle entry, decode and validate it, caching the result in + the state. Media and thumbnail entries are read twice per import (the + references pre-scan and the file import), and every read counts + against the shared text budget, so the second read reuses the first." + [cfg entry decode validate] + (if-let [object (get-in @bfc/*state* [:input-cache entry])] + object + (let [object (->> (read-entry cfg (::bfc/input cfg) entry) + (decode) + (validate))] + (vswap! bfc/*state* assoc-in [:input-cache entry] object) + object))) + (defn- read-file-media - [{:keys [::bfc/input ::entries-index] :as cfg} file-id] + [{:keys [::entries-index] :as cfg} file-id] (->> (get-in entries-index [:media (str file-id)]) (reduce (fn [result {:keys [id entry]}] - (let [object (->> (read-entry cfg input entry) - (decode-media) - (validate-media)) + (let [object (read-decoded-entry cfg entry decode-media validate-media) object (-> object (assoc :file-id file-id) (update :created-at default-now) @@ -926,12 +941,10 @@ (d/ordered-map))))) (defn- read-file-thumbnails - [{:keys [::bfc/input ::entries-index] :as cfg} file-id] + [{:keys [::entries-index] :as cfg} file-id] (->> (get-in entries-index [:thumbnails (str file-id)]) (reduce (fn [result {:keys [page-id frame-id tag entry]}] - (let [object (->> (read-entry cfg input entry) - (decode-file-thumbnail) - (validate-file-thumbnail))] + (let [object (read-decoded-entry cfg entry decode-file-thumbnail validate-file-thumbnail)] (if (and (= frame-id (:frame-id object)) (= page-id (:page-id object)) @@ -968,23 +981,19 @@ 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}] + [{:keys [::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))] + (let [object (read-decoded-entry cfg 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))] + (let [object (read-decoded-entry cfg entry decode-file-thumbnail validate-file-thumbnail)] (when (and (= tag (:tag object)) (= page-id (:page-id object)) (= frame-id (:frame-id object))) @@ -1018,8 +1027,7 @@ (let [params (-> item (update :id bfc/lookup-index) (assoc :file-id file-id') - (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))))] + (bfc/resolve-storage-row :media))] (tap-progress cfg {:section :media :id (:id params) :file-id file-id :current (inc index) :total (count media)}) @@ -1036,7 +1044,7 @@ ::db/on-conflict-do-nothing? (::bfc/overwrite cfg)))) (doseq [[index item] (d/enumerate thumbnails)] - (let [media-id (bfc/reference-storage-id (:media-id item) (:thumbnail bfc/storage-bucket-by-kind)) + (let [media-id (:media-id (bfc/resolve-storage-row item :thumbnail)) object-id (-> (assoc item :file-id file-id') (cth/fmt-object-id)) params {:file-id file-id' @@ -1111,7 +1119,11 @@ ;; what the storage subsystem registers in other parallel ;; transaction (let [storage (sto/resolve cfg) - references (read-storage-references cfg) + ;; Without object entries there is nothing to persist and no + ;; reference to resolve: skip the media/thumbnails pre-scan. + references (if (seq (:objects entries-index)) + (read-storage-references cfg) + {}) entries (:objects entries-index) total (count entries)] diff --git a/backend/src/app/storage.clj b/backend/src/app/storage.clj index 90216bb6a0..0e39642094 100644 --- a/backend/src/app/storage.clj +++ b/backend/src/app/storage.clj @@ -184,7 +184,8 @@ (def ^:private sql:get-storage-object-any "SELECT * FROM storage_object - WHERE id = ?") + WHERE id = ? + AND status = 'valid'") (defn- get-database-object ([conn id] diff --git a/backend/test/backend_tests/binfile_test.clj b/backend/test/backend_tests/binfile_test.clj index f47833556c..32b5781ccf 100644 --- a/backend/test/backend_tests/binfile_test.clj +++ b/backend/test/backend_tests/binfile_test.clj @@ -3040,6 +3040,19 @@ :sobject sobject :storage storage})) +(t/deftest resolve-storage-reference-raises-on-missing-object + ;; A reference to a storage row that no longer exists fails loudly + ;; instead of emitting a null that the import would reject. + (let [out (binding [bfc/*state* (volatile! (bfc/initial-state))] + (try + (with-redefs [sto/get-object (fn [_ _ _] nil)] + (bfc/resolve-storage-reference nil (uuid/random) "file-media-object")) + :no-error + (catch Throwable e + (ex-data e))))] + (t/is (= :internal (:type out))) + (t/is (= :storage-object-not-found (:code out))))) + (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 @@ -3090,6 +3103,67 @@ (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 export-binfile-v3-emits-a-single-copy-per-bucket + ;; Two references of the same bucket sharing one wrong-bucket object + ;; resolve to the same emitted copy, not to one copy each. + (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 + {:media-id (:id foreign) + :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) + copies (filter object-entry? (keys entries))] + + (t/is (some? media)) + (t/is (= (:media-id media) (:thumbnail-id media))) + (t/is (not= (str (:id foreign)) (:media-id media))) + (t/is (= 1 (count copies))) + (t/is (= (str "objects/" (:media-id media) ".json") + (first copies))))) + +(t/deftest export-import-binfile-v3-round-trips-emitted-copy + ;; End to end of the issue case: a reference to a wrong-bucket object + ;; without a live twin exports an alias copy and imports it back as an + ;; object of the required bucket, with identical content. + (let [profile (th/create-profile* 1) + {:keys [file row storage]} (prepare-file-with-media-object profile) + + 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)}) + result (import-zip! profile (export-to-zip! (:id file))) + new-id (first (:file-ids result)) + media (first (th/db-query :file-media-object {:file-id new-id :deleted-at nil})) + backend (-> (:app.storage/storage th/*system*) + (stt/configure-storage-backend)) + obj1 (sto/get-object backend (:media-id media)) + obj2 (sto/get-object backend (:thumbnail-id media)) + sample1 (io/read (io/input-stream (th/tempfile "backend_tests/test_files/sample.jpg"))) + sample2 (io/read (io/input-stream (th/tempfile "backend_tests/test_files/sample2.jpg")))] + + (t/is (= 1 (count (:file-ids result)))) + (t/is (some? media)) + (t/is (some? obj1)) + (t/is (some? obj2)) + (t/is (= "file-media-object" (:bucket (meta obj1)))) + (t/is (= "file-media-object" (:bucket (meta obj2)))) + (t/is (= (sto/calculate-hash sample1) + (sto/calculate-hash (sto/get-object-bytes backend obj1)))) + (t/is (= (sto/calculate-hash sample2) + (sto/calculate-hash (sto/get-object-bytes backend obj2)))))) + (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 @@ -3187,8 +3261,8 @@ (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/is (= (sto/calculate-hash (sto/get-object-bytes storage obj1)) + (sto/calculate-hash (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` @@ -3237,5 +3311,70 @@ (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/is (= (sto/calculate-hash (sto/get-object-bytes storage obj1)) + (sto/calculate-hash (sto/get-object-bytes storage obj2)))))) + +(defn- v1-sobjects-input + "Build a minimal :v1/sobjects section body: an ids vector followed by + one (uuid, metadata, blob) triple per id, using the same writers the + exporter uses." + [objects] + (let [baos (java.io.ByteArrayOutputStream.) + out (io/data-output-stream baos)] + (binding [v1/*position* (atom 0)] + (v1/write-obj! out (mapv :id objects)) + (doseq [{:keys [id meta blob]} objects] + (v1/write-uuid! out id) + (v1/write-obj! out meta) + (v1/write-stream! out (java.io.ByteArrayInputStream. ^bytes blob) (alength ^bytes blob)))) + (io/input-stream (.toByteArray baos)))) + +(defn- read-v1-sobjects + "Run the :v1/sobjects import section over `objects` with the given + media and thumbnail rows and file-id index already in the state." + [objects media thumbnails index] + (let [input (v1-sobjects-input objects)] + (db/tx-run! th/*system* + (fn [system] + (let [cfg (assoc system + ::bfc/timestamp (ct/now) + ::bfc/input (io/data-input-stream input) + ::v1/section :v1/sobjects)] + (binding [bfc/*state* (volatile! {:media media + :thumbnails thumbnails + :index index}) + v1/*position* (atom 0)] + (v1/read-section cfg))))))) + +(defn- count-storage-objects + [] + (-> (th/db-exec! ["select count(*) as n from storage_object"]) + first + :n)) + +(t/deftest import-binfile-v1-does-not-store-unreferenced-objects + ;; Objects that no reference uses are not persisted. + (let [blob (.getBytes "unreferenced-blob" "UTF-8") + before (count-storage-objects)] + (read-v1-sobjects [{:id (uuid/random) + :meta {:content-type "image/png"} + :blob blob}] + [] + [] + {}) + (t/is (= before (count-storage-objects))))) + +(t/deftest import-binfile-v1-rejects-undefined-storage-reference + ;; A reference to an object that the section does not contain must be + ;; rejected instead of dangling. + (let [file-id (uuid/random) + media-item {:id (uuid/random) + :file-id file-id + :media-id (uuid/random)} + out (try + (read-v1-sobjects [] [media-item] [] {file-id (uuid/random)}) + :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))))) diff --git a/backend/test/backend_tests/storage_test.clj b/backend/test/backend_tests/storage_test.clj index 60629752e9..db99917a6f 100644 --- a/backend/test/backend_tests/storage_test.clj +++ b/backend/test/backend_tests/storage_test.clj @@ -184,7 +184,9 @@ (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/is (= "content" (slurp (sto/get-object-data storage deleted {:include-deleted? true})))) + (t/is (nil? (sto/get-object-bytes storage deleted))) + (t/is (= "content" (String. ^bytes (sto/get-object-bytes storage deleted {:include-deleted? true}) "UTF-8")))))) (t/deftest get-object-by-hash (let [storage (-> (:app.storage/storage th/*system*) @@ -200,6 +202,27 @@ (t/is (nil? (sto/get-object-by-hash storage {:hash "given-hash" :bucket "file-object-thumbnail"}))))) +(t/deftest get-object-by-hash-excludes-dead-rows + ;; The hash lookup picks a reusable twin: dying rows must never be + ;; eligible, or the export would reuse blobs about to disappear. + (let [storage (-> (:app.storage/storage th/*system*) + (configure-storage-backend)) + params {:hash "given-hash" + :bucket "file-media-object"} + 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 (some? (sto/get-object-by-hash storage params))) + + (th/db-update! :storage-object {:status "pending"} {:id (:id object)}) + (t/is (nil? (sto/get-object-by-hash storage params))) + + (th/db-update! :storage-object {:status "valid"} {:id (:id object)}) + (t/is (true? (sto/del-object! storage (:id object)))) + (t/is (nil? (sto/get-object-by-hash storage params))))) + (t/deftest put-and-delete-object (let [storage (-> (:app.storage/storage th/*system*) (configure-storage-backend)) @@ -884,6 +907,20 @@ (t/is (nil? (sto/get-object storage (:id object)))))) +(t/deftest pending-objects-excluded-from-get-with-include-deleted + ;; {:include-deleted? true} skips only the deletion filter, not the + ;; lifecycle-state filter: a pending row is never readable, even when + ;; the caller asks for deleted objects. + (let [storage (-> (:app.storage/storage th/*system*) + (configure-storage-backend)) + content (sto/content "content") + object (sto/put-object! storage {::sto/content content + :content-type "text/plain"})] + + (th/db-update! :storage-object {:status "pending"} {:id (:id object)}) + + (t/is (nil? (sto/get-object storage (:id object) {:include-deleted? true}))))) + (t/deftest pending-objects-excluded-from-dedup (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 40eb5690da..853fe52063 100644 --- a/library/src/lib/export.cljs +++ b/library/src/lib/export.cljs @@ -70,6 +70,9 @@ "file-change"}) (def ^:private schema:storage-object + ;; The entry `:bucket` is an audit/compat label; the bucket the object + ;; is stored with is decided by the reference that uses it, never by + ;; this label. [:map {:title "StorageObject"} [:id ::sm/uuid] [:size ::sm/int] diff --git a/library/test/export.test.js b/library/test/export.test.js index 761b1c5116..886da005fd 100644 --- a/library/test/export.test.js +++ b/library/test/export.test.js @@ -12,7 +12,11 @@ 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`. +// Buckets that can appear inside a `.penpot` file. Oracle kept in sync +// by hand with the backend `app.storage/valid-buckets` and +// `lib.export/valid-buckets` (`organization`, `tempfile`, +// `upload-session` and `job-resource` are runtime-only and never travel +// inside a file). const ALLOWED_BUCKETS = new Set([ "file-media-object", "team-font-variant", @@ -98,6 +102,14 @@ test("export a file with media writes one coherent object per media", async () = assert.equal(object.hash, undefined); assert.equal(typeof object.size, "number"); assert.equal(typeof object.contentType, "string"); + // No other keys may leak into the entry: the malli encoder only + // transforms the declared ones. + assert.deepEqual(Object.keys(object).sort(), [ + "bucket", + "contentType", + "id", + "size", + ]); } // The object blob (not only its metadata) is part of the bundle.