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)
SocketServerOpen,
SocketServerAccept,
SocketServerClose,
+ TLSAcceptClient,
Succeed,
TermAttributedVariables,
TermVariables,
&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")
("$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)
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) :-
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).
Stderr,
Stdout,
TcpStream(ClauseName, TcpStream),
- TlsStream(ClauseName, TlsStream<TcpStream>),
+ TlsStream(ClauseName, TlsStream<Stream>),
}
impl StreamInstance {
}
#[inline]
- pub(crate) fn from_tls_stream(address: ClauseName, tls_stream: TlsStream<TcpStream>) -> Self {
+ pub(crate) fn from_tls_stream(address: ClauseName, tls_stream: TlsStream<Stream>) -> Self {
Stream::from_inst(StreamInstance::TlsStream(address, tls_stream))
}
use sodiumoxide::crypto::scalarmult::curve25519::*;
-use native_tls::TlsConnector;
+use native_tls::{TlsConnector,TlsAcceptor,Identity};
use base64;
use roxmltree;
"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(
}
};
- Stream::from_tls_stream(socket_addr, stream)
+ let addr = clause_name!("TLS".to_string(), self.atom_tbl);
+ Stream::from_tls_stream(addr, stream)
}
_ => {
unreachable!()
}
}
}
+ &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)],
projects / scryer-prolog.git / commitdiff