]> Repositorios git - scryer-prolog.git/commitdiff
Change to rustls and expose optional client certificate
authorJavier Sagredo <[email protected]>
Mon, 15 Jun 2026 22:09:35 +0000 (00:09 +0200)
committerJavier Sagredo <[email protected]>
Tue, 16 Jun 2026 22:23:53 +0000 (00:23 +0200)
Cargo.lock
Cargo.toml
build/instructions_template.rs
src/lib/tls.pl
src/machine/streams.rs
src/machine/system_calls.rs

index 480ba916c96a0c8047e276d8f0af64bc6515bf45..752063de8cf30132a53bdb6001ca1d78122de7f7 100644 (file)
@@ -145,6 +145,29 @@ dependencies = [
  "syn 2.0.117",
 ]
 
+[[package]]
+name = "aws-lc-rs"
+version = "1.17.0"
+source = "registry+https://github.com/rust-lang/crates.io-index"
+checksum = "5ec2f1fc3ec205783a5da9a7e6c1509cc69dedf09a1949e412c1e18469326d00"
+dependencies = [
+ "aws-lc-sys",
+ "untrusted 0.7.1",
+ "zeroize",
+]
+
+[[package]]
+name = "aws-lc-sys"
+version = "0.41.0"
+source = "registry+https://github.com/rust-lang/crates.io-index"
+checksum = "1a2f9779ce85b93ab6170dd940ad0169b5766ff848247aff13bb788b832fe3f4"
+dependencies = [
+ "cc",
+ "cmake",
+ "dunce",
+ "fs_extra",
+]
+
 [[package]]
 name = "backtrace"
 version = "0.3.76"
@@ -284,6 +307,8 @@ source = "registry+https://github.com/rust-lang/crates.io-index"
 checksum = "a1dce859f0832a7d088c4f1119888ab94ef4b5d6795d1ce05afb7fe159d79f98"
 dependencies = [
  "find-msvc-tools",
+ "jobserver",
+ "libc",
  "shlex",
 ]
 
@@ -373,6 +398,15 @@ dependencies = [
  "error-code",
 ]
 
+[[package]]
+name = "cmake"
+version = "0.1.58"
+source = "registry+https://github.com/rust-lang/crates.io-index"
+checksum = "c0f78a02292a74a88ac736019ab962ece0bc380e3f977bf72e376c5d78ff0678"
+dependencies = [
+ "cc",
+]
+
 [[package]]
 name = "colorchoice"
 version = "1.0.5"
@@ -921,6 +955,12 @@ dependencies = [
  "percent-encoding",
 ]
 
+[[package]]
+name = "fs_extra"
+version = "1.3.0"
+source = "registry+https://github.com/rust-lang/crates.io-index"
+checksum = "42703706b716c37f96a77aea830392ad231f44c9e9a67872fa5548707e11b11c"
+
 [[package]]
 name = "funty"
 version = "2.0.0"
@@ -1201,6 +1241,12 @@ version = "0.5.2"
 source = "registry+https://github.com/rust-lang/crates.io-index"
 checksum = "fc0fef456e4baa96da950455cd02c081ca953b141298e41db3fc7e36b1da849c"
 
+[[package]]
+name = "hex"
+version = "0.4.3"
+source = "registry+https://github.com/rust-lang/crates.io-index"
+checksum = "7f24254aa9a54b5c858eaee2f5bccdb46aaf0e486a595ed5fd8f86ba55232a70"
+
 [[package]]
 name = "home"
 version = "0.5.12"
@@ -1565,6 +1611,16 @@ version = "1.0.18"
 source = "registry+https://github.com/rust-lang/crates.io-index"
 checksum = "8f42a60cbdf9a97f5d2305f08a87dc4e09308d1276d28c869c684d7777685682"
 
+[[package]]
+name = "jobserver"
+version = "0.1.34"
+source = "registry+https://github.com/rust-lang/crates.io-index"
+checksum = "9afb3de4395d6b3e67a780b6de64b51c978ecf11cb9a462c66be7d4ca9039d33"
+dependencies = [
+ "getrandom 0.3.4",
+ "libc",
+]
+
 [[package]]
 name = "js-sys"
 version = "0.3.99"
@@ -1888,10 +1944,10 @@ dependencies = [
  "libc",
  "log",
  "openssl",
- "openssl-probe",
+ "openssl-probe 0.2.1",
  "openssl-sys",
  "schannel",
- "security-framework",
+ "security-framework 3.7.0",
  "security-framework-sys",
  "tempfile",
 ]
@@ -2050,6 +2106,12 @@ dependencies = [
  "syn 2.0.117",
 ]
 
+[[package]]
+name = "openssl-probe"
+version = "0.1.6"
+source = "registry+https://github.com/rust-lang/crates.io-index"
+checksum = "d05e27ee213611ffe7d6348b942e8f942b37114c00cc03cec254295a4a17852e"
+
 [[package]]
 name = "openssl-probe"
 version = "0.2.1"
@@ -2574,7 +2636,7 @@ dependencies = [
  "cfg-if",
  "getrandom 0.2.17",
  "libc",
- "untrusted",
+ "untrusted 0.9.0",
  "windows-sys 0.52.0",
 ]
 
@@ -2640,6 +2702,7 @@ version = "0.22.4"
 source = "registry+https://github.com/rust-lang/crates.io-index"
 checksum = "bf4ef73721ac7bcd79b2b315da7779d8fc09718c6b3d2d1b2d94850eb8c18432"
 dependencies = [
+ "aws-lc-rs",
  "log",
  "ring",
  "rustls-pki-types",
@@ -2648,6 +2711,19 @@ dependencies = [
  "zeroize",
 ]
 
+[[package]]
+name = "rustls-native-certs"
+version = "0.7.3"
+source = "registry+https://github.com/rust-lang/crates.io-index"
+checksum = "e5bfb394eeed242e909609f56089eecfe5fda225042e8b171791b9c95f5931e5"
+dependencies = [
+ "openssl-probe 0.1.6",
+ "rustls-pemfile 2.2.0",
+ "rustls-pki-types",
+ "schannel",
+ "security-framework 2.11.1",
+]
+
 [[package]]
 name = "rustls-pemfile"
 version = "1.0.4"
@@ -2681,9 +2757,10 @@ version = "0.102.8"
 source = "registry+https://github.com/rust-lang/crates.io-index"
 checksum = "64ca1bc8749bd4cf37b5ce386cc146580777b4e8572c7b97baf22c83f444bee9"
 dependencies = [
+ "aws-lc-rs",
  "ring",
  "rustls-pki-types",
- "untrusted",
+ "untrusted 0.9.0",
 ]
 
 [[package]]
@@ -2777,6 +2854,7 @@ name = "scryer-prolog"
 version = "0.10.0"
 dependencies = [
  "arcu",
+ "aws-lc-rs",
  "base64 0.22.1",
  "bit-set",
  "bitvec",
@@ -2799,6 +2877,7 @@ dependencies = [
  "fxhash",
  "getrandom 0.2.17",
  "git-version",
+ "hex",
  "hostname",
  "iai-callgrind",
  "indexmap",
@@ -2809,7 +2888,6 @@ dependencies = [
  "libloading",
  "maplit",
  "modular-bitfield",
- "native-tls",
  "num-order",
  "ordered-float",
  "ouroboros",
@@ -2824,6 +2902,9 @@ dependencies = [
  "ring",
  "ripemd",
  "roxmltree",
+ "rustls",
+ "rustls-native-certs",
+ "rustls-pemfile 2.2.0",
  "rustyline",
  "ryu",
  "scraper",
@@ -2854,6 +2935,19 @@ version = "3.0.10"
 source = "registry+https://github.com/rust-lang/crates.io-index"
 checksum = "490dcfcbfef26be6800d11870ff2df8774fa6e86d047e3e8c8a76b25655e41ca"
 
+[[package]]
+name = "security-framework"
+version = "2.11.1"
+source = "registry+https://github.com/rust-lang/crates.io-index"
+checksum = "897b2245f0b511c87893af39b033e5ca9cce68824c4d7e7630b5a1d339658d02"
+dependencies = [
+ "bitflags 2.11.1",
+ "core-foundation 0.9.4",
+ "core-foundation-sys",
+ "libc",
+ "security-framework-sys",
+]
+
 [[package]]
 name = "security-framework"
 version = "3.7.0"
@@ -3621,6 +3715,12 @@ version = "0.2.6"
 source = "registry+https://github.com/rust-lang/crates.io-index"
 checksum = "ebc1c04c71510c7f702b52b7c350734c9ff1295c464a03335b00bb84fc54f853"
 
+[[package]]
+name = "untrusted"
+version = "0.7.1"
+source = "registry+https://github.com/rust-lang/crates.io-index"
+checksum = "a156c684c91ea7d62626509bce3cb4e1d9ed5c4d978f7b4352658f96a4c26b4a"
+
 [[package]]
 name = "untrusted"
 version = "0.9.0"
index f75116770fcf0c8cffd20d438fe5f1a43a0d9567..5bfd8603ff8ae8150374640a115b4643fe8afd7c 100644 (file)
@@ -31,7 +31,7 @@ all-simple-cross = ["all-pure", "ffi", "crypto-full"]
 ffi = ["dep:libffi"]
 repl = ["dep:crossterm", "dep:ctrlc", "dep:rustyline"]
 hostname = ["dep:hostname"]
-tls = ["dep:native-tls"]
+tls = ["dep:rustls", "dep:rustls-native-certs", "dep:rustls-pemfile", "dep:aws-lc-rs", "dep:hex"]
 http = ["dep:warp", "dep:reqwest"]
 # crypto function that require non pure-rust dependencies
 crypto-full = ["dep:ring"]
@@ -105,10 +105,14 @@ crossterm = { version = "0.28.1", optional = true }
 ctrlc = { version = "3.4.4", optional = true }
 hostname = { version = "0.4.0", optional = true }
 libffi = { version = "5.1.0", optional = true }
-native-tls = { version = "0.2.12", optional = true }
+rustls-pemfile = { version = "2", optional = true }
 # the version requirement of reqwest is kept low for compatibility with old deno versions
 # that pin reqwest to 0.11.20
 reqwest = { version = "0.11.0", optional = true }
+rustls = { version = "0.22", optional = true, features = ["aws_lc_rs"] }
+aws-lc-rs = { version = "1.15", optional = true }
+hex = { version = "0.4", optional = true }
+rustls-native-certs = { version = "0.7", optional = true }
 rustyline = { version = "18.0.0", optional = true }
 tokio = { version = "1.39.2", features = ["full"] }
 warp = { version = "0.3.7", features = ["tls"], optional = true }
index 2dad5291098872068b69c1f5d090aca61ad21ebd..605c09e9ec0f539ed0d1919266def4a161fde9fd 100644 (file)
@@ -467,7 +467,7 @@ enum SystemClauseType {
     SocketServerAccept,
     #[strum_discriminants(strum(props(Arity = "1", Name = "$socket_server_close")))]
     SocketServerClose,
-    #[strum_discriminants(strum(props(Arity = "4", Name = "$tls_accept_client")))]
+    #[strum_discriminants(strum(props(Arity = "5", Name = "$tls_accept_client")))]
     TLSAcceptClient,
     #[strum_discriminants(strum(props(Arity = "3", Name = "$tls_client_connect")))]
     TLSClientConnect,
index 3fae7aeb71b158a8d70f3976a8ebf50653a0a2a7..f974accd03f398d21d289ce6b07d88465f732c69 100644 (file)
@@ -7,7 +7,8 @@
 :- 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
+                tls_server_negotiate/3, % +Context, +Stream0, -Stream
+                tls_server_negotiate/4  % +Context, +Stream0, -Stream, +Options
                ]).
 
 :- use_module(library(lists)).
@@ -52,31 +53,24 @@ tls_client_negotiate(tls_context(Host), S0, S) :-
 
    Use tls_server_context/2 to create a TLS context, for example with:
 
-   tls_server_context(Context, [pkcs12(Chars)])
+   tls_server_context(Context, [certificate(Cert),key(Key)])
 
-   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.
+   where Cert is a list of characters with the contents of a
+   PEM-encoded certificate chain, and Key is a list of characters with
+   the contents of the corresponding PEM-encoded private key. The
+   private key may be in PKCS #8, PKCS #1 (RSA) or SEC1 (EC) format.
 
-   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
+   The certificate chain should contain a leaf certificate followed by
+   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:
+   library(dcgs) to read the contents of "cert.pem" and "key.pem" into
+   strings:
 
-   phrase_from_file(seq(Chars), "identity.pfx", [type(binary)])
+   phrase_from_file(seq(Cert), "cert.pem"), phrase_from_file(seq(Key), "key.pem")
 
    The obtained context should be treated as an opaque Prolog term.
 
@@ -95,16 +89,20 @@ tls_client_negotiate(tls_context(Host), S0, S) :-
    is created for every connection, using the specified parameters.
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
-tls_server_context(tls_context(Cert,Password), Options) :-
-        (   member(pcks12(Cert), Options) ->
+tls_server_context(tls_context(Cert,Key), Options) :-
+        (   member(certificate(Cert), Options) ->
             must_be(chars, Cert)
-        ;   domain_error(contains_pcks12, Options, tls_server_context/2)
+        ;   domain_error(contains_certificate, Options, tls_server_context/2)
         ),
-        (   member(password(Password), Options) ->
-            must_be(chars, Password)
-        ;   Password = ""
+        (   member(key(Key), Options) ->
+            must_be(chars, Key)
+        ;   domain_error(contains_key, Options, tls_server_context/2)
         ).
 
-tls_server_negotiate(tls_context(Cert,Password), S0, S) :-
-        '$tls_accept_client'(Cert, Password, S0, S).
+tls_server_negotiate(Ctx, S0, S) :-
+    tls_server_negotiate(Ctx, S0, S, []).
 
+tls_server_negotiate(tls_context(Cert,Key), S0, S, Options) :-
+    member(client_certificate(ClientCert), Options) ->
+    '$tls_accept_client'(Cert, Key, S0, S, ClientCert)
+    ; '$tls_accept_client'(Cert, Key, S0, S, _).
index a956a00c7a684cbd84b941ba1cf98f6275f4e442..5dd5427ee1977a3e40c7ec1c3d335a50acb05c6c 100644 (file)
@@ -35,7 +35,7 @@ use std::sync::mpsc::Receiver;
 use std::sync::mpsc::TryRecvError;
 
 #[cfg(feature = "tls")]
-use native_tls::TlsStream;
+use rustls::{ClientConnection, ServerConnection, StreamOwned as RustlsStreamOwned};
 
 #[cfg(feature = "http")]
 use warp::hyper;
@@ -249,10 +249,65 @@ impl Write for NamedTcpStream {
 }
 
 #[cfg(feature = "tls")]
-#[derive(Debug)]
+pub enum TlsStream {
+    Client(RustlsStreamOwned<ClientConnection, Stream>),
+    Server(RustlsStreamOwned<ServerConnection, Stream>),
+}
+
+#[cfg(feature = "tls")]
+impl TlsStream {
+    #[inline]
+    pub fn send_close_notify(&mut self) {
+        match self {
+            TlsStream::Client(s) => s.conn.send_close_notify(),
+            TlsStream::Server(s) => s.conn.send_close_notify(),
+        }
+    }
+}
+
+#[cfg(feature = "tls")]
+impl Read for TlsStream {
+    #[inline]
+    fn read(&mut self, buf: &mut [u8]) -> std::io::Result<usize> {
+        match self {
+            TlsStream::Client(s) => s.read(buf),
+            TlsStream::Server(s) => s.read(buf),
+        }
+    }
+}
+
+#[cfg(feature = "tls")]
+impl Write for TlsStream {
+    #[inline]
+    fn write(&mut self, buf: &[u8]) -> std::io::Result<usize> {
+        match self {
+            TlsStream::Client(s) => s.write(buf),
+            TlsStream::Server(s) => s.write(buf),
+        }
+    }
+
+    #[inline]
+    fn flush(&mut self) -> std::io::Result<()> {
+        match self {
+            TlsStream::Client(s) => s.flush(),
+            TlsStream::Server(s) => s.flush(),
+        }
+    }
+}
+
+#[cfg(feature = "tls")]
 pub struct NamedTlsStream {
     address: Atom,
-    tls_stream: TlsStream<Stream>,
+    tls_stream: TlsStream,
+}
+
+#[cfg(feature = "tls")]
+impl fmt::Debug for NamedTlsStream {
+    fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result {
+        f.debug_struct("NamedTlsStream")
+            .field("address", &self.address)
+            .finish_non_exhaustive()
+    }
 }
 
 #[cfg(feature = "tls")]
@@ -1452,11 +1507,7 @@ impl Stream {
 
     #[cfg(feature = "tls")]
     #[inline]
-    pub(crate) fn from_tls_stream(
-        address: Atom,
-        tls_stream: TlsStream<Stream>,
-        arena: &mut Arena,
-    ) -> Self {
+    pub(crate) fn from_tls_stream(address: Atom, tls_stream: TlsStream, arena: &mut Arena) -> Self {
         Stream::NamedTls(arena_alloc!(
             StreamLayout::new(CharReader::new(NamedTlsStream {
                 address,
@@ -1531,10 +1582,23 @@ impl Stream {
     pub(crate) fn close(&mut self) -> Result<(), std::io::Error> {
         match self {
             Stream::NamedTcp(ref mut tcp_stream) => {
-                tcp_stream.inner_mut().tcp_stream.shutdown(Shutdown::Both)
+                let result = tcp_stream.inner_mut().tcp_stream.shutdown(Shutdown::Both);
+                // Release the underlying socket immediately instead of waiting
+                // for the arena to be garbage-collected.
+                tcp_stream.drop_payload();
+                result
             }
             #[cfg(feature = "tls")]
-            Stream::NamedTls(ref mut tls_stream) => tls_stream.inner_mut().tls_stream.shutdown(),
+            Stream::NamedTls(ref mut tls_stream) => {
+                let inner = tls_stream.inner_mut();
+                inner.tls_stream.send_close_notify();
+                let result = inner.tls_stream.flush();
+                // Release the rustls connection state (buffers, ServerConfig)
+                // immediately instead of waiting for the arena to be
+                // garbage-collected.
+                tls_stream.drop_payload();
+                result
+            }
             #[cfg(feature = "http")]
             Stream::HttpRead(ref mut http_stream) => {
                 http_stream.drop_payload();
index 0e36d1ad9cca3aa7a5667914ecc6c9509fc3a6b8..b960e54fc5903ebdabc6e83983574fdf06d51e20 100644 (file)
@@ -87,7 +87,16 @@ use crrl::{ed25519, secp256k1, x25519};
 pub(crate) mod special_math;
 
 #[cfg(feature = "tls")]
-use native_tls::{Identity, TlsAcceptor, TlsConnector};
+use aws_lc_rs;
+#[cfg(feature = "tls")]
+use rustls::pki_types::{CertificateDer, PrivateKeyDer, ServerName};
+#[cfg(feature = "tls")]
+use rustls::server::danger::*;
+#[cfg(feature = "tls")]
+use rustls::{
+    ClientConfig, ClientConnection, DistinguishedName, RootCertStore, ServerConfig,
+    ServerConnection, SignatureScheme,
+};
 
 use base64;
 use roxmltree;
@@ -7254,9 +7263,30 @@ impl Machine {
                 3,
             )?;
 
-            let connector = TlsConnector::new().unwrap();
-            let stream = match connector.connect(&hostname.as_str(), stream0) {
-                Ok(tls_stream) => tls_stream,
+            let mut roots = RootCertStore::empty();
+            if let Ok(certs) = rustls_native_certs::load_native_certs() {
+                for cert in certs {
+                    let _ = roots.add(cert);
+                }
+            }
+
+            let config = ClientConfig::builder()
+                .with_root_certificates(roots)
+                .with_no_client_auth();
+
+            let server_name = match ServerName::try_from(hostname.as_str().to_string()) {
+                Ok(name) => name,
+                Err(_) => {
+                    return Err(self.machine_st.open_permission_error(
+                        self.machine_st.registers[1],
+                        atom!("tls_client_negotiate"),
+                        3,
+                    ));
+                }
+            };
+
+            let mut conn = match ClientConnection::new(Arc::new(config), server_name) {
+                Ok(conn) => conn,
                 Err(_) => {
                     return Err(self.machine_st.open_permission_error(
                         self.machine_st.registers[1],
@@ -7266,8 +7296,20 @@ impl Machine {
                 }
             };
 
+            let mut sock = stream0;
+            if conn.complete_io(&mut sock).is_err() {
+                return Err(self.machine_st.open_permission_error(
+                    self.machine_st.registers[1],
+                    atom!("tls_client_negotiate"),
+                    3,
+                ));
+            }
+
+            let tls_stream =
+                crate::machine::streams::TlsStream::Client(rustls::StreamOwned::new(conn, sock));
+
             let addr = atom!("TLS");
-            let stream = Stream::from_tls_stream(addr, stream, &mut self.machine_st.arena);
+            let stream = Stream::from_tls_stream(addr, tls_stream, &mut self.machine_st.arena);
 
             self.indices
                 .add_stream(stream, atom!("tls_client_negotiate"), 3)
@@ -7286,55 +7328,143 @@ impl Machine {
     #[cfg(feature = "tls")]
     #[inline(always)]
     pub(crate) fn tls_accept_client(&mut self) -> CallResult {
-        let pkcs12 = self.string_encoding_bytes(self.machine_st.registers[1], atom!("octet"));
+        use std::cell::RefCell;
 
-        if let Some(password) = self
-            .machine_st
-            .value_to_str_like(self.machine_st.registers[2])
-        {
-            let identity = match Identity::from_pkcs12(&pkcs12, &password.as_str()) {
-                Ok(identity) => identity,
-                Err(_) => {
-                    return Err(self.machine_st.open_permission_error(
-                        self.machine_st.registers[1],
-                        atom!("tls_server_negotiate"),
-                        3,
-                    ));
-                }
-            };
+        // A new TLS connection is negotiated for every incoming request. Building
+        // a fresh ServerConfig each time means re-parsing the certificate chain
+        // and (potentially large) private key on every connection. Cache the most
+        // recently built config, keyed by the raw cert/key bytes, and reuse it.
+        thread_local! {
+            static CONFIG_CACHE: RefCell<Option<(Vec<u8>, Vec<u8>, Arc<ServerConfig>)>> =
+                RefCell::new(None);
+        }
 
-            let stream0 = self.machine_st.get_stream_or_alias(
+        let cert_pem = self.string_encoding_bytes(self.machine_st.registers[1], atom!("octet"));
+        let key_pem = self.string_encoding_bytes(self.machine_st.registers[2], atom!("octet"));
+
+        let stream0 = self.machine_st.get_stream_or_alias(
+            self.machine_st.registers[3],
+            &self.indices,
+            atom!("tls_server_negotiate"),
+            3,
+        )?;
+
+        let cached_config = CONFIG_CACHE.with(|cache| {
+            cache.borrow().as_ref().and_then(|(cert, key, config)| {
+                (cert == &cert_pem && key == &key_pem).then(|| config.clone())
+            })
+        });
+
+        let config = match cached_config {
+            Some(config) => config,
+            None => {
+                let cert_chain: Vec<CertificateDer<'static>> = match rustls_pemfile::certs(
+                    &mut &cert_pem[..],
+                )
+                .collect::<Result<Vec<_>, _>>()
+                {
+                    Ok(certs) if !certs.is_empty() => certs,
+                    _ => {
+                        return Err(self.machine_st.open_permission_error(
+                            self.machine_st.registers[1],
+                            atom!("tls_server_negotiate"),
+                            3,
+                        ));
+                    }
+                };
+
+                let private_key: PrivateKeyDer<'static> =
+                    match rustls_pemfile::private_key(&mut &key_pem[..]) {
+                        Ok(Some(key)) => key,
+                        _ => {
+                            return Err(self.machine_st.open_permission_error(
+                                self.machine_st.registers[2],
+                                atom!("tls_server_negotiate"),
+                                3,
+                            ));
+                        }
+                    };
+
+                let config = match ServerConfig::builder()
+                    .with_client_cert_verifier(Arc::new(TrivialClientVerifier))
+                    .with_single_cert(cert_chain, private_key)
+                {
+                    Ok(config) => Arc::new(config),
+                    Err(_) => {
+                        return Err(self.machine_st.open_permission_error(
+                            self.machine_st.registers[1],
+                            atom!("tls_server_negotiate"),
+                            3,
+                        ));
+                    }
+                };
+
+                CONFIG_CACHE.with(|cache| {
+                    *cache.borrow_mut() = Some((cert_pem.clone(), key_pem.clone(), config.clone()));
+                });
+
+                config
+            }
+        };
+
+        let mut conn = match ServerConnection::new(config) {
+            Ok(conn) => conn,
+            Err(_) => {
+                return Err(self.machine_st.open_permission_error(
+                    self.machine_st.registers[3],
+                    atom!("tls_server_negotiate"),
+                    3,
+                ));
+            }
+        };
+
+        let mut sock = stream0;
+        if conn.complete_io(&mut sock).is_err() {
+            return Err(self.machine_st.open_permission_error(
                 self.machine_st.registers[3],
-                &self.indices,
                 atom!("tls_server_negotiate"),
                 3,
-            )?;
+            ));
+        }
 
-            let acceptor = TlsAcceptor::new(identity).unwrap();
+        let client_digest = conn.peer_certificates().and_then(|peer_certs| {
+            peer_certs.first().map(|client_cert| {
+                let cert_bytes = client_cert.as_ref();
+                aws_lc_rs::digest::digest(&aws_lc_rs::digest::SHA256, cert_bytes)
+            })
+        });
 
-            let stream = match acceptor.accept(stream0) {
-                Ok(tls_stream) => tls_stream,
-                Err(_) => {
-                    return Err(self.machine_st.open_permission_error(
-                        self.machine_st.registers[3],
-                        atom!("tls_server_negotiate"),
-                        3,
-                    ));
-                }
-            };
+        let tls_stream =
+            crate::machine::streams::TlsStream::Server(rustls::StreamOwned::new(conn, sock));
+        let stream = Stream::from_tls_stream(atom!("TLS"), tls_stream, &mut self.machine_st.arena);
 
-            let stream = Stream::from_tls_stream(atom!("TLS"), stream, &mut self.machine_st.arena);
+        self.indices
+            .add_stream(stream, atom!("tls_server_negotiate"), 3)
+            .map_err(|stub_gen| stub_gen(&mut self.machine_st))?;
 
-            self.indices
-                .add_stream(stream, atom!("tls_server_negotiate"), 3)
-                .map_err(|stub_gen| stub_gen(&mut self.machine_st))?;
+        let stream_addr = self.deref_register(4);
+        self.machine_st
+            .bind(stream_addr.as_var().unwrap(), stream.into());
 
-            let stream_addr = self.deref_register(4);
-            self.machine_st
-                .bind(stream_addr.as_var().unwrap(), stream.into());
-        } else {
-            unreachable!();
-        }
+        let digest_cell = match client_digest {
+            Some(digest) => {
+                let bytes = digest.as_ref();
+                resource_error_call_result!(
+                    self.machine_st,
+                    sized_iter_to_heap_list(
+                        &mut self.machine_st.heap,
+                        bytes.len(),
+                        bytes
+                            .iter()
+                            .map(|b| fixnum_as_cell!(Fixnum::build_with(*b)))
+                    )
+                )
+            }
+            None => atom_as_cell!(atom!("none")),
+        };
+
+        self.machine_st
+            .bind(self.deref_register(5).as_var().unwrap(), digest_cell);
 
         Ok(())
     }
@@ -9598,3 +9728,56 @@ impl hkdf::KeyType for MyKey<usize> {
         self.0
     }
 }
+
+
+#[cfg(feature = "tls")]
+#[derive(Debug)]
+struct TrivialClientVerifier;
+
+#[cfg(feature = "tls")]
+impl ClientCertVerifier for TrivialClientVerifier {
+    fn offer_client_auth(&self) -> bool {
+        true
+    }
+
+    fn client_auth_mandatory(&self) -> bool {
+        false
+    }
+
+    fn root_hint_subjects(&self) -> &[DistinguishedName] {
+        &[]
+    }
+
+    fn verify_client_cert(
+        &self,
+        _end_entity: &CertificateDer<'_>,
+        _intermediates: &[CertificateDer<'_>],
+        _now: rustls::pki_types::UnixTime,
+    ) -> Result<ClientCertVerified, rustls::Error> {
+        Ok(ClientCertVerified::assertion())
+    }
+
+    fn verify_tls12_signature(
+        &self,
+        _message: &[u8],
+        _cert: &CertificateDer<'_>,
+        _dss: &rustls::DigitallySignedStruct,
+    ) -> Result<rustls::client::danger::HandshakeSignatureValid, rustls::Error> {
+        Ok(rustls::client::danger::HandshakeSignatureValid::assertion())
+    }
+
+    fn verify_tls13_signature(
+        &self,
+        _message: &[u8],
+        _cert: &CertificateDer<'_>,
+        _dss: &rustls::DigitallySignedStruct,
+    ) -> Result<rustls::client::danger::HandshakeSignatureValid, rustls::Error> {
+        Ok(rustls::client::danger::HandshakeSignatureValid::assertion())
+    }
+
+    fn supported_verify_schemes(&self) -> Vec<SignatureScheme> {
+        rustls::crypto::aws_lc_rs::default_provider()
+            .signature_verification_algorithms
+            .supported_schemes()
+    }
+}