Adding upstream version 3.7.9.upstream/3.7.9upstream

Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>

14 files changed, 924 insertions, 0 deletions

diff --git a/guile/tests/anonymous-auth.scm b/guile/tests/anonymous-auth.scm
new file mode 100644
index 0000000..e9010bc
--- /dev/null
+++ b/guile/tests/anonymous-auth.scm
@@ -0,0 +1,93 @@
+;;; GnuTLS --- Guile bindings for GnuTLS.
+;;; Copyright (C) 2007-2013, 2016 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 session establishment using anonymous authentication.  Exercise the
+;;; record layer low-level API.
+;;;
+
+(use-modules (gnutls)
+             (gnutls build tests)
+             (srfi srfi-4))
+
+
+;; TLS session settings.
+(define priorities
+  "NONE:+VERS-TLS1.2:+CIPHER-ALL:+MAC-ALL:+SIGN-ALL:+COMP-ALL:+ANON-DH")
+
+;; Message sent by the client.
+(define %message (apply u8vector (iota 256)))
+
+(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-dh-params file)
+  (import-something pkcs3-import-dh-parameters file
+                    x509-certificate-format/pem))
+
+;; Debugging.
+;; (set-log-level! 100)
+;; (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)))
+     (with-child-process pid
+       ;; server-side
+       (let ((server (make-session connection-end/server)))
+         (set-session-priorities! server priorities)
+
+         (set-session-transport-fd! server (port->fdes (cdr socket-pair)))
+         (let ((cred (make-anonymous-server-credentials))
+               (dh-params (import-dh-params "dh-parameters.pem")))
+           ;; Note: DH parameter generation can take some time.
+           (set-anonymous-server-dh-parameters! cred dh-params)
+           (set-session-credentials! server cred))
+         (set-session-dh-prime-bits! server 1024)
+
+         (handshake server)
+         (let* ((buf (make-u8vector (u8vector-length %message)))
+                (amount (record-receive! server buf)))
+           (bye server close-request/rdwr)
+           (and (zero? (cdr (waitpid pid)))
+                (= amount (u8vector-length %message))
+                (equal? buf %message))))
+
+       ;; client-side (child process)
+       (let ((client (make-session connection-end/client)))
+         (set-session-priorities! client priorities)
+         (set-session-server-name! client
+                                   server-name-type/dns (gethostname))
+         (set-session-transport-fd! client (port->fdes (car socket-pair)))
+         (set-session-credentials! client (make-anonymous-client-credentials))
+         (set-session-dh-prime-bits! client 1024)
+
+         (handshake client)
+         (record-send client %message)
+         (bye client close-request/rdwr)
+
+         (primitive-exit))))))
+
+;;; arch-tag: 8c98de24-0a53-4290-974e-4b071ad162a0
diff --git a/guile/tests/dh-parameters.pem b/guile/tests/dh-parameters.pem
new file mode 100644
index 0000000..9a824c3
--- /dev/null
+++ b/guile/tests/dh-parameters.pem
@@ -0,0 +1,5 @@
+-----BEGIN DH PARAMETERS-----
+MIGGAoGAtkxw2jlsVCsrfLqxrN+IrF/3W8vVFvDzYbLmxi2GQv9s/PQGWP1d9i22
+P2DprfcJknWt7KhCI1SaYseOQIIIAYP78CfyIpGScW/vS8khrw0rlQiyeCvQgF3O
+GeGOEywcw+oQT4SmFOD7H0smJe2CNyjYpexBXQ/A0mbTF9QKm1cCAQU=
+-----END DH PARAMETERS-----
diff --git a/guile/tests/errors.scm b/guile/tests/errors.scm
new file mode 100644
index 0000000..b8d4623
--- /dev/null
+++ b/guile/tests/errors.scm
@@ -0,0 +1,44 @@
+;;; GnuTLS --- Guile bindings for GnuTLS.
+;;; 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
+;;; 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 the error/exception mechanism.
+;;;
+
+(use-modules (gnutls)
+             (gnutls build tests))
+
+(run-test
+ (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/pkcs-import-export.scm b/guile/tests/pkcs-import-export.scm
new file mode 100644
index 0000000..014f43a
--- /dev/null
+++ b/guile/tests/pkcs-import-export.scm
@@ -0,0 +1,52 @@
+;;; GnuTLS --- Guile bindings for GnuTLS.
+;;; Copyright (C) 2007-2012 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>.
+
+
+;;;
+;;; Exercise the DH/RSA PKCS3/PKCS1 export/import functions.
+;;;
+
+(use-modules (gnutls)
+             (gnutls build tests)
+             (srfi srfi-4))
+
+(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-dh-params file)
+  (import-something pkcs3-import-dh-parameters file
+                    x509-certificate-format/pem))
+
+(run-test
+    (lambda ()
+      (let* ((dh-params (import-dh-params "dh-parameters.pem"))
+             (export
+              (pkcs3-export-dh-parameters dh-params
+                                          x509-certificate-format/pem)))
+        (and (u8vector? export)
+             (let ((import
+                    (pkcs3-import-dh-parameters export
+                                                x509-certificate-format/pem)))
+               (dh-parameters? import))))))
+
+;;; arch-tag: adff0f07-479e-421e-b47f-8956e06b9902
diff --git a/guile/tests/premature-termination.scm b/guile/tests/premature-termination.scm
new file mode 100644
index 0000000..4c17da3
--- /dev/null
+++ b/guile/tests/premature-termination.scm
@@ -0,0 +1,92 @@
+;;; GnuTLS --- Guile bindings for GnuTLS.
+;;; Copyright (C) 2022 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 handling of premature session termination on the client side while
+;;; reading from a session record port.
+;;;
+
+(use-modules (gnutls)
+             (gnutls build tests)
+             (srfi srfi-4))
+
+;; TLS session settings.
+(define priorities
+  "NONE:+VERS-TLS1.2:+CIPHER-ALL:+MAC-ALL:+SIGN-ALL:+COMP-ALL:+ANON-DH")
+
+;; Message sent by the client.
+(define %message (apply u8vector (iota 256)))
+
+(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-dh-params file)
+  (import-something pkcs3-import-dh-parameters file
+                    x509-certificate-format/pem))
+
+;; Debugging.
+;; (set-log-level! 100)
+;; (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)))
+     (with-child-process pid
+       ;; server-side
+       (let ((server (make-session connection-end/server)))
+         (close-port (car socket-pair))           ;close the client end
+         (set-session-priorities! server priorities)
+         (set-session-transport-fd! server (fileno (cdr socket-pair)))
+         (let ((cred (make-anonymous-server-credentials))
+               (dh-params (import-dh-params "dh-parameters.pem")))
+           ;; Note: DH parameter generation can take some time.
+           (set-anonymous-server-dh-parameters! cred dh-params)
+           (set-session-credentials! server cred))
+         (set-session-dh-prime-bits! server 1024)
+
+         (handshake server)
+
+         (alarm 60)                               ;time out after a while
+         (close-port (cdr socket-pair))           ;close prematurely
+         (zero? (cdr (waitpid pid))))
+
+       ;; client-side (child process)
+       (let ((client (make-session connection-end/client)))
+         (close-port (cdr socket-pair))           ;close the server end
+         (set-session-priorities! client priorities)
+         (set-session-server-name! client
+                                   server-name-type/dns (gethostname))
+         (set-session-transport-fd! client (port->fdes (car socket-pair)))
+         (set-session-credentials! client (make-anonymous-client-credentials))
+         (set-session-dh-prime-bits! client 1024)
+
+         (handshake client)
+
+         ;; Read from the session record port: instead of getting an
+         ;; 'error/premature-termination' exception, we expect to get EOF.
+         (let* ((port (session-record-port client))
+                (read (read port)))
+           (format #t "client received ~s~%" read)
+           (primitive-exit (if (eof-object? read) 0 1))))))))
diff --git a/guile/tests/priorities.scm b/guile/tests/priorities.scm
new file mode 100644
index 0000000..6e83729
--- /dev/null
+++ b/guile/tests/priorities.scm
@@ -0,0 +1,70 @@
+;;; GnuTLS --- Guile bindings for GnuTLS
+;;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
+;;;
+;;; GnuTLS is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 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 General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GnuTLS-EXTRA; 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@gnu.org>.
+
+
+;;;
+;;; Exercise the priority API of GnuTLS.
+;;;
+
+(use-modules (gnutls)
+             (gnutls build tests)
+             (srfi srfi-1)
+             (srfi srfi-26))
+
+(define %valid-priority-strings
+  ;; Valid priority strings (from the manual).
+  '("NONE:+VERS-TLS1.2:+MAC-ALL:+RSA:+AES-128-CBC:+SIGN-ALL:+COMP-NULL"
+    "NORMAL:-ARCFOUR-128"
+    "SECURE128:-VERS-SSL3.0:+COMP-NULL"
+    "NONE:+VERS-TLS1.2:+AES-128-CBC:+RSA:+SHA1:+COMP-NULL:+SIGN-RSA-SHA1"))
+
+(define %invalid-priority-strings
+  ;; Invalid strings: the prefix and the suffix that leads to a parse error.
+  '(("" . "THIS-DOES-NOT-WORK")
+    ("NORMAL:" . "FAIL-HERE")
+    ("SECURE128:-VERS-SSL3.0:" . "+FAIL-HERE")
+    ("NONE:+VERS-TLS1.2:+AES-128-CBC:"
+     . "+FAIL-HERE:+SHA1:+COMP-NULL:+SIGN-RSA-SHA1")))
+
+(run-test
+
+    (lambda ()
+      (let ((s (make-session connection-end/client)))
+        ;; We shouldn't have any exception with the valid priority strings.
+        (for-each (cut set-session-priorities! s <>)
+                  %valid-priority-strings)
+
+        (every (lambda (prefix+suffix)
+                 (let* ((prefix (car prefix+suffix))
+                        (suffix (cdr prefix+suffix))
+                        (pos    (string-length prefix))
+                        (string (string-append prefix suffix)))
+                   (catch 'gnutls-error
+                     (lambda ()
+                       (let ((s (make-session connection-end/client)))
+                         ;; The following call should raise an exception.
+                         (set-session-priorities! s string)
+                         #f))
+                     (lambda (key err function error-location . unused)
+                       (and (eq? key 'gnutls-error)
+                            (eq? err error/invalid-request)
+                            (eq? function 'set-session-priorities!)
+                            (= error-location pos))))))
+               %invalid-priority-strings))))
diff --git a/guile/tests/reauth.scm b/guile/tests/reauth.scm
new file mode 100644
index 0000000..0f768e5
--- /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))))))
diff --git a/guile/tests/rsa-parameters.pem b/guile/tests/rsa-parameters.pem
new file mode 100644
index 0000000..b1cd7db
--- /dev/null
+++ b/guile/tests/rsa-parameters.pem
@@ -0,0 +1,15 @@
+-----BEGIN RSA PRIVATE KEY-----
+MIICWwIBAAKBgQDMOUZ0VEyX41ZLmZ7O0FPDaUYoJRFSoQF82TVt7zTcyLGTIoER
+QRpqpzA6DUyHZyX4bEodiCc4ks0efZYv7sjfz9pH1nEQiNe30ScFml79Yz8TmGtC
+aSiDEigZOq8F0NAzBgN9pfS5sxZw5yMK69m9DOUU/uQRJPM0nIaa6IHQ9QIDAQAB
+AoGAChNITcxr4/FwDDZFvrPJ8iHTN39OqbouQdvQdj4/KCZRlm31GqYQ2NKrPy3x
+SNvWpHkpNehF8RVS/85X1sEL0WJQ4h9/krWYsmO6h8ve/kMT6A2K2vVkv+Li/QBi
+6RyjP+FUcN5INe2cmRx7U04HaBoLyXg0wSOfRxpIez6nobkCQQDafbFQhGxqf0cS
+sMMu1jOX2HGGWwoPXWk8CANVmZWAZz3B507hc0di4ITgwTpw/JRr0RxzkEZQChLy
+RQDbW/5NAkEA70iPmsCVD7mSf8yo4h52YClmHhsHGkHD+kealg1Nq5LmnKoNftfa
+Ftg3wG8X7d86DU1pq1tJbRiUmxtgcGgBSQJABXNrUAnttn50ZHf6dpmrcddZhbOR
+va5j6LZ+ds09GJX6yXKe2isJFeNqDT1k2trCTSpLXmq0Bl0p+ddU3SQfZQJAXIXl
+KUSAHtV1pT8AqnZ29VXsq4Vt6KQ3YEZhqtW4C7jAvSEwGLTkGmM+o4URbqQbMVuW
+mXCx4qJXi+Y5Ex3UKQJAcuKAICXkM0Zi2aKE5Rv64w30VRbT2dNFGw2hWoHcQU9X
+S6Bf9LJmL8rJ8GOqwjEO8TbnAn+yNevd9zuFsGbw9A==
+-----END RSA PRIVATE KEY-----
diff --git a/guile/tests/session-record-port.scm b/guile/tests/session-record-port.scm
new file mode 100644
index 0000000..6a7ec03
--- /dev/null
+++ b/guile/tests/session-record-port.scm
@@ -0,0 +1,134 @@
+;;; GnuTLS --- Guile bindings for GnuTLS.
+;;; Copyright (C) 2007-2012, 2014, 2016, 2022 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 session establishment using anonymous authentication.  Exercise the
+;;; `session-record-port' API.
+;;;
+
+(use-modules (gnutls)
+             (gnutls build tests)
+             (srfi srfi-4))
+
+;; TLS session settings.
+(define priorities
+  "NONE:+VERS-TLS1.2:+CIPHER-ALL:+MAC-ALL:+SIGN-ALL:+COMP-ALL:+ANON-DH")
+
+;; Message sent by the client.
+(define %message (apply u8vector (iota 256)))
+
+(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-dh-params file)
+  (import-something pkcs3-import-dh-parameters file
+                    x509-certificate-format/pem))
+
+;; Debugging.
+;; (set-log-level! 100)
+;; (set-log-procedure! (lambda (level str)
+;;                       (format #t "[~a|~a] ~a" (getpid) level str)))
+
+(run-test
+ (lambda ()
+   ;; Stress the GC.  In 0.0, this triggered an abort due to
+   ;; "scm_unprotect_object called during GC".
+   (let ((sessions (map (lambda (i)
+                          (make-session connection-end/server))
+                        (iota 123))))
+     (for-each session-record-port sessions)
+     (gc)(gc)(gc))
+
+   ;; Stress the GC.  The session associated with each port in PORTS should
+   ;; remain reachable.
+   (let ((ports (map session-record-port
+                     (map (lambda (i)
+                            (make-session connection-end/server))
+                          (iota 123)))))
+     (gc)(gc)(gc)
+     (for-each (lambda (p)
+                 (catch 'gnutls-error
+                   (lambda ()
+                     (read p))
+                   (lambda (key . args)
+                     #t)))
+               ports))
+
+   ;; Try using the record port for I/O.
+   (let ((socket-pair (socketpair PF_UNIX SOCK_STREAM 0)))
+     (with-child-process pid
+
+       ;; server-side
+       (let ((server (make-session connection-end/server)))
+         (set-session-priorities! server priorities)
+
+         (set-session-transport-fd! server (fileno (cdr socket-pair)))
+         (let ((cred (make-anonymous-server-credentials))
+               (dh-params (import-dh-params "dh-parameters.pem")))
+           ;; Note: DH parameter generation can take some time.
+           (set-anonymous-server-dh-parameters! cred dh-params)
+           (set-session-credentials! server cred))
+         (set-session-dh-prime-bits! server 1024)
+
+         (handshake server)
+         (let* ((buf (make-u8vector (u8vector-length %message)))
+                (amount
+                 (uniform-vector-read! buf (session-record-port server))))
+           (bye server close-request/rdwr)
+
+           ;; Make sure we got everything right.
+           (and (eq? (session-record-port server)
+                     (session-record-port server))
+                (zero? (cdr (waitpid pid)))
+                (= amount (u8vector-length %message))
+                (equal? buf %message)
+                (eof-object?
+                 (read-char (session-record-port server)))
+
+                ;; Close the port and make sure its 'close' procedure is
+                ;; called.
+                (let* ((closed? #f)
+                       (port  (session-record-port server))
+                       (close (lambda (p)
+                                (format #t "closing port ~s~%" p)
+                                (set! closed? (eq? p port)))))
+                  (set-session-record-port-close! port close)
+                  (close-port port)
+                  closed?))))
+
+       ;; client-side (child process)
+       (let ((client (make-session connection-end/client)))
+         (set-session-priorities! client priorities)
+
+         (set-session-transport-port! client (car socket-pair))
+         (set-session-credentials! client (make-anonymous-client-credentials))
+         (set-session-dh-prime-bits! client 1024)
+
+         (handshake client)
+         (uniform-vector-write %message (session-record-port client))
+         (bye client close-request/rdwr)
+
+         (primitive-exit))))))
+
+;;; arch-tag: e873226a-d0b6-4a93-87ec-a1b5ad2ae8a2
diff --git a/guile/tests/srp-base64.scm b/guile/tests/srp-base64.scm
new file mode 100644
index 0000000..2ad0221
--- /dev/null
+++ b/guile/tests/srp-base64.scm
@@ -0,0 +1,42 @@
+;;; GnuTLS --- Guile bindings for GnuTLS.
+;;; Copyright (C) 2007-2012 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 SRP base64 encoding and decoding.
+;;;
+
+(use-modules (gnutls)
+             (gnutls build tests))
+
+(define %message
+  "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.")
+
+(run-test
+ (lambda ()
+   (let ((encoded (srp-base64-encode %message)))
+     (and (string? encoded)
+          (string=? (srp-base64-decode encoded)
+                    %message)))))
+
+
+;;; arch-tag: ea1534a5-d513-4208-9a75-54bd4710f915
diff --git a/guile/tests/x509-auth.scm b/guile/tests/x509-auth.scm
new file mode 100644
index 0000000..21f192f
--- /dev/null
+++ b/guile/tests/x509-auth.scm
@@ -0,0 +1,110 @@
+;;; GnuTLS --- Guile bindings for GnuTLS.
+;;; Copyright (C) 2007-2014, 2016 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 session establishment using X.509 certificate authentication.
+;;; Based on `openpgp-auth.scm'.
+;;;
+
+(use-modules (gnutls)
+             (gnutls build tests)
+             (srfi srfi-4))
+
+;; TLS session settings.
+(define priorities
+  "NORMAL")
+
+;; 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! 3)
+;; (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))
+             (dh     (import-dh-params "dh-parameters.pem")))
+         (set-session-priorities! server priorities)
+         (set-server-session-certificate-request! server
+                                                  certificate-request/require)
+
+         (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))
+         (set-session-dh-prime-bits! server 1024)
+
+         (handshake server)
+         (let ((msg (read (session-record-port server)))
+               (auth-type (session-authentication-type 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))
+             (cred   (make-certificate-credentials)))
+         (set-session-priorities! client priorities)
+         (set-certificate-credentials-x509-keys! cred (list pub) sec)
+         (set-session-credentials! client cred)
+         (set-session-dh-prime-bits! client 1024)
+
+         (set-session-transport-fd! client (port->fdes (car socket-pair)))
+
+         (handshake client)
+         (write %message (session-record-port client))
+         (bye client close-request/rdwr)
+
+         (primitive-exit))))))
+
+;;; arch-tag: 1f88f835-a5c8-4fd6-94b6-5a13571ba03d
diff --git a/guile/tests/x509-certificate.pem b/guile/tests/x509-certificate.pem
new file mode 100644
index 0000000..f6f4bed
--- /dev/null
+++ b/guile/tests/x509-certificate.pem
@@ -0,0 +1,32 @@
+-----BEGIN CERTIFICATE-----
+MIICmDCCAgOgAwIBAgIBAjALBgkqhkiG9w0BAQUwUjELMAkGA1UEBhMCR1IxDDAK
+BgNVBAoTA0ZTRjEPMA0GA1UECxMGR05VVExTMSQwIgYDVQQDExtHTlVUTFMgSU5U
+RVJNRURJQVRFIFRFU1QgQ0EwHhcNMDQwNjI4MjI0NzAwWhcNMDcwMzIyMjI0NzAw
+WjBJMQswCQYDVQQGEwJHUjEMMAoGA1UEChMDRlNGMQ8wDQYDVQQLEwZHTlVUTFMx
+GzAZBgNVBAMTEkdOVVRMUyBURVNUIFNFUlZFUjCBnDALBgkqhkiG9w0BAQEDgYwA
+MIGIAoGA1chUqA9ib8S5GKd29B9d1rwgUncFhJPu0+RK8kOyOsV3qBdtdWeBSiGW
+So1RHkcmV9BlbUtmuHioAUkZPSo8gtoEy3JpSemW221BsjwITjGeZxZsb+4C/U2X
+HUIlO+jqBK5VYbpNXkP/2ofMkWWAZyKnI+PMIfFvv/cASsI0k48CAwEAAaOBjTCB
+ijAMBgNVHRMBAf8EAjAAMBQGA1UdEQQNMAuCCWxvY2FsaG9zdDATBgNVHSUEDDAK
+BggrBgEFBQcDATAPBgNVHQ8BAf8EBQMDB6AAMB0GA1UdDgQWBBTIZD/hlqUB89OE
+AwonwqGflkHtijAfBgNVHSMEGDAWgBQ2tS+xHdrw3r4o20MwGkLdzh5UlDALBgkq
+hkiG9w0BAQUDgYEAWPpWlUlvzDZRbpneYw8d6Q8On/ZPmSYBCm38vTKPEoNA6lW1
+WIc3Vbw5zOeSfDLifIWV2W/MqyjDo9MeWvSKpcUfRfibpXBgbA4RAGW0j2K1JQmE
+gP3k1vMicYzn5EglhZjoa9I+36a90vJraqzHQ7DrKtW0FDfW2GREzSh9RV8=
+-----END CERTIFICATE-----
+
+-----BEGIN CERTIFICATE-----
+MIICajCCAdWgAwIBAgIBATALBgkqhkiG9w0BAQUwRTELMAkGA1UEBhMCR1IxDDAK
+BgNVBAoTA0ZTRjEPMA0GA1UECxMGR05VVExTMRcwFQYDVQQDEw5HTlVUTFMgVEVT
+VCBDQTAeFw0wNDA2MjgyMjQ2MDBaFw0wNzAzMjMyMjQ2MDBaMFIxCzAJBgNVBAYT
+AkdSMQwwCgYDVQQKEwNGU0YxDzANBgNVBAsTBkdOVVRMUzEkMCIGA1UEAxMbR05V
+VExTIElOVEVSTUVESUFURSBURVNUIENBMIGcMAsGCSqGSIb3DQEBAQOBjAAwgYgC
+gYC0JKSLzHuiWK66XYOJk6AxDBo94hdCFnfIor7xnZkqTgiUQZhk9HDVmmz1+tLd
+yJk6r9PK+WMDDBkSOvT+SmQNd9mL2JzI+bJWwoB77aJ7vUI3/9+ugtffiapnX6wx
+vLyAxeJRyN0Q3oBHc6N2dJo9z1NHoFe8xipXXHOdxU1DAwIDAQABo2QwYjAPBgNV
+HRMBAf8EBTADAQH/MA8GA1UdDwEB/wQFAwMHBAAwHQYDVR0OBBYEFDa1L7Ed2vDe
+vijbQzAaQt3OHlSUMB8GA1UdIwQYMBaAFHnrG2+jZuZ54dHitdvaJwZFKQpIMAsG
+CSqGSIb3DQEBBQOBgQCi/SI37DrGCeZhtGhU2AyZFaqskRoFt4zAb9UYaGZaYEh5
+0VUZsA/Ol8jiiQTtiCokZswhSsn+2McZmcspKigsY2aEBrry+TGFWMnYu5j5kcwP
+1nVuHxLRwLt2rIsjgkeSNdHr8XHKi9/Roz/Gj86OnBAHwPt8WHfHK+63cMX1WA==
+-----END CERTIFICATE-----
diff --git a/guile/tests/x509-certificates.scm b/guile/tests/x509-certificates.scm
new file mode 100644
index 0000000..874c8ac
--- /dev/null
+++ b/guile/tests/x509-certificates.scm
@@ -0,0 +1,99 @@
+;;; GnuTLS --- Guile bindings for GnuTLS.
+;;; Copyright (C) 2007-2012, 2021 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>.
+
+
+;;;
+;;; Exercise the X.509 certificate API.
+;;;
+
+(use-modules (gnutls)
+             (gnutls build tests)
+             (srfi srfi-4)
+             (srfi srfi-11)
+             (ice-9 format))
+
+(define %certificate-file
+  (search-path %load-path "x509-certificate.pem"))
+
+(define %private-key-file
+  (search-path %load-path "x509-key.pem"))
+
+(define %first-oid
+  ;; The certificate's first OID.
+  "2.5.4.6")
+
+(define %signature-algorithm
+  ;; The certificate's signature algorithm.
+  sign-algorithm/rsa-sha1)
+
+(define %sha1-fingerprint
+  ;; The certificate's SHA-1 fingerprint.
+  "7c55df47de718869d55998ee1e9301331ccd0601")
+
+(define %sha256-fingerprint
+  ;; The certificate's SHA-256 fingerprint.
+  "0db40a5ee20169d25f090e4d165d87266b1a04722cddec4da36692c81c3096f6")
+
+
+(define (file-size file)
+  (stat:size (stat file)))
+
+(define (u8vector->hex-string u8vector)
+  (string-join (map (lambda (u8) (format #f "~2,'0x" u8))
+                    (u8vector->list u8vector))
+               ""))
+
+
+(run-test
+    (lambda ()
+      (let ((raw-certificate (make-u8vector (file-size %certificate-file)))
+            (raw-privkey     (make-u8vector (file-size %private-key-file))))
+
+        (uniform-vector-read! raw-certificate
+                              (open-input-file %certificate-file))
+        (uniform-vector-read! raw-privkey
+                              (open-input-file %private-key-file))
+
+        (let ((cert (import-x509-certificate raw-certificate
+                                             x509-certificate-format/pem))
+              (sec  (import-x509-private-key raw-privkey
+                                             x509-certificate-format/pem)))
+
+          (and (x509-certificate? cert)
+               (x509-private-key? sec)
+               (string? (x509-certificate-dn cert))
+               (string? (x509-certificate-issuer-dn cert))
+               (string=? (x509-certificate-dn-oid cert 0) %first-oid)
+               (eq? (x509-certificate-signature-algorithm cert)
+                    %signature-algorithm)
+               (x509-certificate-matches-hostname? cert "localhost")
+               (let-values (((type name)
+                             (x509-certificate-subject-alternative-name
+                              cert 0)))
+                 (and (string? name)
+                      (string?
+                       (x509-subject-alternative-name->string type))))
+               (equal? (u8vector->hex-string
+                        (x509-certificate-fingerprint cert digest/sha1))
+                       %sha1-fingerprint)
+               (equal? (u8vector->hex-string
+                        (x509-certificate-fingerprint cert digest/sha256))
+                       %sha256-fingerprint))))))
+
+;;; arch-tag: eef09b52-30e8-472a-8b93-cb636434f6eb
diff --git a/guile/tests/x509-key.pem b/guile/tests/x509-key.pem
new file mode 100644
index 0000000..1e80b2e
--- /dev/null
+++ b/guile/tests/x509-key.pem
@@ -0,0 +1,15 @@
+-----BEGIN RSA PRIVATE KEY-----
+MIICWwIBAAKBgQDVyFSoD2JvxLkYp3b0H13WvCBSdwWEk+7T5EryQ7I6xXeoF211
+Z4FKIZZKjVEeRyZX0GVtS2a4eKgBSRk9KjyC2gTLcmlJ6ZbbbUGyPAhOMZ5nFmxv
+7gL9TZcdQiU76OoErlVhuk1eQ//ah8yRZYBnIqcj48wh8W+/9wBKwjSTjwIDAQAB
+AoGAAn2Ueua++1Vb4K0mxh5NbhCAAeXwEwTULfTFaMAgJe4iADvRoyIDEBWHFjRC
+QyuKB1DetaDAwBprvqQW3q8MyGYD7P9h85Wfu/hpIYKTw9hNeph420aE8WXw2ygl
+TkJz3bzkMrXe/WjdhS1kTt8avCNQR/p0jM/UHvNze4oLc1ECQQDfammiczQFtj+F
+uf3CNcYwp5XNumF+pubdGb+UHUiHyCuVQxvm+LXgq8wXV/uXFLrp7FQFLCDQf0ji
+KDB2YQvRAkEA9PY/2AaGsU7j8ePwQbxCkwuj3hY6O6aNLIGxKxwZrzbob26c+tQk
+/++e0IXusIscBvcRV1Kg8Ff6fnw7/AdhXwJAG8qVbOuRmGk0BkwuFmPoeW3vNQgR
+X96O7po0qPBqVdRAU2rvzYtkCFxYqq0ilI0ekZtAfKxbeykaQaRkkKPaoQJAcifP
+yWJ/tu8z4DM7Ka+pFqTMwIllM1U3vFtv3LXezDE7AGDCyHKdB7MXcPXqj6nmCLMi
+swwiLLahAOBnUqk6xwJAJQ4pGcFFlCiIiVsq0wYSYmZUcRpSIInEQ0f8/xN6J22Z
+siP5vnJM3F7R6ciYTt2gzNci/W9cdZI2HxskkO5lbQ==
+-----END RSA PRIVATE KEY-----