diff --git a/ironclad.asd b/ironclad.asd index defa749..710556e 100644 --- a/ironclad.asd +++ b/ironclad.asd @@ -14,7 +14,7 @@ :description "A cryptographic toolkit written in pure Common Lisp" :license "BSD 3-Clause" :default-component-class ironclad-source-file - :depends-on (#+sbcl "sb-rotate-byte" #+sbcl "sb-posix" "bordeaux-threads") + :depends-on (#+sbcl "sb-rotate-byte" #+sbcl "sb-posix" "bordeaux-threads" "trivial-garbage") :in-order-to ((test-op (test-op "ironclad/tests"))) :components ((:static-file "LICENSE") (:static-file "NEWS") diff --git a/src/prng/os-prng.lisp b/src/prng/os-prng.lisp index 3f82d3a..2adac93 100644 --- a/src/prng/os-prng.lisp +++ b/src/prng/os-prng.lisp @@ -9,32 +9,58 @@ (defmethod prng-random-data (num-bytes (prng os-prng)) #+unix (let ((seq (make-array num-bytes :element-type '(unsigned-byte 8)))) - (unless (slot-boundp prng 'source) - (setf (slot-value prng 'source) - (open #P"/dev/urandom" :element-type '(unsigned-byte 8)))) - (assert (>= (read-sequence seq (slot-value prng 'source)) num-bytes)) + (unless (>= (read-sequence seq (slot-value prng 'source)) num-bytes) + (error 'ironclad-error :format-control "Failed to get random data.")) seq) - #+(and win32 sb-dynamic-core)(sb-win32:crypt-gen-random num-bytes) - #+(and os-windows ccl) (multiple-value-bind (buff buffp) - (ccl:make-heap-ivector num-bytes '(unsigned-byte 8)) - (when (= (ccl:external-call "SystemFunction036" :address buffp :unsigned-long num-bytes :boolean) 0) - (error 'ironclad-error :format-control "RtlGenRandom failed")) - (let ((copy (copy-seq buff))) - (ccl:dispose-heap-ivector buff) - (ccl:dispose-heap-ivector buffp) - copy)) - #+(and os-windows allegro) (let ((buff (make-array num-bytes :element-type '(unsigned-byte 8)))) - (when (= (rtl-gen-random buff num-bytes) 0) - (error 'ironclad-error :format-control "RtlGenRandom failed")) - buff) - #+(and mswindows lispworks)(let ((buff (sys:in-static-area (make-array num-bytes :element-type '(unsigned-byte 8))))) - (unless (fli:with-dynamic-lisp-array-pointer (buff buff) (rtl-gen-random buff num-bytes)) (error 'ironclad-error :format-control "RtlGenRandom failed")) - (copy-seq buff)) - #-(or unix (and win32 sb-dynamic-core) (and os-windows ccl) (and os-windows allegro) (and mswindows lispworks))(error 'ironclad-error :format-control "OS-RANDOM-SEED is not supported on your platform.")) + + #+(and win32 sb-dynamic-core) + (sb-win32:crypt-gen-random num-bytes) + + #+(and os-windows ccl) + (multiple-value-bind (buff buffp) + (ccl:make-heap-ivector num-bytes '(unsigned-byte 8)) + (when (zerop (ccl:external-call "SystemFunction036" + :address buffp + :unsigned-long num-bytes + :boolean)) + (error 'ironclad-error :format-control "RtlGenRandom failed")) + (let ((copy (copy-seq buff))) + (ccl:dispose-heap-ivector buff) + (ccl:dispose-heap-ivector buffp) + copy)) + + #+(and os-windows allegro) + (let ((buff (make-array num-bytes :element-type '(unsigned-byte 8)))) + (when (zerop (rtl-gen-random buff num-bytes)) + (error 'ironclad-error :format-control "RtlGenRandom failed")) + buff) + + #+(and mswindows lispworks) + (let ((buff (sys:in-static-area (make-array num-bytes :element-type '(unsigned-byte 8))))) + (unless (fli:with-dynamic-lisp-array-pointer (buff buff) + (rtl-gen-random buff num-bytes)) + (error 'ironclad-error :format-control "RtlGenRandom failed")) + (copy-seq buff)) + + #-(or unix + (and win32 sb-dynamic-core) + (and os-windows ccl) + (and os-windows allegro) + (and mswindows lispworks)) + (error 'ironclad-error + :format-control "OS-RANDOM-SEED is not supported on your platform.")) (defmethod make-prng ((name (eql :os)) &key seed) (declare (ignorable seed)) - (make-instance 'os-prng)) + (let ((prng (make-instance 'os-prng))) + #+unix + (let ((source (open #P"/dev/urandom" + #+ccl :sharing #+ccl :external + :element-type '(unsigned-byte 8)))) + (setf (slot-value prng 'source) source) + (trivial-garbage:finalize prng (lambda () (close source)))) + prng)) (setf *prng* (make-prng :os)) -#+thread-support(pushnew '(*prng* . (make-prng :os)) bt:*default-special-bindings* :test #'equal) +#+thread-support +(pushnew '(*prng* . (make-prng :os)) bt:*default-special-bindings* :test #'equal)