]> gitweb.factorcode.org Git - factor.git/commitdiff
openssl: use TLS_method() to get the highest supported version
authorDoug Coleman <doug.coleman@gmail.com>
Thu, 20 Apr 2023 00:29:47 +0000 (19:29 -0500)
committerDoug Coleman <doug.coleman@gmail.com>
Thu, 20 Apr 2023 00:29:47 +0000 (19:29 -0500)
TLSv1_1_method-style functions are deprecated

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

index ce34d86d771971d9cc66197ebe804a4f2375ecd9..ae467bae748b736a74bb1cd998614bb1086394ad 100644 (file)
@@ -12,6 +12,7 @@ unicode ;
 IN: io.sockets.secure.openssl
 
 GENERIC: ssl-method ( symbol -- method )
+M: TLS ssl-method drop TLS_method ;
 M: TLSv1 ssl-method drop TLSv1_method ;
 M: TLSv1.1 ssl-method drop TLSv1_1_method ;
 M: TLSv1.2 ssl-method drop TLSv1_2_method ;
index f2da80eac916488645edb68de8d75bffb472ef37..601ec22b9e8428b0fa97fba67201ab7dae63a231 100644 (file)
@@ -4,6 +4,10 @@ IN: io.sockets.secure
 HELP: secure-socket-timeout
 { $var-description "Timeout for operations not associated with a constructed port instance, such as SSL handshake and shutdown. Represented as a " { $link duration } "." } ;
 
+HELP: TLS
+{ $description "Possible value for the " { $snippet "method" } " slot of a " { $link secure-config } "."
+$nl
+"TLS uses the newest protocol (TLSv1.3 as of 4/20/2023) for secure socket communications." } ;
 
 HELP: TLSv1
 { $description "Possible value for the " { $snippet "method" } " slot of a " { $link secure-config } "."
@@ -18,16 +22,17 @@ $nl
 HELP: TLSv1.2
 { $description "Possible value for the " { $snippet "method" } " slot of a " { $link secure-config } "."
 $nl
-"TLSv1.2 is the newest protocol for secure socket communications." } ;
+"TLSv1.2 is an older protocol for secure socket communications." } ;
 
 ARTICLE: "ssl-methods" "SSL/TLS methods"
 "The " { $snippet "method" } " slot of a " { $link secure-config } " can be set to one of the following values:"
 { $subsections
+    TLS
     TLSv1
     TLSv1.1
     TLSv1.2
 }
-"The default value is " { $link TLSv1.2 } "." ;
+"The default value is " { $link TLS } "." ;
 
 HELP: secure-config
 { $class-description "Instances represent secure socket configurations." } ;
index 3d96234df1c3fef87150c5f7f458b87e8b1d7447..2827c9d60c7f0d835a2a74924b8b6cdda73c8eca 100644 (file)
@@ -17,12 +17,13 @@ HOOK: ssl-certificate-verification-supported? secure-socket-backend ( -- ? )
 M: object ssl-supported? f ;
 M: object ssl-certificate-verification-supported? f ;
 
-SINGLETONS: TLSv1 TLSv1.1 TLSv1.2 ;
+SINGLETONS: TLSv1 TLSv1.1 TLSv1.2 TLS ;
 
 ERROR: no-tls-supported ;
 
 MEMO: best-tls-method ( -- class )
     {
+        { [ "TLS_method" "libssl" dlsym? ] [ TLS ] }
         { [ "TLSv1_2_method" "libssl" dlsym? ] [ TLSv1.2 ] }
         { [ "TLSv1_1_method" "libssl" dlsym? ] [ TLSv1.1 ] }
         { [ "TLSv1_method" "libssl" dlsym? ] [ TLSv1 ] }
index ca5e8ff2268288f63731b27eec36a869ca578da6..dee418066eb415a8d8e19ab2a8be91d3c10dff28 100644 (file)
@@ -22,8 +22,8 @@ maybe-init-ssl
 : new-ctx ( method -- ctx )
     SSL_CTX_new &SSL_CTX_free ;
 
-: new-tls1-ctx ( -- ctx )
-    TLSv1_client_method new-ctx ;
+: new-tls-ctx ( -- ctx )
+    TLS_client_method new-ctx ;
 
 : new-ssl ( ctx -- ssl )
     SSL_new &SSL_free ;
@@ -32,14 +32,14 @@ maybe-init-ssl
     { f f f }
 } [
     [
-        new-tls1-ctx tls-opts [ has-opt ] with map
+        new-tls-ctx tls-opts [ has-opt ] with map
     ] with-destructors
 ] unit-test
 
 ! Test setting options
 { t } [
     [
-        new-tls1-ctx tls-opts [ [ set-opt ] [ has-opt ] 2bi ] with map
+        new-tls-ctx tls-opts [ [ set-opt ] [ has-opt ] 2bi ] with map
         [ t = ] count
     ] with-destructors
     ssl-new-api? get-global 0 3 ? =
@@ -47,7 +47,7 @@ maybe-init-ssl
 
 ! Initial state
 { t } [
-    [ new-tls1-ctx new-ssl SSL_state_string_long ] with-destructors
+    [ new-tls-ctx new-ssl SSL_state_string_long ] with-destructors
     ssl-new-api? get-global
     "before SSL initialization" "before/connect initialization" ? =
 ] unit-test
@@ -56,7 +56,7 @@ maybe-init-ssl
     { "read header" 1 }
 } [
     [
-        new-tls1-ctx new-ssl {
+        new-tls-ctx new-ssl {
             SSL_rstate_string_long
             SSL_want
         } [ execute( x -- x ) ] with map
@@ -65,6 +65,6 @@ maybe-init-ssl
 
 { f } [
     [
-        new-tls1-ctx new-ssl get-ssl-peer-certificate
+        new-tls-ctx new-ssl get-ssl-peer-certificate
     ] with-destructors
 ] unit-test
index d5eec61f37368f903232699ae93c09b7fd689bd7..fd9b0244b3c7fe37f192549e1721f911495cb087 100644 (file)
@@ -400,7 +400,7 @@ FUNCTION: int SSL_library_init ( )
 FUNCTION: void SSL_load_error_strings ( )
 ! ------------------------------------------------------------------------------
 
-! Sets the default SSL version
+! Sets the default SSL version (deprecated)
 FUNCTION: ssl-method SSLv2_client_method ( )
 FUNCTION: ssl-method SSLv23_client_method ( )
 FUNCTION: ssl-method SSLv23_server_method ( )
@@ -413,6 +413,10 @@ FUNCTION: ssl-method TLSv1_server_method ( )
 FUNCTION: ssl-method TLSv1_method ( )
 FUNCTION: ssl-method TLSv1_1_method ( )
 FUNCTION: ssl-method TLSv1_2_method ( )
+! Preferred, uses TLSv1.3 if available
+FUNCTION: ssl-method TLS_method ( )
+FUNCTION: ssl-method TLS_client_method ( )
+FUNCTION: ssl-method TLS_server_method ( )
 
 CONSTANT: DTLS1_VERSION_MAJOR 0xfe
 CONSTANT: SSL3_VERSION_MAJOR 0x03
@@ -697,3 +701,10 @@ FUNCTION: int sk_num ( _STACK* s )
 FUNCTION: void* sk_value ( _STACK* s, int v )
 
 ! ------------------------------------------------------------------------------
+
+! For TLSv1.3
+FUNCTION: void SSL_CTX_set_ciphersuites ( SSL_CTX *ctx, char *ciphersuites )
+FUNCTION: int SSL_set_ciphersuites ( SSL *ssl, char *ciphersuites )
+FUNCTION: void SSL_set_SSL_CTX ( SSL *ssl, SSL_CTX *ctx )
+FUNCTION: int SSL_set1_host ( SSL *ssl, char *hostname )
+FUNCTION: int SSL_do_handshake ( SSL *ssl )