Merge branch 'guile-reauth' into 'master'

Support post-handshake reauthentication in the Guile bindings

See merge request gnutls/gnutls!1026

7 files changed, 408 insertions, 29 deletions

diff --git a/guile/Makefile.am b/guile/Makefile.am
index 13bdeee774..0b19bad90f 100644
--- a/guile/Makefile.am
+++ b/guile/Makefile.am
@@ -1,5 +1,5 @@
 #  GnuTLS --- Guile bindings for GnuTLS.
-#  Copyright (C) 2007-2012, 2016 Free Software Foundation, Inc.
+#  Copyright (C) 2007-2012, 2016, 2019 Free Software Foundation, Inc.
 #
 #  GnuTLS is free software; you can redistribute it and/or
 #  modify it under the terms of the GNU Lesser General Public
@@ -101,6 +101,7 @@ TESTS =						\
   tests/errors.scm				\
   tests/x509-certificates.scm			\
   tests/x509-auth.scm				\
+  tests/reauth.scm				\
   tests/priorities.scm
 
 if ENABLE_SRP
diff --git a/guile/modules/gnutls.in b/guile/modules/gnutls.in
index d705a0db42..eed0ffcf8e 100644
--- a/guile/modules/gnutls.in
+++ b/guile/modules/gnutls.in
@@ -1,5 +1,5 @@
 ;;; GnuTLS --- Guile bindings for GnuTLS.
-;;; Copyright (C) 2007-2012, 2014, 2015, 2016 Free Software Foundation, Inc.
+;;; Copyright (C) 2007-2012, 2014, 2015, 2016, 2019 Free Software Foundation, Inc.
 ;;;
 ;;; GnuTLS is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU Lesser General Public
@@ -25,7 +25,7 @@
 
            ;; sessions
            session?
-           make-session bye handshake rehandshake
+           make-session bye handshake rehandshake reauthenticate
            alert-get alert-send
            session-cipher session-kx session-mac session-protocol
            session-compression-method session-certificate-type
@@ -101,7 +101,8 @@
            ;; enum->string functions
            cipher->string kx->string params->string credentials->string
            mac->string digest->string compression-method->string
-           connection-end->string alert-level->string
+           connection-end->string connection-flag->string
+           alert-level->string
            alert-description->string handshake-description->string
            certificate-status->string certificate-request->string
            close-request->string
@@ -155,6 +156,25 @@
            compression-method/lzo
            connection-end/server
            connection-end/client
+           connection-flag/datagram
+           connection-flag/nonblock
+           connection-flag/no-extensions
+           connection-flag/no-replay-protection
+           connection-flag/no-signal
+           connection-flag/allow-id-change
+           connection-flag/enable-false-start
+           connection-flag/force-client-cert
+           connection-flag/no-tickets
+           connection-flag/key-share-top
+           connection-flag/key-share-top2
+           connection-flag/key-share-top3
+           connection-flag/post-handshake-auth
+           connection-flag/no-auto-rekey
+           connection-flag/safe-padding-check
+           connection-flag/enable-early-start
+           connection-flag/enable-rawpk
+           connection-flag/auto-reauth
+           connection-flag/enable-early-data
            alert-level/warning
            alert-level/fatal
            alert-description/close-notify
@@ -254,6 +274,7 @@
            ;;   sed -r -e 's|^#define GNUTLS_E_([^ ]+).*$|error/\1|' | tr A-Z_ a-z-
            error/success
            error/unsupported-version-packet
+           error/tls-packet-decoding-error
            error/unexpected-packet-length
            error/invalid-session
            error/fatal-alert-received
@@ -269,6 +290,7 @@
            error/expired
            error/db-error
            error/srp-pwd-error
+           error/keyfile-error
            error/insufficient-credentials
            error/insuficient-credentials
            error/insufficient-cred
@@ -300,6 +322,8 @@
            error/too-many-empty-packets
            error/unknown-pk-algorithm
            error/too-many-handshake-packets
+           error/received-disallowed-name
+           error/certificate-required
            error/no-temporary-rsa-params
            error/no-compression-algorithms
            error/no-cipher-suites
@@ -307,6 +331,7 @@
            error/pk-sig-verify-failed
            error/illegal-srp-username
            error/srp-pwd-parsing-error
+           error/keyfile-parsing-error
            error/no-temporary-dh-params
            error/asn1-element-not-found
            error/asn1-identifier-not-found
@@ -342,6 +367,7 @@
            error/unsafe-renegotiation-denied
            error/unknown-srp-username
            error/premature-termination
+           error/malformed-cidr
            error/base64-encoding-error
            error/incompatible-gcrypt-library
            error/incompatible-crypto-library
@@ -352,6 +378,7 @@
            error/base64-unexpected-header-error
            error/openpgp-subkey-error
            error/crypto-already-registered
+           error/already-registered
            error/handshake-too-large
            error/cryptodev-ioctl-error
            error/cryptodev-device-error
@@ -359,6 +386,10 @@
            error/bad-cookie
            error/openpgp-preferred-key-error
            error/incompat-dsa-key-with-tls-protocol
+           error/insufficient-security
+           error/heartbeat-pong-received
+           error/heartbeat-ping-received
+           error/unrecognized-name
            error/pkcs11-error
            error/pkcs11-load-error
            error/parsing-error
@@ -385,10 +416,65 @@
            error/certificate-list-unsorted
            error/illegal-parameter
            error/no-priorities-were-set
+           error/x509-unsupported-extension
+           error/session-eof
+           error/tpm-error
+           error/tpm-key-password-error
+           error/tpm-srk-password-error
+           error/tpm-session-error
+           error/tpm-key-not-found
+           error/tpm-uninitialized
+           error/tpm-no-lib
+           error/no-certificate-status
+           error/ocsp-response-error
+           error/random-device-error
+           error/auth-error
+           error/no-application-protocol
+           error/sockets-init-error
+           error/key-import-failed
+           error/inappropriate-fallback
+           error/certificate-verification-error
+           error/privkey-verification-error
+           error/unexpected-extensions-length
+           error/asn1-embedded-null-in-string
+           error/self-test-error
+           error/no-self-test
+           error/lib-in-error-state
+           error/pk-generation-error
+           error/idna-error
+           error/need-fallback
+           error/session-user-id-changed
+           error/handshake-during-false-start
+           error/unavailable-during-handshake
+           error/pk-invalid-pubkey
+           error/pk-invalid-privkey
+           error/not-yet-activated
+           error/invalid-utf8-string
+           error/no-embedded-data
+           error/invalid-utf8-email
+           error/invalid-password-string
+           error/certificate-time-error
+           error/record-overflow
+           error/asn1-time-error
+           error/incompatible-sig-with-key
+           error/pk-invalid-pubkey-params
+           error/pk-no-validation-params
+           error/ocsp-mismatch-with-certs
+           error/no-common-key-share
+           error/reauth-request
+           error/too-many-matches
+           error/crl-verification-error
+           error/missing-extension
+           error/db-entry-exists
+           error/early-data-rejected
            error/unimplemented-feature
+           error/int-ret-0
+           error/int-check-again
            error/application-error-max
            error/application-error-min
 
+           fatal-error?
+
            ;; OpenPGP keys (formerly in GnuTLS-extra)
            openpgp-certificate? openpgp-private-key?
            import-openpgp-certificate import-openpgp-private-key
diff --git a/guile/modules/gnutls/build/enums.scm b/guile/modules/gnutls/build/enums.scm
index 1ef46b77a5..6554099f06 100644
--- a/guile/modules/gnutls/build/enums.scm
+++ b/guile/modules/gnutls/build/enums.scm
@@ -1,5 +1,5 @@
 ;;; GnuTLS --- Guile bindings for GnuTLS.
-;;; Copyright (C) 2007-2012, 2014 Free Software Foundation, Inc.
+;;; Copyright (C) 2007-2012, 2014, 2019 Free Software Foundation, Inc.
 ;;;
 ;;; GnuTLS is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU Lesser General Public
@@ -341,6 +341,30 @@
                   #f
                   "GNUTLS_"))
 
+(define %connection-flag-enum
+  (make-enum-type 'connection-flag "gnutls_init_flags_t"
+                  '(datagram
+                    nonblock
+                    no-extensions
+                    no-replay-protection
+                    no-signal
+                    allow-id-change
+                    enable-false-start
+                    force-client-cert
+                    no-tickets
+                    key-share-top
+                    key-share-top2
+                    key-share-top3
+                    post-handshake-auth
+                    no-auto-rekey
+                    safe-padding-check
+                    enable-early-start
+                    enable-rawpk
+                    auto-reauth
+                    enable-early-data)
+                  #f
+                  "GNUTLS_"))
+
 (define %alert-level-enum
   (make-enum-type 'alert-level "gnutls_alert_level_t"
                   '(warning fatal)
@@ -459,10 +483,11 @@ unrecognized-name unknown-psk-identity)
   (make-enum-type 'error "int"
                   '(
 ;; FIXME: Automate this:
-;; grep '^#define GNUTLS_E_' ../../../../includes/gnutls/gnutls.h.in \
+;; grep '^#define GNUTLS_E_' ../../../lib/includes/gnutls/gnutls.h.in \
 ;;  | sed -r -e 's/^#define GNUTLS_E_([^ ]+).*$/\1/' | tr A-Z_ a-z-
 success
 unsupported-version-packet
+tls-packet-decoding-error
 unexpected-packet-length
 invalid-session
 fatal-alert-received
@@ -478,6 +503,7 @@ again
 expired
 db-error
 srp-pwd-error
+keyfile-error
 insufficient-credentials
 insuficient-credentials
 insufficient-cred
@@ -509,6 +535,8 @@ file-error
 too-many-empty-packets
 unknown-pk-algorithm
 too-many-handshake-packets
+received-disallowed-name
+certificate-required
 no-temporary-rsa-params
 no-compression-algorithms
 no-cipher-suites
@@ -516,6 +544,7 @@ openpgp-getkey-failed
 pk-sig-verify-failed
 illegal-srp-username
 srp-pwd-parsing-error
+keyfile-parsing-error
 no-temporary-dh-params
 asn1-element-not-found
 asn1-identifier-not-found
@@ -551,6 +580,7 @@ safe-renegotiation-failed
 unsafe-renegotiation-denied
 unknown-srp-username
 premature-termination
+malformed-cidr
 base64-encoding-error
 incompatible-gcrypt-library
 incompatible-crypto-library
@@ -561,6 +591,7 @@ random-failed
 base64-unexpected-header-error
 openpgp-subkey-error
 crypto-already-registered
+already-registered
 handshake-too-large
 cryptodev-ioctl-error
 cryptodev-device-error
@@ -568,6 +599,10 @@ channel-binding-not-available
 bad-cookie
 openpgp-preferred-key-error
 incompat-dsa-key-with-tls-protocol
+insufficient-security
+heartbeat-pong-received
+heartbeat-ping-received
+unrecognized-name
 pkcs11-error
 pkcs11-load-error
 parsing-error
@@ -594,7 +629,60 @@ pkcs11-requested-object-not-availble
 certificate-list-unsorted
 illegal-parameter
 no-priorities-were-set
+x509-unsupported-extension
+session-eof
+tpm-error
+tpm-key-password-error
+tpm-srk-password-error
+tpm-session-error
+tpm-key-not-found
+tpm-uninitialized
+tpm-no-lib
+no-certificate-status
+ocsp-response-error
+random-device-error
+auth-error
+no-application-protocol
+sockets-init-error
+key-import-failed
+inappropriate-fallback
+certificate-verification-error
+privkey-verification-error
+unexpected-extensions-length
+asn1-embedded-null-in-string
+self-test-error
+no-self-test
+lib-in-error-state
+pk-generation-error
+idna-error
+need-fallback
+session-user-id-changed
+handshake-during-false-start
+unavailable-during-handshake
+pk-invalid-pubkey
+pk-invalid-privkey
+not-yet-activated
+invalid-utf8-string
+no-embedded-data
+invalid-utf8-email
+invalid-password-string
+certificate-time-error
+record-overflow
+asn1-time-error
+incompatible-sig-with-key
+pk-invalid-pubkey-params
+pk-no-validation-params
+ocsp-mismatch-with-certs
+no-common-key-share
+reauth-request
+too-many-matches
+crl-verification-error
+missing-extension
+db-entry-exists
+early-data-rejected
 unimplemented-feature
+int-ret-0
+int-check-again
 application-error-max
 application-error-min
 )
@@ -617,7 +705,8 @@ application-error-min
 (define %gnutls-enums
   ;; All enums.
   (list %cipher-enum %kx-enum %params-enum %credentials-enum %mac-enum
-        %digest-enum %compression-method-enum %connection-end-enum
+        %digest-enum %compression-method-enum
+        %connection-end-enum %connection-flag-enum
         %alert-level-enum %alert-description-enum %handshake-description-enum
         %certificate-status-enum %certificate-request-enum
         %close-request-enum %protocol-enum %certificate-type-enum
diff --git a/guile/src/core.c b/guile/src/core.c
index 7cb0c32bf1..dc6611a4d7 100644
--- a/guile/src/core.c
+++ b/guile/src/core.c
@@ -29,6 +29,7 @@
 #include <libguile.h>
 
 #include <alloca.h>
+#include <assert.h>
 
 #include "enums.h"
 #include "smobs.h"
@@ -128,21 +129,27 @@ SCM_DEFINE (scm_gnutls_version, "gnutls-version", 0, 0, 0,
 
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_gnutls_make_session, "make-session", 1, 0, 0,
-            (SCM end),
+SCM_DEFINE (scm_gnutls_make_session, "make-session", 1, 0, 1,
+            (SCM end, SCM flags),
             "Return a new session for connection end @var{end}, either "
-            "@code{connection-end/server} or @code{connection-end/client}.")
+            "@code{connection-end/server} or @code{connection-end/client}.  "
+	    "The optional @var{flags} arguments are @code{connection-flag} "
+	    "values such as @code{connection-flag/auto-reauth}.")
 #define FUNC_NAME s_scm_gnutls_make_session
 {
-  int err;
+  int err, i;
   gnutls_session_t c_session;
   gnutls_connection_end_t c_end;
+  gnutls_init_flags_t c_flags = 0;
   SCM session_data;
 
   c_end = scm_to_gnutls_connection_end (end, 1, FUNC_NAME);
 
   session_data = SCM_GNUTLS_MAKE_SESSION_DATA ();
-  err = gnutls_init (&c_session, c_end);
+  for (i = 2; scm_is_pair (flags); flags = scm_cdr (flags), i++)
+    c_flags |= scm_to_gnutls_connection_flag (scm_car (flags), i, FUNC_NAME);
+
+  err = gnutls_init (&c_session, c_end | c_flags);
 
   if (EXPECT_FALSE (err))
     scm_gnutls_error (err, FUNC_NAME);
@@ -208,7 +215,24 @@ SCM_DEFINE (scm_gnutls_rehandshake, "rehandshake", 1, 0, 0,
 
   return SCM_UNSPECIFIED;
 }
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_reauthenticate, "reauthenticate", 1, 0, 0,
+            (SCM session), "Perform a re-authentication step for @var{session}.")
+#define FUNC_NAME s_scm_gnutls_reauthenticate
+{
+  int err;
+  gnutls_session_t c_session;
+
+  c_session = scm_to_gnutls_session (session, 1, FUNC_NAME);
 
+  /* FIXME: Allow flags as an argument.  */
+  err = gnutls_reauth (c_session, 0);
+  if (EXPECT_FALSE (err))
+    scm_gnutls_error (err, FUNC_NAME);
+
+  return SCM_UNSPECIFIED;
+}
 #undef FUNC_NAME
 
 SCM_DEFINE (scm_gnutls_alert_get, "alert-get", 1, 0, 0,
@@ -881,8 +905,15 @@ do_fill_port (void *data)
   const fill_port_data_t *args = (fill_port_data_t *) data;
 
   c_port = args->c_port;
-  result = gnutls_record_recv (args->c_session,
-                               c_port->read_buf, c_port->read_buf_size);
+
+  /* We can get GNUTLS_E_AGAIN due to a "short read", which does _not_
+     correspond to an actual EAGAIN from read(2) since the underlying file
+     descriptor is blocking.  Thus, we can safely loop right away.  */
+  do
+    result = gnutls_record_recv (args->c_session,
+				 c_port->read_buf, c_port->read_buf_size);
+  while (result == GNUTLS_E_AGAIN || result == GNUTLS_E_INTERRUPTED);
+
   if (EXPECT_TRUE (result > 0))
     {
       c_port->read_pos = c_port->read_buf;
@@ -1008,9 +1039,25 @@ read_from_session_record_port (SCM port, SCM dst, size_t start, size_t count)
 
   read_buf = (char *) SCM_BYTEVECTOR_CONTENTS (dst) + start;
 
-  /* XXX: Leave guile mode when SCM_GNUTLS_SESSION_TRANSPORT_IS_FD is
-     true?  */
-  result = gnutls_record_recv (c_session, read_buf, count);
+  /* We can get GNUTLS_E_AGAIN due to a "short read", which does _not_
+     correspond to an actual EAGAIN from read(2) if the underlying file
+     descriptor is blocking--e.g., from 'get_last_packet', returning
+     GNUTLS_E_REQUESTED_DATA_NOT_AVAILABLE.
+
+     If SESSION is backed by a file descriptor, return -1 to indicate that
+     we'd better poll; otherwise loop, which is good enough if the underlying
+     port is blocking.  */
+  do
+    result = gnutls_record_recv (c_session, read_buf, count);
+  while (result == GNUTLS_E_INTERRUPTED
+	 || (result == GNUTLS_E_AGAIN
+	     && !SCM_GNUTLS_SESSION_TRANSPORT_IS_FD (c_session)));
+
+  if (result == GNUTLS_E_AGAIN
+      && SCM_GNUTLS_SESSION_TRANSPORT_IS_FD (c_session))
+    /* Tell Guile that reading would block.  */
+    return (size_t) -1;
+
   if (EXPECT_FALSE (result < 0))
     /* FIXME: Silently swallowed! */
     scm_gnutls_error (result, FUNC_NAME);
@@ -1019,6 +1066,22 @@ read_from_session_record_port (SCM port, SCM dst, size_t start, size_t count)
 }
 #undef FUNC_NAME
 
+/* Return the file descriptor that backs PORT.  This function is called upon a
+   blocking read--i.e., 'read_from_session_record_port' returned -1.  */
+static int
+session_record_port_fd (SCM port)
+{
+  SCM session;
+  gnutls_session_t c_session;
+
+  session = SCM_GNUTLS_SESSION_RECORD_PORT_SESSION (port);
+  c_session = scm_to_gnutls_session (session, 1, __func__);
+
+  assert (SCM_GNUTLS_SESSION_TRANSPORT_IS_FD (c_session));
+
+  return gnutls_transport_get_int (c_session);
+}
+
 static size_t
 write_to_session_record_port (SCM port, SCM src, size_t start, size_t count)
 #define FUNC_NAME "write_to_session_record_port"
@@ -1092,6 +1155,11 @@ scm_init_gnutls_session_record_port_type (void)
 #endif
                         write_to_session_record_port);
 
+#if !USING_GUILE_BEFORE_2_2
+  scm_set_port_read_wait_fd (session_record_port_type,
+			     session_record_port_fd);
+#endif
+
   /* Guile >= 1.9.3 doesn't need a custom mark procedure, and doesn't need a
      finalizer (since memory associated with the port is automatically
      reclaimed.)  */
diff --git a/guile/src/errors.c b/guile/src/errors.c
index 102be5180b..a78f2ffef8 100644
--- a/guile/src/errors.c
+++ b/guile/src/errors.c
@@ -1,5 +1,5 @@
 /* GnuTLS --- Guile bindings for GnuTLS.
-   Copyright (C) 2007-2012 Free Software Foundation, Inc.
+   Copyright (C) 2007-2012, 2019 Free Software Foundation, Inc.
 
    GnuTLS is free software; you can redistribute it and/or
    modify it under the terms of the GNU Lesser General Public
@@ -52,6 +52,16 @@ scm_gnutls_error (int c_err, const char *c_func)
   scm_gnutls_error_with_args (c_err, c_func, SCM_EOL);
 }
 
+SCM_DEFINE (scm_gnutls_fatal_error_p, "fatal-error?", 1, 0, 0,
+	    (SCM err),
+	    "Return true if @var{error} is fatal.")
+#define FUNC_NAME s_scm_gnutls_fatal_error_p
+{
+  int c_err = scm_to_gnutls_error (err, 1, FUNC_NAME);
+  return scm_from_bool (gnutls_error_is_fatal (c_err));
+}
+#undef FUNC_NAME
+
 
 
 void
diff --git a/guile/tests/errors.scm b/guile/tests/errors.scm
index 4d4d958f85..b8d46234ab 100644
--- a/guile/tests/errors.scm
+++ b/guile/tests/errors.scm
@@ -1,5 +1,5 @@
 ;;; GnuTLS --- Guile bindings for GnuTLS.
-;;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
+;;; Copyright (C) 2007-2012, 2019 Free Software Foundation, Inc.
 ;;;
 ;;; GnuTLS is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU Lesser General Public
@@ -26,15 +26,19 @@
              (gnutls build tests))
 
 (run-test
-    (lambda ()
-      (let ((s (make-session connection-end/server)))
-        (catch 'gnutls-error
-          (lambda ()
-            (handshake s))
-          (lambda (key err function . currently-unused)
-            (and (eq? key 'gnutls-error)
-                 err
-                 (string? (error->string err))
-                 (eq? function 'handshake)))))))
+ (lambda ()
+   (and (fatal-error? error/hash-failed)
+        (not (fatal-error? error/reauth-request))
+
+        (let ((s (make-session connection-end/server)))
+          (catch 'gnutls-error
+            (lambda ()
+              (handshake s))
+            (lambda (key err function . currently-unused)
+              (and (eq? key 'gnutls-error)
+                   err
+                   (fatal-error? err)
+                   (string? (error->string err))
+                   (eq? function 'handshake))))))))
 
 ;;; arch-tag: 73ed6229-378d-4a12-a5c6-4c2586c6e3a2
diff --git a/guile/tests/reauth.scm b/guile/tests/reauth.scm
new file mode 100644
index 0000000000..0f768e514e
--- /dev/null
+++ b/guile/tests/reauth.scm
@@ -0,0 +1,121 @@
+;;; GnuTLS --- Guile bindings for GnuTLS.
+;;; Copyright (C) 2019 Free Software Foundation, Inc.
+;;;
+;;; GnuTLS is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public
+;;; License as published by the Free Software Foundation; either
+;;; version 2.1 of the License, or (at your option) any later version.
+;;;
+;;; GnuTLS is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with GnuTLS; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
+
+;;; Written by Ludovic Courtès <ludo@chbouib.org>.
+
+
+;;;
+;;; Test TLS 1.3 re-authentication requests.
+;;;
+
+(use-modules (gnutls)
+             (gnutls build tests)
+             (srfi srfi-4))
+
+
+;; TLS session settings.
+(define priorities
+  "NORMAL:+VERS-TLS1.3")
+
+;; Message sent by the client.
+(define %message
+  (cons "hello, world!" (iota 4444)))
+
+(define (import-something import-proc file fmt)
+  (let* ((path (search-path %load-path file))
+         (size (stat:size (stat path)))
+         (raw  (make-u8vector size)))
+    (uniform-vector-read! raw (open-input-file path))
+    (import-proc raw fmt)))
+
+(define (import-key import-proc file)
+  (import-something import-proc file x509-certificate-format/pem))
+
+(define (import-dh-params file)
+  (import-something pkcs3-import-dh-parameters file
+                    x509-certificate-format/pem))
+
+;; Debugging.
+;; (set-log-level! 5)
+;; (set-log-procedure! (lambda (level str)
+;;                       (format #t "[~a|~a] ~a" (getpid) level str)))
+
+(run-test
+ (lambda ()
+   (let ((socket-pair (socketpair PF_UNIX SOCK_STREAM 0))
+         (pub         (import-key import-x509-certificate
+                                  "x509-certificate.pem"))
+         (sec         (import-key import-x509-private-key
+                                  "x509-key.pem")))
+     (with-child-process pid
+
+       ;; server-side
+       (let ((server (make-session connection-end/server
+                                   connection-flag/post-handshake-auth))
+             (dh     (import-dh-params "dh-parameters.pem")))
+         (set-session-priorities! server "NORMAL:+VERS-TLS1.3")
+         (set-session-transport-fd! server (port->fdes (cdr socket-pair)))
+         (let ((cred (make-certificate-credentials))
+               (trust-file (search-path %load-path
+                                        "x509-certificate.pem"))
+               (trust-fmt  x509-certificate-format/pem))
+           (set-certificate-credentials-dh-parameters! cred dh)
+           (set-certificate-credentials-x509-keys! cred (list pub) sec)
+           (set-certificate-credentials-x509-trust-file! cred
+                                                         trust-file
+                                                         trust-fmt)
+           (set-session-credentials! server cred))
+
+         (handshake server)
+         (let ((msg (read (session-record-port server)))
+               (auth-type (session-authentication-type server)))
+           (set-server-session-certificate-request! server
+                                                    certificate-request/request)
+
+           ;; Request a post-handshake reauthentication.
+           (reauthenticate server)
+
+           (write msg (session-record-port server))
+           (bye server close-request/rdwr)
+           (and (zero? (cdr (waitpid pid)))
+                (eq? auth-type credentials/certificate)
+                (equal? msg %message))))
+
+       ;; client-side (child process)
+       (let ((client (make-session connection-end/client
+                                   connection-flag/post-handshake-auth
+                                   connection-flag/auto-reauth))
+             (cred   (make-certificate-credentials)))
+         (set-session-priorities! client
+                                  "NORMAL:-VERS-ALL:+VERS-TLS1.3:+VERS-TLS1.2:+VERS-TLS1.0")
+         (set-certificate-credentials-x509-keys! cred (list pub) sec)
+         (set-session-credentials! client cred)
+
+         (set-session-transport-fd! client (port->fdes (car socket-pair)))
+
+         (handshake client)
+         (write %message (session-record-port client))
+
+         ;; In the middle of the 'read' call, we receive a post-handshake
+         ;; reauthentication request that should be automatically handled,
+         ;; thanks to CONNECTION-FLAG/AUTO-REAUTH.
+         (let ((msg (read (session-record-port client))))
+           (unless (equal? msg %message)
+             (error "wrong message" msg)))
+         (bye client close-request/rdwr)
+
+         (primitive-exit))))))