Codebase audit fixes

README.md

@@ -87,6 +87,16 @@ Use `materialize` to convert a nested `XITDB` data structure to a native Clojure
 (xdb/materialize (get-in @db [:users "alice"])) ;; => {:name "Alice" :age 31}
 ```
 
+A value read from a database is a pointer into that database's storage, so it can
+be written back into the *same* database without copying (this is what makes
+reverting to an earlier version cheap, see History below), but it cannot be
+written into a *different* database. Doing so throws an `IllegalArgumentException`;
+`materialize` the value first to copy it:
+
+```clojure
+(reset! other-db (xdb/materialize (get @db :users)))
+```
+
 ## No query language
 
 Use `filter`, `group-by`, `reduce`, etc.

deps.edn

@@ -1,6 +1,6 @@
 {:paths ["src" "test"]
  :deps  {org.clojure/clojure        {:mvn/version "1.12.0"}
-         io.github.radarroark/xitdb {:mvn/version "0.34.0"}}
+         io.github.radarroark/xitdb {:mvn/version "0.36.0"}}
 
  :aliases
  {:test  {:extra-deps {io.github.cognitect-labs/test-runner

src/xitdb/common.clj

@@ -27,9 +27,18 @@
     (seq? v) (doall (map materialize v))
     :else v))
 
+(def ^:private ^Class unwrap-interface (:on-interface IUnwrap))
+
+(defn wrapper?
+  "True for the XITDB* wrapper types, which all implement `IUnwrap` inline.
+  An interface check rather than `satisfies?`, which costs microseconds per
+  call on non-implementing classes and sits on the per-element write path."
+  [v]
+  (instance? unwrap-interface v))
+
 (defn unwrap
   "For a value that wraps another value, returns the wrapped value."
   [v]
-  (if (satisfies? IUnwrap v)
+  (if (wrapper? v)
     (-unwrap v)
-    v))
+    v))

src/xitdb/db.clj

@@ -2,11 +2,12 @@
   (:require
     [xitdb.common :as common]
     [xitdb.util.conversion :as conversion]
+    [xitdb.util.db-context :as db-context]
     [xitdb.xitdb-types :as xtypes])
   (:import
     [io.github.radarroark.xitdb
-     Core CoreBufferedFile CoreMemory Database Database$ContextFunction Hasher
-     RandomAccessBufferedFile RandomAccessMemory ReadArrayList WriteArrayList WriteCursor]
+     Core CoreBufferedFile CoreMemory CoreReadOnlyFile Database Database$ContextFunction Hasher
+     RandomAccessBufferedFile RandomAccessMemory ReadArrayList ReadCursor WriteArrayList WriteCursor]
     [java.io File]
     [java.nio.file Files]
     [java.nio.file.attribute FileAttribute]
@@ -51,26 +52,20 @@
         nil)))
   (.count history))
 
-(defn- write-value! [^WriteCursor cursor new-value]
-  (if (satisfies? common/ISlot new-value)
-    (.write cursor (common/-slot new-value))
-    (.write cursor (conversion/v->slot! cursor new-value))))
-
 (defn xitdb-reset!
   "Sets the value of the database to `new-value`.
   Returns new history index."
   [^WriteArrayList history new-value]
   (append-context! history nil (fn [^WriteCursor cursor]
-                                 (write-value! cursor new-value))))
+                                 (.write cursor (conversion/v->slot! cursor new-value)))))
 
 (defn v->slot!
   "Converts a value to a slot which can be written to a cursor.
-  For XITDB* types (which support ISlot), will return `-slot`,
-  for all other types `conversion/v->slot!`"
+  XITDB* types are written by reference (structural sharing) when they belong
+  to the same database as `cursor`; values from another database are refused.
+  All other types are converted by `conversion/v->slot!`."
   [^WriteCursor cursor v]
-  (if (satisfies? common/ISlot v)
-    (common/-slot v)
-    (conversion/v->slot! cursor v)))
+  (conversion/v->slot! cursor v))
 
 (defn xitdb-swap!
   "Starts a new transaction and calls `f` with the value at `base-keypath`.
@@ -81,15 +76,17 @@
   Returns the transaction history index."
   [db base-keypath f & args]
   (let [history (db-history db)
-        slot (.getSlot history -1)]
+        slot    (.getSlot history -1)]
     (append-context!
       history
       slot
-      (fn [^WriteCursor cursor]
-        (let [cursor (conversion/keypath-cursor cursor base-keypath)
-              obj (xtypes/read-from-cursor cursor true)]
-          (let [retval (apply f (into [obj] args))]
-            (write-value! cursor retval)))))))
+      (fn [^WriteCursor root-cursor]
+        (let [cursor (conversion/keypath-cursor root-cursor base-keypath)
+              obj    (xtypes/read-from-cursor cursor true)
+              retval (apply f (into [obj] args))
+              ;; the callback may have frozen the original destination
+              cursor (conversion/keypath-cursor root-cursor base-keypath)]
+          (.write cursor (conversion/v->slot! cursor retval)))))))
 
 (defn xitdb-swap-with-lock!
   "Performs the 'swap!' operation while locking `db.lock`.
@@ -120,6 +117,14 @@
   [^Database db]
   (.close ^Core (.-core db)))
 
+(defn- close-after-failure!
+  "Closes a core without replacing the failure that triggered cleanup."
+  [^Core core ^Throwable failure]
+  (try
+    (.close core)
+    (catch Throwable close-error
+      (.addSuppressed failure close-error))))
+
 
 (defn ^ReadArrayList read-history
   "Returns the read only transaction history array."
@@ -131,15 +136,15 @@
 (defn deref-at
   "Returns the version of the data at the specified index."
   [xdb index]
-  (let [history (read-history (-> xdb .tldbro .get))
+  (let [history (read-history (.-rodb xdb))
         cursor  (.getCursor history index)]
     (xtypes/read-from-cursor cursor false)))
 
-(deftype XITDBDatabase [tldbro rwdb lock]
+(deftype XITDBDatabase [rodb rwdb lock]
 
   java.io.Closeable
   (close [this]
-    (close-db-internal! (.get tldbro))
+    (close-db-internal! rodb)
     (close-db-internal! rwdb))
 
   clojure.lang.IDeref
@@ -148,7 +153,7 @@
 
   clojure.lang.Counted
   (count [this]
-    (.count (read-history (.get tldbro))))
+    (.count (read-history rodb)))
 
   clojure.lang.IAtom
 
@@ -177,26 +182,44 @@
   (swap [this f x y args]
     (apply xitdb-swap-with-lock! (concat [this nil f x y] args))))
 
-(defn- wrap-db [filename ^Database rwdb]
-  (if (= :memory filename)
-    (let [tdbmem (proxy [ThreadLocal] []
-                   (initialValue []
-                     rwdb))]
-      (->XITDBDatabase tdbmem rwdb (ReentrantLock.)))
-
-    (let [tldb (proxy [ThreadLocal] []
-                 (initialValue []
-                   (open-database filename "r")))]
-      (->XITDBDatabase tldb rwdb (ReentrantLock.)))))
+(defn- wrap-db
+  "Wraps writer handle `rwdb` into an XITDBDatabase, opening its reader handle.
+
+  Reads go through one shared read-only handle, so a value read on one thread
+  can be used from any other. The engine's read path only touches the handle's
+  Core and its immutable header: the in-memory Core keeps a per-thread position
+  and `CoreReadOnlyFile` keeps a per-thread file handle, and key hashing
+  uses independent engine digests (see `conversion/db-key-hash`). Writes go through
+  `rwdb` under the lock.
+
+  The writer refers to its reader so values from that reader are accepted
+  when written back and values from other databases are not."
+  [filename ^Database rwdb]
+  (let [^Core ro-core (if (= :memory filename)
+                        (.-core rwdb)
+                        (CoreReadOnlyFile. (File. ^String filename)))
+        context       (try
+                        (db-context/create ro-core (.-core rwdb) (.hasher rwdb))
+                        (catch Throwable t
+                          (when-not (= :memory filename)
+                            (close-after-failure! ro-core t))
+                          (throw t)))]
+    (->XITDBDatabase (:reader context) (:writer context) (ReentrantLock.))))
 
 (defn xit-db
   "Returns a new XITDBDatabase which can be used to query and transact data.
   `filename` can be `:memory` or the name of a file on the filesystem.
   If the file does not exist, it will be created.
-  The returned database handle can be used from multiple threads.
-  Reads can run in parallel, transactions (eg. `swap!`) will only allow one writer at a time."
+  The returned database handle can be used from multiple threads, and so can the
+  values read from it. Reads can run in parallel, transactions (eg. `swap!`) will
+  only allow one writer at a time."
   [filename]
-  (wrap-db filename (open-database filename "rw")))
+  (let [^Database writer (open-database filename "rw")]
+    (try
+      (wrap-db filename writer)
+      (catch Throwable t
+        (close-after-failure! (.-core writer) t)
+        (throw t)))))
 
 (defn- create-compact-target [filename]
   (if (= :memory filename)
@@ -225,21 +248,14 @@
       (throw (IllegalStateException. "compact should not be called from swap! or reset!")))
     (try
       (.lock lock)
-      (let [target-info (create-compact-target target)
+      (let [target-info       (create-compact-target target)
             ^Core target-core (:core target-info)]
         (try
           (let [compacted (.compact ^Database (.-rwdb xdb) target-core)]
-            ;; xitdb 0.34.0 shares the source's mutable digest with the copy.
-            ;; These handles have independent locks, so their digests must too.
-            (set! (.-md compacted)
-                  (MessageDigest/getInstance (.getAlgorithm (.-md compacted))))
             (wrap-db target compacted))
           (catch Throwable t
             ;; Clean up the target without hiding the original error
-            (try
-              (.close target-core)
-              (catch Throwable close-error
-                (.addSuppressed ^Throwable t close-error)))
+            (close-after-failure! target-core t)
             (when-let [^File file (:file target-info)]
               (try
                 (Files/deleteIfExists (.toPath file))
@@ -266,13 +282,13 @@
     (xitdb-swap-with-lock! xdb keypath (constantly new-value)))
 
   (swap [this f]
-    (xitdb-swap-with-lock! xdb keypath  f))
+    (xitdb-swap-with-lock! xdb keypath f))
 
   (swap [this f a]
-    (xitdb-swap-with-lock! xdb keypath  f a))
+    (xitdb-swap-with-lock! xdb keypath f a))
 
   (swap [this f a1 a2]
-    (xitdb-swap-with-lock! xdb keypath  f a1 a2))
+    (xitdb-swap-with-lock! xdb keypath f a1 a2))
 
   (swap [this f x y args]
     (apply xitdb-swap-with-lock! (concat [xdb keypath f x y] args))))
@@ -296,6 +312,10 @@
   [x]
   (when-not (satisfies? common/IReadOnly x)
     (throw (IllegalArgumentException.
-            (str "freeze! requires a writeable XITDB data structure, got: " (type x)))))
-  (-> x common/-unwrap .cursor .db .freeze)
-  (common/-read-only x))
+             (str "freeze! requires a writeable XITDB data structure, got: " (type x)))))
+  (let [^ReadCursor cursor (-> x common/-unwrap .cursor)
+        ^Database writer (.-db cursor)
+        ^Database reader (db-context/reader-database writer)]
+    (.freeze writer)
+    (.flush ^Core (.-core writer))
+    (xtypes/read-from-cursor (ReadCursor. (.-slotPtr cursor) reader) false)))

src/xitdb/hash_map.clj

@@ -92,7 +92,7 @@
   common/IMaterialize
   (-materialize [this]
     (reduce (fn [m [k v]]
-              (assoc m k (common/materialize v))) {} (seq this)))
+              (assoc m (common/materialize k) (common/materialize v))) {} (seq this)))
 
   common/IMaterializeShallow
   (-materialize-shallow [this]

src/xitdb/linked_list.clj

@@ -76,7 +76,7 @@
     (to-array (into [] this)))
 
   (^objects toArray [this ^objects array]
-    (let [len (count this)
+    (let [len             (count this)
           ^objects result (if (or (nil? array) (< (alength array) len))
                             (make-array Object len)
                             array)]
@@ -97,14 +97,14 @@
   common/IMaterialize
   (-materialize [this]
     (apply list
-      (reduce (fn [a v]
-                (conj a (common/materialize v))) [] (seq this))))
+           (reduce (fn [a v]
+                     (conj a (common/materialize v))) [] (seq this))))
 
   common/IMaterializeShallow
   (-materialize-shallow [this]
     (apply list
-      (reduce (fn [a v]
-                (conj a v)) [] (seq this))))
+           (reduce (fn [a v]
+                     (conj a v)) [] (seq this))))
 
   Object
   (toString [this]

src/xitdb/snapshot.clj

@@ -10,9 +10,12 @@
 (defn snapshot-memory-db
   "Returns a memory database with the value of `keypath` in the database at `filename`
   When keypath is [], returns a memdb with all the data in the db `filename`.
-  Useful for REPL-based investigation and testing."
+  Useful for REPL-based investigation and testing.
+
+  The value read from `filename` is a pointer into that file, so it is
+  materialized (copied) before being written into the memory database."
   [filename keypath]
   (with-open [db (xit-db-existing filename)]
     (let [memdb (xdb/xit-db :memory)]
-      (reset! memdb (get-in @db keypath))
+      (reset! memdb (xdb/materialize (get-in @db keypath)))
       memdb)))

src/xitdb/sorted_map.clj

@@ -139,7 +139,7 @@
   common/IMaterialize
   (-materialize [this]
     (reduce (fn [m [k v]]
-              (assoc m k (common/materialize v))) (sorted-map-by sorted-key/key-comparator) (seq this)))
+              (assoc m (common/materialize k) (common/materialize v))) (sorted-map-by sorted-key/key-comparator) (seq this)))
 
   common/IMaterializeShallow
   (-materialize-shallow [this]