luciano/nippy
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Revert v2.14.2 hotfix reset

Browse source
This commit is contained in:
Peter Taoussanis 2020-07-24 19:38:16 +02:00
parent ea93fee8e2
commit cf84a441f4
7 changed files with 517 additions and 261 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

25
project.clj
View file

@ -1,4 +1,4 @@
(defproject com.taoensso/nippy "2.14.2" (defproject com.taoensso/nippy "2.15.0"
:author "Peter Taoussanis <https://www.taoensso.com>" :author "Peter Taoussanis <https://www.taoensso.com>"
:description "High-performance serialization library for Clojure" :description "High-performance serialization library for Clojure"
:url "https://github.com/ptaoussanis/nippy" :url "https://github.com/ptaoussanis/nippy"
@ -14,11 +14,11 @@
:dependencies :dependencies
[[org.clojure/clojure "1.5.1"] [[org.clojure/clojure "1.5.1"]
[org.clojure/tools.reader "1.1.1"] [org.clojure/tools.reader "1.3.2"]
[com.taoensso/encore "2.93.0"] [com.taoensso/encore "2.122.0"]
[org.iq80.snappy/snappy "0.4"] [org.iq80.snappy/snappy "0.4"]
[org.tukaani/xz "1.6"] [org.tukaani/xz "1.8"]
[net.jpountz.lz4/lz4 "1.3"]] [org.lz4/lz4-java "1.7.1"]]
:profiles :profiles
{;; :default [:base :system :user :provided :dev] {;; :default [:base :system :user :provided :dev]
@ -28,22 +28,23 @@
:1.7 {:dependencies [[org.clojure/clojure "1.7.0"]]} :1.7 {:dependencies [[org.clojure/clojure "1.7.0"]]}
:1.8 {:dependencies [[org.clojure/clojure "1.8.0"]]} :1.8 {:dependencies [[org.clojure/clojure "1.8.0"]]}
:1.9 {:dependencies [[org.clojure/clojure "1.9.0"]]} :1.9 {:dependencies [[org.clojure/clojure "1.9.0"]]}
:1.10 {:dependencies [[org.clojure/clojure "1.10.1"]]}
:test {:jvm-opts ["-Xms1024m" "-Xmx2048m"] :test {:jvm-opts ["-Xms1024m" "-Xmx2048m"]
:dependencies [[org.clojure/test.check "0.9.0"] :dependencies [[org.clojure/test.check "1.1.0"]
[org.clojure/data.fressian "0.2.1"] [org.clojure/data.fressian "1.0.0"]
[org.xerial.snappy/snappy-java "1.1.7.1"]]} [org.xerial.snappy/snappy-java "1.1.7.6"]]}
:dev [:1.9 :test :server-jvm :dev [:1.10 :test :server-jvm
{:plugins {:plugins
[[lein-pprint "1.2.0"] [[lein-pprint "1.3.2"]
[lein-ancient "0.6.15"] [lein-ancient "0.6.15"]
[lein-codox "0.10.3"]]}]} [lein-codox "0.10.7"]]}]}
:codox :codox
{:language :clojure {:language :clojure
:source-uri "https://github.com/ptaoussanis/nippy/blob/master/{filepath}#L{line}"} :source-uri "https://github.com/ptaoussanis/nippy/blob/master/{filepath}#L{line}"}
:aliases :aliases
{"test-all" ["with-profile" "+1.9:+1.8:+1.7:+1.6:+1.5" "test"] {"test-all" ["with-profile" "+1.10:+1.9:+1.8:+1.7:+1.6:+1.5" "test"]
"deploy-lib" ["do" "deploy" "clojars," "install"] "deploy-lib" ["do" "deploy" "clojars," "install"]
"start-dev" ["with-profile" "+dev" "repl" ":headless"]} "start-dev" ["with-profile" "+dev" "repl" ":headless"]}

457
src/taoensso/nippy.clj
View file

@ -13,19 +13,19 @@
[java.io ByteArrayInputStream ByteArrayOutputStream DataInputStream [java.io ByteArrayInputStream ByteArrayOutputStream DataInputStream
DataOutputStream Serializable ObjectOutputStream ObjectInputStream DataOutputStream Serializable ObjectOutputStream ObjectInputStream
DataOutput DataInput] DataOutput DataInput]
[java.lang.reflect Method] [java.lang.reflect Method Field Constructor]
;; [java.net URI] ; TODO [java.net URI]
[java.util Date UUID] [java.util Date UUID]
[java.util.regex Pattern] [java.util.regex Pattern]
[clojure.lang Keyword Symbol BigInt Ratio [clojure.lang Keyword Symbol BigInt Ratio
APersistentMap APersistentVector APersistentSet APersistentMap APersistentVector APersistentSet
IPersistentMap ; IPersistentVector IPersistentSet IPersistentList IPersistentMap ; IPersistentVector IPersistentSet IPersistentList
PersistentQueue PersistentTreeMap PersistentTreeSet PersistentList PersistentQueue PersistentTreeMap PersistentTreeSet PersistentList
LazySeq IRecord ISeq])) LazySeq IRecord ISeq IType]))
(if (vector? enc/encore-version) (if (vector? enc/encore-version)
(enc/assert-min-encore-version [2 67 1]) (enc/assert-min-encore-version [2 121 0])
(enc/assert-min-encore-version 2.67)) (enc/assert-min-encore-version 2.121))
(comment (comment
(set! *unchecked-math* :warn-on-boxed) (set! *unchecked-math* :warn-on-boxed)
@ -59,25 +59,38 @@
(def ^:private ^:const head-version "Current Nippy header format version" 1) (def ^:private ^:const head-version "Current Nippy header format version" 1)
(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
;; - 5 compressors, #{nil :snappy :lz4 :lzma2 :else}
;; - 4 encryptors, #{nil :aes128-cbc-sha512 :aes128-gcm-sha512 :else}
{(byte 0) {:version 1 :compressor-id nil :encryptor-id nil} {(byte 0) {:version 1 :compressor-id nil :encryptor-id nil}
(byte 2) {:version 1 :compressor-id nil :encryptor-id :aes128-cbc-sha512}
(byte 14) {:version 1 :compressor-id nil :encryptor-id :aes128-gcm-sha512}
(byte 4) {:version 1 :compressor-id nil :encryptor-id :else} (byte 4) {:version 1 :compressor-id nil :encryptor-id :else}
(byte 5) {:version 1 :compressor-id :else :encryptor-id nil}
(byte 6) {:version 1 :compressor-id :else :encryptor-id :else}
;;
(byte 2) {:version 1 :compressor-id nil :encryptor-id :aes128-sha512}
;;
(byte 1) {:version 1 :compressor-id :snappy :encryptor-id nil} (byte 1) {:version 1 :compressor-id :snappy :encryptor-id nil}
(byte 3) {:version 1 :compressor-id :snappy :encryptor-id :aes128-sha512} (byte 3) {:version 1 :compressor-id :snappy :encryptor-id :aes128-cbc-sha512}
(byte 15) {:version 1 :compressor-id :snappy :encryptor-id :aes128-gcm-sha512}
(byte 7) {:version 1 :compressor-id :snappy :encryptor-id :else} (byte 7) {:version 1 :compressor-id :snappy :encryptor-id :else}
;;
;;; :lz4 used for both lz4 and lz4hc compressor (the two are compatible) ;;; :lz4 used for both lz4 and lz4hc compressor (the two are compatible)
(byte 8) {:version 1 :compressor-id :lz4 :encryptor-id nil} (byte 8) {:version 1 :compressor-id :lz4 :encryptor-id nil}
(byte 9) {:version 1 :compressor-id :lz4 :encryptor-id :aes128-sha512} (byte 9) {:version 1 :compressor-id :lz4 :encryptor-id :aes128-cbc-sha512}
(byte 16) {:version 1 :compressor-id :lz4 :encryptor-id :aes128-gcm-sha512}
(byte 10) {:version 1 :compressor-id :lz4 :encryptor-id :else} (byte 10) {:version 1 :compressor-id :lz4 :encryptor-id :else}
;;
(byte 11) {:version 1 :compressor-id :lzma2 :encryptor-id nil} (byte 11) {:version 1 :compressor-id :lzma2 :encryptor-id nil}
(byte 12) {:version 1 :compressor-id :lzma2 :encryptor-id :aes128-sha512} (byte 12) {:version 1 :compressor-id :lzma2 :encryptor-id :aes128-cbc-sha512}
(byte 13) {:version 1 :compressor-id :lzma2 :encryptor-id :else}}) (byte 17) {:version 1 :compressor-id :lzma2 :encryptor-id :aes128-gcm-sha512}
(byte 13) {:version 1 :compressor-id :lzma2 :encryptor-id :else}
(byte 5) {:version 1 :compressor-id :else :encryptor-id nil}
(byte 18) {:version 1 :compressor-id :else :encryptor-id :aes128-cbc-sha512}
(byte 19) {:version 1 :compressor-id :else :encryptor-id :aes128-gcm-sha512}
(byte 6) {:version 1 :compressor-id :else :encryptor-id :else}})
(comment (count (sort (keys head-meta))))
(defmacro ^:private when-debug [& body] (when #_true false `(do ~@body))) (defmacro ^:private when-debug [& body] (when #_true false `(do ~@body)))
@ -106,7 +119,7 @@
49 :record-md 49 :record-md
80 :record-lg ; Used only for back-compatible thawing 80 :record-lg ; Used only for back-compatible thawing
81 :type ; TODO Implement? 81 :type
3 :nil 3 :nil
8 :true 8 :true
@ -125,7 +138,7 @@
57 :sym-lg 57 :sym-lg
58 :regex 58 :regex
71 :uri ; TODO Implement? 71 :uri
53 :bytes-0 53 :bytes-0
7 :bytes-sm 7 :bytes-sm
@ -139,6 +152,8 @@
69 :vec-md 69 :vec-md
21 :vec-lg 21 :vec-lg
115 :objects-lg ; TODO Could include md, sm, 0 later if there's demand
18 :set-0 18 :set-0
111 :set-sm 111 :set-sm
32 :set-md 32 :set-md
@ -244,17 +259,21 @@
(enc/defalias encrypt encryption/encrypt) (enc/defalias encrypt encryption/encrypt)
(enc/defalias decrypt encryption/decrypt) (enc/defalias decrypt encryption/decrypt)
(enc/defalias aes128-encryptor encryption/aes128-encryptor)
(enc/defalias aes128-gcm-encryptor encryption/aes128-gcm-encryptor)
(enc/defalias aes128-cbc-encryptor encryption/aes128-cbc-encryptor)
(enc/defalias aes128-encryptor encryption/aes128-gcm-encryptor) ; Default
(enc/defalias freezable? utils/freezable?)) (enc/defalias freezable? utils/freezable?))
;;;; Dynamic config ;;;; Dynamic config
;; See also `nippy.tools` ns for further dynamic config support ;; See also `nippy.tools` ns for further dynamic config support
;; TODO Switch to thread-local proxies? ;; For back compatibility (nb Timbre's Carmine appender)
(enc/defonce ^:dynamic *final-freeze-fallback* "DEPRECATED: prefer `*freeze-fallback`." nil)
(enc/defonce ^:dynamic *freeze-fallback* "(fn [data-output x])->freeze, nil => default" nil)
(enc/defonce ^:dynamic *freeze-fallback* "(fn [data-output x]), nil => default" nil) (enc/defonce ^:dynamic *custom-readers* "{<hash-or-byte-id> (fn [data-input])->read}" nil)
(enc/defonce ^:dynamic *custom-readers* "{<hash-or-byte-id> (fn [data-input])}" nil)
(enc/defonce ^:dynamic *auto-freeze-compressor* (enc/defonce ^:dynamic *auto-freeze-compressor*
"(fn [byte-array])->compressor used by `(freeze <x> {:compressor :auto}), "(fn [byte-array])->compressor used by `(freeze <x> {:compressor :auto}),
nil => default" nil => default"
@ -301,12 +320,7 @@
source, you can use `(constantly true)` as predicate. This source, you can use `(constantly true)` as predicate. This
will whitelist everything, allowing Serializable for ANY class. will whitelist everything, allowing Serializable for ANY class.
**** IMPORTANT ********************************************************* Default value as of v2.15.0 is: #{}.
To avoid a breaking change in an <x.y.patch> release, the default value
in Nippy v2.14.1 is `(constantly true)`, which MAY BE UNSAFE!!!
PLEASE REVIEW AND ADJUST THIS SETTING AS NECESSARY FOR YOUR ENVIRONMENT!
************************************************************************
PRs welcome for additional known-safe classes to be added to default PRs welcome for additional known-safe classes to be added to default
whitelist. whitelist.
@ -324,8 +338,7 @@
[1] https://groups.google.com/forum/#!msg/clojure/WaL3hHzsevI/7zHU-L7LBQAJ" [1] https://groups.google.com/forum/#!msg/clojure/WaL3hHzsevI/7zHU-L7LBQAJ"
#_#{#_"java.lang.Throwable"} #{#_"java.lang.Throwable"})
(constantly true))
(defn set-freeze-fallback! [x] (alter-var-root #'*freeze-fallback* (constantly x))) (defn set-freeze-fallback! [x] (alter-var-root #'*freeze-fallback* (constantly x)))
(defn set-auto-freeze-compressor! [x] (alter-var-root #'*auto-freeze-compressor* (constantly x))) (defn set-auto-freeze-compressor! [x] (alter-var-root #'*auto-freeze-compressor* (constantly x)))
@ -342,8 +355,6 @@
See also `*serializable-whitelist*." See also `*serializable-whitelist*."
[f] (alter-var-root #'*serializable-whitelist* f)) [f] (alter-var-root #'*serializable-whitelist* f))
(declare ^:dynamic *final-freeze-fallback*) ; DEPRECATED
;;;; Freezing ;;;; Freezing
#_(do #_(do
@ -733,6 +744,12 @@
(-run! (fn [in] (-freeze-with-meta! in out)) s))))) (-run! (fn [in] (-freeze-with-meta! in out)) s)))))
(defn- write-objects [^DataOutput out ^objects ary]
(let [len (alength ary)]
(write-id out id-objects-lg)
(write-lg-count out len)
(-run! (fn [in] (-freeze-with-meta! in out)) ary)))
(defn- write-serializable [^DataOutput out x ^String class-name] (defn- write-serializable [^DataOutput out x ^String class-name]
(when-debug (println (str "write-serializable: " (type x)))) (when-debug (println (str "write-serializable: " (type x))))
(let [class-name-ba (.getBytes class-name charset) (let [class-name-ba (.getBytes class-name charset)
@ -951,12 +968,17 @@
(write-biginteger out (.denominator x))) (write-biginteger out (.denominator x)))
(id-freezer Date id-date (.writeLong out (.getTime x))) (id-freezer Date id-date (.writeLong out (.getTime x)))
(id-freezer URI id-uri
(write-str out (.toString x)))
(id-freezer UUID id-uuid (id-freezer UUID id-uuid
(.writeLong out (.getMostSignificantBits x)) (.writeLong out (.getMostSignificantBits x))
(.writeLong out (.getLeastSignificantBits x))) (.writeLong out (.getLeastSignificantBits x)))
(freezer Boolean (if x (write-id out id-true) (write-id out id-false))) (freezer Boolean (if x (write-id out id-true) (write-id out id-false)))
(freezer (Class/forName "[B") (write-bytes out x)) (freezer (Class/forName "[B") (write-bytes out x))
(freezer (Class/forName "[Ljava.lang.Object;") (write-objects out x))
(freezer String (write-str out x)) (freezer String (write-str out x))
(freezer Keyword (write-kw out x)) (freezer Keyword (write-kw out x))
(freezer Symbol (write-sym out x)) (freezer Symbol (write-sym out x))
@ -993,6 +1015,20 @@
(-freeze-without-meta! (into {} x) out))) (-freeze-without-meta! (into {} x) out)))
(freezer IType
(let [aclass (class x)
cname (.getName aclass)]
(write-id out id-type)
(write-str out cname)
(let [basis-method (.getMethod aclass "getBasis" nil)
basis (.invoke basis-method nil nil)]
(-run!
(fn [b]
(let [^Field cfield (.getField aclass (name b))]
(let [fvalue (.get cfield x)]
(-freeze-without-meta! fvalue out))))
basis))))
(freezer Object (freezer Object
(when-debug (println (str "freeze-fallback: " (type x)))) (when-debug (println (str "freeze-fallback: " (type x))))
(if-let [ff *freeze-fallback*] (if-let [ff *freeze-fallback*]
@ -1008,10 +1044,7 @@
(try-write-serializable out x) (try-write-serializable out x)
(try-write-readable out x) (try-write-readable out x)
;; For back compatibility (nb Timbre's Carmine appender) (when-let [fff *final-freeze-fallback*] (fff out x) true) ; Deprecated
(when-let [fff *final-freeze-fallback*]
(fff out x)
true)
(throw-unfreezable x)))) (throw-unfreezable x))))
@ -1047,65 +1080,98 @@
(with-cache (-freeze-with-meta! x dos)) (with-cache (-freeze-with-meta! x dos))
(.toByteArray baos))) (.toByteArray baos)))
(defn- call-with-bindings
"Allow opts to override config bindings. Undocumented."
[opts f]
(let [opt->bindings
(fn [bindings id var]
(if-let [o (find opts id)]
(assoc bindings var (val o))
(do bindings)))
bindings
(-> nil
(opt->bindings :freeze-fallback #'*freeze-fallback*)
(opt->bindings :auto-freeze-compressor #'*auto-freeze-compressor*)
(opt->bindings :serializable-whitelist #'*serializable-whitelist*)
(opt->bindings :custom-readers #'*custom-readers*))]
(if-not bindings
(f) ; Common case
(try
(push-thread-bindings bindings)
(f)
(finally
(pop-thread-bindings))))))
(comment
(enc/qb 1e4
(call-with-bindings {} (fn [] *freeze-fallback*))
(call-with-bindings {:freeze-fallback "foo"} (fn [] *freeze-fallback*))))
(defn freeze (defn freeze
"Serializes arg (any Clojure data type) to a byte array. To freeze custom "Serializes arg (any Clojure data type) to a byte array. To freeze custom
types, extend the Clojure reader or see `extend-freeze`." types, extend the Clojure reader or see `extend-freeze`."
([x] (freeze x nil)) ([x] (freeze x nil))
([x {:keys [compressor encryptor password] ([x {:as opts
:keys [compressor encryptor password]
:or {compressor :auto :or {compressor :auto
encryptor aes128-encryptor} encryptor aes128-gcm-encryptor}}]
:as opts}]
(let [;; Intentionally undocumented:
no-header? (or (get opts :no-header?)
(get opts :skip-header?))
encryptor (when password encryptor)
baos (ByteArrayOutputStream. 64)
dos (DataOutputStream. baos)]
(if (and (nil? compressor) (nil? encryptor)) (call-with-bindings opts
(do ; Optimized case (fn []
(when-not no-header? ; Avoid `wrap-header`'s array copy:
(let [head-ba (get-head-ba {:compressor-id nil :encryptor-id nil})]
(.write dos head-ba 0 4)))
(with-cache (-freeze-with-meta! x dos))
(.toByteArray baos))
(do (let [;; Intentionally undocumented:
(with-cache (-freeze-with-meta! x dos)) no-header? (or (get opts :no-header?)
(let [ba (.toByteArray baos) (get opts :skip-header?))
encryptor (when password encryptor)
baos (ByteArrayOutputStream. 64)
dos (DataOutputStream. baos)]
compressor (if (and (nil? compressor) (nil? encryptor))
(if (identical? compressor :auto) (do ; Optimized case
(if no-header? (when-not no-header? ; Avoid `wrap-header`'s array copy:
lz4-compressor (let [head-ba (get-head-ba {:compressor-id nil :encryptor-id nil})]
(if-let [fc *auto-freeze-compressor*] (.write dos head-ba 0 4)))
(fc ba) (with-cache (-freeze-with-meta! x dos))
;; Intelligently enable compression only if benefit (.toByteArray baos))
;; is likely to outweigh cost:
(when (> (alength ba) 8192) lz4-compressor)))
(if (fn? compressor) (do
(compressor ba) ; Assume compressor selector fn (with-cache (-freeze-with-meta! x dos))
compressor ; Assume compressor (let [ba (.toByteArray baos)
))
ba (if compressor (compress compressor ba) ba) compressor
ba (if encryptor (encrypt encryptor password ba) ba)] (if (identical? compressor :auto)
(if no-header?
lz4-compressor
(if-let [fc *auto-freeze-compressor*]
(fc ba)
;; Intelligently enable compression only if benefit
;; is likely to outweigh cost:
(when (> (alength ba) 8192) lz4-compressor)))
(if no-header? (if (fn? compressor)
ba (compressor ba) ; Assume compressor selector fn
(wrap-header ba compressor ; Assume compressor
{:compressor-id ))
(when-let [c compressor]
(or (compression/standard-header-ids
(compression/header-id c))
:else))
:encryptor-id ba (if compressor (compress compressor ba) ba)
(when-let [e encryptor] ba (if encryptor (encrypt encryptor password ba) ba)]
(or (encryption/standard-header-ids
(encryption/header-id e)) (if no-header?
:else))})))))))) ba
(wrap-header ba
{:compressor-id
(when-let [c compressor]
(or (compression/standard-header-ids
(compression/header-id c))
:else))
:encryptor-id
(when-let [e encryptor]
(or (encryption/standard-header-ids
(encryption/header-id e))
:else))}))))))))))
;;;; Thawing ;;;; Thawing
@ -1143,6 +1209,13 @@
(enc/reduce-n (fn [acc _] (conj acc (thaw-from-in! in))) to n))) (enc/reduce-n (fn [acc _] (conj acc (thaw-from-in! in))) to n)))
(defn- read-objects [^objects ary ^DataInput in]
(enc/reduce-n
(fn [^objects ary i]
(aset ary i (thaw-from-in! in))
ary)
ary (alength ary)))
(defn- read-kvs-into [to ^DataInput in ^long n] (defn- read-kvs-into [to ^DataInput in ^long n]
(if (and (editable? to) (> n 10)) (if (and (editable? to) (> n 10))
(persistent! (persistent!
@ -1226,6 +1299,30 @@
:throwable e :throwable e
:nippy/unthawable {:class-name class-name :content content}})))) :nippy/unthawable {:class-name class-name :content content}}))))
(defn- read-type [in class-name]
(try
(let [aclass (clojure.lang.RT/classForName class-name)
nbasis
(let [basis-method (.getMethod aclass "getBasis" nil)
basis (.invoke basis-method nil nil)]
(count basis))
cvalues (object-array nbasis)]
(enc/reduce-n
(fn [_ i] (aset cvalues i (thaw-from-in! in)))
nil nbasis)
(let [ctors (.getConstructors aclass)
^Constructor ctor (aget ctors 0) ; Impl. detail? Ref. https://goo.gl/XWmckR
]
(.newInstance ctor cvalues)))
(catch Exception e
{:type :type
:throwable e
:nippy/unthawable {:class-name class-name}})))
(defn thaw-from-in! (defn thaw-from-in!
"Deserializes a frozen object from given DataInput to its original Clojure "Deserializes a frozen object from given DataInput to its original Clojure
data type. data type.
@ -1248,6 +1345,8 @@
id-record-md (read-record in (read-utf8 in (read-md-count in))) id-record-md (read-record in (read-utf8 in (read-md-count in)))
id-record-lg (read-record in (read-utf8 in (read-lg-count in))) id-record-lg (read-record in (read-utf8 in (read-lg-count in)))
id-type (read-type in (thaw-from-in! in))
id-nil nil id-nil nil
id-true true id-true true
id-false false id-false false
@ -1271,6 +1370,8 @@
id-bytes-md (read-bytes in (read-md-count in)) id-bytes-md (read-bytes in (read-md-count in))
id-bytes-lg (read-bytes in (read-lg-count in)) id-bytes-lg (read-bytes in (read-lg-count in))
id-objects-lg (read-objects (object-array (read-lg-count in)) in)
id-str-0 "" id-str-0 ""
id-str-sm (read-utf8 in (read-sm-count in)) id-str-sm (read-utf8 in (read-sm-count in))
id-str-md (read-utf8 in (read-md-count in)) id-str-md (read-utf8 in (read-md-count in))
@ -1334,6 +1435,7 @@
(read-biginteger in)) (read-biginteger in))
id-date (Date. (.readLong in)) id-date (Date. (.readLong in))
id-uri (URI. (thaw-from-in! in))
id-uuid (UUID. (.readLong in) (.readLong in)) id-uuid (UUID. (.readLong in) (.readLong in))
;; Deprecated ------------------------------------------------------ ;; Deprecated ------------------------------------------------------
@ -1383,18 +1485,19 @@
:lzma2 lzma2-compressor :lzma2 lzma2-compressor
:lz4 lz4-compressor :lz4 lz4-compressor
:no-header (throw (ex-info ":auto not supported on headerless data." {})) :no-header (throw (ex-info ":auto not supported on headerless data." {}))
:else (throw (ex-info ":auto not supported for non-standard compressors." {})) :else (throw (ex-info ":auto not supported for non-standard compressors." {}))
(throw (ex-info (str "Unrecognized :auto compressor id: " compressor-id) (do (throw (ex-info (str "Unrecognized :auto compressor id: " compressor-id)
{:compressor-id compressor-id})))) {:compressor-id compressor-id})))))
(defn- get-auto-encryptor [encryptor-id] (defn- get-auto-encryptor [encryptor-id]
(case encryptor-id (case encryptor-id
nil nil nil nil
:aes128-sha512 aes128-encryptor :aes128-gcm-sha512 aes128-gcm-encryptor
:no-header (throw (ex-info ":auto not supported on headerless data." {})) :aes128-cbc-sha512 aes128-cbc-encryptor
:else (throw (ex-info ":auto not supported for non-standard encryptors." {})) :no-header (throw (ex-info ":auto not supported on headerless data." {}))
(throw (ex-info (str "Unrecognized :auto encryptor id: " encryptor-id) :else (throw (ex-info ":auto not supported for non-standard encryptors." {}))
{:encryptor-id encryptor-id})))) (do (throw (ex-info (str "Unrecognized :auto encryptor id: " encryptor-id)
{:encryptor-id encryptor-id})))))
(def ^:private err-msg-unknown-thaw-failure (def ^:private err-msg-unknown-thaw-failure
"Decryption/decompression failure, or data unfrozen/damaged.") "Decryption/decompression failure, or data unfrozen/damaged.")
@ -1428,80 +1531,83 @@
([ba] (thaw ba nil)) ([ba] (thaw ba nil))
([^bytes ba ([^bytes ba
{:keys [v1-compatibility? compressor encryptor password] {:as opts
:keys [v1-compatibility? compressor encryptor password]
:or {compressor :auto :or {compressor :auto
encryptor :auto} encryptor :auto}}]
:as opts}]
(assert (not (get opts :headerless-meta)) (assert (not (get opts :headerless-meta))
":headerless-meta `thaw` opt removed in Nippy v2.7+") ":headerless-meta `thaw` opt removed in Nippy v2.7+")
(let [v2+? (not v1-compatibility?) (call-with-bindings opts
no-header? (get opts :no-header?) ; Intentionally undocumented (fn []
ex (fn ex
([ msg] (ex nil msg))
([e msg] (throw (ex-info (str "Thaw failed: " msg)
{:opts (assoc opts
:compressor compressor
:encryptor encryptor)}
e))))
thaw-data (let [v2+? (not v1-compatibility?)
(fn [data-ba compressor-id encryptor-id ex-fn] no-header? (get opts :no-header?) ; Intentionally undocumented
(let [compressor (if (identical? compressor :auto) ex (fn ex
(get-auto-compressor compressor-id) ([ msg] (ex nil msg))
compressor) ([e msg] (throw (ex-info (str "Thaw failed: " msg)
encryptor (if (identical? encryptor :auto) {:opts (assoc opts
(get-auto-encryptor encryptor-id) :compressor compressor
encryptor)] :encryptor encryptor)}
e))))
(when (and encryptor (not password)) thaw-data
(ex "Password required for decryption.")) (fn [data-ba compressor-id encryptor-id ex-fn]
(let [compressor (if (identical? compressor :auto)
(get-auto-compressor compressor-id)
compressor)
encryptor (if (identical? encryptor :auto)
(get-auto-encryptor encryptor-id)
encryptor)]
(try (when (and encryptor (not password))
(let [ba data-ba (ex "Password required for decryption."))
ba (if encryptor (decrypt encryptor password ba) ba)
ba (if compressor (decompress compressor ba) ba)
dis (DataInputStream. (ByteArrayInputStream. ba))]
(with-cache (thaw-from-in! dis))) (try
(let [ba data-ba
ba (if encryptor (decrypt encryptor password ba) ba)
ba (if compressor (decompress compressor ba) ba)
dis (DataInputStream. (ByteArrayInputStream. ba))]
(catch Exception e (ex-fn e))))) (with-cache (thaw-from-in! dis)))
;; Hackish + can actually segfault JVM due to Snappy bug, (catch Exception e (ex-fn e)))))
;; Ref. http://goo.gl/mh7Rpy - no better alternatives, unfortunately
thaw-v1-data
(fn [data-ba ex-fn]
(thaw-data data-ba :snappy nil
(fn [_] (thaw-data data-ba nil nil (fn [_] (ex-fn nil))))))]
(if no-header? ;; Hackish + can actually segfault JVM due to Snappy bug,
(if v2+? ;; Ref. http://goo.gl/mh7Rpy - no better alternatives, unfortunately
(thaw-data ba :no-header :no-header (fn [e] (ex e err-msg-unknown-thaw-failure))) thaw-v1-data
(thaw-data ba :no-header :no-header (fn [data-ba ex-fn]
(fn [e] (thaw-v1-data ba (fn [_] (ex e err-msg-unknown-thaw-failure)))))) (thaw-data data-ba :snappy nil
(fn [_] (thaw-data data-ba nil nil (fn [_] (ex-fn nil))))))]
;; At this point we assume that we have a header iff we have v2+ data (if no-header?
(if-let [[data-ba {:keys [compressor-id encryptor-id unrecognized-meta?] (if v2+?
:as head-meta}] (try-parse-header ba)] (thaw-data ba :no-header :no-header (fn [e] (ex e err-msg-unknown-thaw-failure)))
(thaw-data ba :no-header :no-header
(fn [e] (thaw-v1-data ba (fn [_] (ex e err-msg-unknown-thaw-failure))))))
;; A well-formed header _appears_ to be present (it's possible though ;; At this point we assume that we have a header iff we have v2+ data
;; unlikely that this is a fluke and data is actually headerless): (if-let [[data-ba {:keys [compressor-id encryptor-id unrecognized-meta?]
(if v2+? :as head-meta}] (try-parse-header ba)]
(if unrecognized-meta?
(ex err-msg-unrecognized-header)
(thaw-data data-ba compressor-id encryptor-id
(fn [e] (ex e err-msg-unknown-thaw-failure))))
(if unrecognized-meta? ;; A well-formed header _appears_ to be present (it's possible though
(thaw-v1-data ba (fn [_] (ex err-msg-unrecognized-header))) ;; unlikely that this is a fluke and data is actually headerless):
(thaw-data data-ba compressor-id encryptor-id (if v2+?
(fn [e] (thaw-v1-data ba (fn [_] (ex e err-msg-unknown-thaw-failure))))))) (if unrecognized-meta?
(ex err-msg-unrecognized-header)
(thaw-data data-ba compressor-id encryptor-id
(fn [e] (ex e err-msg-unknown-thaw-failure))))
;; Well-formed header definitely not present (if unrecognized-meta?
(if v2+? (thaw-v1-data ba (fn [_] (ex err-msg-unrecognized-header)))
(ex err-msg-unknown-thaw-failure) (thaw-data data-ba compressor-id encryptor-id
(thaw-v1-data ba (fn [_] (ex err-msg-unknown-thaw-failure))))))))) (fn [e] (thaw-v1-data ba (fn [_] (ex e err-msg-unknown-thaw-failure)))))))
;; Well-formed header definitely not present
(if v2+?
(ex err-msg-unknown-thaw-failure)
(thaw-v1-data ba (fn [_] (ex err-msg-unknown-thaw-failure)))))))))))
(comment (comment
(thaw (freeze "hello")) (thaw (freeze "hello"))
@ -1593,6 +1699,9 @@
;;;; Stress data ;;;; Stress data
(defrecord StressRecord [data]) (defrecord StressRecord [data])
(deftype StressType [data]
Object
(equals [a b] (= (.-data a) (.-data ^StressType b))))
(def stress-data "Reference data used for tests & benchmarks" (def stress-data "Reference data used for tests & benchmarks"
{:bytes (byte-array [(byte 1) (byte 2) (byte 3)]) {:bytes (byte-array [(byte 1) (byte 2) (byte 3)])
:nil nil :nil nil
@ -1647,10 +1756,13 @@
:bigdec (bigdec 3.1415926535897932384626433832795) :bigdec (bigdec 3.1415926535897932384626433832795)
:ratio 22/7 :ratio 22/7
:uri (URI. "https://clojure.org/reference/data_structures")
:uuid (java.util.UUID/randomUUID) :uuid (java.util.UUID/randomUUID)
:date (java.util.Date.) :date (java.util.Date.)
:objects (object-array [1 "two" {:data "data"}])
:stress-record (StressRecord. "data") :stress-record (StressRecord. "data")
:stress-type (StressType. "data")
;; Serializable ;; Serializable
:throwable (Throwable. "Yolo") :throwable (Throwable. "Yolo")
@ -1659,14 +1771,14 @@
(def stress-data-comparable (def stress-data-comparable
"Reference data with stuff removed that breaks roundtrip equality" "Reference data with stuff removed that breaks roundtrip equality"
(dissoc stress-data :bytes :throwable :exception :ex-info :regex)) (dissoc stress-data :bytes :throwable :exception :ex-info :regex :objects))
(def stress-data-benchable (def stress-data-benchable
"Reference data with stuff removed that breaks reader or other utils we'll "Reference data with stuff removed that breaks reader or other utils we'll
be benching against" be benching against"
(dissoc stress-data (dissoc stress-data
:bytes :throwable :exception :ex-info :queue :queue-empty :bytes :throwable :exception :ex-info :queue :queue-empty
:byte :stress-record :regex)) :byte :stress-record :stress-type :regex :objects))
;;;; Tools ;;;; Tools
@ -1698,12 +1810,29 @@
(inspect-ba (freeze "hello")) (inspect-ba (freeze "hello"))
(seq (:data-ba (inspect-ba (freeze "hello"))))) (seq (:data-ba (inspect-ba (freeze "hello")))))
(defn freeze-to-string
"Convenience util: like `freeze`, but returns a Base64-encoded string.
See also `thaw-from-string`."
([x ] (freeze-to-string x nil))
([x freeze-opts]
(let [ba (freeze x freeze-opts)]
(.encodeToString (java.util.Base64/getEncoder)
ba))))
(defn thaw-from-string
"Convenience util: like `thaw`, but takes a Base64-encoded string.
See also `freeze-to-string`."
([s ] (thaw-from-string s nil))
([^String s thaw-opts]
(let [ba (.decode (java.util.Base64/getDecoder) s)]
(thaw ba thaw-opts))))
(comment (thaw-from-string (freeze-to-string {:a :A :b [:B1 :B2]})))
(defn freeze-to-file (defn freeze-to-file
"Convenience util: writes `(freeze x freeze-opts)` byte array to "Convenience util: like `freeze`, but writes to `(clojure.java.io/file <file>)`
`(clojure.java.io/file file)` and returns the byte array. and returns the byte array written.
See also `thaw-from-file`."
(freeze-to-file \"my-filename.npy\" my-val) => Serialized byte array"
([file x ] (freeze-to-file file x nil)) ([file x ] (freeze-to-file file x nil))
([file x freeze-opts] ([file x freeze-opts]
(let [^bytes ba (freeze x freeze-opts)] (let [^bytes ba (freeze x freeze-opts)]
@ -1712,14 +1841,12 @@
ba))) ba)))
(defn thaw-from-file (defn thaw-from-file
"Convenience util: returns `(thaw ba thaw-opts)` Clojure value for the "Convenience util: like `thaw`, but reads from `(clojure.java.io/file <file>)`.
byte array read from `(clojure.java.io/file file)`.
(thaw-from-file \"my-filename.npy\") => Deserialized Clojure value
To thaw from a resource on classpath (e.g in Leiningen `resources` dir): To thaw from a resource on classpath (e.g in Leiningen `resources` dir):
(thaw-from-file (clojure.java.io/resource \"my-resource-name.npy\"))" (thaw-from-file (clojure.java.io/resource \"my-resource-name.npy\"))
See also `freeze-to-file`."
([file ] (thaw-from-file file nil)) ([file ] (thaw-from-file file nil))
([file thaw-opts] ([file thaw-opts]
(let [file (jio/file file), (let [file (jio/file file),
@ -1736,6 +1863,4 @@
;;;; Deprecated ;;;; Deprecated
(enc/deprecated (enc/deprecated (def freeze-fallback-as-str "DEPRECATED" write-unfreezable))
(enc/defonce ^:dynamic *final-freeze-fallback* "DEPRECATED" nil)
(def freeze-fallback-as-str "DEPRECATED" write-unfreezable))

153
src/taoensso/nippy/crypto.clj Normal file
View file

@ -0,0 +1,153 @@
(ns taoensso.nippy.crypto
"Low-level crypto utils.
Private & alpha, very likely to change!"
(:refer-clojure :exclude [rand-nth])
(:require [taoensso.encore :as enc]))
;; Note that AES128 may be preferable to AES256 due to known attack
;; vectors specific to AES256, Ref. https://goo.gl/qU4CCV
;; or for a counter argument, Ref. https://goo.gl/9LA9Yb
;;;; Randomness
(do
(defn rand-nth [coll] (nth coll (int (* (.nextDouble (enc/srng)) (count coll)))))
(defn rand-bytes ^bytes [size] (let [ba (byte-array size)] (.nextBytes (enc/srng) ba) ba))
(defn rand-double ^double [] (.nextDouble (enc/srng)))
(defn rand-gauss ^double [] (.nextGaussian (enc/srng)))
(defn rand-bool [] (.nextBoolean (enc/srng)))
(defn rand-long
(^long [ ] (.nextLong (enc/srng)))
(^long [n] (long (* (long n) (.nextDouble (enc/srng)))))))
(comment
(seq (rand-bytes 16))
(rand-nth [:a :b :c :d])
(rand-long 100))
;;;; Hashing
(def ^:private sha256-md* (enc/thread-local-proxy (java.security.MessageDigest/getInstance "SHA-256")))
(def ^:private sha512-md* (enc/thread-local-proxy (java.security.MessageDigest/getInstance "SHA-512")))
(defn sha256-md ^java.security.MessageDigest [] (.get ^ThreadLocal sha256-md*))
(defn sha512-md ^java.security.MessageDigest [] (.get ^ThreadLocal sha512-md*))
(defn sha256-ba ^bytes [ba] (.digest (sha256-md) ba))
(defn sha512-ba ^bytes [ba] (.digest (sha512-md) ba))
(enc/compile-if clojure.lang.Murmur3
(defn murmur3 [^String s] (clojure.lang.Murmur3/hashUnencodedChars s))
nil)
;;;; Key derivation (salt+password -> key / hash)
;; (fn [salt-ba utf8]) -> bytes
;; (defn ba->hex [^bytes ba] (org.apache.commons.codec.binary.Hex/encodeHexString ba))
(defn take-ba ^bytes [n ^bytes ba] (java.util.Arrays/copyOf ba ^int n)) ; Pads if ba too small
(defn utf8->ba ^bytes [^String s] (.getBytes s "UTF-8"))
(defn- add-salt ^bytes [?salt-ba ba] (if ?salt-ba (enc/ba-concat ?salt-ba ba) ba))
(defn pwd-as-ba ^bytes [utf8-or-ba] (if (string? utf8-or-ba) (utf8->ba utf8-or-ba) (enc/have enc/bytes? utf8-or-ba)))
(comment (seq (pwd-as-ba "foo")))
(defn sha512-key-ba
"SHA512-based key generator. Good JVM availability without extra dependencies
(PBKDF2, bcrypt, scrypt, etc.). Decent security when using many rounds."
(^bytes [?salt-ba utf8-or-ba ] (sha512-key-ba ?salt-ba utf8-or-ba 163835 #_(* Short/MAX_VALUE 5)))
(^bytes [?salt-ba utf8-or-ba ^long n-rounds]
(let [ba (add-salt ?salt-ba (pwd-as-ba utf8-or-ba))
md (sha512-md)]
(enc/reduce-n (fn [acc in] (.digest md acc)) ba n-rounds))))
(comment
(count (seq (sha512-key-ba (utf8->ba "salt") "password" 1)))
(count (seq (sha512-key-ba nil "password" 1))))
;;;; Crypto
(defprotocol ICipherKit
(get-cipher ^javax.crypto.Cipher [_] "Returns a thread-safe `javax.crypto.Cipher` instance.")
(get-iv-size [_] "Returns necessary iv-ba length.")
(get-key-spec ^javax.crypto.spec.SecretKeySpec [_ ba] "Returns a `javax.crypto.spec.SecretKeySpec`.")
(get-param-spec ^java.security.spec.AlgorithmParameterSpec [_ iv-ba] "Returns a `java.security.spec.AlgorithmParameters`."))
;; Prefer GCM > CBC, Ref. https://goo.gl/jpZoj8
(def ^:private gcm-cipher* (enc/thread-local-proxy (javax.crypto.Cipher/getInstance "AES/GCM/NoPadding")))
(def ^:private cbc-cipher* (enc/thread-local-proxy (javax.crypto.Cipher/getInstance "AES/CBC/PKCS5Padding")))
(defn gcm-cipher ^javax.crypto.Cipher [] (.get ^ThreadLocal gcm-cipher*))
(defn cbc-cipher ^javax.crypto.Cipher [] (.get ^ThreadLocal cbc-cipher*))
;
(deftype CipherKit-AES-GCM []
ICipherKit
(get-cipher [_] (gcm-cipher))
(get-iv-size [_] 12)
(get-key-spec [_ ba] (javax.crypto.spec.SecretKeySpec. ba "AES"))
(get-param-spec [_ iv-ba] (javax.crypto.spec.GCMParameterSpec. 128 iv-ba)))
(deftype CipherKit-AES-CBC []
ICipherKit
(get-cipher [_] (cbc-cipher))
(get-iv-size [_] 16)
(get-key-spec [_ ba] (javax.crypto.spec.SecretKeySpec. ba "AES"))
(get-param-spec [_ iv-ba] (javax.crypto.spec.IvParameterSpec. iv-ba)))
(def cipher-kit-aes-gcm "Default CipherKit for AES GCM" (CipherKit-AES-GCM.))
(def cipher-kit-aes-cbc "Default CipherKit for AES CBC" (CipherKit-AES-CBC.))
;; Output bytes: [ <iv> <?salt> <encrypted>]
;; Could also do: [<iv-len> <iv> <salt-len> <?salt> <encrypted>]
(defn encrypt
[{:keys [cipher-kit ?salt-ba key-ba plain-ba rand-bytes-fn]
:or {cipher-kit cipher-kit-aes-gcm
rand-bytes-fn rand-bytes}}]
(let [iv-size (long (get-iv-size cipher-kit))
iv-ba (rand-bytes-fn iv-size)
prefix-ba (if ?salt-ba (enc/ba-concat iv-ba ?salt-ba) iv-ba)
key-spec (get-key-spec cipher-kit key-ba)
param-spec (get-param-spec cipher-kit iv-ba)
cipher (get-cipher cipher-kit)]
(.init cipher javax.crypto.Cipher/ENCRYPT_MODE key-spec param-spec)
(enc/ba-concat prefix-ba (.doFinal cipher plain-ba))))
(comment (encrypt {:?salt-ba nil :key-ba (take-ba 16 (sha512-key-ba nil "pwd")) :plain-ba (utf8->ba "data")}))
(defn decrypt
[{:keys [cipher-kit salt-size salt->key-fn enc-ba]
:or {cipher-kit cipher-kit-aes-gcm}}]
(let [salt-size (long salt-size)
iv-size (long (get-iv-size cipher-kit))
prefix-size (+ iv-size salt-size)
[prefix-ba enc-ba] (enc/ba-split enc-ba prefix-size)
[iv-ba salt-ba] (if (pos? salt-size)
(enc/ba-split prefix-ba iv-size)
[prefix-ba nil])
key-ba (salt->key-fn salt-ba)
key-spec (get-key-spec cipher-kit key-ba)
param-spec (get-param-spec cipher-kit iv-ba)
cipher (get-cipher cipher-kit)]
(.init cipher javax.crypto.Cipher/DECRYPT_MODE key-spec param-spec)
(.doFinal cipher enc-ba)))
(comment
(do
(defn sha512-k16 [?salt-ba pwd] (take-ba 16 (sha512-key-ba ?salt-ba pwd)))
(defn roundtrip [kit ?salt-ba key-ba key-fn]
(let [salt-size (count ?salt-ba)
encr (encrypt {:cipher-kit kit :?salt-ba ?salt-ba :key-ba key-ba :plain-ba (utf8->ba "data")})
decr (decrypt {:cipher-kit kit :salt-size salt-size :salt->key-fn key-fn :enc-ba encr})]
(String. ^bytes decr "UTF-8")))
[(let [s (rand-bytes 16)] (roundtrip cipher-kit-aes-gcm s (sha512-k16 s "pwd") #(sha512-k16 % "pwd")))
(let [s nil] (roundtrip cipher-kit-aes-gcm s (sha512-k16 s "pwd") #(sha512-k16 % "pwd")))
(let [s (rand-bytes 16)] (roundtrip cipher-kit-aes-cbc s (sha512-k16 s "pwd") #(sha512-k16 % "pwd")))
(let [s nil] (roundtrip cipher-kit-aes-cbc s (sha512-k16 s "pwd") #(sha512-k16 % "pwd")))])
(enc/qb 10
(let [s (rand-bytes 16)]
(roundtrip cipher-kit-aes-gcm s (sha512-k16 s "pwd") #(sha512-k16 % "pwd"))))
;; 2394.89
)

127
src/taoensso/nippy/encryption.clj
View file

@ -1,63 +1,24 @@
(ns taoensso.nippy.encryption (ns taoensso.nippy.encryption
"Simple no-nonsense crypto with reasonable defaults" "Simple no-nonsense crypto with reasonable defaults"
(:require [taoensso.encore :as enc])) (:require
[taoensso.encore :as enc]
[taoensso.nippy.crypto :as crypto]))
;;;; Interface (def standard-header-ids
"These'll support :auto thaw"
(def standard-header-ids "These'll support :auto thaw" #{:aes128-sha512}) #{:aes128-cbc-sha512
:aes128-gcm-sha512})
(defprotocol IEncryptor (defprotocol IEncryptor
(header-id [encryptor]) (header-id [encryptor])
(encrypt ^bytes [encryptor pwd ba]) (encrypt ^bytes [encryptor pwd ba])
(decrypt ^bytes [encryptor pwd ba])) (decrypt ^bytes [encryptor pwd ba]))
;;;; Default digests, ciphers, etc.
(def ^:private aes128-cipher* (enc/thread-local-proxy (javax.crypto.Cipher/getInstance "AES/CBC/PKCS5Padding")))
(def ^:private sha512-md* (enc/thread-local-proxy (java.security.MessageDigest/getInstance "SHA-512")))
(def ^:private prng* (enc/thread-local-proxy (java.security.SecureRandom/getInstance "SHA1PRNG")))
(defn- aes128-cipher ^javax.crypto.Cipher [] (.get ^ThreadLocal aes128-cipher*))
(defn- sha512-md ^java.security.MessageDigest [] (.get ^ThreadLocal sha512-md*))
(defn- prng ^java.security.SecureRandom [] (.get ^ThreadLocal prng*))
(def ^:private ^:const aes128-block-size (.getBlockSize (aes128-cipher)))
(def ^:private ^:const salt-size aes128-block-size)
(defn- rand-bytes [size] (let [ba (byte-array size)] (.nextBytes (prng) ba) ba))
;;;; Default key-gen
(defn- sha512-key
"SHA512-based key generator. Good JVM availability without extra dependencies
(PBKDF2, bcrypt, scrypt, etc.). Decent security when using many rounds."
([salt-ba pwd ] (sha512-key salt-ba pwd (* Short/MAX_VALUE (if salt-ba 5 64))))
([salt-ba pwd ^long n]
(let [md (sha512-md)
init-ba (let [pwd-ba (.getBytes ^String pwd "UTF-8")]
(if salt-ba (enc/ba-concat salt-ba pwd-ba) pwd-ba))
^bytes ba (enc/reduce-n (fn [acc in] (.digest md acc)) init-ba n)]
(-> ba
(java.util.Arrays/copyOf aes128-block-size)
(javax.crypto.spec.SecretKeySpec. "AES")))))
(comment
(enc/qb 10
(sha512-key nil "hi" (* Short/MAX_VALUE 1)) ; ~40ms per hash (fast)
(sha512-key nil "hi" (* Short/MAX_VALUE 5)) ; ~180ms (default)
(sha512-key nil "hi" (* Short/MAX_VALUE 32)) ; ~1200ms (conservative)
(sha512-key nil "hi" (* Short/MAX_VALUE 128)) ; ~4500ms (paranoid)
))
;;;; Default implementations
(defn- throw-destructure-ex [typed-password] (defn- throw-destructure-ex [typed-password]
(throw (ex-info (throw (ex-info
(str "Expected password form: " (str "Expected password form: "
"[<#{:salted :cached}> <password-string>].\n " "[<#{:salted :cached}> <password-string>].\n "
"See `default-aes128-encryptor` docstring for details!") "See `aes128-encryptor` docstring for details!")
{:typed-password typed-password}))) {:typed-password typed-password})))
(defn- destructure-typed-pwd [typed-password] (defn- destructure-typed-pwd [typed-password]
@ -70,46 +31,41 @@
(comment (destructure-typed-pwd [:salted "foo"])) (comment (destructure-typed-pwd [:salted "foo"]))
(deftype AES128Encryptor [header-id keyfn cached-keyfn] (deftype AES128Encryptor [header-id cipher-kit salted-key-fn cached-key-fn]
IEncryptor IEncryptor
(header-id [_] header-id) (header-id [_] header-id)
(encrypt [_ typed-pwd data-ba] (encrypt [_ typed-pwd plain-ba]
(let [[type pwd] (destructure-typed-pwd typed-pwd) (let [[type pwd] (destructure-typed-pwd typed-pwd)
salt? (identical? type :salted) salt? (identical? type :salted)
iv-ba (rand-bytes aes128-block-size) ?salt-ba (when salt? (crypto/rand-bytes 16))
salt-ba (when salt? (rand-bytes salt-size)) key-ba
prefix-ba (if salt? (enc/ba-concat iv-ba salt-ba) iv-ba) (crypto/take-ba 16 ; 128 bit AES
key (if salt? (if-let [salt-ba ?salt-ba]
(keyfn salt-ba pwd) (salted-key-fn salt-ba pwd)
(cached-keyfn salt-ba pwd)) (cached-key-fn nil pwd)))]
iv (javax.crypto.spec.IvParameterSpec. iv-ba)
cipher (aes128-cipher)]
(.init cipher javax.crypto.Cipher/ENCRYPT_MODE (crypto/encrypt
^javax.crypto.spec.SecretKeySpec key iv) {:cipher-kit cipher-kit
(enc/ba-concat prefix-ba (.doFinal cipher data-ba)))) :?salt-ba ?salt-ba
:key-ba key-ba
:plain-ba plain-ba})))
(decrypt [_ typed-pwd ba] (decrypt [_ typed-pwd enc-ba]
(let [[type pwd] (destructure-typed-pwd typed-pwd) (let [[type pwd] (destructure-typed-pwd typed-pwd)
salt? (identical? type :salted) salt? (identical? type :salted)
prefix-size (+ aes128-block-size (if salt? salt-size 0)) salt->key-fn
[prefix-ba data-ba] (enc/ba-split ba prefix-size) (if salt?
[iv-ba salt-ba] (if salt? #(salted-key-fn % pwd)
(enc/ba-split prefix-ba aes128-block-size) #(cached-key-fn % pwd))]
[prefix-ba nil])
key (if salt?
(keyfn salt-ba pwd)
(cached-keyfn salt-ba pwd))
iv (javax.crypto.spec.IvParameterSpec. iv-ba) (crypto/decrypt
cipher (aes128-cipher)] {:cipher-kit cipher-kit
:salt-size (if salt? 16 0)
:salt->key-fn salt->key-fn
:enc-ba enc-ba}))))
(.init cipher javax.crypto.Cipher/DECRYPT_MODE (def aes128-gcm-encryptor
^javax.crypto.spec.SecretKeySpec key iv) "Default 128bit AES-GCM encryptor with many-round SHA-512 key-gen.
(.doFinal cipher data-ba))))
(def aes128-encryptor
"Default 128bit AES encryptor with many-round SHA-512 key-gen.
Password form [:salted \"my-password\"] Password form [:salted \"my-password\"]
--------------------------------------- ---------------------------------------
@ -144,7 +100,18 @@
Faster than `aes128-salted`, and harder to attack any particular key - but Faster than `aes128-salted`, and harder to attack any particular key - but
increased danger if a key is somehow compromised." increased danger if a key is somehow compromised."
(AES128Encryptor. :aes128-sha512 sha512-key (enc/memoize_ sha512-key))) (AES128Encryptor. :aes128-gcm-sha512
crypto/cipher-kit-aes-gcm
(do (fn [ salt-ba pwd] (crypto/take-ba 16 (crypto/sha512-key-ba salt-ba pwd (* Short/MAX_VALUE 5)))))
(enc/memoize_ (fn [_salt-ba pwd] (crypto/take-ba 16 (crypto/sha512-key-ba nil pwd (* Short/MAX_VALUE 64)))))))
(def aes128-cbc-encryptor
"Default 128bit AES-CBC encryptor with many-round SHA-512 key-gen.
See also `aes-128-cbc-encryptor`."
(AES128Encryptor. :aes128-cbc-sha512
crypto/cipher-kit-aes-cbc
(do (fn [ salt-ba pwd] (crypto/take-ba 16 (crypto/sha512-key-ba salt-ba pwd (* Short/MAX_VALUE 5)))))
(enc/memoize_ (fn [_salt-ba pwd] (crypto/take-ba 16 (crypto/sha512-key-ba nil pwd (* Short/MAX_VALUE 64)))))))
;;;; Default implementation ;;;; Default implementation

2
src/taoensso/nippy/tools.clj
View file

@ -3,8 +3,6 @@
Used by Carmine, Faraday, etc." Used by Carmine, Faraday, etc."
(:require [taoensso.nippy :as nippy])) (:require [taoensso.nippy :as nippy]))
;; TODO Switch to thread-local proxies?
(def ^:dynamic *freeze-opts* nil) (def ^:dynamic *freeze-opts* nil)
(def ^:dynamic *thaw-opts* nil) (def ^:dynamic *thaw-opts* nil)

4
src/taoensso/nippy/utils.clj
View file

@ -93,6 +93,9 @@
test for pre/post serialization value equality (there's no good general test for pre/post serialization value equality (there's no good general
way of doing so)." way of doing so)."
;; TODO Not happy with this approach in general, could do with a refactor.
;; Maybe return true/false/nil (nil => maybe)?
([x] (freezable? x nil)) ([x] (freezable? x nil))
([x {:keys [allow-clojure-reader? allow-java-serializable?]}] ([x {:keys [allow-clojure-reader? allow-java-serializable?]}]
(if (is-coll? x) (if (is-coll? x)
@ -102,6 +105,7 @@
(is? x java.lang.String) (is? x java.lang.String)
(is? x java.lang.Long) (is? x java.lang.Long)
(is? x java.lang.Double) (is? x java.lang.Double)
(nil? x)
(is? x clojure.lang.BigInt) (is? x clojure.lang.BigInt)
(is? x clojure.lang.Ratio) (is? x clojure.lang.Ratio)

10
test/taoensso/nippy/tests/main.clj
View file

@ -38,6 +38,9 @@
#(freeze % {:password [:salted "p"]})) #(freeze % {:password [:salted "p"]}))
test-data))) test-data)))
(is (= (vec (:objects nippy/stress-data))
((comp vec thaw freeze) (:objects nippy/stress-data))))
(is (= test-data ((comp #(thaw % {:compressor nippy/lzma2-compressor}) (is (= test-data ((comp #(thaw % {:compressor nippy/lzma2-compressor})
#(freeze % {:compressor nippy/lzma2-compressor})) #(freeze % {:compressor nippy/lzma2-compressor}))
test-data))) test-data)))
@ -74,7 +77,12 @@
(thaw (org.xerial.snappy.Snappy/uncompress xerial-ba)) (thaw (org.xerial.snappy.Snappy/uncompress xerial-ba))
(thaw (org.xerial.snappy.Snappy/uncompress iq80-ba)) (thaw (org.xerial.snappy.Snappy/uncompress iq80-ba))
(thaw (org.iq80.snappy.Snappy/uncompress iq80-ba 0 (alength iq80-ba))) (thaw (org.iq80.snappy.Snappy/uncompress iq80-ba 0 (alength iq80-ba)))
(thaw (org.iq80.snappy.Snappy/uncompress xerial-ba 0 (alength xerial-ba))))))) (thaw (org.iq80.snappy.Snappy/uncompress xerial-ba 0 (alength xerial-ba))))))
(is ; CBC auto-encryptor compatibility
(= "payload"
(thaw (freeze "payload" {:password [:salted "pwd"] :encryptor nippy/aes128-cbc-encryptor})
(do {:password [:salted "pwd"]})))))
;;;; Custom types & records ;;;; Custom types & records