basis/random/windows/windows.factor

   1 USING: accessors alien.c-types alien.data byte-arrays
   2 combinators.short-circuit continuations destructors init kernel
   3 locals namespaces random windows.advapi32 windows.errors
   4 windows.kernel32 windows.types math.bitwise ;
   5 IN: random.windows
   6
   7 TUPLE: windows-rng provider type ;
   8 C: <windows-rng> windows-rng
   9
  10 TUPLE: windows-crypto-context handle ;
  11 C: <windows-crypto-context> windows-crypto-context
  12
  13 M: windows-crypto-context dispose ( tuple -- )
  14     handle>> 0 CryptReleaseContext win32-error=0/f ;
  15
  16 CONSTANT: factor-crypto-container "FactorCryptoContainer"
  17
  18 :: (acquire-crypto-context) ( provider type flags -- handle ret )
  19     HCRYPTPROV <c-object> :> handle
  20     handle
  21     factor-crypto-container
  22     provider
  23     type
  24     flags
  25     CryptAcquireContextW handle swap ;
  26
  27 : acquire-crypto-context ( provider type -- handle )
  28     CRYPT_MACHINE_KEYSET
  29     (acquire-crypto-context)
  30     0 = [
  31         GetLastError NTE_BAD_KEYSET =
  32         [ drop f ] [ win32-error-string throw ] if
  33     ] [
  34         *void*
  35     ] if ;
  36
  37 : create-crypto-context ( provider type -- handle )
  38     { CRYPT_MACHINE_KEYSET CRYPT_NEWKEYSET } flags
  39     (acquire-crypto-context) win32-error=0/f *void* ;
  40
  41 ERROR: acquire-crypto-context-failed provider type ;
  42
  43 : attempt-crypto-context ( provider type -- handle )
  44     {
  45         [ acquire-crypto-context ]
  46         [ create-crypto-context ]
  47         [ acquire-crypto-context-failed ]
  48     } 2|| ;
  49
  50 : windows-crypto-context ( provider type -- context )
  51     attempt-crypto-context <windows-crypto-context> ;
  52
  53 M: windows-rng random-bytes* ( n tuple -- bytes )
  54     [
  55         [ provider>> ] [ type>> ] bi
  56         windows-crypto-context &dispose
  57         handle>> swap dup <byte-array>
  58         [ CryptGenRandom win32-error=0/f ] keep
  59     ] with-destructors ;
  60
  61 [
  62     MS_DEF_PROV
  63     PROV_RSA_FULL <windows-rng> system-random-generator set-global
  64
  65     [ MS_STRONG_PROV PROV_RSA_FULL <windows-rng> ]
  66     [ drop MS_ENH_RSA_AES_PROV PROV_RSA_AES <windows-rng> ] recover
  67     secure-random-generator set-global
  68 ] "random.windows" add-startup-hook
  69
  70 [
  71     [
  72         ! system-random-generator get-global &dispose drop
  73         ! secure-random-generator get-global &dispose drop
  74     ] with-destructors
  75 ] "random.windows" add-shutdown-hook