1 USING: accessors alien.data byte-arrays continuations
2 destructors init kernel literals locals namespaces random
3 sequences windows.advapi32 windows.errors windows.handles
7 TUPLE: windows-crypto-context < win32-handle provider type ;
9 M: windows-crypto-context dispose* ( tuple -- )
10 [ handle>> 0 CryptReleaseContext win32-error=0/f ]
11 [ f >>handle drop ] bi ;
13 CONSTANT: factor-crypto-container "FactorCryptoContainer"
15 :: (acquire-crypto-context) ( provider type flags -- handle )
17 factor-crypto-container
21 CryptAcquireContextW win32-error=0/f
22 ] with-out-parameters ;
24 : acquire-crypto-context ( provider type -- handle )
25 CRYPT_MACHINE_KEYSET (acquire-crypto-context) ;
27 : create-crypto-context ( provider type -- handle )
28 flags{ CRYPT_MACHINE_KEYSET CRYPT_NEWKEYSET } (acquire-crypto-context) ;
30 ERROR: acquire-crypto-context-failed provider type error ;
32 : attempt-crypto-context ( provider type -- handle )
33 [ acquire-crypto-context ]
34 [ drop [ create-crypto-context ] [ acquire-crypto-context-failed ] recover ] recover ;
36 : initialize-crypto-context ( crypto-context -- crypto-context )
37 dup [ provider>> ] [ type>> ] bi attempt-crypto-context >>handle ;
39 : <windows-crypto-context> ( provider type -- windows-crypto-type )
40 windows-crypto-context new-disposable
43 initialize-crypto-context ; inline
45 M: windows-crypto-context random-bytes* ( n windows-crypto-context -- bytes )
46 handle>> swap [ ] [ <byte-array> ] bi
47 [ CryptGenRandom win32-error=0/f ] keep ;
49 ! Some Windows installations still don't work, so just set
50 ! system and secure rngs to f
51 : try-crypto-providers ( seq -- windows-crypto-context/f )
53 [ first2 <windows-crypto-context> ] attempt-all
54 ] [ 2drop f ] recover ;
58 ${ MS_ENHANCED_PROV PROV_RSA_FULL }
59 ${ MS_DEF_PROV PROV_RSA_FULL }
60 } try-crypto-providers system-random-generator set-global
63 ${ MS_STRONG_PROV PROV_RSA_FULL }
64 ${ MS_ENH_RSA_AES_PROV PROV_RSA_AES }
65 } try-crypto-providers secure-random-generator set-global
66 ] "random.windows" add-startup-hook