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 )
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 )
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 )
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
{ } [
<test-secure-config> [ ] with-secure-context
[ ] with-test-context
] 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
tools.test ;
USING: destructors kernel math namespaces openssl openssl.libssl
sequences tools.test ;
IN: openssl.libssl.tests
maybe-init-ssl
@ -37,18 +37,26 @@ maybe-init-ssl
] unit-test
! Test setting options
{ 3 } [
{ t } [
[
new-tls1-ctx tls-opts [ [ set-opt ] [ has-opt ] 2bi ] with map
[ t = ] count
] with-destructors
ssl-new-api? get-global 0 3 ? =
] unit-test
! 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 {
SSL_state_string_long
SSL_rstate_string_long
SSL_want
SSL_get_peer_certificate

View File

@ -1,11 +1,13 @@
! Copyright (C) 2007, 2008, Slava Pestov, Elie CHAFTARI.
! See http://factorcode.org/license.txt for BSD license.
USING: init kernel namespaces openssl.libcrypto openssl.libssl
sequences ;
USING: alien.libraries init kernel math namespaces openssl.libcrypto
openssl.libssl sequences ;
IN: openssl
! This code is based on http://www.rtfm.com/openssl-examples/
SYMBOLS: ssl-initialized? ssl-new-api? ;
SINGLETON: openssl
: (ssl-error-string) ( n -- string )
@ -20,12 +22,22 @@ SINGLETON: openssl
: ssl-error ( obj -- )
{ f 0 } member? [ (ssl-error) ] when ;
: init-ssl ( -- )
: init-old-api ( -- )
SSL_library_init ssl-error
SSL_load_error_strings
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 ( -- )
ssl-initialized? get-global [