diff --git a/extra/io/unix/sockets/secure/secure-tests.factor b/extra/io/unix/sockets/secure/secure-tests.factor index cbda002354..dca8fbbbc7 100644 --- a/extra/io/unix/sockets/secure/secure-tests.factor +++ b/extra/io/unix/sockets/secure/secure-tests.factor @@ -9,7 +9,7 @@ concurrency.promises byte-arrays locals calendar io.timeouts ; [ ] [ "port" set ] unit-test -: with-test-context +: with-test-context ( quot -- ) "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 ) [ "127.0.0.1" "port" get ?promise ascii drop contents ] with-secure-context ; diff --git a/extra/io/unix/sockets/secure/secure.factor b/extra/io/unix/sockets/secure/secure.factor index 946e0e7be5..a0acbebb3a 100755 --- a/extra/io/unix/sockets/secure/secure.factor +++ b/extra/io/unix/sockets/secure/secure.factor @@ -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) ; diff --git a/extra/openssl/libssl/libssl.factor b/extra/openssl/libssl/libssl.factor index 3218d67b5c..dced2e5c0c 100755 --- a/extra/openssl/libssl/libssl.factor +++ b/extra/openssl/libssl/libssl.factor @@ -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 @@ -24,11 +20,47 @@ IN: openssl.libssl : SSL_FILETYPE_ASN1 X509_FILETYPE_ASN1 ; inline : SSL_FILETYPE_PEM X509_FILETYPE_PEM ; inline -: SSL_CTRL_NEED_TMP_RSA 1 ; inline -: SSL_CTRL_SET_TMP_RSA 2 ; inline -: SSL_CTRL_SET_TMP_DH 3 ; inline -: SSL_CTRL_SET_TMP_RSA_CB 4 ; inline -: SSL_CTRL_SET_TMP_DH_CB 5 ; inline +: SSL_CTRL_NEED_TMP_RSA 1 ; inline +: SSL_CTRL_SET_TMP_RSA 2 ; inline +: SSL_CTRL_SET_TMP_DH 3 ; inline +: 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 @@ -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 ) ; +! Sets the maximum depth for the allowed ctx certificate chain verification +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 ! =============================================== diff --git a/extra/openssl/openssl.factor b/extra/openssl/openssl.factor index b2dbda7d2e..6d750bd8e0 100755 --- a/extra/openssl/openssl.factor +++ b/extra/openssl/openssl.factor @@ -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 ; +: ( config ctx -- context ) + openssl-context new + swap >>handle + swap >>config + V{ } clone >>aliens + H{ } clone >>sessions ; + M: openssl ( 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 |dispose { + [ set-session-cache ] [ load-certificate-chain ] [ set-default-password ] [ use-private-key-file ] @@ -152,8 +166,9 @@ M: openssl ( 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