steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Server certificate verification, lazy handshake for accept

db4
Slava Pestov 2008-05-22 00:29:19 -05:00
parent 95358981e6
commit b301858c67
7 changed files with 11019 additions and 95 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
extra/io/sockets/secure/secure.factor
View File

@ -15,6 +15,8 @@ SINGLETONS: SSLv2 SSLv23 SSLv3 TLSv1 ;
TUPLE: secure-config
method
key-file password
verify
verify-depth
ca-file ca-path
dh-file
ephemeral-key-bits ;
@ -22,7 +24,9 @@ ephemeral-key-bits ;
: <secure-config> ( -- config )
secure-config new
SSLv23 >>method
1024 >>ephemeral-key-bits ;
1024 >>ephemeral-key-bits
! "resource:extra/openssl/cacert.pem" >>ca-file
t >>verify ;
TUPLE: secure-context config handle disposed ;

90
extra/io/unix/sockets/secure/secure-tests.factor
View File

@ -44,8 +44,8 @@ concurrency.promises byte-arrays locals calendar io.timeouts ;
[ ] [
[
drop
input-stream get stream>> handle>> f >>connected drop
"hello" write flush
input-stream get stream>> handle>> f >>connected drop
] server-test
] unit-test
@ -55,7 +55,7 @@ concurrency.promises byte-arrays locals calendar io.timeouts ;
! actually an invalid certificate
[ ] [ <promise> "port" set ] unit-test
[ ] [ [ drop ] server-test ] unit-test
[ ] [ [ drop "hi" write ] server-test ] unit-test
[
<secure-config> [
@ -97,54 +97,58 @@ concurrency.promises byte-arrays locals calendar io.timeouts ;
[
"127.0.0.1" 0 <inet4> <secure> ascii <server> [
dup addr>> addrspec>> port>> "port" get fulfill
accept drop dispose
accept drop dup stream-read1 drop dispose
] with-disposal
] with-test-context
] with-variable
] [ io-timeout? ] must-fail-with
! Client socket shutdown timeout
[ ] [ <promise> "port" set ] unit-test
[ ] [
[
[
"127.0.0.1" 0 <inet4> <secure> ascii <server> [
dup addr>> addrspec>> port>> "port" get fulfill
accept drop 1 minutes sleep dispose
] with-disposal
] with-test-context
] "Silly server" spawn drop
] unit-test
! Until I sort out two-stage handshaking, I can't do much here
[
1 seconds secure-socket-timeout [
<secure-config> [
"127.0.0.1" "port" get ?promise <inet4> <secure>
ascii <client> drop dispose
] with-secure-context
] with-variable
] [ io-timeout? ] must-fail-with
! Server socket shutdown timeout
[ ] [ <promise> "port" set ] unit-test
[ ] [
[ ] [ <promise> "port" set ] unit-test
[ ] [
[
[
"127.0.0.1" 0 <inet4> <secure> ascii <server> [
dup addr>> addrspec>> port>> "port" get fulfill
accept drop 1 minutes sleep dispose
] with-disposal
] with-test-context
] "Silly server" spawn drop
] unit-test
[
1 seconds secure-socket-timeout [
<secure-config> [
"127.0.0.1" "port" get ?promise <inet4> <secure>
ascii <client> drop dispose
] with-secure-context
] with-variable
] [ io-timeout? ] must-fail-with
! Server socket shutdown timeout
[ ] [ <promise> "port" set ] unit-test
[ ] [
[
"127.0.0.1" "port" get ?promise
<inet4> <secure> ascii <client> drop 1 minutes sleep dispose
] with-test-context
] "Silly client" spawn drop
] unit-test
[
1 seconds secure-socket-timeout [
[
"127.0.0.1" 0 <inet4> <secure> ascii <server> [
dup addr>> addrspec>> port>> "port" get fulfill
accept drop dispose
] with-disposal
] with-test-context
] with-variable
] [ io-timeout? ] must-fail-with
[
"127.0.0.1" "port" get ?promise
<inet4> <secure> ascii <client> drop 1 minutes sleep dispose
] with-test-context
] "Silly client" spawn drop
] unit-test
[
1 seconds secure-socket-timeout [
[
"127.0.0.1" 0 <inet4> <secure> ascii <server> [
dup addr>> addrspec>> port>> "port" get fulfill
accept drop dispose
] with-disposal
] with-test-context
] with-variable
] [ io-timeout? ] must-fail-with
] drop

71
extra/io/unix/sockets/secure/secure.factor
View File

@ -22,6 +22,26 @@ M: ssl-handle handle-fd file>> handle-fd ;
nip (ssl-error)
] if ;
: check-accept-response ( handle r -- event )
over handle>> over SSL_get_error
{
{ SSL_ERROR_NONE [ 2drop f ] }
{ SSL_ERROR_WANT_READ [ 2drop +input+ ] }
{ SSL_ERROR_WANT_WRITE [ 2drop +output+ ] }
{ SSL_ERROR_SYSCALL [ syscall-error ] }
{ SSL_ERROR_SSL [ (ssl-error) ] }
} case ;
: do-ssl-accept ( ssl-handle -- )
dup dup handle>> SSL_accept check-accept-response dup
[ >r dup file>> r> wait-for-fd do-ssl-accept ] [ 2drop ] if ;
: maybe-handshake ( ssl-handle -- )
dup connected>> [ drop ] [
t >>connected
[ do-ssl-accept ] with-timeout
] if ;
: check-response ( port r -- port r n )
over handle>> handle>> over SSL_get_error ; inline
@ -38,6 +58,7 @@ M: ssl-handle handle-fd file>> handle-fd ;
} case ;
M: ssl-handle refill
dup maybe-handshake
handle>> ! ssl
over buffer>>
[ buffer-end ] ! buf
@ -57,6 +78,7 @@ M: ssl-handle refill
} case ;
M: ssl-handle drain
dup maybe-handshake
handle>> ! ssl
over buffer>>
[ buffer@ ] ! buf
@ -107,52 +129,25 @@ M: secure establish-connection ( client-out remote -- )
M: secure (server) addrspec>> (server) ;
: check-accept-response ( handle r -- event )
M: secure (accept)
[
addrspec>> (accept) >r |dispose <ssl-socket> r>
] with-destructors ;
: check-shutdown-response ( handle r -- event )
#! We don't do two-step shutdown here because I couldn't
#! figure out how to do it with non-blocking BIOs. Also, it
#! seems that SSL_shutdown always returns 0 -- this sounds
#! like a bug
over handle>> over SSL_get_error
{
{ SSL_ERROR_NONE [ 2drop f ] }
{ SSL_ERROR_WANT_READ [ 2drop +input+ ] }
{ SSL_ERROR_WANT_WRITE [ 2drop +output+ ] }
{ SSL_ERROR_SYSCALL [ syscall-error ] }
{ SSL_ERROR_SYSCALL [ dup zero? [ 2drop f ] [ syscall-error ] if ] }
{ SSL_ERROR_SSL [ (ssl-error) ] }
} case ;
: do-ssl-accept ( ssl-handle -- )
dup dup handle>> SSL_accept check-accept-response dup
[ >r dup file>> r> wait-for-fd do-ssl-accept ] [ 2drop ] if ;
M: secure (accept)
[
addrspec>> (accept) >r
|dispose <ssl-socket> t >>connected |dispose
dup [ do-ssl-accept ] with-timeout r>
] with-destructors ;
: check-shutdown-response ( handle r -- event )
#! SSL_shutdown always returns 0 due to openssl bugs?
{
{ 1 [ drop f ] }
{ 0 [
dup handle>> dup f 0 SSL_read 2dup SSL_get_error
{
{ SSL_ERROR_ZERO_RETURN [ 3drop +retry+ ] }
{ SSL_ERROR_WANT_READ [ 3drop +input+ ] }
{ SSL_ERROR_WANT_WRITE [ 3drop +output+ ] }
{ SSL_ERROR_SYSCALL [ syscall-error ] }
{ SSL_ERROR_SSL [ (ssl-error) ] }
} case
] }
{ -1 [
handle>> -1 SSL_get_error
{
{ SSL_ERROR_WANT_READ [ +input+ ] }
{ SSL_ERROR_WANT_WRITE [ +output+ ] }
{ SSL_ERROR_SYSCALL [ -1 syscall-error ] }
{ SSL_ERROR_SSL [ (ssl-error) ] }
} case
] }
} case ;
: (shutdown) ( handle -- )
dup dup handle>> SSL_shutdown check-shutdown-response
dup [ dupd wait-for-fd (shutdown) ] [ 2drop ] if ;

10908
extra/openssl/cacert.pem Normal file
View File

File diff suppressed because it is too large Load Diff

14
extra/openssl/libssl/libssl.factor
View File

@ -122,6 +122,11 @@ FUNCTION: int SSL_read ( ssl-pointer ssl, void* buf, int num ) ;
FUNCTION: int SSL_shutdown ( ssl-pointer ssl ) ;
: SSL_SENT_SHUTDOWN 1 ;
: SSL_RECEIVED_SHUTDOWN 2 ;
FUNCTION: int SSL_get_shutdown ( ssl-pointer ssl ) ;
FUNCTION: void SSL_free ( ssl-pointer ssl ) ;
FUNCTION: int SSL_want ( ssl-pointer ssl ) ;
@ -151,6 +156,15 @@ FUNCTION: int SSL_use_certificate_file ( ssl-pointer ssl,
FUNCTION: int SSL_CTX_load_verify_locations ( ssl-ctx ctx, char* CAfile,
char* CApath ) ;
FUNCTION: int SSL_CTX_set_default_verify_paths ( ssl-ctx ctx ) ;
: SSL_VERIFY_NONE 0 ; inline
: SSL_VERIFY_PEER 1 ; inline
: SSL_VERIFY_FAIL_IF_NO_PEER_CERT 2 ; inline
: SSL_VERIFY_CLIENT_ONCE 4 ; inline
FUNCTION: void SSL_CTX_set_verify ( ssl-ctx ctx, int mode, void* callback ) ;
FUNCTION: void SSL_CTX_set_client_CA_list ( ssl-ctx ctx, ssl-pointer list ) ;
FUNCTION: ssl-pointer SSL_load_client_CA_file ( char* file ) ;

24
extra/openssl/openssl.factor
View File

@ -94,11 +94,14 @@ TUPLE: openssl-context < secure-context aliens ;
[ ca-file>> dup [ (normalize-path) ] when ]
[ ca-path>> dup [ (normalize-path) ] when ] bi
] bi
SSL_CTX_load_verify_locations ssl-error
] [ drop ] if ;
SSL_CTX_load_verify_locations
] [ handle>> SSL_CTX_set_default_verify_paths ] if ssl-error ;
: set-verify-depth ( ctx -- )
handle>> 1 SSL_CTX_set_verify_depth ;
dup config>> verify-depth>> [
[ handle>> ] [ config>> verify-depth>> ] bi
SSL_CTX_set_verify_depth
] [ drop ] if ;
TUPLE: bio handle disposed ;
@ -154,11 +157,6 @@ M: openssl-context dispose*
TUPLE: ssl-handle file handle connected disposed ;
ERROR: no-secure-context ;
M: no-secure-context summary
drop "Secure socket operations must be wrapped in calls to with-secure-context" ;
SYMBOL: default-secure-context
: context-expired? ( context -- ? )
@ -195,9 +193,11 @@ M: ssl-handle dispose*
[ 2drop ] [ common-name-verify-error ] if ;
M: openssl check-certificate ( host ssl -- )
handle>>
[ nip check-verify-result ]
[ check-common-name ]
2bi ;
current-secure-context config>> verify>> [
handle>>
[ nip check-verify-result ]
[ check-common-name ]
2bi
] [ 2drop ] if ;
openssl secure-socket-backend set-global

1
extra/openssl/tags.txt
View File

@ -1,3 +1,2 @@
enterprise
network
bindings