2009-09-17 23:07:21 -04:00
|
|
|
USING: accessors alien.c-types alien.data byte-arrays
|
2009-05-20 20:30:35 -04:00
|
|
|
combinators.short-circuit continuations destructors init kernel
|
|
|
|
locals namespaces random windows.advapi32 windows.errors
|
2010-01-28 23:45:19 -05:00
|
|
|
windows.kernel32 windows.types math.bitwise sequences fry
|
|
|
|
literals ;
|
2008-03-19 17:18:03 -04:00
|
|
|
IN: random.windows
|
|
|
|
|
2009-11-18 11:01:00 -05:00
|
|
|
TUPLE: windows-rng provider type ;
|
2008-03-29 15:25:57 -04:00
|
|
|
C: <windows-rng> windows-rng
|
2008-03-28 23:10:01 -04:00
|
|
|
|
2008-03-29 15:25:57 -04:00
|
|
|
TUPLE: windows-crypto-context handle ;
|
2008-03-28 23:10:01 -04:00
|
|
|
C: <windows-crypto-context> windows-crypto-context
|
|
|
|
|
|
|
|
M: windows-crypto-context dispose ( tuple -- )
|
|
|
|
handle>> 0 CryptReleaseContext win32-error=0/f ;
|
|
|
|
|
2009-05-20 20:30:35 -04:00
|
|
|
CONSTANT: factor-crypto-container "FactorCryptoContainer"
|
2008-03-29 15:25:57 -04:00
|
|
|
|
2010-05-23 04:27:40 -04:00
|
|
|
:: (acquire-crypto-context) ( provider type flags -- ret handle )
|
2010-05-23 03:07:47 -04:00
|
|
|
{ HCRYPTPROV } [
|
|
|
|
factor-crypto-container
|
|
|
|
provider
|
|
|
|
type
|
|
|
|
flags
|
|
|
|
CryptAcquireContextW
|
2010-07-16 17:32:05 -04:00
|
|
|
] with-out-parameters ;
|
2008-03-29 15:25:57 -04:00
|
|
|
|
|
|
|
: acquire-crypto-context ( provider type -- handle )
|
2009-05-22 18:15:40 -04:00
|
|
|
CRYPT_MACHINE_KEYSET
|
|
|
|
(acquire-crypto-context)
|
2010-05-23 03:07:47 -04:00
|
|
|
swap 0 = [
|
2009-05-20 20:30:35 -04:00
|
|
|
GetLastError NTE_BAD_KEYSET =
|
|
|
|
[ drop f ] [ win32-error-string throw ] if
|
2010-05-23 03:07:47 -04:00
|
|
|
] when ;
|
2008-03-29 15:25:57 -04:00
|
|
|
|
2009-05-20 20:30:35 -04:00
|
|
|
: create-crypto-context ( provider type -- handle )
|
2010-04-01 15:43:27 -04:00
|
|
|
flags{ CRYPT_MACHINE_KEYSET CRYPT_NEWKEYSET }
|
2009-05-22 18:18:24 -04:00
|
|
|
(acquire-crypto-context) win32-error=0/f *void* ;
|
2009-05-20 20:30:35 -04:00
|
|
|
|
|
|
|
ERROR: acquire-crypto-context-failed provider type ;
|
|
|
|
|
|
|
|
: attempt-crypto-context ( provider type -- handle )
|
|
|
|
{
|
|
|
|
[ acquire-crypto-context ]
|
|
|
|
[ create-crypto-context ]
|
|
|
|
[ acquire-crypto-context-failed ]
|
|
|
|
} 2|| ;
|
2008-03-29 15:25:57 -04:00
|
|
|
|
|
|
|
: windows-crypto-context ( provider type -- context )
|
2009-05-20 20:40:52 -04:00
|
|
|
attempt-crypto-context <windows-crypto-context> ;
|
2008-03-29 15:25:57 -04:00
|
|
|
|
|
|
|
M: windows-rng random-bytes* ( n tuple -- bytes )
|
|
|
|
[
|
|
|
|
[ provider>> ] [ type>> ] bi
|
2008-05-14 20:03:07 -04:00
|
|
|
windows-crypto-context &dispose
|
|
|
|
handle>> swap dup <byte-array>
|
2008-03-29 15:25:57 -04:00
|
|
|
[ CryptGenRandom win32-error=0/f ] keep
|
|
|
|
] with-destructors ;
|
|
|
|
|
2010-01-29 00:28:11 -05:00
|
|
|
ERROR: no-windows-crypto-provider error ;
|
2010-01-28 23:45:19 -05:00
|
|
|
|
|
|
|
: try-crypto-providers ( seq -- windows-rng )
|
2010-01-29 00:28:11 -05:00
|
|
|
[ first2 <windows-rng> ] attempt-all
|
|
|
|
dup windows-rng? [ no-windows-crypto-provider ] unless ;
|
2010-01-28 23:45:19 -05:00
|
|
|
|
2008-03-29 15:25:57 -04:00
|
|
|
[
|
2010-01-28 23:45:19 -05:00
|
|
|
{
|
|
|
|
${ MS_ENHANCED_PROV PROV_RSA_FULL }
|
|
|
|
${ MS_DEF_PROV PROV_RSA_FULL }
|
|
|
|
} try-crypto-providers
|
|
|
|
system-random-generator set-global
|
2008-03-29 15:25:57 -04:00
|
|
|
|
2010-01-28 23:45:19 -05:00
|
|
|
{
|
|
|
|
${ MS_STRONG_PROV PROV_RSA_FULL }
|
|
|
|
${ MS_ENH_RSA_AES_PROV PROV_RSA_AES }
|
|
|
|
} try-crypto-providers secure-random-generator set-global
|
2009-10-19 22:17:02 -04:00
|
|
|
] "random.windows" add-startup-hook
|
2008-03-29 15:25:57 -04:00
|
|
|
|
2009-10-19 22:17:02 -04:00
|
|
|
[
|
|
|
|
[
|
2009-11-30 17:59:40 -05:00
|
|
|
! system-random-generator get-global &dispose drop
|
|
|
|
! secure-random-generator get-global &dispose drop
|
2009-10-19 22:17:02 -04:00
|
|
|
] with-destructors
|
|
|
|
] "random.windows" add-shutdown-hook
|