Merge pull request #1132 from triska/tls_library

ADDED: library(tls) for negotiating TLS connections

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)
@@ -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:
 

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")
@@ -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)

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, []).
 

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,
+    builtins:parse_stream_options(Options,
-                         [Alias, EOFAction, Reposition, TLS, Type],
+                                  [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).

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).
+

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 mut stream = Stream::from_tcp_stream(socket_addr, tcp_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!()
-                                }
-                            }
-                        };
 
                         *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();