io.sockets.secure.windows: secure socket implementation for windows, it works reasonably but certificate validation is not working correctly yet

basis/io/sockets/secure/openssl/openssl-tests.factor

@@ -40,3 +40,9 @@ IN: io.sockets.secure.openssl.tests
     [ SSL_get_peer_certificate ] tri
     subject-name
 ] unit-test
+
+[ "google.com" ] [
+    URL" https://www.google.se" url-addr resolve-host first
+    [ ((client)) ] keep [ <ports> ] dip establish-connection
+    handle>> handle>> SSL_get_peer_certificate subject-name
+] unit-test

basis/io/sockets/secure/windows/windows.factor

@@ -0,0 +1,74 @@
+USING:
+    accessors
+    alien
+    combinators
+    fry
+    io io.sockets.private io.sockets.secure io.sockets.secure.openssl io.sockets.windows
+    io.timeouts
+    kernel
+    openssl openssl.libcrypto openssl.libssl ;
+IN: io.sockets.secure.windows
+
+! Most of this vocab is duplicated code from io.sockets.secure.unix so
+! you could probably unify them.
+M: openssl ssl-supported? t ;
+
+: <ssl-socket> ( winsock -- ssl )
+    [ handle>> alien-address BIO_NOCLOSE BIO_new_socket ] keep <ssl-handle>
+    [ handle>> swap dup SSL_set_bio ] keep ;
+
+M: secure ((client)) ( addrspec -- handle )
+    addrspec>> ((client)) <ssl-socket> ;
+
+: establish-ssl-connection ( client-out remote -- )
+    make-sockaddr/size <ConnectEx-args>
+    swap >>port
+    dup port>> handle>> file>> handle>> >>s dup
+    s>> get-ConnectEx-ptr >>ptr dup
+    call-ConnectEx wait-for-socket drop ;
+
+! The error codes needs to be handled properly.
+: check-connect-response ( ssl-handle r -- event )
+    over handle>> over SSL_get_error
+    {
+        { SSL_ERROR_NONE [ 2drop f ] }
+        {
+            SSL_ERROR_WANT_READ
+            [ 2drop "input route" ]
+        }
+        {
+            SSL_ERROR_WANT_WRITE
+            [ 2drop "output route" ]
+        }
+        {
+            SSL_ERROR_SYSCALL
+            [ 2drop "syscall error" ]
+        }
+        { SSL_ERROR_SSL [ (ssl-error) ] }
+    } case ;
+
+: do-ssl-connect ( ssl-handle -- )
+    dup dup handle>> SSL_connect check-connect-response dup
+    [ dupd 2drop do-ssl-connect ] [ 2drop ] if ;
+
+: resume-session ( ssl-handle ssl-session -- )
+    [ [ handle>> ] dip SSL_set_session ssl-error ]
+    [ drop do-ssl-connect ]
+    2bi ;
+
+: begin-session ( ssl-handle addrspec -- )
+    [ drop do-ssl-connect ]
+    [ [ handle>> SSL_get1_session ] dip save-session ]
+    2bi ;
+
+: secure-connection ( client-out addrspec -- )
+    [ handle>> ] dip
+    [
+        '[
+            _ dup get-session
+            [ resume-session ] [ begin-session ] ?if
+        ] with-timeout
+    ] [ drop t >>connected drop ] 2bi ;
+
+M: secure establish-connection ( client-out remote -- )
+    addrspec>> [ establish-ssl-connection ] [ secure-connection ] 2bi ;