diff --git a/basis/io/sockets/secure/openssl/openssl-docs.factor b/basis/io/sockets/secure/openssl/openssl-docs.factor index a4f70cb7cc..c8fe87f93b 100644 --- a/basis/io/sockets/secure/openssl/openssl-docs.factor +++ b/basis/io/sockets/secure/openssl/openssl-docs.factor @@ -46,3 +46,8 @@ HELP: check-ssl-error { "event/f" "f or a symbol indicating the desired operation" } } { $description "Checks if the last SSL function returned successfully or not. If so, returns " { $link f } " or a symbol, " { $link +input+ } " or " { $link +output+ } ", that indicates the socket operation required by libssl." } ; + +HELP: maybe-handshake +{ $values + { "ssl-handle" ssl-handle } +} { $description "Performs SSL handshaking (using " { $link SSL_accept } ") if the handle isn't connected. Then sets its state to connected." } ; diff --git a/basis/io/sockets/secure/openssl/openssl-tests.factor b/basis/io/sockets/secure/openssl/openssl-tests.factor index 2f962df11e..57fb60efcf 100644 --- a/basis/io/sockets/secure/openssl/openssl-tests.factor +++ b/basis/io/sockets/secure/openssl/openssl-tests.factor @@ -1,4 +1,4 @@ -USING: accessors http.client http.server io.servers +USING: accessors continuations http.client http.server io.servers io.sockets.secure io.sockets.secure.openssl kernel tools.test ; IN: io.sockets.secure.openssl.tests @@ -19,3 +19,7 @@ IN: io.sockets.secure.openssl.tests { t } [ "www.badssl.com" "*.badssl.com" subject-names-match? ] unit-test { f } [ "foo.bar.badssl.com" "*.badssl.com" subject-names-match? ] unit-test { f } [ ".com" "*.badssl.com" subject-names-match? ] unit-test + +{ f } [ + 33 [ maybe-handshake ] [ drop ] recover connected>> +] unit-test diff --git a/basis/io/sockets/secure/openssl/openssl.factor b/basis/io/sockets/secure/openssl/openssl.factor index 86aaac1671..4aec171ae3 100644 --- a/basis/io/sockets/secure/openssl/openssl.factor +++ b/basis/io/sockets/secure/openssl/openssl.factor @@ -261,8 +261,8 @@ SYMBOL: default-secure-context : maybe-handshake ( ssl-handle -- ) dup connected>> [ drop ] [ - t >>connected - [ do-ssl-accept ] with-timeout + [ [ do-ssl-accept ] with-timeout ] + [ t swap connected<< ] bi ] if ; ! Input ports