Merge pull request #1132 from triska/tls_library
ADDED: library(tls) for negotiating TLS connections
This commit is contained in:
@@ -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)
|
||||
@@ -554,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:
|
||||
|
||||
|
||||
@@ -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")
|
||||
@@ -742,11 +744,12 @@ 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),
|
||||
("$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)
|
||||
|
||||
@@ -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, []).
|
||||
|
||||
|
||||
@@ -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],
|
||||
builtins:parse_stream_options(Options,
|
||||
[Alias, EOFAction, Reposition, Type],
|
||||
socket_client_open/3),
|
||||
'$socket_client_open'(Address, Port, Stream, Alias, EOFAction, Reposition, Type, TLS).
|
||||
'$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).
|
||||
|
||||
110
src/lib/tls.pl
Normal file
110
src/lib/tls.pl
Normal file
@@ -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).
|
||||
|
||||
@@ -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();
|
||||
|
||||
Reference in New Issue
Block a user