blob: df80d3d04ae65575877b76f93c0bdeed8a883e30 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
|
;;;; -*- mode: lisp; indent-tabs-mode: nil -*-
;;;; os-prng.lisp -- OS-provided pseudo-random number generator
(in-package :crypto)
#+unix
(defparameter *os-prng-stream* nil)
#+unix
(defparameter *os-prng-stream-lock* (bt2:make-lock))
(defclass os-prng ()
())
(defmethod prng-random-data (num-bytes (prng os-prng))
#+unix
(let* ((seq (make-array num-bytes :element-type '(unsigned-byte 8)))
(n (bt2:with-lock-held (*os-prng-stream-lock*)
(unless (and *os-prng-stream* (open-stream-p *os-prng-stream*))
(setf *os-prng-stream* (open #P"/dev/urandom"
#+ccl :sharing #+ccl :external
:element-type '(unsigned-byte 8))))
(read-sequence seq *os-prng-stream*))))
(if (< n num-bytes)
(error 'ironclad-error :format-control "Failed to get random data.")
seq))
#+(and win32 sbcl)
(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 sbcl)
(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))
(setf *prng* (make-prng :os))
#+thread-support
(pushnew '(*prng* . (make-prng :os)) bt2:*default-special-bindings* :test #'equal)
|
