From 74e76b6f975b06a4bf97cbedefafb058ba660bd2 Mon Sep 17 00:00:00 2001 From: Markus Triska Date: Sun, 5 Dec 2021 16:33:44 +0100 Subject: [PATCH 1/4] MODIFIED: Remove TLS-related predicates from library(sockets). They will become available in a new library, library(tls). --- README.md | 4 --- src/clause_types.rs | 2 +- src/lib/sockets.pl | 85 +++------------------------------------------ 3 files changed, 5 insertions(+), 86 deletions(-) diff --git a/README.md b/README.md index f5d83fae..b22a00d8 100644 --- a/README.md +++ b/README.md @@ -537,10 +537,6 @@ The modules that ship with Scryer Prolog are also called is often used together with [`library(sgml)`](src/lib/sgml.pl). * [`sockets`](src/lib/sockets.pl) Predicates for opening and accepting TCP connections as streams. - TLS negotiation is performed via the option `tls(true)` in - `socket_client_open/3`, yielding secure encrypted connections. - TLS *servers* can be created with `tls_server_context/2` and - `tls_server_negotiate/3`. * [`os`](src/lib/os.pl) Predicates for reasoning about environment variables. * [`iso_ext`](src/lib/iso_ext.pl) diff --git a/src/clause_types.rs b/src/clause_types.rs index e6ef05a6..5419eb85 100644 --- a/src/clause_types.rs +++ b/src/clause_types.rs @@ -742,7 +742,7 @@ impl SystemClauseType { ("$set_seed", 1) => Some(SystemClauseType::SetSeed), ("$skip_max_list", 4) => Some(SystemClauseType::SkipMaxList), ("$sleep", 1) => Some(SystemClauseType::Sleep), - ("$socket_client_open", 8) => Some(SystemClauseType::SocketClientOpen), + ("$socket_client_open", 7) => Some(SystemClauseType::SocketClientOpen), ("$socket_server_open", 3) => Some(SystemClauseType::SocketServerOpen), ("$socket_server_accept", 7) => Some(SystemClauseType::SocketServerAccept), ("$socket_server_close", 1) => Some(SystemClauseType::SocketServerClose), diff --git a/src/lib/sockets.pl b/src/lib/sockets.pl index ed1ba1b0..e2b1b723 100644 --- a/src/lib/sockets.pl +++ b/src/lib/sockets.pl @@ -3,24 +3,9 @@ socket_server_open/2, socket_server_accept/4, socket_server_close/1, - tls_server_context/2, % tls_server_context(-Context, +Options) - tls_server_negotiate/3, % tls_server_negotiate(+Context, +Stream0, -Stream) current_hostname/1]). :- use_module(library(error)). -:- use_module(library(lists)). - -% a client can negotiate a TLS connection by specifying the option -% tls(true) in socket_client_open/3 - -parse_socket_options_(tls(TLS), tls-TLS) :- - must_be(boolean, TLS), !. -parse_socket_options_(Option, OptionPair) :- - builtins:parse_stream_options_(Option, OptionPair). - -parse_socket_options(Options, OptionValues, Stub) :- - DefaultOptions = [alias-[], eof_action-eof_code, reposition-false, tls-false, type-text], - builtins:parse_options_list(Options, sockets:parse_socket_options_, DefaultOptions, OptionValues, Stub). socket_client_open(Addr, Stream, Options) :- ( var(Addr) -> @@ -37,10 +22,10 @@ socket_client_open(Addr, Stream, Options) :- ; throw(error(type_error(socket_address, Addr), socket_client_open/3)) ), - parse_socket_options(Options, - [Alias, EOFAction, Reposition, TLS, Type], - socket_client_open/3), - '$socket_client_open'(Address, Port, Stream, Alias, EOFAction, Reposition, Type, TLS). + builtins:parse_stream_options(Options, + [Alias, EOFAction, Reposition, Type], + socket_client_open/3), + '$socket_client_open'(Address, Port, Stream, Alias, EOFAction, Reposition, Type). socket_server_open(Addr, ServerSocket) :- @@ -70,65 +55,3 @@ socket_server_close(ServerSocket) :- current_hostname(HostName) :- '$current_hostname'(HostName). - -/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - TLS Servers - =========== - - Use tls_server_context/2 to create a TLS context, for example with: - - tls_server_context(Context, [pkcs12(Chars)]) - - where Chars is a list of characters with the contents of a - DER-formatted PKCS #12 archive. The option password(Ps) can be used - to specify the password Ps (also a string) for decrypting the key. - On some versions of OSX, and potentially also on other platforms, - empty passwords are not supported. - - The archive should contain a leaf certificate and its private key, - as well any intermediate certificates that should be sent to - clients to allow them to build a chain to a trusted root. The chain - certificates should be in order from the leaf certificate towards - the root. - - PKCS #12 archives typically have the file extension .p12 or .pfx, - and can be created with the OpenSSL pkcs12 tool: - - $ openssl pkcs12 -export -out identity.pfx \ - -inkey key.pem -in cert.pem -certfile chain_certs.pem - - - You can use phrase_from_file/3 from library(pio) and seq//1 from - library(dcgs) to read the contents of "identity.pfx" into a string: - - phrase_from_file(seq(Chars), "identity.pfx", [type(binary)]) - - The obtained context should be treated as an opaque Prolog term. - - Using the context and an existing stream S0 (for example, the - result of socket_server_accept/4), a TLS stream S can be negotiated - by a Prolog-based server with: - - tls_server_negotiate(Context, S0, S) - - S will be an encrypted and authenticated stream with the client. - - The advantage of separating the creation of the server context from - negotiating a connection is that the context can be created only - once, and quickly cloned for every incoming connection. This is - currently not implemented: In the present implementation, a new context - is created for every connection, using the specified parameters. -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ - -tls_server_context(tls_context(Cert,Password), Options) :- - ( member(pcks12(Cert), Options) -> - must_be(chars, Cert) - ; domain_error(contains_pcks12, Options, tls_server_context/2) - ), - ( member(password(Password), Options) -> - must_be(chars, Password) - ; Password = "" - ). - -tls_server_negotiate(tls_context(Cert,Password), S0, S) :- - '$tls_accept_client'(Cert, Password, S0, S). From 7e8a635e7eb41e11058703784a08c9810ce0a00e Mon Sep 17 00:00:00 2001 From: Markus Triska Date: Sun, 5 Dec 2021 17:11:38 +0100 Subject: [PATCH 2/4] implement tls_client_negotiate/3 for explicit negotiation --- src/clause_types.rs | 3 ++ src/machine/system_calls.rs | 71 +++++++++++++++++-------------------- 2 files changed, 35 insertions(+), 39 deletions(-) diff --git a/src/clause_types.rs b/src/clause_types.rs index 5419eb85..cb654867 100644 --- a/src/clause_types.rs +++ b/src/clause_types.rs @@ -274,6 +274,7 @@ pub(crate) enum SystemClauseType { SocketServerAccept, SocketServerClose, TLSAcceptClient, + TLSClientConnect, Succeed, TermAttributedVariables, TermVariables, @@ -565,6 +566,7 @@ impl SystemClauseType { &SystemClauseType::SocketServerAccept => clause_name!("$socket_server_accept"), &SystemClauseType::SocketServerClose => clause_name!("$socket_server_close"), &SystemClauseType::TLSAcceptClient => clause_name!("$tls_accept_client"), + &SystemClauseType::TLSClientConnect => clause_name!("$tls_client_connect"), &SystemClauseType::Succeed => clause_name!("$succeed"), &SystemClauseType::TermAttributedVariables => { clause_name!("$term_attributed_variables") @@ -747,6 +749,7 @@ impl SystemClauseType { ("$socket_server_accept", 7) => Some(SystemClauseType::SocketServerAccept), ("$socket_server_close", 1) => Some(SystemClauseType::SocketServerClose), ("$tls_accept_client", 4) => Some(SystemClauseType::TLSAcceptClient), + ("$tls_client_connect", 3) => Some(SystemClauseType::TLSClientConnect), ("$store_global_var", 2) => Some(SystemClauseType::StoreGlobalVar), ("$store_backtrackable_global_var", 2) => { Some(SystemClauseType::StoreBacktrackableGlobalVar) diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs index 960cc361..0505e138 100644 --- a/src/machine/system_calls.rs +++ b/src/machine/system_calls.rs @@ -4176,45 +4176,7 @@ impl MachineState { Ok(tcp_stream) => { let socket_addr = clause_name!(socket_addr, self.atom_tbl); - let mut stream = { - let tls = match self.store(self.deref(self[temp_v!(8)])) { - Addr::Con(h) if self.heap.atom_at(h) => { - if let HeapCellValue::Atom(ref atom, _) = &self.heap[h] { - atom.as_str() - } else { - unreachable!() - } - } - _ => { - unreachable!() - } - }; - - match tls { - "false" => Stream::from_tcp_stream(socket_addr, tcp_stream), - "true" => { - let connector = TlsConnector::new().unwrap(); - let stream = Stream::from_tcp_stream(socket_addr, tcp_stream); - let stream = - match connector.connect(socket_atom.as_str(), stream) { - Ok(tls_stream) => tls_stream, - Err(_) => { - return Err(self.open_permission_error( - addr, - "socket_client_open", - 3, - )); - } - }; - - let addr = clause_name!("TLS".to_string(), self.atom_tbl); - Stream::from_tls_stream(addr, stream) - } - _ => { - unreachable!() - } - } - }; + let mut stream = Stream::from_tcp_stream(socket_addr, tcp_stream); *stream.options_mut() = options; @@ -4418,6 +4380,37 @@ impl MachineState { } } } + &SystemClauseType::TLSClientConnect => { + let hostname = self.heap_pstr_iter(self[temp_v!(1)]).to_string(); + + let stream0 = self.get_stream_or_alias( + self[temp_v!(2)], + &indices.stream_aliases, + "tls_client_negotiate", + 3, + )?; + + let connector = TlsConnector::new().unwrap(); + let stream = + match connector.connect(&hostname, stream0) { + Ok(tls_stream) => tls_stream, + Err(_) => { + return Err(self.open_permission_error( + self[temp_v!(1)], + "tls_client_negotiate", + 3, + )); + } + }; + + let addr = clause_name!("TLS".to_string(), self.atom_tbl); + let stream = Stream::from_tls_stream(addr, stream); + indices.streams.insert(stream.clone()); + + let stream = self.heap.to_unifiable(HeapCellValue::Stream(stream)); + let stream_addr = self.store(self.deref(self[temp_v!(3)])); + self.bind(stream_addr.as_var().unwrap(), stream); + } &SystemClauseType::TLSAcceptClient => { let pkcs12 = self.string_encoding_bytes(1, "octet"); let password = self.heap_pstr_iter(self[temp_v!(2)]).to_string(); From 538085169aba6fa9cbf737fae10f512790bdd62b Mon Sep 17 00:00:00 2001 From: Markus Triska Date: Sun, 5 Dec 2021 16:46:52 +0100 Subject: [PATCH 3/4] ADDED: library(tls), providing all predicates for TLS connections. The currently available predicates for TLS-connections can be extended with predicates to load and reason about certificates etc. --- README.md | 2 + src/lib/tls.pl | 110 +++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 112 insertions(+) create mode 100644 src/lib/tls.pl diff --git a/README.md b/README.md index b22a00d8..09878933 100644 --- a/README.md +++ b/README.md @@ -550,6 +550,8 @@ The modules that ship with Scryer Prolog are also called ECDH key exchange over Curve25519 (X25519), authenticated symmetric encryption with ChaCha20-Poly1305, and reasoning about elliptic curves. * [`uuid`](src/lib/uuid.pl) UUIDv4 generation and hex representation +* [`tls`](src/lib/tls.pl) + Predicates for negotiating TLS connections explicitly. To use predicates provided by the `lists` library, write: diff --git a/src/lib/tls.pl b/src/lib/tls.pl new file mode 100644 index 00000000..3fae7aeb --- /dev/null +++ b/src/lib/tls.pl @@ -0,0 +1,110 @@ +/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + Negotiation of TLS connections. + Written Dec. 2021 by Markus Triska (triska@metalevel.at) + Part of Scryer Prolog. +- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ + +:- module(tls, [tls_client_context/2, % -Context, +Options + tls_client_negotiate/3, % +Context, +Stream0, -Stream + tls_server_context/2, % -Context, +Options + tls_server_negotiate/3 % +Context, +Stream0, -Stream + ]). + +:- use_module(library(lists)). +:- use_module(library(error)). + +/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + TLS Clients + =========== + + Use tls_client_context/2 to create a TLS context, for example with: + + tls_client_context(Context, [hostname("metalevel.at")]) + + Using the context and an existing stream S0 (for example, the + result of socket_client_open/3), a TLS stream S can be negotiated + with: + + tls_client_negotiate(Context, S0, S) + + S will be an encrypted and authenticated stream with the server. + + The advantage of separating the creation of the client context from + negotiating a connection is that the context can be created only once, + and quickly reused if needed. This is currently not implemented: In + the present implementation, a new internal "Connector" is created for + every connection, using the specified hostname. +- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ + +tls_client_context(tls_context(Host), Options) :- + must_be(list, Options), + ( member(hostname(Host), Options) -> + must_be(chars, Host) + ; Host = "" + ). + +tls_client_negotiate(tls_context(Host), S0, S) :- + '$tls_client_connect'(Host, S0, S). + +/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + TLS Servers + =========== + + Use tls_server_context/2 to create a TLS context, for example with: + + tls_server_context(Context, [pkcs12(Chars)]) + + where Chars is a list of characters with the contents of a + DER-formatted PKCS #12 archive. The option password(Ps) can be used + to specify the password Ps (also a string) for decrypting the key. + On some versions of OSX, and potentially also on other platforms, + empty passwords are not supported. + + The archive should contain a leaf certificate and its private key, + as well any intermediate certificates that should be sent to + clients to allow them to build a chain to a trusted root. The chain + certificates should be in order from the leaf certificate towards + the root. + + PKCS #12 archives typically have the file extension .p12 or .pfx, + and can be created with the OpenSSL pkcs12 tool: + + $ openssl pkcs12 -export -out identity.pfx \ + -inkey key.pem -in cert.pem -certfile chain_certs.pem + + + You can use phrase_from_file/3 from library(pio) and seq//1 from + library(dcgs) to read the contents of "identity.pfx" into a string: + + phrase_from_file(seq(Chars), "identity.pfx", [type(binary)]) + + The obtained context should be treated as an opaque Prolog term. + + Using the context and an existing stream S0 (for example, the + result of socket_server_accept/4), a TLS stream S can be negotiated + by a Prolog-based server with: + + tls_server_negotiate(Context, S0, S) + + S will be an encrypted and authenticated stream with the client. + + The advantage of separating the creation of the server context from + negotiating a connection is that the context can be created only + once, and quickly cloned for every incoming connection. This is + currently not implemented: In the present implementation, a new context + is created for every connection, using the specified parameters. +- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ + +tls_server_context(tls_context(Cert,Password), Options) :- + ( member(pcks12(Cert), Options) -> + must_be(chars, Cert) + ; domain_error(contains_pcks12, Options, tls_server_context/2) + ), + ( member(password(Password), Options) -> + must_be(chars, Password) + ; Password = "" + ). + +tls_server_negotiate(tls_context(Cert,Password), S0, S) :- + '$tls_accept_client'(Cert, Password, S0, S). + From dc5e935ecd47485e9d29bb425c8b7c71288772c2 Mon Sep 17 00:00:00 2001 From: Markus Triska Date: Sun, 5 Dec 2021 17:28:00 +0100 Subject: [PATCH 4/4] use newly available predicates from library(tls) for HTTPS --- src/lib/http/http_open.pl | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/lib/http/http_open.pl b/src/lib/http/http_open.pl index 60e88608..6d720f1b 100644 --- a/src/lib/http/http_open.pl +++ b/src/lib/http/http_open.pl @@ -1,5 +1,5 @@ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Written June 2020 by Markus Triska (triska@metalevel.at) + Written 2020, 2021 by Markus Triska (triska@metalevel.at) Part of Scryer Prolog. http_open(+Address, -Stream, +Options) @@ -29,6 +29,7 @@ :- use_module(library(charsio)). :- use_module(library(dcgs)). :- use_module(library(lists), [member/2]). +:- use_module(library(tls)). http_open(Address, Stream, Options) :- must_be(list, Options), @@ -74,7 +75,10 @@ chars_host_url(Cs, Host, [/|Us]) :- atom_chars(Host, Hs). connect(https, Host, Stream) :- - socket_client_open(Host:443, Stream, [tls(true)]). + socket_client_open(Host:443, Stream0, []), + atom_chars(Host, HostChars), + tls_client_context(Context, [hostname(HostChars)]), + tls_client_negotiate(Context, Stream0, Stream). connect(http, Host, Stream) :- socket_client_open(Host:80, Stream, []).