From 77c04c3a14fffb44a866ba6de1787112c734978b Mon Sep 17 00:00:00 2001 From: Markus Triska Date: Thu, 2 Dec 2021 22:10:04 +0100 Subject: [PATCH] ADDED: Support for creating TLS servers. The new predicates tls_server_context/2 and tls_server_negotiate/3 can be used to negotiate TLS connections with clients for encrypted and authenticated communication. --- README.md | 2 ++ src/clause_types.rs | 3 ++ src/lib/sockets.pl | 67 +++++++++++++++++++++++++++++++++++++ src/machine/streams.rs | 4 +-- src/machine/system_calls.rs | 51 ++++++++++++++++++++++++++-- 5 files changed, 122 insertions(+), 5 deletions(-) diff --git a/README.md b/README.md index 37405b45..f5d83fae 100644 --- a/README.md +++ b/README.md @@ -539,6 +539,8 @@ The modules that ship with Scryer Prolog are also called 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 74f68ddf..e6ef05a6 100644 --- a/src/clause_types.rs +++ b/src/clause_types.rs @@ -273,6 +273,7 @@ pub(crate) enum SystemClauseType { SocketServerOpen, SocketServerAccept, SocketServerClose, + TLSAcceptClient, Succeed, TermAttributedVariables, TermVariables, @@ -563,6 +564,7 @@ impl SystemClauseType { &SystemClauseType::SocketServerOpen => clause_name!("$socket_server_open"), &SystemClauseType::SocketServerAccept => clause_name!("$socket_server_accept"), &SystemClauseType::SocketServerClose => clause_name!("$socket_server_close"), + &SystemClauseType::TLSAcceptClient => clause_name!("$tls_accept_client"), &SystemClauseType::Succeed => clause_name!("$succeed"), &SystemClauseType::TermAttributedVariables => { clause_name!("$term_attributed_variables") @@ -744,6 +746,7 @@ impl SystemClauseType { ("$socket_server_open", 3) => Some(SystemClauseType::SocketServerOpen), ("$socket_server_accept", 7) => Some(SystemClauseType::SocketServerAccept), ("$socket_server_close", 1) => Some(SystemClauseType::SocketServerClose), + ("$tls_accept_client", 4) => Some(SystemClauseType::TLSAcceptClient), ("$store_global_var", 2) => Some(SystemClauseType::StoreGlobalVar), ("$store_backtrackable_global_var", 2) => { Some(SystemClauseType::StoreBacktrackableGlobalVar) diff --git a/src/lib/sockets.pl b/src/lib/sockets.pl index dd386a3b..ed1ba1b0 100644 --- a/src/lib/sockets.pl +++ b/src/lib/sockets.pl @@ -3,11 +3,16 @@ 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) :- @@ -65,3 +70,65 @@ 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). diff --git a/src/machine/streams.rs b/src/machine/streams.rs index e1773685..69f66022 100644 --- a/src/machine/streams.rs +++ b/src/machine/streams.rs @@ -117,7 +117,7 @@ enum StreamInstance { Stderr, Stdout, TcpStream(ClauseName, TcpStream), - TlsStream(ClauseName, TlsStream), + TlsStream(ClauseName, TlsStream), } impl StreamInstance { @@ -543,7 +543,7 @@ impl Stream { } #[inline] - pub(crate) fn from_tls_stream(address: ClauseName, tls_stream: TlsStream) -> Self { + pub(crate) fn from_tls_stream(address: ClauseName, tls_stream: TlsStream) -> Self { Stream::from_inst(StreamInstance::TlsStream(address, tls_stream)) } diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs index 302e1fc5..960cc361 100644 --- a/src/machine/system_calls.rs +++ b/src/machine/system_calls.rs @@ -65,7 +65,7 @@ use openssl::nid::Nid; use sodiumoxide::crypto::scalarmult::curve25519::*; -use native_tls::TlsConnector; +use native_tls::{TlsConnector,TlsAcceptor,Identity}; use base64; use roxmltree; @@ -4194,8 +4194,9 @@ impl MachineState { "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(), tcp_stream) { + match connector.connect(socket_atom.as_str(), stream) { Ok(tls_stream) => tls_stream, Err(_) => { return Err(self.open_permission_error( @@ -4206,7 +4207,8 @@ impl MachineState { } }; - Stream::from_tls_stream(socket_addr, stream) + let addr = clause_name!("TLS".to_string(), self.atom_tbl); + Stream::from_tls_stream(addr, stream) } _ => { unreachable!() @@ -4416,6 +4418,49 @@ impl MachineState { } } } + &SystemClauseType::TLSAcceptClient => { + let pkcs12 = self.string_encoding_bytes(1, "octet"); + let password = self.heap_pstr_iter(self[temp_v!(2)]).to_string(); + let identity = + match Identity::from_pkcs12(&pkcs12, &password) { + Ok(identity) => identity, + Err(_) => { + return Err(self.open_permission_error( + self[temp_v!(1)], + "tls_server_negotiate", + 3, + )); + } + }; + + let stream0 = self.get_stream_or_alias( + self[temp_v!(3)], + &indices.stream_aliases, + "tls_server_negotiate", + 3, + )?; + + let acceptor = TlsAcceptor::new(identity).unwrap(); + + let stream = + match acceptor.accept(stream0) { + Ok(tls_stream) => tls_stream, + Err(_) => { + return Err(self.open_permission_error( + self[temp_v!(3)], + "tls_server_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!(4)])); + self.bind(stream_addr.as_var().unwrap(), stream); + } &SystemClauseType::SetStreamPosition => { let mut stream = self.get_stream_or_alias( self[temp_v!(1)], -- 2.54.0