Permalink
Browse files

Use CryptGenRandom for OS-provided random seed whenever possible.

As long as advapi32 is not used by the runtime's C part,
sb-dynamic-core with its early binding + late linking of aliens makes
this feature significantly easier to add. Hence no support for

Fallback to pid + time pseudo-randomness is preserved here, in the
spirit of unix-specific /dev/urandom code (whether it's good design is
another question).

* package-data-list.lisp-expr (sb-cold:package-data): export
sb-win32:crypt-gen-random

* src/code/target-random.lisp (seed-random-state): call
sb-win32:crypt-gen-random for sb-dynamic-core builds.
  • Loading branch information...
akovalenko committed Jan 13, 2012
1 parent 0df3a6b commit 934cbaa322f0f5723bf5348fcbe1d7f0235fd2db
Showing with 44 additions and 0 deletions.
  1. +1 −0 package-data-list.lisp-expr
  2. +4 −0 src/code/target-random.lisp
  3. +1 −0 src/code/warm-lib.lisp
  4. +32 −0 src/code/win32.lisp
  5. +6 −0 tools-for-build/grovel-headers.c
@@ -2865,6 +2865,7 @@ SBCL itself"
"CREATE-FILE"
"CREATE-FILE-MAPPING"
"CREATE-WAITABLE-TIMER"
+ "CRYPT-GEN-RANDOM"
"DWORD"
"FD-CLEAR-INPUT"
"FD-LISTEN"
@@ -153,6 +153,10 @@
(let ((a (make-array '(8) :element-type '(unsigned-byte 32))))
(assert (= 8 (read-sequence a r)))
a)))
+ #!+(and win32 sb-dynamic-core)
+ (progn
+ (/show0 "Getting randomness from CryptGenRandom")
+ (sb!win32:crypt-gen-random 32))
;; When /dev/urandom is not available, we make do with time and pid
;; Thread ID and/or address of a CONS cell would be even better, but...
(progn
View
@@ -16,5 +16,6 @@
(progn
(load-shared-object "kernel32.dll")
(load-shared-object "msvcrt.dll")
+ (load-shared-object "advapi32.dll")
(load-shared-object "ws2_32.dll")
(load-shared-object "shell32.dll"))
View
@@ -1333,3 +1333,35 @@ format for such streams."
(unwind-protect (funcall thunk fd)
(real-crt-close fd)))
(values nil errno))))
+
+#!+sb-dynamic-core
+(progn
+ (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))))))
@@ -30,6 +30,7 @@
#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#include <shlobj.h>
+ #include <wincrypt.h>
#undef boolean
#else
#include <poll.h>
@@ -242,6 +243,11 @@ main(int argc, char *argv[])
defconstant("STD_OUTPUT_HANDLE", STD_OUTPUT_HANDLE);
defconstant("STD_ERROR_HANDLE", STD_ERROR_HANDLE);
+ printf(";;; WinCrypt");
+ defconstant("crypt-verifycontext", CRYPT_VERIFYCONTEXT);
+ defconstant("crypt-silent", CRYPT_SILENT);
+ defconstant("prov-rsa-full", PROV_RSA_FULL);
+
/* FIXME: SB-UNIX and SB-WIN32 really need to be untangled. */
printf("(in-package \"SB!UNIX\")\n\n");
printf(";;; Unix-like constants and types on Windows\n");

0 comments on commit 934cbaa

Please sign in to comment.