[nop] Misc housekeeping

This commit is contained in:
Peter Taoussanis 2023-09-26 10:07:42 +02:00
parent f3ff7ae8a3
commit d566134da8
5 changed files with 229 additions and 235 deletions

View file

@ -25,16 +25,13 @@
PersistentQueue PersistentTreeMap PersistentTreeSet PersistentList PersistentQueue PersistentTreeMap PersistentTreeSet PersistentList
MapEntry LazySeq IRecord ISeq IType])) MapEntry LazySeq IRecord ISeq IType]))
(enc/assert-min-encore-version [3 67 0]) (enc/assert-min-encore-version [3 68 0])
(comment (comment
(set! *unchecked-math* :warn-on-boxed) (set! *unchecked-math* :warn-on-boxed)
(set! *unchecked-math* false) (set! *unchecked-math* false)
(thaw (freeze stress-data))) (thaw (freeze stress-data)))
;;;; TODO
;; - Performance would benefit from ^:static support / direct linking / etc.
;;;; Nippy data format ;;;; Nippy data format
;; * 4-byte header (Nippy v2.x+) (may be disabled but incl. by default) [1] ;; * 4-byte header (Nippy v2.x+) (may be disabled but incl. by default) [1]
;; { * 1-byte type id ;; { * 1-byte type id
@ -55,7 +52,7 @@
(def ^:private ^:const head-meta (def ^:private ^:const head-meta
"Final byte of 4-byte Nippy header stores version-dependent metadata" "Final byte of 4-byte Nippy header stores version-dependent metadata"
;; Currently ;; Currently:
;; - 6x compressors: #{nil :zstd :lz4 #_:lzo :lzma2 :snappy :else} ;; - 6x compressors: #{nil :zstd :lz4 #_:lzo :lzma2 :snappy :else}
;; - 4x encryptors: #{nil :aes128-cbc-sha512 :aes128-gcm-sha512 :else} ;; - 4x encryptors: #{nil :aes128-cbc-sha512 :aes128-gcm-sha512 :else}
@ -223,14 +220,14 @@
;;; DEPRECATED (only support thawing) ;;; DEPRECATED (only support thawing)
;; Desc-sorted by deprecation date ;; Desc-sorted by deprecation date
105 [:str-sm_ [[:bytes {:read 1}]]] ; [2023-mm-dd v3.3.3] Switch to unsigned sm* 105 [:str-sm_ [[:bytes {:read 1}]]] ; [2023-08-02 v3.3.0] Switch to unsigned sm*
110 [:vec-sm_ [[:elements {:read 1}]]] ; [2023-mm-dd v3.3.3] Switch to unsigned sm* 110 [:vec-sm_ [[:elements {:read 1}]]] ; [2023-08-02 v3.3.0] Switch to unsigned sm*
111 [:set-sm_ [[:elements {:read 1}]]] ; [2023-mm-dd v3.3.3] Switch to unsigned sm* 111 [:set-sm_ [[:elements {:read 1}]]] ; [2023-08-02 v3.3.0] Switch to unsigned sm*
112 [:map-sm_ [[:elements {:read 1 :multiplier 2}]]] ; [2023-mm-dd v3.3.3] Switch to unsigned sm* 112 [:map-sm_ [[:elements {:read 1 :multiplier 2}]]] ; [2023-08-02 v3.3.0] Switch to unsigned sm*
100 [:long-sm_ [[:bytes 1]]] ; [2023-mm-dd v3.3.3] Switch to 2x pos/neg ids 100 [:long-sm_ [[:bytes 1]]] ; [2023-08-02 v3.3.0] Switch to 2x pos/neg ids
101 [:long-md_ [[:bytes 2]]] ; [2023-mm-dd v3.3.3] Switch to 2x pos/neg ids 101 [:long-md_ [[:bytes 2]]] ; [2023-08-02 v3.3.0] Switch to 2x pos/neg ids
102 [:long-lg_ [[:bytes 4]]] ; [2023-mm-dd v3.3.3] Switch to 2x pos/neg ids 102 [:long-lg_ [[:bytes 4]]] ; [2023-08-02 v3.3.0] Switch to 2x pos/neg ids
78 [:sym-md_ [[:bytes {:read 4}]]] ; [2020-11-18 v3.1.1] Buggy size field, Ref. #138 78 [:sym-md_ [[:bytes {:read 4}]]] ; [2020-11-18 v3.1.1] Buggy size field, Ref. #138
77 [:kw-md_ [[:bytes {:read 4}]]] ; [2020-11-18 v3.1.1] Buggy size field, Ref. #138 77 [:kw-md_ [[:bytes {:read 4}]]] ; [2020-11-18 v3.1.1] Buggy size field, Ref. #138
@ -354,8 +351,8 @@
;;;; Dynamic config ;;;; Dynamic config
;; See also `nippy.tools` ns for further dynamic config support ;; See also `nippy.tools` ns for further dynamic config support
;; For back compatibility (nb Timbre's Carmine appender) ;; For back compatibility (incl. Timbre's Carmine appender)
(enc/defonce ^:dynamic ^:no-doc ^:deprecated *final-freeze-fallback* "DEPRECATED: prefer `*freeze-fallback`." nil) (enc/defonce ^:dynamic ^:no-doc ^:deprecated *final-freeze-fallback* "Prefer `*freeze-fallback`.")
(enc/defonce ^:dynamic *freeze-fallback* (enc/defonce ^:dynamic *freeze-fallback*
"Controls Nippy's behaviour when trying to freeze an item for which Nippy "Controls Nippy's behaviour when trying to freeze an item for which Nippy
doesn't currently have a native freeze/thaw implementation. doesn't currently have a native freeze/thaw implementation.
@ -388,7 +385,7 @@
(enc/defonce ^:dynamic *incl-metadata?* "Include metadata when freezing/thawing?" true) (enc/defonce ^:dynamic *incl-metadata?* "Include metadata when freezing/thawing?" true)
(enc/defonce ^:dynamic *thaw-xform* (enc/defonce ^:dynamic *thaw-xform*
"Experimental, subject to change. Feedback welcome. "Experimental, subject to change. Feedback welcome!
Transducer to use when thawing standard Clojure collection types Transducer to use when thawing standard Clojure collection types
(vectors, maps, sets, lists, etc.). (vectors, maps, sets, lists, etc.).
@ -432,14 +429,14 @@
;; Unfortunately quite a bit of complexity to do this safely ;; Unfortunately quite a bit of complexity to do this safely
(def default-freeze-serializable-allowlist (def default-freeze-serializable-allowlist
"Allows *any* class-name to be frozen using Java's Serializable interface. "Allows *any* class-name to be frozen using Java's `Serializable` interface.
This is generally safe since RCE risk is present only when thawing. This is generally safe since RCE risk is present only when thawing.
See also `*freeze-serializable-allowlist*`." See also `*freeze-serializable-allowlist*`."
#{"*"}) #{"*"})
(def default-thaw-serializable-allowlist (def default-thaw-serializable-allowlist
"A set of common safe class-names to allow to be frozen using Java's "A set of common safe class-names to allow to be frozen using Java's
Serializable interface. PRs welcome for additions. `Serializable` interface. PRs welcome for additions.
See also `*thaw-serializable-allowlist*`." See also `*thaw-serializable-allowlist*`."
#{"[I" "[F" "[Z" "[B" "[C" "[D" "[S" "[J" #{"[I" "[F" "[Z" "[B" "[C" "[D" "[S" "[J"
@ -477,58 +474,19 @@
"clojure.lang.ExceptionInfo" "clojure.lang.ExceptionInfo"
"clojure.lang.ArityException"}) "clojure.lang.ArityException"})
(defn- allow-and-record? [s] (= s "allow-and-record"))
(defn- split-class-names>set [s] (when (string? s) (if (= s "") #{} (set (mapv str/trim (str/split s #"[,:]"))))))
(comment
(split-class-names>set "")
(split-class-names>set "foo, bar:baz"))
(comment (.getName (.getSuperclass (.getClass (java.util.concurrent.TimeoutException.)))))
(let [ids
{:legacy {:base {:prop "taoensso.nippy.serializable-whitelist-base" :env "TAOENSSO_NIPPY_SERIALIZABLE_WHITELIST_BASE"}
:add {:prop "taoensso.nippy.serializable-whitelist-add" :env "TAOENSSO_NIPPY_SERIALIZABLE_WHITELIST_ADD"}}
:freeze {:base {:prop "taoensso.nippy.freeze-serializable-allowlist-base" :env "TAOENSSO_NIPPY_FREEZE_SERIALIZABLE_ALLOWLIST_BASE"}
:add {:prop "taoensso.nippy.freeze-serializable-allowlist-add" :env "TAOENSSO_NIPPY_FREEZE_SERIALIZABLE_ALLOWLIST_ADD"}}
:thaw {:base {:prop "taoensso.nippy.thaw-serializable-allowlist-base" :env "TAOENSSO_NIPPY_THAW_SERIALIZABLE_ALLOWLIST_BASE"}
:add {:prop "taoensso.nippy.thaw-serializable-allowlist-add" :env "TAOENSSO_NIPPY_THAW_SERIALIZABLE_ALLOWLIST_ADD"}}}]
(defn- init-allowlist [action default incl-legacy?]
(let [allowlist-base
(or
(when-let [s
(or
(do (enc/get-sys-val* (get-in ids [action :base :prop]) (get-in ids [action :base :env])))
(when incl-legacy? (enc/get-sys-val* (get-in ids [:legacy :base :prop]) (get-in ids [:legacy :base :env]))))]
(if (allow-and-record? s) s (split-class-names>set s)))
default)
allowlist-add
(when-let [s
(or
(do (enc/get-sys-val* (get-in ids [action :add :prop]) (get-in ids [action :add :env])))
(when incl-legacy? (enc/get-sys-val* (get-in ids [:legacy :add :prop]) (get-in ids [:legacy :add :env]))))]
(if (allow-and-record? s) s (split-class-names>set s)))]
(if (and allowlist-base allowlist-add)
(into (enc/have set? allowlist-base) allowlist-add)
(do allowlist-base)))))
(let [doc (let [doc
"Used when attempting to <freeze/thaw> an object that: "Used when attempting to <freeze/thaw> an object that:
- Does NOT implement Nippy's Freezable protocol. - Does NOT implement Nippy's `Freezable` protocol.
- DOES implement Java's Serializable interface. - DOES implement Java's `Serializable` interface.
In this case, the allowlist will be checked to see if Java's In this case, the allowlist will be checked to see if Java's
Serializable interface may be used. `Serializable` interface may be used.
This is a security measure to prevent possible Remote Code Execution This is a security measure to prevent possible Remote Code Execution
(RCE) when thawing malicious payloads. See [1] for details. (RCE) when thawing malicious payloads. See [1] for details.
If `freeze` encounters a disallowed Serialized class, it will throw. If `freeze` encounters a disallowed `Serializable` class, it will throw.
If `thaw` encounters a disallowed Serialized class, it will: If `thaw` encounters a disallowed `Serializable` class, it will:
- Throw if it's not possible to safely quarantine the object - Throw if it's not possible to safely quarantine the object
(object was frozen with Nippy < v2.15.0-final). (object was frozen with Nippy < v2.15.0-final).
@ -572,7 +530,7 @@
The special `\"allow-and-record\"` value is also possible, see [2]. The special `\"allow-and-record\"` value is also possible, see [2].
Upgrading from an older version of Nippy and unsure whether you've been Upgrading from an older version of Nippy and unsure whether you've been
using Nippy's Serializable support, or which classes to allow? See [2]. using Nippy's `Serializable` support, or which classes to allow? See [2].
See also `taoensso.encore/name-filter` for a util to help easily build See also `taoensso.encore/name-filter` for a util to help easily build
more advanced predicate functions. more advanced predicate functions.
@ -583,115 +541,22 @@
[1] https://github.com/ptaoussanis/nippy/issues/130 [1] https://github.com/ptaoussanis/nippy/issues/130
[2] See `allow-and-record-any-serializable-class-unsafe`."] [2] See `allow-and-record-any-serializable-class-unsafe`."]
(enc/defonce ^{:dynamic true :doc doc} *freeze-serializable-allowlist* (init-allowlist :freeze default-freeze-serializable-allowlist false)) (enc/defonce ^{:dynamic true :doc doc} *freeze-serializable-allowlist* (impl/init-serializable-allowlist :freeze default-freeze-serializable-allowlist false))
(enc/defonce ^{:dynamic true :doc doc} *thaw-serializable-allowlist* (init-allowlist :thaw default-thaw-serializable-allowlist true))) (enc/defonce ^{:dynamic true :doc doc} *thaw-serializable-allowlist* (impl/init-serializable-allowlist :thaw default-thaw-serializable-allowlist true)))
(enc/defonce ^:dynamic ^:no-doc ^:deprecated *serializable-whitelist* (enc/defonce ^:dynamic ^:no-doc ^:deprecated *serializable-whitelist*
;; Mostly retained for https://github.com/juxt/crux/releases/tag/20.09-1.11.0 ;; Retained for https://github.com/juxt/crux/releases/tag/20.09-1.11.0
"DEPRECATED, now called `*thaw-serializable-allowlist*`" nil) "Prefer `*thaw-serializable-allowlist*`." nil)
(let [nmax 1000 (enc/defaliases
ngc 16000 impl/allow-and-record-any-serializable-class-unsafe
state_ (atom {}) ; {<class-name> <frequency>} impl/get-recorded-serializable-classes)
lock_ (atom nil) ; ?promise
trim (fn [nmax state]
(persistent!
(enc/reduce-top nmax val enc/rcompare conj!
(transient {}) state)))]
;; Note: trim strategy isn't perfect: it can be tough for new (defn- freeze-serializable-allowed? [x] (impl/serializable-allowed? *freeze-serializable-allowlist* x))
;; classes to break into the top set since frequencies are being (defn- thaw-serializable-allowed? [x] (impl/serializable-allowed? (or *serializable-whitelist* *thaw-serializable-allowlist*) x))
;; reset only for classes outside the top set.
;;
;; In practice this is probably good enough since the main objective
;; is to discard one-off anonymous classes to protect state from
;; endlessly growing. Also `gc-rate` allows state to temporarily grow
;; significantly beyond `nmax` size, which helps to give new classes
;; some chance to accumulate a competitive frequency before next GC.
(defn ^{:-state_ state_} ; Undocumented
allow-and-record-any-serializable-class-unsafe
"A predicate (fn allow-class? [class-name]) fn that can be assigned
to `*freeze-serializable-allowlist*` and/or
`*thaw-serializable-allowlist*` that:
- Will allow ANY class to use Nippy's Serializable support (unsafe).
- And will record {<class-name> <frequency-allowed>} for the <=1000
classes that ~most frequently made use of this support.
`get-recorded-serializable-classes` returns the recorded state.
This predicate is provided as a convenience for users upgrading from
previous versions of Nippy that allowed the use of Serializable for all
classes by default.
While transitioning from an unsafe->safe configuration, you can use
this predicate (unsafe) to record information about which classes have
been using Nippy's Serializable support in your environment.
Once some time has passed, you can check the recorded state. If you're
satisfied that all recorded classes are safely Serializable, you can
then merge the recorded classes into Nippy's default allowlist/s, e.g.:
(alter-var-root #'thaw-serializable-allowlist*
(fn [_] (into default-thaw-serializable-allowlist
(keys (get-recorded-serializable-classes)))))"
[class-name]
(when-let [p @lock_] @p)
(let [n (count
(swap! state_
(fn [m] (assoc m class-name
(inc (long (or (get m class-name) 0)))))))]
;; Garbage collection (GC): may be serializing anonymous classes, etc.
;; so input domain could be infinite
(when (> n ngc) ; Too many classes recorded, uncommon
(let [p (promise)]
(when (compare-and-set! lock_ nil p) ; Acquired GC lock
(try
(do (reset! state_ (trim nmax @state_))) ; GC state
(finally (reset! lock_ nil) (deliver p nil))))))
n))
(defn get-recorded-serializable-classes
"Returns {<class-name> <frequency>} of the <=1000 classes that ~most
frequently made use of Nippy's Serializable support via
`allow-and-record-any-serializable-class-unsafe`.
See that function's docstring for more info."
[] (trim nmax @state_)))
(comment (comment
(count (get-recorded-serializable-classes)) (enc/qb 1e6 (freeze-serializable-allowed? "foo")) ; 65.63
(enc/reduce-n
(fn [_ n] (allow-and-record-any-serializable-class-unsafe (str n)))
nil 0 1e5))
(let [fn? fn?
compile
(enc/fmemoize
(fn [x]
(if (allow-and-record? x)
allow-and-record-any-serializable-class-unsafe
(enc/name-filter x))))
conform?* (fn [x cn] ((compile x) cn)) ; Uncached because input domain possibly infinite
conform?
(fn [x cn]
(if (fn? x)
(x cn) ; Intentionally uncached, can be handy
(conform?* x cn)))]
(defn- freeze-serializable-allowed? [class-name] (conform? *freeze-serializable-allowlist* class-name))
(defn- thaw-serializable-allowed? [class-name]
(conform? (or *serializable-whitelist* *thaw-serializable-allowlist*)
class-name)))
(comment
(enc/qb 1e6 (freeze-serializable-allowed? "foo")) ; 119.92
(binding [*freeze-serializable-allowlist* #{"foo.*" "bar"}] (binding [*freeze-serializable-allowlist* #{"foo.*" "bar"}]
(freeze-serializable-allowed? "foo.bar"))) (freeze-serializable-allowed? "foo.bar")))
@ -743,9 +608,8 @@
(do (do
(def ^:private ^:const range-ubyte (- Byte/MAX_VALUE Byte/MIN_VALUE)) (def ^:private ^:const range-ubyte (- Byte/MAX_VALUE Byte/MIN_VALUE))
(def ^:private ^:const range-ushort (- Short/MAX_VALUE Short/MIN_VALUE)) (def ^:private ^:const range-ushort (- Short/MAX_VALUE Short/MIN_VALUE))
(def ^:private ^:const range-uint (- Integer/MAX_VALUE Integer/MIN_VALUE))) (def ^:private ^:const range-uint (- Integer/MAX_VALUE Integer/MIN_VALUE))
(do
(defmacro ^:private sm-count?* [n] `(<= ~n range-ubyte)) ; Unsigned (defmacro ^:private sm-count?* [n] `(<= ~n range-ubyte)) ; Unsigned
(defmacro ^:private sm-count? [n] `(<= ~n Byte/MAX_VALUE)) (defmacro ^:private sm-count? [n] `(<= ~n Byte/MAX_VALUE))
(defmacro ^:private md-count? [n] `(<= ~n Short/MAX_VALUE)) (defmacro ^:private md-count? [n] `(<= ~n Short/MAX_VALUE))
@ -1083,7 +947,7 @@
(deftype Cached [val]) (deftype Cached [val])
(defn cache (defn cache
"Experimental, subject to change. Feedback welcome. "Experimental, subject to change. Feedback welcome!
Wraps value so that future writes of the same wrapped value with same Wraps value so that future writes of the same wrapped value with same
metadata will be efficiently encoded as references to this one. metadata will be efficiently encoded as references to this one.
@ -1098,13 +962,14 @@
(freezer Cached (freezer Cached
(let [x-val (.-val x)] (let [x-val (.-val x)]
(if-let [cache_ (.get -cache-proxy)] (if-let [cache_ (.get -cache-proxy)]
(let [cache @cache_ (let [cache @cache_
k #_x-val [x-val (meta x-val)] ; Also check meta for equality k #_x-val [x-val (meta x-val)] ; Also check meta for equality
?idx (get cache k) ?idx (get cache k)
^int idx (or ?idx ^int idx
(let [idx (count cache)] (or ?idx
(vswap! cache_ assoc k idx) (let [idx (count cache)]
idx)) (vswap! cache_ assoc k idx)
idx))
first-occurance? (nil? ?idx)] first-occurance? (nil? ?idx)]
@ -2210,7 +2075,7 @@
(comment (enc/qb 1e6 (freezable? "hello"))) ; 49.76 (comment (enc/qb 1e6 (freezable? "hello"))) ; 49.76
(defn inspect-ba (defn inspect-ba
"Experimental, subject to change. Feedback welcome." "Experimental, subject to change. Feedback welcome!"
([ba ] (inspect-ba ba nil)) ([ba ] (inspect-ba ba nil))
([ba thaw-opts] ([ba thaw-opts]
(when (enc/bytes? ba) (when (enc/bytes? ba)
@ -2300,14 +2165,14 @@
;;;; Deprecated ;;;; Deprecated
(enc/deprecated (enc/deprecated
(def ^:deprecated freeze-fallback-as-str "DEPRECATED, use `write-unfreezable`" write-unfreezable) (def ^:no-doc ^:deprecated freeze-fallback-as-str "Prefer `write-unfreezable`." write-unfreezable)
(defn ^:deprecated set-freeze-fallback! "DEPRECATED, just use `alter-var-root`" [x] (alter-var-root #'*freeze-fallback* (constantly x))) (defn ^:no-doc ^:deprecated set-freeze-fallback! "Prefer `alter-var-root`." [x] (alter-var-root #'*freeze-fallback* (constantly x)))
(defn ^:deprecated set-auto-freeze-compressor! "DEPRECATED, just use `alter-var-root`" [x] (alter-var-root #'*auto-freeze-compressor* (constantly x))) (defn ^:no-doc ^:deprecated set-auto-freeze-compressor! "Prefer `alter-var-root`." [x] (alter-var-root #'*auto-freeze-compressor* (constantly x)))
(defn ^:deprecated swap-custom-readers! "DEPRECATED, just use `alter-var-root`" [f] (alter-var-root #'*custom-readers* f)) (defn ^:no-doc ^:deprecated swap-custom-readers! "Prefer `alter-var-root`." [f] (alter-var-root #'*custom-readers* f))
(defn ^:deprecated swap-serializable-whitelist! (defn ^:no-doc ^:deprecated swap-serializable-whitelist!
"DEPRECATED, just use "Prefer:
(alter-var-root *thaw-serializable-allowlist* f) and/or (alter-var-root *thaw-serializable-allowlist* f) and/or
(alter-var-root *freeze-serializable-allow-list* f) instead." (alter-var-root *freeze-serializable-allow-list* f) instead."
[f] [f]
(alter-var-root *freeze-serializable-allowlist* (fn [old] (f (enc/have set? old)))) (alter-var-root *freeze-serializable-allowlist* (fn [old] (f (enc/have set? old))))
(alter-var-root *thaw-serializable-allowlist* (fn [old] (f (enc/have set? old)))))) (alter-var-root *thaw-serializable-allowlist* (fn [old] (f (enc/have set? old))))))

View file

@ -4,10 +4,9 @@
[taoensso.encore :as enc] [taoensso.encore :as enc]
[taoensso.nippy.crypto :as crypto])) [taoensso.nippy.crypto :as crypto]))
(def standard-header-ids (def ^:const standard-header-ids
"These'll support `:auto` thaw." "These support `:auto` thaw."
#{:aes128-cbc-sha512 #{:aes128-cbc-sha512 :aes128-gcm-sha512})
:aes128-gcm-sha512})
(defprotocol IEncryptor (defprotocol IEncryptor
(header-id [encryptor]) (header-id [encryptor])

View file

@ -55,4 +55,140 @@
(seems-serializable? (fn [])) ; Uncacheable (seems-serializable? (fn [])) ; Uncacheable
)) ))
;;;; ;;;; Java Serializable
(defn- allow-and-record? [s] (= s "allow-and-record"))
(defn- split-class-names>set [s] (when (string? s) (if (= s "") #{} (set (mapv str/trim (str/split s #"[,:]"))))))
(comment
(split-class-names>set "")
(split-class-names>set "foo, bar:baz"))
(comment (.getName (.getSuperclass (.getClass (java.util.concurrent.TimeoutException.)))))
(let [ids
{:freeze {:base :taoensso.nippy.freeze-serializable-allowlist-base
:add :taoensso.nippy.freeze-serializable-allowlist-add}
:thaw {:base :taoensso.nippy.thaw-serializable-allowlist-base
:add :taoensso.nippy.thaw-serializable-allowlist-add}
:legacy {:base :taoensso.nippy.serializable-whitelist-base
:add :taoensso.nippy.serializable-whitelist-add}}]
(defn init-serializable-allowlist
[action default incl-legacy?]
(let [allowlist-base
(or
(when-let [s
(or
(do (enc/get-sys-val* (get-in ids [action :base])))
(when incl-legacy? (enc/get-sys-val* (get-in ids [:legacy :base]))))]
(if (allow-and-record? s) s (split-class-names>set s)))
default)
allowlist-add
(when-let [s
(or
(do (enc/get-sys-val* (get-in ids [action :add])))
(when incl-legacy? (enc/get-sys-val* (get-in ids [:legacy :add]))))]
(if (allow-and-record? s) s (split-class-names>set s)))]
(if (and allowlist-base allowlist-add)
(into (enc/have set? allowlist-base) allowlist-add)
(do allowlist-base)))))
;;;
(let [nmax 1000
ngc 16000
state_ (enc/latom {}) ; {<class-name> <frequency>}
lock_ (enc/latom nil) ; ?promise
trim
(fn [nmax state]
(persistent!
(enc/reduce-top nmax val enc/rcompare conj!
(transient {}) state)))]
;; Note: trim strategy isn't perfect: it can be tough for new
;; classes to break into the top set since frequencies are being
;; reset only for classes outside the top set.
;;
;; In practice this is probably good enough since the main objective
;; is to discard one-off anonymous classes to protect state from
;; endlessly growing. Also `gc-rate` allows state to temporarily grow
;; significantly beyond `nmax` size, which helps to give new classes
;; some chance to accumulate a competitive frequency before next GC.
(defn ^{:-state_ state_} ; Undocumented
allow-and-record-any-serializable-class-unsafe
"A predicate (fn allow-class? [class-name]) fn that can be assigned
to `*freeze-serializable-allowlist*` and/or
`*thaw-serializable-allowlist*` that:
- Will allow ANY class to use Nippy's `Serializable` support (unsafe).
- And will record {<class-name> <frequency-allowed>} for the <=1000
classes that ~most frequently made use of this support.
`get-recorded-serializable-classes` returns the recorded state.
This predicate is provided as a convenience for users upgrading from
previous versions of Nippy that allowed the use of `Serializable` for all
classes by default.
While transitioning from an unsafe->safe configuration, you can use
this predicate (unsafe) to record information about which classes have
been using Nippy's `Serializable` support in your environment.
Once some time has passed, you can check the recorded state. If you're
satisfied that all recorded classes are safely `Serializable`, you can
then merge the recorded classes into Nippy's default allowlist/s, e.g.:
(alter-var-root #'thaw-serializable-allowlist*
(fn [_] (into default-thaw-serializable-allowlist
(keys (get-recorded-serializable-classes)))))"
[class-name]
(when-let [p (lock_)] @p)
(let [n (count (state_ #(assoc % class-name (inc (long (or (get % class-name) 0))))))]
;; Garbage collection (GC): may be serializing anonymous classes, etc.
;; so input domain could be infinite
(when (> n ngc) ; Too many classes recorded, uncommon
(let [p (promise)]
(when (compare-and-set! lock_ nil p) ; Acquired GC lock
(try
(do (reset! state_ (trim nmax (state_)))) ; GC state
(finally (reset! lock_ nil) (deliver p nil))))))
n))
(defn get-recorded-serializable-classes
"Returns {<class-name> <frequency>} of the <=1000 classes that ~most
frequently made use of Nippy's `Serializable` support via
`allow-and-record-any-serializable-class-unsafe`.
See that function's docstring for more info."
[] (trim nmax (state_))))
;;;
(comment
(count (get-recorded-serializable-classes))
(enc/reduce-n
(fn [_ n] (allow-and-record-any-serializable-class-unsafe (str n)))
nil 0 1e5))
(let [compile
(enc/fmemoize
(fn [x]
(if (allow-and-record? x)
allow-and-record-any-serializable-class-unsafe
(enc/name-filter x))))
fn? fn?
conform?
(fn [x cn]
(if (fn? x)
(x cn) ; Intentionally uncached, can be handy
((compile x) cn)))]
(defn serializable-allowed? [allow-list class-name]
(conform? allow-list class-name)))

View file

@ -1,45 +1,40 @@
(ns taoensso.nippy.tools (ns taoensso.nippy.tools
"Utils for community tools that want to add user-configurable Nippy support. "Utils for community tools that want to add user-configurable Nippy support.
Used by Carmine, Faraday, etc." Used by Carmine, Faraday, etc."
(:require [taoensso.nippy :as nippy])) (:require
[taoensso.encore :as enc]
[taoensso.nippy :as nippy]))
(def ^:dynamic *freeze-opts* nil) (def ^:dynamic *freeze-opts* nil)
(def ^:dynamic *thaw-opts* nil) (def ^:dynamic *thaw-opts* nil)
(defn ^:no-doc -merge-opts
"Private, implementation detail."
([x y ] (if x (conj x y) y))
([x y z] (-merge-opts (-merge-opts x y) z)))
(do (do
(defmacro with-freeze-opts [opts & body] `(binding [*freeze-opts* ~opts ] ~@body)) (defmacro with-freeze-opts [opts & body] `(binding [*freeze-opts* ~opts ] ~@body))
(defmacro with-freeze-opts+ [opts & body] `(binding [*freeze-opts* (-merge-opts *freeze-opts* ~opts)] ~@body)) (defmacro with-freeze-opts+ [opts & body] `(binding [*freeze-opts* (enc/fast-merge *freeze-opts* ~opts)] ~@body))
(defmacro with-thaw-opts [opts & body] `(binding [*thaw-opts* ~opts ] ~@body)) (defmacro with-thaw-opts [opts & body] `(binding [*thaw-opts* ~opts ] ~@body))
(defmacro with-thaw-opts+ [opts & body] `(binding [*thaw-opts* (-merge-opts *thaw-opts* ~opts)] ~@body))) (defmacro with-thaw-opts+ [opts & body] `(binding [*thaw-opts* (enc/fast-merge *thaw-opts* ~opts)] ~@body)))
(deftype WrappedForFreezing [val opts]) (deftype WrappedForFreezing [val opts])
(defn wrapped-for-freezing? [x] (instance? WrappedForFreezing x)) (defn wrapped-for-freezing? [x] (instance? WrappedForFreezing x))
(let [-merge-opts -merge-opts] (defn wrap-for-freezing
(defn wrap-for-freezing "Captures (merge `tools/*thaw-opts*` `wrap-opts`), and returns
"Captures (merge `tools/*thaw-opts*` `wrap-opts`), and returns
the given argument in a wrapped form so that `tools/freeze` will the given argument in a wrapped form so that `tools/freeze` will
use the captured options when freezing the wrapper argument. use the captured options when freezing the wrapper argument.
See also `tools/freeze`." See also `tools/freeze`."
([x ] (wrap-for-freezing x nil)) ([x ] (wrap-for-freezing x nil))
([x wrap-opts] ([x wrap-opts]
(let [captured-opts (-merge-opts *freeze-opts* wrap-opts)] ; wrap > dynamic (let [captured-opts (enc/fast-merge *freeze-opts* wrap-opts)] ; wrap > dynamic
(if (instance? WrappedForFreezing x) (if (instance? WrappedForFreezing x)
(let [^WrappedForFreezing x x] (let [^WrappedForFreezing x x]
(if (= (.-opts x) captured-opts) (if (= (.-opts x) captured-opts)
x x
(WrappedForFreezing. (.-val x) captured-opts))) (WrappedForFreezing. (.-val x) captured-opts)))
(WrappedForFreezing. x captured-opts)))))) (WrappedForFreezing. x captured-opts)))))
(let [-merge-opts -merge-opts] (defn freeze
(defn freeze "Like `nippy/freeze` but uses as options the following, merged in
"Like `nippy/freeze` but uses as options the following, merged in
order of ascending preference: order of ascending preference:
1. `default-opts` given to this fn (default nil). 1. `default-opts` given to this fn (default nil).
@ -47,28 +42,27 @@
3. Opts captured by `tools/wrap-for-freezing` (default nil). 3. Opts captured by `tools/wrap-for-freezing` (default nil).
See also `tools/wrap-for-freezing`." See also `tools/wrap-for-freezing`."
([x ] (freeze x nil)) ([x ] (freeze x nil))
([x default-opts] ([x default-opts]
(let [default-opts (get default-opts :default-opts default-opts) ; Back compatibility (let [default-opts (get default-opts :default-opts default-opts) ; Back compatibility
active-opts (-merge-opts default-opts *freeze-opts*)] ; dynamic > default active-opts (enc/fast-merge default-opts *freeze-opts*)] ; dynamic > default
(if (instance? WrappedForFreezing x) (if (instance? WrappedForFreezing x)
(let [^WrappedForFreezing x x] (let [^WrappedForFreezing x x]
(nippy/freeze (.-val x) (-merge-opts active-opts (.-opts x)))) ; captured > active! (nippy/freeze (.-val x) (enc/fast-merge active-opts (.-opts x)))) ; captured > active!
(nippy/freeze x active-opts)))))) (nippy/freeze x active-opts)))))
(let [-merge-opts -merge-opts] (defn thaw
(defn thaw "Like `nippy/thaw` but uses as options the following, merged in
"Like `nippy/thaw` but uses as options the following, merged in
order of ascending preference: order of ascending preference:
1. `default-opts` given to this fn (default nil). 1. `default-opts` given to this fn (default nil).
2. `tools/*thaw-opts*` dynamic value (default nil)." 2. `tools/*thaw-opts*` dynamic value (default nil)."
([ba ] (thaw ba nil)) ([ba ] (thaw ba nil))
([ba default-opts] ([ba default-opts]
(let [default-opts (get default-opts :default-opts default-opts) ; Back compatibility (let [default-opts (get default-opts :default-opts default-opts) ; Back compatibility
active-opts (-merge-opts default-opts *thaw-opts*)] ; dynamic > default active-opts (enc/fast-merge default-opts *thaw-opts*)] ; dynamic > default
(nippy/thaw ba active-opts))))) (nippy/thaw ba active-opts))))
(comment (thaw (freeze (wrap-for-freezing "wrapped")))) (comment (thaw (freeze (wrap-for-freezing "wrapped"))))

View file

@ -58,9 +58,9 @@
;;;; ;;;;
(defn- is-coll? (defn- is-coll?
"Checks for _explicit_ IPersistentCollection types with Nippy support. "Checks for explicit `IPersistentCollection` types with Nippy support.
Checking for explicit concrete types is tedious but preferable since a Tedious but preferable since a `freezable?` false positive would be much
`freezable?` false positive would be much worse than a false negative." worse than a false negative."
[x] [x]
(let [is? #(when (instance? % x) %)] (let [is? #(when (instance? % x) %)]
(or (or