Started Guile integration.

Documentation is still missing.  A bit rough on the edges, but `make'
and `make check' do work.

19 files changed, 1082 insertions, 0 deletions

diff --git a/guile/tests/Makefile.am b/guile/tests/Makefile.am
new file mode 100644
index 0000000000..b0109217f4
--- /dev/null
+++ b/guile/tests/Makefile.am
@@ -0,0 +1,30 @@
+#  GNUTLS -- Guile bindings for GnuTLS.
+#  Copyright (C) 2007  Free Software Foundation
+#
+#  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
+
+TESTS = anonymous-auth.scm session-record-port.scm		\
+        pkcs-import-export.scm					\
+	openpgp-keys.scm openpgp-keyring.scm openpgp-auth.scm	\
+        srp-base64.scm errors.scm				\
+	x509-certificates.scm x509-auth.scm
+
+TESTS_ENVIRONMENT = $(top_builddir)/guile/pre-inst-guile -L $(srcdir)
+
+
+EXTRA_DIST = $(TESTS) openpgp-pub.asc openpgp-sec.asc	\
+             openpgp-keyring.gpg openpgp-keyring.asc	\
+	     rsa-parameters.pem				\
+	     x509-certificate.pem x509-key.pem
diff --git a/guile/tests/anonymous-auth.scm b/guile/tests/anonymous-auth.scm
new file mode 100644
index 0000000000..eb4375fc3b
--- /dev/null
+++ b/guile/tests/anonymous-auth.scm
@@ -0,0 +1,102 @@
+;;; GNUTLS --- Guile bindings for GnuTLS.
+;;; Copyright (C) 2007  Free Software Foundation
+;;;
+;;; 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)
+             (srfi srfi-4))
+
+
+;; TLS session settings.
+(define %protos  (list protocol/tls-1.0))
+(define %certs   '())
+(define %ciphers (list cipher/null cipher/arcfour cipher/aes-128-cbc
+                       cipher/aes-256-cbc))
+(define %kx      (list kx/anon-dh))
+(define %macs    (list mac/sha1 mac/rmd160 mac/md5))
+
+;; Message sent by the client.
+(define %message (apply u8vector (iota 256)))
+
+;; Debugging.
+;; (set-log-level! 100)
+;; (set-log-procedure! (lambda (level str)
+;;                       (format #t "[~a|~a] ~a" (getpid) level str)))
+
+(dynamic-wind
+    (lambda ()
+      #t)
+
+    (lambda ()
+      (let ((socket-pair (socketpair PF_UNIX SOCK_STREAM 0))
+            (pid         (primitive-fork)))
+        (if (= 0 pid)
+
+            (let ((client (make-session connection-end/client)))
+              ;; client-side (child process)
+              (set-session-default-priority! client)
+              (set-session-certificate-type-priority! client %certs)
+              (set-session-kx-priority! client %kx)
+              (set-session-protocol-priority! client %protos)
+              (set-session-cipher-priority! client %ciphers)
+              (set-session-mac-priority! client %macs)
+
+              (set-session-transport-fd! client (fileno (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)
+
+              (exit))
+
+            (let ((server (make-session connection-end/server)))
+              ;; server-side
+              (set-session-default-priority! server)
+              (set-session-certificate-type-priority! server %certs)
+              (set-session-kx-priority! server %kx)
+              (set-session-protocol-priority! server %protos)
+              (set-session-cipher-priority! server %ciphers)
+              (set-session-mac-priority! server %macs)
+
+              (set-session-transport-fd! server (fileno (cdr socket-pair)))
+              (let ((cred (make-anonymous-server-credentials))
+                    (dh-params (make-dh-parameters 1024)))
+                ;; 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)
+                (exit (= amount (u8vector-length %message))
+                      (equal? buf %message)))))))
+
+    (lambda ()
+      ;; failure
+      (exit 1)))
+
+;;; arch-tag: 8c98de24-0a53-4290-974e-4b071ad162a0
diff --git a/guile/tests/errors.scm b/guile/tests/errors.scm
new file mode 100644
index 0000000000..d739cecb40
--- /dev/null
+++ b/guile/tests/errors.scm
@@ -0,0 +1,46 @@
+;;; GNUTLS --- Guile bindings for GnuTLS.
+;;; Copyright (C) 2007  Free Software Foundation
+;;;
+;;; 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))
+
+(dynamic-wind
+    (lambda ()
+      #t)
+
+    (lambda ()
+      (let ((s (make-session connection-end/server)))
+        (catch 'gnutls-error
+          (lambda ()
+            (handshake s))
+          (lambda (key err function . currently-unused)
+            (exit (and (eq? key 'gnutls-error)
+                       err
+                       (string? (error->string err))
+                       (eq? function 'handshake)))))))
+
+    (lambda ()
+      ;; failure
+      (exit 1)))
+
+;;; arch-tag: 73ed6229-378d-4a12-a5c6-4c2586c6e3a2
diff --git a/guile/tests/openpgp-auth.scm b/guile/tests/openpgp-auth.scm
new file mode 100644
index 0000000000..bdc1d97d43
--- /dev/null
+++ b/guile/tests/openpgp-auth.scm
@@ -0,0 +1,132 @@
+;;; GNUTLS-EXTRA --- Guile bindings for GnuTLS-EXTRA.
+;;; Copyright (C) 2007  Free Software Foundation
+;;;
+;;; GNUTLS-EXTRA 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 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; GNUTLS-EXTRA 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@chbouib.org>.
+
+
+;;;
+;;; Test session establishment using OpenPGP certificate authentication.
+;;;
+;;; XXX: `set-certificate-credentials-openpgp-keys!' is broken (i.e.,
+;;; segfaults) in GnuTLS 1.7.2 and earlier.
+;;;
+
+(use-modules (gnutls)
+             (gnutls extra)
+             (srfi srfi-4))
+
+
+;; TLS session settings.
+(define %protos  (list protocol/tls-1.0))
+(define %certs   (list certificate-type/openpgp))
+(define %ciphers (list cipher/null cipher/arcfour cipher/aes-128-cbc
+                       cipher/aes-256-cbc))
+(define %kx      (list kx/rsa kx/rsa-export kx/dhe-dss kx/dhe-dss))
+(define %macs    (list mac/sha1 mac/rmd160 mac/md5))
+
+;; 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 openpgp-key-format/base64))
+
+(define (import-rsa-params file)
+  (import-something pkcs1-import-rsa-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)))
+
+(dynamic-wind
+    (lambda ()
+      #t)
+
+    (lambda ()
+      (let ((socket-pair (socketpair PF_UNIX SOCK_STREAM 0))
+            (pub         (import-key import-openpgp-public-key
+                                     "openpgp-pub.asc"))
+            (sec         (import-key import-openpgp-private-key
+                                     "openpgp-sec.asc")))
+        (let ((pid (primitive-fork)))
+          (if (= 0 pid)
+
+              (let ((client (make-session connection-end/client))
+                    (cred   (make-certificate-credentials)))
+                ;; client-side (child process)
+                (set-session-default-priority! client)
+                (set-session-certificate-type-priority! client %certs)
+                (set-session-kx-priority! client %kx)
+                (set-session-protocol-priority! client %protos)
+                (set-session-cipher-priority! client %ciphers)
+                (set-session-mac-priority! client %macs)
+
+                (set-certificate-credentials-openpgp-keys! cred pub sec)
+                (set-session-credentials! client cred)
+                (set-session-dh-prime-bits! client 1024)
+
+                (set-session-transport-fd! client (fileno (car socket-pair)))
+
+                (handshake client)
+                (write %message (session-record-port client))
+                (bye client close-request/rdwr)
+
+                (exit))
+
+              (let ((server (make-session connection-end/server))
+                    (rsa    (import-rsa-params "rsa-parameters.pem"))
+                    (dh     (make-dh-parameters 1024)))
+                ;; server-side
+                (set-session-default-priority! server)
+                (set-session-certificate-type-priority! server %certs)
+                (set-session-kx-priority! server %kx)
+                (set-session-protocol-priority! server %protos)
+                (set-session-cipher-priority! server %ciphers)
+                (set-session-mac-priority! server %macs)
+                (set-server-session-certificate-request! server
+                         certificate-request/require)
+
+                (set-session-transport-fd! server (fileno (cdr socket-pair)))
+                (let ((cred (make-certificate-credentials)))
+                  (set-certificate-credentials-dh-parameters! cred dh)
+                  (set-certificate-credentials-rsa-export-parameters! cred rsa)
+                  (set-certificate-credentials-openpgp-keys! cred pub sec)
+                  (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)
+                  (exit (and (eq? auth-type credentials/certificate)
+                             (equal? msg %message)))))))))
+
+    (lambda ()
+      ;; failure
+      (exit 1)))
+
+;;; arch-tag: 1a973ed5-f45d-45a4-8160-900b6a8c27ff
diff --git a/guile/tests/openpgp-keyring.asc b/guile/tests/openpgp-keyring.asc
new file mode 100644
index 0000000000..4495a5a8e3
--- /dev/null
+++ b/guile/tests/openpgp-keyring.asc
@@ -0,0 +1,37 @@
+-----BEGIN PGP PUBLIC KEY BLOCK-----
+Version: GnuPG v1.4.6 (GNU/Linux)
+
+mQGiBDxnlY0RBACAsWUhi/goBvpvTBgL8fFPwBAuD04VYFEtC7+4pBp6kFsHjUR7
+TTUkBsOk2PvMHrDdv0+C4x2CH8YGP1e+O0f2yLWk8Uu+kkF12yiqbbvDEiCdeJT6
+c3vIstY8vJ9Jso5g/LB8Xggq88R7jXFS3hH+WC5v/6P6SARfzXl457cVewCgvxSf
+Gsm9mFospJ0B3RGyg5MB0d8D/RQQryJCGdR2nLe4VfctPL2QBD/1XhtubqEbetaV
+PxssqrJdA+eplBRT7UHokSBahM8gmSmNuSrLDujPfEtaMg6YIkB+Kq0VeJLE0cXT
+ZIH29KJlI/qk1xG4K7D6B0cKaHC/L4BIoKcQLJzfTIPw3frS4jVeNaQZNHSVqZ8/
+VmOMA/9rkNtccQ4RVd9WTFoHKvT4vfiISEOIzKGmcBY9Hymq7MCci3mNe4CDImkv
+ZgnjDlJAM91CX1ODthPLBqvyhnMhhxDnaDl4Nh42uPMSr9JEW2IwoIbFne10ihGT
+O4lBS1C28UfSGEMm/8JBMtxAjbYy3BYzUtCMA+bGBG6Voe5i5LQlRHIuIFdobyAo
+Tm8gY29tbWVudHMpIDx3aG9Ad2hvaXMub3JnPohdBBMRAgAdBQI8Z5WNBQkDwmcA
+BQsHCgMEAxUDAgMWAgECF4AACgkQNRRc6qfZPD+WWACfeJnLyfbpTDB7mDh3aATb
++0PXz28AoKRdApBVM6Bty+vWyXH6HfF6ZTj+mQGiBDxKxWwRBADnLna2Lu+po71Z
+QJMpJBgFDALXAp1sogZu/DTIYDhifGQ+saZSp68dN89G/FBaweDGmbN4lbS8s+U1
+Qf/aR2bWFowriq/WqyJGbQbRgDTV2saY5pk7pbNQ/4IuHNhwKnURTotzprCcs7k8
+5E27UWybtflbtmYYhgKgoURyNsBljwCgj1teeNhfeSzCBy+UdGRXJvtNk3MD/jV4
+1onWYG6RGOn5pwQrljzyPz2PE3eic8Dwl02/RLPKvL4U3WRBJVWGPjmpxidmLXes
+NmYq5El5LDJi0/EumDKnVlMJ1nugrk3yX17aCTcFatW+ifQGnr1+x2zkMkQd9dUv
+/9BtOeX2HjaUe2mKd8tiq4HkpBIr+QUGcdmUbIZeBADQYUN6lk3eMYgYwrJN4Ajm
+AJa2DbimhLhag40Rn8kwMRiJrVejuSf0SPhOslPGI+2nO0L/eLzmOmpTHXWmTOhU
+BROAjp9bEM4HXTQXuAEWSRixMdNUTIdlqOy5lx9hoJ/HPVCYBhBrWXfSEcsOHQTQ
+7Za86Juuj3PYALBSE5y/jbRJT3BlbkNESyB0ZXN0IGtleSAoT25seSBpbnRlbmRl
+ZCBmb3IgdGVzdCBwdXJwb3NlcyEpIDxvcGVuY2RrQGZvby1iYXIub3JnPohiBBMR
+AgAaBQI8SsVsBQsHCgMEAxUDAgMWAgECHgECF4AAEgkQvVcs3MzAfDUHZUdQRwAB
+AYHBAJwOEo2O1ER8bcvOYVDZzYbiDYRZpQCfZoFmLIDGqs8dLSvCBPCC/oDT26S5
+AQ0EPErFbxAEAOIBVlJgadBn0k9NcebThljgi+O/JGwa3OCNtpzY1FnB7TNXOEEH
+mHVa/befF5fPAi5wx5YPEspoltJ8/SShHNMW3eH7zB6mFcXDH+xlbkZweMh1/FCb
+HsuZyLVsLYdcUOIBi1sPo3hgbrZCWiUzgw9V/SHWSQFWFdSaHQnpUQ9fAAMFBADQ
+va3kBDJ1hnXIfQcww2CYFGe64b62zBBaPB82a/2+oS43hFZRMji4rUFOUqKpZh0d
+8dtrtfM/aQYWYQdVbIEyJDMLMJMtt8jMgiVnLXriSvJGl1DlObZh6mR10uA82NOD
+jcSorEr9ITU2/j6W7J0K6mUWS1duAbN6jcqJ8rJX0IhOBBgRAgAGBQI8SsVvABIJ
+EL1XLNzMwHw1B2VHUEcAAQF1ZgCfYB4fmeCwfHfmfz7soeGflGPTc2cAn2rGnrQR
+mm/79Enn0VTYLgXUCGHb
+=7B/E
+-----END PGP PUBLIC KEY BLOCK-----
diff --git a/guile/tests/openpgp-keyring.gpg b/guile/tests/openpgp-keyring.gpg
new file mode 100644
index 0000000000..f78440407b
--- /dev/null
+++ b/guile/tests/openpgp-keyring.gpg
diff --git a/guile/tests/openpgp-keyring.scm b/guile/tests/openpgp-keyring.scm
new file mode 100644
index 0000000000..6a25f866da
--- /dev/null
+++ b/guile/tests/openpgp-keyring.scm
@@ -0,0 +1,79 @@
+;;; GNUTLS-EXTRA --- Guile bindings for GnuTLS-EXTRA.
+;;; Copyright (C) 2007  Free Software Foundation
+;;;
+;;; GNUTLS-EXTRA 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 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; GNUTLS-EXTRA 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@chbouib.org>.
+
+
+;;;
+;;; Exercise the OpenPGP keyring API part of GnuTLS-extra.
+;;;
+;;; XXX: Keyring import is broken in GnuTLS versions up to and including 1.7.8.
+;;;
+
+(use-modules (gnutls extra) (gnutls)
+             (srfi srfi-1)
+             (srfi srfi-4))
+
+(define %raw-keyring-file
+  (search-path %load-path "openpgp-keyring.gpg"))
+
+(define %ascii-keyring-file
+  (search-path %load-path "openpgp-keyring.asc"))
+
+(define %ids-in-keyring
+  ;; The IDs of keys that are in the keyring.
+  ;; Change me if you change the keyring file.
+  (list '#u8(#x35 #x14 #x5c #xea
+             #xa7 #xd9 #x3c #x3f)
+        '#u8(#xbd #x57 #x2c #xdc
+             #xcc #xc0 #x7c #x35)))
+
+(define (file-size file)
+  (stat:size (stat file)))
+
+(define (valid-keyring? file format)
+  ;; Return true if FILE contains a valid keyring encoded in FORMAT.
+  (let ((raw-keyring (make-u8vector (file-size file))))
+
+    (uniform-vector-read! raw-keyring (open-input-file file))
+
+    (let ((keyring (import-openpgp-keyring raw-keyring format))
+          (null-id (make-u8vector 8 0)))
+
+      (and (openpgp-keyring? keyring)
+           (not (openpgp-keyring-contains-key-id? keyring null-id))
+           (every (lambda (id)
+                    (openpgp-keyring-contains-key-id? keyring id))
+                  %ids-in-keyring)))))
+
+(dynamic-wind
+
+    (lambda ()
+      #t)
+
+    (lambda ()
+      (exit
+       (every valid-keyring?
+              (list %raw-keyring-file      %ascii-keyring-file)
+              (list openpgp-key-format/raw openpgp-key-format/base64))))
+
+    (lambda ()
+      ;; failure
+      (exit 1)))
+
+;;; arch-tag: 516bf608-5c8b-4787-abe9-5f7b6e6d660b
diff --git a/guile/tests/openpgp-keys.scm b/guile/tests/openpgp-keys.scm
new file mode 100644
index 0000000000..29cbe821ef
--- /dev/null
+++ b/guile/tests/openpgp-keys.scm
@@ -0,0 +1,79 @@
+;;; GNUTLS-EXTRA --- Guile bindings for GnuTLS-EXTRA.
+;;; Copyright (C) 2007  Free Software Foundation
+;;;
+;;; GNUTLS-EXTRA 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 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; GNUTLS-EXTRA 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@chbouib.org>.
+
+
+;;;
+;;; Exercise the OpenPGP key API part of GnuTLS-extra.
+;;;
+
+(use-modules (gnutls)
+             (gnutls extra)
+             (srfi srfi-1)
+             (srfi srfi-4)
+             (srfi srfi-11))
+
+(define %public-key-file
+  (search-path %load-path "openpgp-pub.asc"))
+
+(define %private-key-file
+  (search-path %load-path "openpgp-sec.asc"))
+
+(define %key-id
+  ;; Change me if you change the key files.
+  '#u8(#xbd #x57 #x2c #xdc #xcc #xc0 #x7c #x35))
+
+(define (file-size file)
+  (stat:size (stat file)))
+
+
+(dynamic-wind
+
+    (lambda ()
+      #t)
+
+    (lambda ()
+      (let ((raw-pubkey  (make-u8vector (file-size %public-key-file)))
+            (raw-privkey (make-u8vector (file-size %private-key-file))))
+
+        (uniform-vector-read! raw-pubkey (open-input-file %public-key-file))
+        (uniform-vector-read! raw-privkey (open-input-file %private-key-file))
+
+        (let ((pub (import-openpgp-public-key raw-pubkey
+                                              openpgp-key-format/base64))
+              (sec (import-openpgp-private-key raw-privkey
+                                               openpgp-key-format/base64)))
+
+          (exit (and (openpgp-public-key? pub)
+                     (openpgp-private-key? sec)
+                     (equal? (openpgp-public-key-id pub) %key-id)
+                     (u8vector? (openpgp-public-key-fingerprint pub))
+                     (every string? (openpgp-public-key-names pub))
+                     (member (openpgp-public-key-version pub) '(3 4))
+                     (list? (openpgp-public-key-usage pub))
+                     (let-values (((pk bits)
+                                   (openpgp-public-key-algorithm pub)))
+                       (and (string? (pk-algorithm->string pk))
+                            (number? bits))))))))
+
+    (lambda ()
+      ;; failure
+      (exit 1)))
+
+;;; arch-tag: 2ee2a377-7f4d-4031-92a8-275090e4f83d
diff --git a/guile/tests/openpgp-pub.asc b/guile/tests/openpgp-pub.asc
new file mode 100644
index 0000000000..6bdfabf9d2
--- /dev/null
+++ b/guile/tests/openpgp-pub.asc
@@ -0,0 +1,24 @@
+-----BEGIN PGP PUBLIC KEY BLOCK-----
+
+mQGiBDxKxWwRBADnLna2Lu+po71ZQJMpJBgFDALXAp1sogZu/DTIYDhifGQ+saZS
+p68dN89G/FBaweDGmbN4lbS8s+U1Qf/aR2bWFowriq/WqyJGbQbRgDTV2saY5pk7
+pbNQ/4IuHNhwKnURTotzprCcs7k85E27UWybtflbtmYYhgKgoURyNsBljwCgj1te
+eNhfeSzCBy+UdGRXJvtNk3MD/jV41onWYG6RGOn5pwQrljzyPz2PE3eic8Dwl02/
+RLPKvL4U3WRBJVWGPjmpxidmLXesNmYq5El5LDJi0/EumDKnVlMJ1nugrk3yX17a
+CTcFatW+ifQGnr1+x2zkMkQd9dUv/9BtOeX2HjaUe2mKd8tiq4HkpBIr+QUGcdmU
+bIZeBADQYUN6lk3eMYgYwrJN4AjmAJa2DbimhLhag40Rn8kwMRiJrVejuSf0SPhO
+slPGI+2nO0L/eLzmOmpTHXWmTOhUBROAjp9bEM4HXTQXuAEWSRixMdNUTIdlqOy5
+lx9hoJ/HPVCYBhBrWXfSEcsOHQTQ7Za86Juuj3PYALBSE5y/jbRJT3BlbkNESyB0
+ZXN0IGtleSAoT25seSBpbnRlbmRlZCBmb3IgdGVzdCBwdXJwb3NlcyEpIDxvcGVu
+Y2RrQGZvby1iYXIub3JnPohaBBMRAgAaBQI8SsVsBQsHCgMEAxUDAgMWAgECHgEC
+F4AACgkQvVcs3MzAfDWBwQCcDhKNjtREfG3LzmFQ2c2G4g2EWaUAn2aBZiyAxqrP
+HS0rwgTwgv6A09ukuQENBDxKxW8QBADiAVZSYGnQZ9JPTXHm04ZY4IvjvyRsGtzg
+jbac2NRZwe0zVzhBB5h1Wv23nxeXzwIucMeWDxLKaJbSfP0koRzTFt3h+8wephXF
+wx/sZW5GcHjIdfxQmx7Lmci1bC2HXFDiAYtbD6N4YG62QlolM4MPVf0h1kkBVhXU
+mh0J6VEPXwADBQQA0L2t5AQydYZ1yH0HMMNgmBRnuuG+tswQWjwfNmv9vqEuN4RW
+UTI4uK1BTlKiqWYdHfHba7XzP2kGFmEHVWyBMiQzCzCTLbfIzIIlZy164kryRpdQ
+5Tm2YepkddLgPNjTg43EqKxK/SE1Nv4+luydCuplFktXbgGzeo3KifKyV9CIRgQY
+EQIABgUCPErFbwAKCRC9VyzczMB8NXVmAJ9gHh+Z4LB8d+Z/Puyh4Z+UY9NzZwCf
+asaetBGab/v0SefRVNguBdQIYds=
+=GwWK
+-----END PGP PUBLIC KEY BLOCK-----
diff --git a/guile/tests/openpgp-sec.asc b/guile/tests/openpgp-sec.asc
new file mode 100644
index 0000000000..58bafeea47
--- /dev/null
+++ b/guile/tests/openpgp-sec.asc
@@ -0,0 +1,32 @@
+-----BEGIN PGP PRIVATE KEY BLOCK-----
+
+lQG7BDxKxWwRBADnLna2Lu+po71ZQJMpJBgFDALXAp1sogZu/DTIYDhifGQ+saZS
+p68dN89G/FBaweDGmbN4lbS8s+U1Qf/aR2bWFowriq/WqyJGbQbRgDTV2saY5pk7
+pbNQ/4IuHNhwKnURTotzprCcs7k85E27UWybtflbtmYYhgKgoURyNsBljwCgj1te
+eNhfeSzCBy+UdGRXJvtNk3MD/jV41onWYG6RGOn5pwQrljzyPz2PE3eic8Dwl02/
+RLPKvL4U3WRBJVWGPjmpxidmLXesNmYq5El5LDJi0/EumDKnVlMJ1nugrk3yX17a
+CTcFatW+ifQGnr1+x2zkMkQd9dUv/9BtOeX2HjaUe2mKd8tiq4HkpBIr+QUGcdmU
+bIZeBADQYUN6lk3eMYgYwrJN4AjmAJa2DbimhLhag40Rn8kwMRiJrVejuSf0SPhO
+slPGI+2nO0L/eLzmOmpTHXWmTOhUBROAjp9bEM4HXTQXuAEWSRixMdNUTIdlqOy5
+lx9hoJ/HPVCYBhBrWXfSEcsOHQTQ7Za86Juuj3PYALBSE5y/jQAAn2P+O9oRyd/b
+1jXd4F2H8SSzMMu3DM/9JiM6RFNBX2ZhY3RvcjoAAK9+8VCrUSp2tkcQT5PxLJzr
+ENoOP4NB/SYjOkRTQV9mYWN0b3I6AACvTy8J9Y0wrRLLV4I96AjHaNfLwQp9E/0m
+IzpEU0FfZmFjdG9yOgAAr2T4CrVVKLaOwyIga909v8jvsToXmxu0SU9wZW5DREsg
+dGVzdCBrZXkgKE9ubHkgaW50ZW5kZWQgZm9yIHRlc3QgcHVycG9zZXMhKSA8b3Bl
+bmNka0Bmb28tYmFyLm9yZz6IWgQTEQIAGgUCPErFbAULBwoDBAMVAwIDFgIBAh4B
+AheAAAoJEL1XLNzMwHw1gcEAmQGbWA2HMKJfa1qvFUwrpVK9zdHtAJ9HHAujC4X+
+0AnRZNUKFdC94Ct+r50BMgQ8SsVvEAQA4gFWUmBp0GfST01x5tOGWOCL478kbBrc
+4I22nNjUWcHtM1c4QQeYdVr9t58Xl88CLnDHlg8SymiW0nz9JKEc0xbd4fvMHqYV
+xcMf7GVuRnB4yHX8UJsey5nItWwth1xQ4gGLWw+jeGButkJaJTODD1X9IdZJAVYV
+1JodCelRD18AAwUEANC9reQEMnWGdch9BzDDYJgUZ7rhvrbMEFo8HzZr/b6hLjeE
+VlEyOLitQU5SoqlmHR3x22u18z9pBhZhB1VsgTIkMwswky23yMyCJWcteuJK8kaX
+UOU5tmHqZHXS4DzY04ONxKisSv0hNTb+PpbsnQrqZRZLV24Bs3qNyonyslfQAAD6
+AqTLHwdVk3VLPMjSKNONdwwYPDTowJ5cHw5Uc2vRRG0OJf0mIzpFTEdfZmFjdG9y
+OgAAqwRFtBcGdsy2AtBSxX4HPMvtBiODIhf9JiM6RUxHX2ZhY3RvcjoAAKsFn0GK
+Y7/TzpNP3IdTXmkQfUXC+YpP/SYjOkVMR19mYWN0b3I6AACrBV0wh13upAu9+4N1
+rXOuK6EkJ4T1//0mIzpFTEdfZmFjdG9yOgAAqwbJVCRiM/nb341fujR8AELlrBOb
+Lqv9JiM6RUxHX2ZhY3RvcjoAAKsGhKSsyEs0Yrs4YvI0CBiIZn1b2G9LiEYEGBEC
+AAYFAjxKxW8ACgkQvVcs3MzAfDV1ZgCeLovqxqOYaIfjREbT8e9+2jy1D20An268
+JJzFTBkCFFN0YlBK57y6qjf0
+=0tJj
+-----END PGP PRIVATE KEY BLOCK-----
diff --git a/guile/tests/pkcs-import-export.scm b/guile/tests/pkcs-import-export.scm
new file mode 100644
index 0000000000..d202668c81
--- /dev/null
+++ b/guile/tests/pkcs-import-export.scm
@@ -0,0 +1,49 @@
+;;; GNUTLS --- Guile bindings for GnuTLS.
+;;; Copyright (C) 2007  Free Software Foundation
+;;;
+;;; 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)
+             (srfi srfi-4))
+
+(dynamic-wind
+
+    (lambda ()
+      #t)
+
+    (lambda ()
+      (exit
+       (let* ((dh-params (make-dh-parameters 1024))
+              (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))))))
+
+    (lambda ()
+      ;; failure
+      (exit 1)))
+
+;;; arch-tag: adff0f07-479e-421e-b47f-8956e06b9902
diff --git a/guile/tests/raw-to-c.scm b/guile/tests/raw-to-c.scm
new file mode 100644
index 0000000000..8f506e7f7c
--- /dev/null
+++ b/guile/tests/raw-to-c.scm
@@ -0,0 +1,16 @@
+(use-modules (r6rs i/o ports)
+             (ice-9 format))
+
+(define line-len 12)
+
+(let ((input (open-input-file "openpgp-keyring.gpg")))
+  (let loop ((byte (get-u8 input))
+             (total 0))
+    (if (eof-object? byte)
+        #t
+        (begin
+          (format #t "0x~:@(~2,'0x, " byte)
+          (if (>= (+ 1 total) line-len) (newline))
+          (loop (get-u8 input)
+                (modulo (+ total 1) line-len))))))
+(newline)
\ No newline at end of file
diff --git a/guile/tests/rsa-parameters.pem b/guile/tests/rsa-parameters.pem
new file mode 100644
index 0000000000..b1cd7db3f5
--- /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 0000000000..e0b313c9de
--- /dev/null
+++ b/guile/tests/session-record-port.scm
@@ -0,0 +1,133 @@
+;;; GNUTLS --- Guile bindings for GnuTLS.
+;;; Copyright (C) 2007  Free Software Foundation
+;;;
+;;; 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)
+             (srfi srfi-4))
+
+
+;; TLS session settings.
+(define %protos  (list protocol/tls-1.0))
+(define %certs   '())
+(define %ciphers (list cipher/null cipher/arcfour cipher/aes-128-cbc
+                       cipher/aes-256-cbc))
+(define %kx      (list kx/anon-dh))
+(define %macs    (list mac/sha1 mac/rmd160 mac/md5))
+
+;; Message sent by the client.
+(define %message (apply u8vector (iota 256)))
+
+;; Debugging.
+;; (set-log-level! 100)
+;; (set-log-procedure! (lambda (level str)
+;;                       (format #t "[~a|~a] ~a" (getpid) level str)))
+
+(dynamic-wind
+    (lambda ()
+      #t)
+
+    (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 to 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))
+            (pid         (primitive-fork)))
+        (if (= 0 pid)
+
+            (let ((client (make-session connection-end/client)))
+              ;; client-side (child process)
+              (set-session-default-priority! client)
+              (set-session-certificate-type-priority! client %certs)
+              (set-session-kx-priority! client %kx)
+              (set-session-protocol-priority! client %protos)
+              (set-session-cipher-priority! client %ciphers)
+              (set-session-mac-priority! client %macs)
+
+              (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)
+
+              (exit))
+
+            (let ((server (make-session connection-end/server)))
+              ;; server-side
+              (set-session-default-priority! server)
+              (set-session-certificate-type-priority! server %certs)
+              (set-session-kx-priority! server %kx)
+              (set-session-protocol-priority! server %protos)
+              (set-session-cipher-priority! server %ciphers)
+              (set-session-mac-priority! server %macs)
+
+              (set-session-transport-port! server (cdr socket-pair))
+              (let ((cred (make-anonymous-server-credentials))
+                    (dh-params (make-dh-parameters 1024)))
+                ;; 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.
+                (exit (eq? (session-record-port server)
+                           (session-record-port server))
+                      (= amount (u8vector-length %message))
+                      (equal? buf %message)
+                      (eof-object?
+                       (read-char (session-record-port server)))))))))
+
+    (lambda ()
+      ;; failure
+      (exit 1)))
+
+;;; 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 0000000000..bb994a508d
--- /dev/null
+++ b/guile/tests/srp-base64.scm
@@ -0,0 +1,39 @@
+;;; GNUTLS --- Guile bindings for GnuTLS.
+;;; Copyright (C) 2007  Free Software Foundation
+;;;
+;;; 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))
+
+(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.")
+
+(exit (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 0000000000..5c82aaebf5
--- /dev/null
+++ b/guile/tests/x509-auth.scm
@@ -0,0 +1,135 @@
+;;; GNUTLS --- Guile bindings for GnuTLS.
+;;; Copyright (C) 2007  Free Software Foundation
+;;;
+;;; 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)
+             (srfi srfi-4))
+
+
+;; TLS session settings.
+(define %protos  (list protocol/tls-1.0))
+(define %certs   (list certificate-type/x509))
+(define %ciphers (list cipher/null cipher/arcfour cipher/aes-128-cbc
+                       cipher/aes-256-cbc))
+(define %kx      (list kx/rsa kx/rsa-export kx/dhe-dss kx/dhe-dss))
+(define %macs    (list mac/sha1 mac/rmd160 mac/md5))
+
+;; 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-rsa-params file)
+  (import-something pkcs1-import-rsa-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)))
+
+(dynamic-wind
+    (lambda ()
+      #t)
+
+    (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")))
+        (let ((pid (primitive-fork)))
+          (if (= 0 pid)
+
+              (let ((client (make-session connection-end/client))
+                    (cred   (make-certificate-credentials)))
+                ;; client-side (child process)
+                (set-session-default-priority! client)
+                (set-session-certificate-type-priority! client %certs)
+                (set-session-kx-priority! client %kx)
+                (set-session-protocol-priority! client %protos)
+                (set-session-cipher-priority! client %ciphers)
+                (set-session-mac-priority! client %macs)
+
+                (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 (fileno (car socket-pair)))
+
+                (handshake client)
+                (write %message (session-record-port client))
+                (bye client close-request/rdwr)
+
+                (exit))
+
+              (let ((server (make-session connection-end/server))
+                    (rsa    (import-rsa-params "rsa-parameters.pem"))
+                    (dh     (make-dh-parameters 1024)))
+                ;; server-side
+                (set-session-default-priority! server)
+                (set-session-certificate-type-priority! server %certs)
+                (set-session-kx-priority! server %kx)
+                (set-session-protocol-priority! server %protos)
+                (set-session-cipher-priority! server %ciphers)
+                (set-session-mac-priority! server %macs)
+                (set-server-session-certificate-request! server
+                         certificate-request/require)
+
+                (set-session-transport-fd! server (fileno (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-rsa-export-parameters! cred rsa)
+                  (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)
+                  (exit (and (eq? auth-type credentials/certificate)
+                             (equal? msg %message)))))))))
+
+    (lambda ()
+      ;; failure
+      (exit 1)))
+
+;;; 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 0000000000..8891072581
--- /dev/null
+++ b/guile/tests/x509-certificate.pem
@@ -0,0 +1,33 @@
+-----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 0000000000..3b5629c3a3
--- /dev/null
+++ b/guile/tests/x509-certificates.scm
@@ -0,0 +1,86 @@
+;;; GNUTLS --- Guile bindings for GnuTLS.
+;;; Copyright (C) 2007  Free Software Foundation
+;;;
+;;; 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)
+             (srfi srfi-4)
+             (srfi srfi-11))
+
+(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 (file-size file)
+  (stat:size (stat file)))
+
+
+(dynamic-wind
+
+    (lambda ()
+      #t)
+
+    (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)))
+
+          (exit (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)))))))))
+
+    (lambda ()
+      ;; failure
+      (exit 1)))
+
+;;; 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 0000000000..1e80b2e55e
--- /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-----