]> gitweb.factorcode.org Git - factor.git/blobdiff - basis/random/windows/windows.factor
Updating code to use with-out-parameters
[factor.git] / basis / random / windows / windows.factor
index 488deef41fe71b5e8ece12067d3e779de5df7f4f..f6918eb8f8197ab7ed011bf5e19245f7dc171e2f 100644 (file)
@@ -1,6 +1,8 @@
-USING: accessors alien.c-types byte-arrays continuations
-kernel windows.advapi32 init namespaces random destructors
-locals windows.errors ;
+USING: accessors alien.c-types alien.data byte-arrays
+combinators.short-circuit continuations destructors init kernel
+locals namespaces random windows.advapi32 windows.errors
+windows.kernel32 windows.types math.bitwise sequences fry
+literals ;
 IN: random.windows
 
 TUPLE: windows-rng provider type ;
@@ -12,25 +14,40 @@ C: <windows-crypto-context> windows-crypto-context
 M: windows-crypto-context dispose ( tuple -- )
     handle>> 0 CryptReleaseContext win32-error=0/f ;
 
-: factor-crypto-container ( -- string ) "FactorCryptoContainer" ; inline
+CONSTANT: factor-crypto-container "FactorCryptoContainer"
 
 :: (acquire-crypto-context) ( provider type flags -- handle )
-    [let | handle [ "HCRYPTPROV" <c-object> ] |
-        handle
+    { HCRYPTPROV } [
         factor-crypto-container
         provider
         type
         flags
-        CryptAcquireContextW win32-error=0/f
-        handle *void* ] ;
+        CryptAcquireContextW
+    ] [ ] with-out-parameters ;
 
 : acquire-crypto-context ( provider type -- handle )
-    [ 0 (acquire-crypto-context) ]
-    [ drop CRYPT_NEWKEYSET (acquire-crypto-context) ] recover ;
+    CRYPT_MACHINE_KEYSET
+    (acquire-crypto-context)
+    swap 0 = [
+        GetLastError NTE_BAD_KEYSET =
+        [ drop f ] [ win32-error-string throw ] if
+    ] when ;
 
+: create-crypto-context ( provider type -- handle )
+    flags{ CRYPT_MACHINE_KEYSET CRYPT_NEWKEYSET }
+    (acquire-crypto-context) win32-error=0/f *void* ;
+
+ERROR: acquire-crypto-context-failed provider type ;
+
+: attempt-crypto-context ( provider type -- handle )
+    {
+        [ acquire-crypto-context ] 
+        [ create-crypto-context ] 
+        [ acquire-crypto-context-failed ]
+    } 2|| ;
 
 : windows-crypto-context ( provider type -- context )
-    acquire-crypto-context <windows-crypto-context> ;
+    attempt-crypto-context <windows-crypto-context> ;
 
 M: windows-rng random-bytes* ( n tuple -- bytes )
     [
@@ -40,13 +57,28 @@ M: windows-rng random-bytes* ( n tuple -- bytes )
         [ CryptGenRandom win32-error=0/f ] keep
     ] with-destructors ;
 
+ERROR: no-windows-crypto-provider error ;
+
+: try-crypto-providers ( seq -- windows-rng )
+    [ first2 <windows-rng> ] attempt-all
+    dup windows-rng? [ no-windows-crypto-provider ] unless ;
+
 [
-    MS_DEF_PROV
-    PROV_RSA_FULL <windows-rng> system-random-generator set-global
+    {
+        ${ MS_ENHANCED_PROV PROV_RSA_FULL }
+        ${ MS_DEF_PROV PROV_RSA_FULL }
+    } try-crypto-providers
+    system-random-generator set-global
 
-    MS_STRONG_PROV
-    PROV_RSA_FULL <windows-rng> secure-random-generator set-global
+    {
+        ${ MS_STRONG_PROV PROV_RSA_FULL }
+        ${ MS_ENH_RSA_AES_PROV PROV_RSA_AES }
+    } try-crypto-providers secure-random-generator set-global
+] "random.windows" add-startup-hook
 
-    ! MS_ENH_RSA_AES_PROV
-    ! PROV_RSA_AES <windows-rng> secure-random-generator set-global
-] "random.windows" add-init-hook
+[
+    [
+        ! system-random-generator get-global &dispose drop
+        ! secure-random-generator get-global &dispose drop
+    ] with-destructors
+] "random.windows" add-shutdown-hook