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
parent
8b6ae235ab
commit
2a5f5ca6b9
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 [
|
||||||
|
|
Loading…
Reference in New Issue