X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fwin32.lisp;h=9c5cc97922e4123fdca85db10ef08298199ad60f;hb=d5520a24b6c356918c2f91bf91dae60f62e1d065;hp=3bdbf5852db73f4d14fb8e6acf4e1b3cc1f99d4a;hpb=dea1e4258272053e8ccda1bf670d43b429878fe2;p=sbcl.git

diff --git a/src/code/win32.lisp b/src/code/win32.lisp
index 3bdbf58..9c5cc97 100644
--- a/src/code/win32.lisp
+++ b/src/code/win32.lisp
@@ -1184,3 +1184,38 @@ absense."
           (unwind-protect (funcall thunk fd)
             (real-crt-close fd)))
         (values nil errno))))
+
+;;; random seeding
+
+(define-alien-routine ("CryptGenRandom" %crypt-gen-random) lispbool
+  (handle handle)
+  (length dword)
+  (buffer (* t)))
+
+(define-alien-routine (#!-sb-unicode "CryptAcquireContextA"
+                       #!+sb-unicode "CryptAcquireContextW"
+                       %crypt-acquire-context) lispbool
+  (handle handle :out)
+  (container system-string)
+  (provider system-string)
+  (provider-type dword)
+  (flags dword))
+
+(define-alien-routine ("CryptReleaseContext" %crypt-release-context) lispbool
+  (handle handle)
+  (flags dword))
+
+(defun crypt-gen-random (length)
+  (multiple-value-bind (ok context)
+      (%crypt-acquire-context nil nil prov-rsa-full
+                              (logior crypt-verifycontext crypt-silent))
+    (unless ok
+      (return-from crypt-gen-random (values nil (get-last-error))))
+    (unwind-protect
+         (let ((data (make-array length :element-type '(unsigned-byte 8))))
+           (with-pinned-objects (data)
+             (if (%crypt-gen-random context length (vector-sap data))
+                 data
+                 (values nil (get-last-error)))))
+      (unless (%crypt-release-context context 0)
+        (win32-error '%crypt-release-context)))))