Throw on freeze (rather than thaw) when trying to freeze an unreadable object with pr-str

This commit is contained in:
Peter Taoussanis 2013-12-03 15:50:24 +07:00
parent 1a7812522c
commit 43c85059d7
2 changed files with 33 additions and 5 deletions

View file

@ -6,7 +6,7 @@ WIP
* Added experimental `inspect-ba` fn for examining data possibly frozen by Nippy. * Added experimental `inspect-ba` fn for examining data possibly frozen by Nippy.
### Changes ### Changes
* * Now throw exception at freeze (rather than thaw) time when trying to serialize an unreadable object using the Clojure reader.
### Fixes ### Fixes
* *

View file

@ -186,6 +186,28 @@
(.writeLong s (.getMostSignificantBits x)) (.writeLong s (.getMostSignificantBits x))
(.writeLong s (.getLeastSignificantBits x))) (.writeLong s (.getLeastSignificantBits x)))
(def reader-serializable?
"`pr-str` will happily print stuff that the Reader can't actually read back,
so we have to test a full roundtrip if we want to throw an exception at freeze
(rather than thaw) time."
(let [cache (atom {})] ; {<type> <serializable?>}
(fn [x]
(let [t (type x)]
(if-let [dv (@cache t)] @dv
(locking cache ; For thread racing
(if-let [dv (@cache t)] @dv ; Retry after lock acquisition
(let [dv (delay
(try (edn/read-string {:readers *data-readers*}
(pr-str x))
true
(catch Exception _ false)))]
(swap! cache assoc t dv)
@dv))))))))
(comment (reader-serializable? "hello"))
(def ^:dynamic *final-freeze-fallback* "Alpha - subject to change." nil)
;; Fallbacks. Note that we'll extend *only* to (lowly) Object to prevent ;; Fallbacks. Note that we'll extend *only* to (lowly) Object to prevent
;; interfering with higher-level implementations, Ref. http://goo.gl/6f7SKl ;; interfering with higher-level implementations, Ref. http://goo.gl/6f7SKl
(extend-type Object (extend-type Object
@ -200,10 +222,16 @@
(.writeObject (java.io.ObjectOutputStream. s) x)) (.writeObject (java.io.ObjectOutputStream. s) x))
(do ;; Fallback #2: Clojure's Reader (do ;; Fallback #2: Clojure's Reader
#_(when debug-mode? (when (reader-serializable? x)
(println (format "DEBUG - Reader fallback: %s" (type x)))) #_(when debug-mode?
(write-id s id-reader) (println (format "DEBUG - Reader fallback: %s" (type x))))
(write-bytes s (.getBytes (pr-str x) "UTF-8")))))) (write-id s id-reader)
(write-bytes s (.getBytes (pr-str x) "UTF-8")))
;; Fallback #3: *final-freeze-fallback*
(if-let [ffb *final-freeze-fallback*] (ffb x s)
(throw (Exception. (format "Unfreezable type: %s %s"
(type x) (str x)))))))))
(def ^:private head-meta-id (reduce-kv #(assoc %1 %3 %2) {} head-meta)) (def ^:private head-meta-id (reduce-kv #(assoc %1 %3 %2) {} head-meta))