diff --git a/basis/io/sockets/secure/openssl/openssl-tests.factor b/basis/io/sockets/secure/openssl/openssl-tests.factor index 75da5489a9..d5b32b577b 100644 --- a/basis/io/sockets/secure/openssl/openssl-tests.factor +++ b/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 [ ] dip establish-connection + handle>> handle>> SSL_get_peer_certificate subject-name +] unit-test diff --git a/basis/io/sockets/secure/windows/windows.factor b/basis/io/sockets/secure/windows/windows.factor new file mode 100644 index 0000000000..d2538c12ba --- /dev/null +++ b/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 ; + +: ( winsock -- ssl ) + [ handle>> alien-address BIO_NOCLOSE BIO_new_socket ] keep + [ handle>> swap dup SSL_set_bio ] keep ; + +M: secure ((client)) ( addrspec -- handle ) + addrspec>> ((client)) ; + +: establish-ssl-connection ( client-out remote -- ) + make-sockaddr/size + 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 ;