SSL session resumption
Slava Pestov
parent
dbe095a84d
commit
71d65880e5
|
|
@ -9,7 +9,7 @@ concurrency.promises byte-arrays locals calendar io.timeouts ;
|
|||
|
||||
[ ] [ <promise> "port" set ] unit-test
|
||||
|
||||
: with-test-context
|
||||
: with-test-context ( quot -- )
|
||||
<secure-config>
|
||||
"resource:extra/openssl/test/server.pem" >>key-file
|
||||
"resource:extra/openssl/test/dh1024.pem" >>dh-file
|
||||
|
|
@ -28,7 +28,7 @@ concurrency.promises byte-arrays locals calendar io.timeouts ;
|
|||
] with-test-context
|
||||
] "SSL server test" spawn drop ;
|
||||
|
||||
: client-test
|
||||
: client-test ( -- string )
|
||||
<secure-config> [
|
||||
"127.0.0.1" "port" get ?promise <inet4> <secure> ascii <client> drop contents
|
||||
] with-secure-context ;
|
||||
|
|
|
|||
|
|
@ -118,13 +118,27 @@ M: secure (get-local-address) addrspec>> (get-local-address) ;
|
|||
dup dup handle>> SSL_connect check-connect-response dup
|
||||
[ dupd wait-for-fd 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 ( ssl-handle addrspec -- )
|
||||
dup get-session [ resume-session ] [ begin-session ] ?if ;
|
||||
|
||||
M: secure establish-connection ( client-out remote -- )
|
||||
[ addrspec>> establish-connection ]
|
||||
addrspec>>
|
||||
[ establish-connection ]
|
||||
[
|
||||
drop handle>>
|
||||
[ [ do-ssl-connect ] with-timeout ]
|
||||
[ t >>connected drop ]
|
||||
bi
|
||||
[ handle>> ] dip
|
||||
[ [ secure-connection ] curry with-timeout ]
|
||||
[ drop t >>connected drop ]
|
||||
2bi
|
||||
] 2bi ;
|
||||
|
||||
M: secure (server) addrspec>> (server) ;
|
||||
|
|
|
|||
|
|
@ -1,12 +1,8 @@
|
|||
! Copyright (C) 2007 Elie CHAFTARI
|
||||
! Portions copyright (C) 2008 Slava Pestov
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
!
|
||||
! Tested with OpenSSL 0.9.8a_0 on Mac OS X 10.4.9 PowerPC
|
||||
!
|
||||
! export LD_LIBRARY_PATH=/opt/local/lib
|
||||
|
||||
USING: alien alien.syntax combinators kernel system namespaces
|
||||
assocs parser sequences words quotations ;
|
||||
assocs parser sequences words quotations math.bitfields ;
|
||||
|
||||
IN: openssl.libssl
|
||||
|
||||
|
|
@ -30,6 +26,42 @@ IN: openssl.libssl
|
|||
: SSL_CTRL_SET_TMP_RSA_CB 4 ; inline
|
||||
: SSL_CTRL_SET_TMP_DH_CB 5 ; inline
|
||||
|
||||
: SSL_CTRL_GET_SESSION_REUSED 6 ; inline
|
||||
: SSL_CTRL_GET_CLIENT_CERT_REQUEST 7 ; inline
|
||||
: SSL_CTRL_GET_NUM_RENEGOTIATIONS 8 ; inline
|
||||
: SSL_CTRL_CLEAR_NUM_RENEGOTIATIONS 9 ; inline
|
||||
: SSL_CTRL_GET_TOTAL_RENEGOTIATIONS 10 ; inline
|
||||
: SSL_CTRL_GET_FLAGS 11 ; inline
|
||||
: SSL_CTRL_EXTRA_CHAIN_CERT 12 ; inline
|
||||
|
||||
: SSL_CTRL_SET_MSG_CALLBACK 13 ; inline
|
||||
: SSL_CTRL_SET_MSG_CALLBACK_ARG 14 ; inline
|
||||
|
||||
: SSL_CTRL_SESS_NUMBER 20 ; inline
|
||||
: SSL_CTRL_SESS_CONNECT 21 ; inline
|
||||
: SSL_CTRL_SESS_CONNECT_GOOD 22 ; inline
|
||||
: SSL_CTRL_SESS_CONNECT_RENEGOTIATE 23 ; inline
|
||||
: SSL_CTRL_SESS_ACCEPT 24 ; inline
|
||||
: SSL_CTRL_SESS_ACCEPT_GOOD 25 ; inline
|
||||
: SSL_CTRL_SESS_ACCEPT_RENEGOTIATE 26 ; inline
|
||||
: SSL_CTRL_SESS_HIT 27 ; inline
|
||||
: SSL_CTRL_SESS_CB_HIT 28 ; inline
|
||||
: SSL_CTRL_SESS_MISSES 29 ; inline
|
||||
: SSL_CTRL_SESS_TIMEOUTS 30 ; inline
|
||||
: SSL_CTRL_SESS_CACHE_FULL 31 ; inline
|
||||
: SSL_CTRL_OPTIONS 32 ; inline
|
||||
: SSL_CTRL_MODE 33 ; inline
|
||||
|
||||
: SSL_CTRL_GET_READ_AHEAD 40 ; inline
|
||||
: SSL_CTRL_SET_READ_AHEAD 41 ; inline
|
||||
: SSL_CTRL_SET_SESS_CACHE_SIZE 42 ; inline
|
||||
: SSL_CTRL_GET_SESS_CACHE_SIZE 43 ; inline
|
||||
: SSL_CTRL_SET_SESS_CACHE_MODE 44 ; inline
|
||||
: SSL_CTRL_GET_SESS_CACHE_MODE 45 ; inline
|
||||
|
||||
: SSL_CTRL_GET_MAX_CERT_LIST 50 ; inline
|
||||
: SSL_CTRL_SET_MAX_CERT_LIST 51 ; inline
|
||||
|
||||
: SSL_ERROR_NONE 0 ; inline
|
||||
: SSL_ERROR_SSL 1 ; inline
|
||||
: SSL_ERROR_WANT_READ 2 ; inline
|
||||
|
|
@ -55,8 +87,9 @@ IN: openssl.libssl
|
|||
} ;
|
||||
|
||||
TYPEDEF: void* ssl-method
|
||||
TYPEDEF: void* ssl-ctx
|
||||
TYPEDEF: void* ssl-pointer
|
||||
TYPEDEF: void* SSL_CTX*
|
||||
TYPEDEF: void* SSL_SESSION*
|
||||
TYPEDEF: void* SSL*
|
||||
|
||||
LIBRARY: libssl
|
||||
|
||||
|
|
@ -64,7 +97,7 @@ LIBRARY: libssl
|
|||
! ssl.h
|
||||
! ===============================================
|
||||
|
||||
FUNCTION: char* SSL_get_version ( ssl-pointer ssl ) ;
|
||||
FUNCTION: char* SSL_get_version ( SSL* ssl ) ;
|
||||
|
||||
! Maps OpenSSL errors to strings
|
||||
FUNCTION: void SSL_load_error_strings ( ) ;
|
||||
|
|
@ -94,42 +127,50 @@ FUNCTION: ssl-method TLSv1_server_method ( ) ;
|
|||
FUNCTION: ssl-method TLSv1_method ( ) ;
|
||||
|
||||
! Creates the context
|
||||
FUNCTION: ssl-ctx SSL_CTX_new ( ssl-method method ) ;
|
||||
FUNCTION: SSL_CTX* SSL_CTX_new ( ssl-method method ) ;
|
||||
|
||||
! Load the certificates and private keys into the SSL_CTX
|
||||
FUNCTION: int SSL_CTX_use_certificate_chain_file ( ssl-ctx ctx,
|
||||
FUNCTION: int SSL_CTX_use_certificate_chain_file ( SSL_CTX* ctx,
|
||||
char* file ) ; ! PEM type
|
||||
|
||||
FUNCTION: ssl-pointer SSL_new ( ssl-ctx ctx ) ;
|
||||
FUNCTION: SSL* SSL_new ( SSL_CTX* ctx ) ;
|
||||
|
||||
FUNCTION: int SSL_set_fd ( ssl-pointer ssl, int fd ) ;
|
||||
FUNCTION: int SSL_set_fd ( SSL* ssl, int fd ) ;
|
||||
|
||||
FUNCTION: void SSL_set_bio ( ssl-pointer ssl, void* rbio, void* wbio ) ;
|
||||
FUNCTION: void SSL_set_bio ( SSL* ssl, void* rbio, void* wbio ) ;
|
||||
|
||||
FUNCTION: int SSL_get_error ( ssl-pointer ssl, int ret ) ;
|
||||
FUNCTION: int SSL_set_session ( SSL* to, SSL_SESSION* session ) ;
|
||||
|
||||
FUNCTION: void SSL_set_connect_state ( ssl-pointer ssl ) ;
|
||||
FUNCTION: int SSL_get_error ( SSL* ssl, int ret ) ;
|
||||
|
||||
FUNCTION: void SSL_set_accept_state ( ssl-pointer ssl ) ;
|
||||
FUNCTION: void SSL_set_connect_state ( SSL* ssl ) ;
|
||||
|
||||
FUNCTION: int SSL_connect ( ssl-pointer ssl ) ;
|
||||
FUNCTION: void SSL_set_accept_state ( SSL* ssl ) ;
|
||||
|
||||
FUNCTION: int SSL_accept ( ssl-pointer ssl ) ;
|
||||
FUNCTION: int SSL_connect ( SSL* ssl ) ;
|
||||
|
||||
FUNCTION: int SSL_write ( ssl-pointer ssl, void* buf, int num ) ;
|
||||
FUNCTION: int SSL_accept ( SSL* ssl ) ;
|
||||
|
||||
FUNCTION: int SSL_read ( ssl-pointer ssl, void* buf, int num ) ;
|
||||
FUNCTION: int SSL_write ( SSL* ssl, void* buf, int num ) ;
|
||||
|
||||
FUNCTION: int SSL_shutdown ( ssl-pointer ssl ) ;
|
||||
FUNCTION: int SSL_read ( SSL* ssl, void* buf, int num ) ;
|
||||
|
||||
FUNCTION: int SSL_shutdown ( SSL* ssl ) ;
|
||||
|
||||
: SSL_SENT_SHUTDOWN 1 ;
|
||||
: SSL_RECEIVED_SHUTDOWN 2 ;
|
||||
|
||||
FUNCTION: int SSL_get_shutdown ( ssl-pointer ssl ) ;
|
||||
FUNCTION: int SSL_get_shutdown ( SSL* ssl ) ;
|
||||
|
||||
FUNCTION: void SSL_free ( ssl-pointer ssl ) ;
|
||||
FUNCTION: int SSL_CTX_set_session_id_context ( SSL_CTX* ctx, char* sid_ctx, uint len ) ;
|
||||
|
||||
FUNCTION: int SSL_want ( ssl-pointer ssl ) ;
|
||||
FUNCTION: SSL_SESSION* SSL_get1_session ( SSL* ssl ) ;
|
||||
|
||||
FUNCTION: void SSL_free ( SSL* ssl ) ;
|
||||
|
||||
FUNCTION: void SSL_SESSION_free ( SSL_SESSION* ses ) ;
|
||||
|
||||
FUNCTION: int SSL_want ( SSL* ssl ) ;
|
||||
|
||||
: SSL_NOTHING 1 ; inline
|
||||
: SSL_WRITING 2 ; inline
|
||||
|
|
@ -140,55 +181,55 @@ FUNCTION: long SSL_get_verify_result ( SSL* ssl ) ;
|
|||
|
||||
FUNCTION: X509* SSL_get_peer_certificate ( SSL* s ) ;
|
||||
|
||||
FUNCTION: void SSL_CTX_free ( ssl-ctx ctx ) ;
|
||||
FUNCTION: void SSL_CTX_free ( SSL_CTX* ctx ) ;
|
||||
|
||||
FUNCTION: void RAND_seed ( void* buf, int num ) ;
|
||||
|
||||
FUNCTION: int SSL_set_cipher_list ( ssl-pointer ssl, char* str ) ;
|
||||
FUNCTION: int SSL_set_cipher_list ( SSL* ssl, char* str ) ;
|
||||
|
||||
FUNCTION: int SSL_use_RSAPrivateKey_file ( ssl-pointer ssl, char* str ) ;
|
||||
FUNCTION: int SSL_use_RSAPrivateKey_file ( SSL* ssl, char* str ) ;
|
||||
|
||||
FUNCTION: int SSL_CTX_use_RSAPrivateKey_file ( ssl-ctx ctx, int type ) ;
|
||||
FUNCTION: int SSL_CTX_use_RSAPrivateKey_file ( SSL_CTX* ctx, int type ) ;
|
||||
|
||||
FUNCTION: int SSL_use_certificate_file ( ssl-pointer ssl,
|
||||
FUNCTION: int SSL_use_certificate_file ( SSL* ssl,
|
||||
char* str, int type ) ;
|
||||
|
||||
FUNCTION: int SSL_CTX_load_verify_locations ( ssl-ctx ctx, char* CAfile,
|
||||
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 ) ;
|
||||
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_verify ( SSL_CTX* ctx, int mode, void* callback ) ;
|
||||
|
||||
FUNCTION: void SSL_CTX_set_client_CA_list ( ssl-ctx ctx, ssl-pointer list ) ;
|
||||
FUNCTION: void SSL_CTX_set_client_CA_list ( SSL_CTX* ctx, SSL* list ) ;
|
||||
|
||||
FUNCTION: ssl-pointer SSL_load_client_CA_file ( char* file ) ;
|
||||
FUNCTION: SSL* SSL_load_client_CA_file ( char* file ) ;
|
||||
|
||||
! Used to manipulate settings of the SSL_CTX and SSL objects.
|
||||
! This function should never be called directly
|
||||
FUNCTION: long SSL_CTX_ctrl ( ssl-ctx ctx, int cmd, long larg, void* parg ) ;
|
||||
FUNCTION: long SSL_CTX_ctrl ( SSL_CTX* ctx, int cmd, long larg, void* parg ) ;
|
||||
|
||||
FUNCTION: void SSL_CTX_set_default_passwd_cb ( ssl-ctx ctx, void* cb ) ;
|
||||
FUNCTION: void SSL_CTX_set_default_passwd_cb ( SSL_CTX* ctx, void* cb ) ;
|
||||
|
||||
FUNCTION: void SSL_CTX_set_default_passwd_cb_userdata ( ssl-ctx ctx,
|
||||
FUNCTION: void SSL_CTX_set_default_passwd_cb_userdata ( SSL_CTX* ctx,
|
||||
void* u ) ;
|
||||
|
||||
FUNCTION: int SSL_CTX_use_PrivateKey_file ( ssl-ctx ctx, char* file,
|
||||
FUNCTION: int SSL_CTX_use_PrivateKey_file ( SSL_CTX* ctx, char* file,
|
||||
int type ) ;
|
||||
|
||||
! Sets the maximum depth for the allowed ctx certificate chain verification
|
||||
FUNCTION: void SSL_CTX_set_verify_depth ( ssl-ctx ctx, int depth ) ;
|
||||
FUNCTION: void SSL_CTX_set_verify_depth ( SSL_CTX* ctx, int depth ) ;
|
||||
|
||||
! Sets DH parameters to be used to be dh.
|
||||
! The key is inherited by all ssl objects created from ctx
|
||||
FUNCTION: void SSL_CTX_set_tmp_dh_callback ( ssl-ctx ctx, void* dh ) ;
|
||||
FUNCTION: void SSL_CTX_set_tmp_dh_callback ( SSL_CTX* ctx, void* dh ) ;
|
||||
|
||||
FUNCTION: void SSL_CTX_set_tmp_rsa_callback ( ssl-ctx ctx, void* rsa ) ;
|
||||
FUNCTION: void SSL_CTX_set_tmp_rsa_callback ( SSL_CTX* ctx, void* rsa ) ;
|
||||
|
||||
FUNCTION: void* BIO_f_ssl ( ) ;
|
||||
|
||||
|
|
@ -198,6 +239,23 @@ FUNCTION: void* BIO_f_ssl ( ) ;
|
|||
: SSL_CTX_set_tmp_dh ( ctx dh -- n )
|
||||
>r SSL_CTRL_SET_TMP_DH 0 r> SSL_CTX_ctrl ;
|
||||
|
||||
: SSL_CTX_set_session_cache_mode ( ctx mode -- n )
|
||||
>r SSL_CTRL_SET_SESS_CACHE_MODE r> f SSL_CTX_ctrl ;
|
||||
|
||||
: SSL_SESS_CACHE_OFF HEX: 0000 ; inline
|
||||
: SSL_SESS_CACHE_CLIENT HEX: 0001 ; inline
|
||||
: SSL_SESS_CACHE_SERVER HEX: 0002 ; inline
|
||||
|
||||
: SSL_SESS_CACHE_BOTH ( -- n )
|
||||
{ SSL_SESS_CACHE_CLIENT SSL_SESS_CACHE_SERVER } flags ; inline
|
||||
|
||||
: SSL_SESS_CACHE_NO_AUTO_CLEAR HEX: 0080 ; inline
|
||||
: SSL_SESS_CACHE_NO_INTERNAL_LOOKUP HEX: 0100 ; inline
|
||||
: SSL_SESS_CACHE_NO_INTERNAL_STORE HEX: 0200 ; inline
|
||||
|
||||
: SSL_SESS_CACHE_NO_INTERNAL ( -- n )
|
||||
{ SSL_SESS_CACHE_NO_INTERNAL_LOOKUP SSL_SESS_CACHE_NO_INTERNAL_STORE } flags ; inline
|
||||
|
||||
! ===============================================
|
||||
! x509.h
|
||||
! ===============================================
|
||||
|
|
|
|||
|
|
@ -2,8 +2,8 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors byte-arrays kernel debugger sequences namespaces math
|
||||
math.order combinators init alien alien.c-types alien.strings libc
|
||||
continuations destructors debugger inspector splitting
|
||||
locals unicode.case
|
||||
continuations destructors debugger inspector splitting assocs
|
||||
random math.parser locals unicode.case
|
||||
openssl.libcrypto openssl.libssl
|
||||
io.backend io.ports io.files io.encodings.8-bit io.sockets.secure
|
||||
io.timeouts ;
|
||||
|
|
@ -48,7 +48,13 @@ SYMBOL: ssl-initialized?
|
|||
|
||||
[ f ssl-initialized? set-global ] "openssl" add-init-hook
|
||||
|
||||
TUPLE: openssl-context < secure-context aliens ;
|
||||
TUPLE: openssl-context < secure-context aliens sessions ;
|
||||
|
||||
: set-session-cache ( ctx -- )
|
||||
handle>>
|
||||
[ SSL_SESS_CACHE_BOTH SSL_CTX_set_session_cache_mode ssl-error ]
|
||||
[ 32 random-bits >hex dup length SSL_CTX_set_session_id_context ssl-error ]
|
||||
bi ;
|
||||
|
||||
: load-certificate-chain ( ctx -- )
|
||||
dup config>> key-file>> [
|
||||
|
|
@ -133,12 +139,20 @@ M: rsa dispose* handle>> RSA_free ;
|
|||
] bi
|
||||
SSL_CTX_set_tmp_rsa ssl-error ;
|
||||
|
||||
: <openssl-context> ( config ctx -- context )
|
||||
openssl-context new
|
||||
swap >>handle
|
||||
swap >>config
|
||||
V{ } clone >>aliens
|
||||
H{ } clone >>sessions ;
|
||||
|
||||
M: openssl <secure-context> ( config -- context )
|
||||
maybe-init-ssl
|
||||
[
|
||||
dup method>> ssl-method SSL_CTX_new
|
||||
dup ssl-error f V{ } clone openssl-context boa |dispose
|
||||
dup ssl-error <openssl-context> |dispose
|
||||
{
|
||||
[ set-session-cache ]
|
||||
[ load-certificate-chain ]
|
||||
[ set-default-password ]
|
||||
[ use-private-key-file ]
|
||||
|
|
@ -152,8 +166,9 @@ M: openssl <secure-context> ( config -- context )
|
|||
|
||||
M: openssl-context dispose*
|
||||
[ aliens>> [ free ] each ]
|
||||
[ sessions>> values [ SSL_SESSION_free ] each ]
|
||||
[ handle>> SSL_CTX_free ]
|
||||
bi ;
|
||||
tri ;
|
||||
|
||||
TUPLE: ssl-handle file handle connected disposed ;
|
||||
|
||||
|
|
@ -204,4 +219,11 @@ M: openssl check-certificate ( host ssl -- )
|
|||
2bi
|
||||
] [ 2drop ] if ;
|
||||
|
||||
: get-session ( addrspec -- session/f )
|
||||
current-secure-context sessions>> at
|
||||
dup expired? [ drop f ] when ;
|
||||
|
||||
: save-session ( session addrspec -- )
|
||||
current-secure-context sessions>> set-at ;
|
||||
|
||||
openssl secure-socket-backend set-global
|
||||
|
|
|
|||
Loading…
Reference in New Issue