From bb7161a46f2e1ee3621270adaaba335db3eedbbf Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sun, 13 Mar 2016 16:10:43 -0700
Subject: [PATCH] io.sockets.secure.windows: Add some code for loading the
 certificates on windows. Still disabled, and the CA certificates are
 duplicated.

---
 .../io/sockets/secure/windows/windows.factor  | 57 +++++++++++++++++--
 1 file changed, 53 insertions(+), 4 deletions(-)

diff --git a/basis/io/sockets/secure/windows/windows.factor b/basis/io/sockets/secure/windows/windows.factor
index ef3bbdf8de..f211f842fc 100644
--- a/basis/io/sockets/secure/windows/windows.factor
+++ b/basis/io/sockets/secure/windows/windows.factor
@@ -1,11 +1,60 @@
-USING: accessors alien io.ports io.sockets.private io.sockets.secure
-io.sockets.secure.openssl io.sockets.windows kernel locals openssl
-openssl.libcrypto openssl.libssl windows.winsock system ;
+USING: accessors alien alien.c-types alien.data alien.strings
+calendar combinators combinators.short-circuit destructors io
+io.encodings.utf8 io.ports io.sockets.private io.sockets.secure
+io.sockets.secure.openssl io.sockets.windows kernel libc locals
+math math.order openssl openssl.libcrypto openssl.libssl system
+windows.crypt32 windows.errors windows.time windows.winsock ;
 IN: io.sockets.secure.windows
 
 M: openssl ssl-supported? t ;
 M: openssl ssl-certificate-verification-supported? f ;
 
+: close-windows-cert-store ( HCERTSTORE -- )
+    0 CertCloseStore win32-error=0/f ;
+
+: load-windows-cert-store ( string -- HCERTSTORE )
+    [ f ] dip CertOpenSystemStore
+    [ win32-error-string throw ] when-zero ;
+
+: X509-NAME. ( X509_NAME -- )
+    f 0 X509_NAME_oneline
+    [ utf8 alien>string print ] [ (free) ] bi ;
+
+: X509. ( X509 -- )
+    {
+        [ X509_get_subject_name "subject: " write X509-NAME. ]
+        [ X509_get_issuer_name "issuer: " write X509-NAME. ]
+    } cleave ;
+
+: add-cert-to-store ( cert-store cert -- )
+    X509_STORE_add_cert ssl-error ;
+
+:: set-windows-certs-for ( name -- )
+    [
+        name load-windows-cert-store :> cs
+        X509_STORE_new :> x509-store
+        f :> ctx!
+        [ ctx ]
+        [
+            cs ctx CertEnumCertificatesInStore ctx!
+            ctx [
+                f ctx [ pbCertEncoded>> void* <ref> ]
+                [ cbCertEncoded>> ] bi d2i_X509
+                {
+                    [ ssl-error ]
+                    ! [ X509. ]
+                    [ x509-store swap X509_STORE_add_cert ssl-error ]
+                } cleave
+            ] when
+        ] do while
+    ] with-destructors ;
+
+! XXX: the MSFT cert is in "CA" twice, and throws an error
+! when loading the second time.
+: set-windows-certs ( -- )
+    ! "CA" set-windows-certs-for
+    "ROOT" set-windows-certs-for ;
+
 M: windows socket-handle handle>> alien-address ;
 
 M: secure ((client)) ( addrspec -- handle )
@@ -23,4 +72,4 @@ M:: secure establish-connection ( client-out addrspec -- )
     client-out addrspec secure-connection
     socket FIONBIO 0 set-ioctl-socket ;
 
-M: windows non-ssl-socket? win32-socket? ;
+M: windows non-ssl-socket? win32-socket? ;
\ No newline at end of file