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 ;
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 } "."
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." } ;
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 ] }
: 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 ;
{ 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 ? =
! 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
{ "read header" 1 }
} [
[
- new-tls1-ctx new-ssl {
+ new-tls-ctx new-ssl {
SSL_rstate_string_long
SSL_want
} [ execute( x -- x ) ] with map
{ f } [
[
- new-tls1-ctx new-ssl get-ssl-peer-certificate
+ new-tls-ctx new-ssl get-ssl-peer-certificate
] with-destructors
] unit-test
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 ( )
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
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 )