]> gitweb.factorcode.org Git - factor.git/commitdiff
openssl.*,io.sockets.*: support for openssl 1.1
authorBjörn Lindqvist <bjourne@gmail.com>
Sat, 1 Jul 2017 11:41:22 +0000 (13:41 +0200)
committerBjörn Lindqvist <bjourne@gmail.com>
Sat, 1 Jul 2017 11:41:22 +0000 (13:41 +0200)
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.

basis/io/sockets/secure/openssl/openssl.factor
basis/io/sockets/secure/secure-tests.factor
basis/openssl/libssl/libssl-tests.factor
basis/openssl/openssl.factor

index d8e8079ec27fa0ce6ddb7934b5d9705a64130928..b22233524f7c55444dad08a2201a501cf6512881 100644 (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
index 65ca8abcd1a91fb8165a255fe4c47e59f7a4453d..294471ddaefa41c66ef123bf69de9917eca4969b 100644 (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
index c9d0b673aaa273af69674ce78fa71a2286d0e3a2..de4c4d461049b84ba97e7a1e12942b778f30e7bd 100644 (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
index 0e1a39633226dd87887ff7db88cf9302c6402f6a..8d2e6b9e8a2d03acaf85cca5fa30b16f3edded6b 100644 (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 [