From c6361436bf186317b8aefce4f5ddc6a7173b590d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Lindqvist?= <bjourne@gmail.com>
Date: Sat, 19 Nov 2016 19:05:53 +0100
Subject: [PATCH] io.sockets.secure.openssl: set connected to t after
do-ssl-accept
This should prevent the SSL_shutdown:shutdown while in init error we've
been seeing
---
basis/io/sockets/secure/openssl/openssl-docs.factor | 5 +++++
basis/io/sockets/secure/openssl/openssl-tests.factor | 6 +++++-
basis/io/sockets/secure/openssl/openssl.factor | 4 ++--
3 files changed, 12 insertions(+), 3 deletions(-)
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 <ssl-handle> [ 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