openssl.*,io.sockets.*: support for openssl 1.1

In the new version, a lot of c function names have changed. So a new
global ssl-new-api? is needed to know if the new or old names should be
used.
modern-harvey2
Björn Lindqvist 2017-07-01 13:41:22 +02:00
parent 8b6ae235ab
commit 2a5f5ca6b9
4 changed files with 39 additions and 11 deletions

View File

@ -337,8 +337,16 @@ M: ssl-handle dispose*
: issuer-name ( certificate -- issuer ) : issuer-name ( certificate -- issuer )
X509_get_issuer_name x509name>string ; X509_get_issuer_name x509name>string ;
: sk-value ( stack v -- obj )
ssl-new-api? get-global [ OPENSSL_sk_value ] [ sk_value ] if ;
: sk-num ( stack -- num )
ssl-new-api? get-global [ OPENSSL_sk_num ] [ sk_num ] if ;
: name-stack>sequence ( name-stack -- seq ) : name-stack>sequence ( name-stack -- seq )
dup sk_num <iota> [ sk_value GENERAL_NAME_st memory>struct ] with map ; dup sk-num <iota> [
sk-value GENERAL_NAME_st memory>struct
] with map ;
: alternative-dns-names ( certificate -- dns-names ) : alternative-dns-names ( certificate -- dns-names )
NID_subject_alt_name f f X509_get_ext_d2i NID_subject_alt_name f f X509_get_ext_d2i

View File

@ -5,7 +5,7 @@ kernel system tools.test ;
{ "hello" 24 } [ "hello" 24 <inet> "hello" <secure> [ host>> ] [ port>> ] bi ] unit-test { "hello" 24 } [ "hello" 24 <inet> "hello" <secure> [ host>> ] [ port>> ] bi ] unit-test
{ } [ { } [
<test-secure-config> [ ] with-secure-context [ ] with-test-context
] unit-test ] unit-test
{ t } [ os windows? ssl-certificate-verification-supported? or ] unit-test { t } [ os windows? ssl-certificate-verification-supported? or ] unit-test

View File

@ -1,5 +1,5 @@
USING: destructors kernel math openssl openssl.libssl sequences USING: destructors kernel math namespaces openssl openssl.libssl
tools.test ; sequences tools.test ;
IN: openssl.libssl.tests IN: openssl.libssl.tests
maybe-init-ssl maybe-init-ssl
@ -37,18 +37,26 @@ maybe-init-ssl
] unit-test ] unit-test
! Test setting options ! Test setting options
{ 3 } [ { t } [
[ [
new-tls1-ctx tls-opts [ [ set-opt ] [ has-opt ] 2bi ] with map new-tls1-ctx tls-opts [ [ set-opt ] [ has-opt ] 2bi ] with map
[ t = ] count [ t = ] count
] with-destructors ] with-destructors
ssl-new-api? get-global 0 3 ? =
] unit-test ] unit-test
! Initial state ! Initial state
{ { "before/connect initialization" "read header" 1 f } } [ { t } [
[ new-tls1-ctx new-ssl SSL_state_string_long ] with-destructors
ssl-new-api? get-global
"before SSL initialization" "before/connect initialization" ? =
] unit-test
{
{ "read header" 1 f }
} [
[ [
new-tls1-ctx new-ssl { new-tls1-ctx new-ssl {
SSL_state_string_long
SSL_rstate_string_long SSL_rstate_string_long
SSL_want SSL_want
SSL_get_peer_certificate SSL_get_peer_certificate

View File

@ -1,11 +1,13 @@
! Copyright (C) 2007, 2008, Slava Pestov, Elie CHAFTARI. ! Copyright (C) 2007, 2008, Slava Pestov, Elie CHAFTARI.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: init kernel namespaces openssl.libcrypto openssl.libssl USING: alien.libraries init kernel math namespaces openssl.libcrypto
sequences ; openssl.libssl sequences ;
IN: openssl IN: openssl
! This code is based on http://www.rtfm.com/openssl-examples/ ! This code is based on http://www.rtfm.com/openssl-examples/
SYMBOLS: ssl-initialized? ssl-new-api? ;
SINGLETON: openssl SINGLETON: openssl
: (ssl-error-string) ( n -- string ) : (ssl-error-string) ( n -- string )
@ -20,12 +22,22 @@ SINGLETON: openssl
: ssl-error ( obj -- ) : ssl-error ( obj -- )
{ f 0 } member? [ (ssl-error) ] when ; { f 0 } member? [ (ssl-error) ] when ;
: init-ssl ( -- ) : init-old-api ( -- )
SSL_library_init ssl-error SSL_library_init ssl-error
SSL_load_error_strings SSL_load_error_strings
OpenSSL_add_all_digests ; OpenSSL_add_all_digests ;
SYMBOL: ssl-initialized? : init-new-api ( -- )
0 f OPENSSL_init_ssl ssl-error
OPENSSL_INIT_LOAD_SSL_STRINGS
OPENSSL_INIT_LOAD_CRYPTO_STRINGS bitand
f OPENSSL_init_ssl ssl-error
OPENSSL_INIT_ADD_ALL_DIGESTS f OPENSSL_init_ssl ssl-error ;
: init-ssl ( -- )
"OPENSSL_init_ssl" "libssl" dlsym? >boolean
[ ssl-new-api? set-global ]
[ [ init-new-api ] [ init-old-api ] if ] bi ;
: maybe-init-ssl ( -- ) : maybe-init-ssl ( -- )
ssl-initialized? get-global [ ssl-initialized? get-global [