Merge branch 'master' of http://www.laas.fr/~lcourtes/software/gnutls

49 files changed, 7706 insertions, 108 deletions

diff --git a/Makefile.am b/Makefile.am
index 44ab3fb639..9aa7ef47af 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -20,7 +20,7 @@
 # along with this file; if not, write to the Free Software Foundation,
 # Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 
-DISTCHECK_CONFIGURE_FLAGS = --enable-gtk-doc
+DISTCHECK_CONFIGURE_FLAGS = --enable-gtk-doc --with-guile-site-dir
 
 SUBDIRS = lgl gl includes lib libextra src doc tests po
 
diff --git a/configure.in b/configure.in
index bddb0f19b7..8c38186e81 100644
--- a/configure.in
+++ b/configure.in
@@ -87,6 +87,17 @@ AC_ARG_ENABLE(profile-mode,
 opt_profiler_mode=$enableval)
 AC_MSG_RESULT($opt_profiler_mode)
 
+opt_guile_bindings=yes
+AC_MSG_CHECKING([whether building Guile bindings])
+AC_ARG_ENABLE(guile,
+	AS_HELP_STRING([--enable-guile], [build GNU Guile bindings]),
+opt_guile_bindings=$enableval)
+AC_MSG_RESULT($opt_guile_bindings)
+
+AC_ARG_WITH([--with-guile-site-dir],
+  [AS_HELP_STRING([--with-guile-site-dir],
+     [use the given directory as the Guile site (use with care)])])
+
 AC_MSG_RESULT([***
 *** Checking for compilation programs...
 ])
@@ -107,6 +118,38 @@ if test "x$GAA" = "x"; then
 ***]])
 fi
 
+AM_CONDITIONAL(HAVE_GCC,   test "x$GCC" = "xyes")
+AM_CONDITIONAL(HAVE_GUILE, test "x$opt_guile_bindings" = "xyes")
+
+if test "x$opt_guile_bindings" = "xyes"; then
+   GUILE_PROGS
+   GUILE_FLAGS
+   AC_PATH_PROG([guile_snarf], [guile-snarf], [not-found])
+   if test "x$guile_snarf" = "xnot-found"; then
+      AC_MSG_ERROR([`guile-snarf' not found.  Please install Guile 1.8.x or later.])
+   fi
+
+   case "x$with_guile_site_dir" in 
+	x|xno)
+	   # Use the default $(GUILE_SITE).
+	   GUILE_SITE_DIR
+	   ;;
+	xyes)
+	   # Automatically derive $(GUILE_SITE) from $(pkgdatadir).  This
+	   # hack is used to allow `distcheck' to work (see
+	   # `DISTCHECK_CONFIGURE_FLAGS' in the top-level `Makefile.am').
+	   GUILE_SITE="${datadir}/guile/site"
+	   AC_SUBST(GUILE_SITE)
+	   ;;
+	*)
+	   # Use the user-specified directory as $(GUILE_SITE).
+	   GUILE_SITE="$with_guile_site_dir"
+	   AC_SUBST(GUILE_SITE)
+	   ;;
+   esac
+fi
+
+
 AC_MSG_RESULT([***
 *** Detecting compiler options...
 ])
@@ -645,6 +688,11 @@ AC_CONFIG_FILES([Makefile po/Makefile.in \
 	src/Makefile src/x509/Makefile src/srp/Makefile src/openpgp/Makefile \
 	src/cfg/Makefile src/cfg/platon/Makefile src/cfg/platon/str/Makefile \
 	lib/libgnutls-config libextra/libgnutls-extra-config \
-	lib/gnutls.pc libextra/gnutls-extra.pc])
+	lib/gnutls.pc libextra/gnutls-extra.pc
+	guile/Makefile guile/modules/Makefile
+	guile/src/Makefile guile/tests/Makefile])
+
+AC_CONFIG_FILES([guile/pre-inst-guile], [chmod +x guile/pre-inst-guile])
+
 
 AC_OUTPUT
diff --git a/doc/Makefile.am b/doc/Makefile.am
index 82e6a02b66..500f4a36ce 100644
--- a/doc/Makefile.am
+++ b/doc/Makefile.am
@@ -19,8 +19,9 @@
 # along with this file; if not, write to the Free Software Foundation,
 # Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 
-EXTRA_DIST = TODO README.CVS README.autoconf certtool.cfg \
-	gnutls.ps gnutls.pdf gnutls.html
+EXTRA_DIST = TODO README.CVS README.autoconf certtool.cfg	\
+	gnutls.ps gnutls.pdf gnutls.html			\
+        extract-guile-c-doc.scm
 SUBDIRS = examples scripts manpages
 if ENABLE_GTK_DOC
 SUBDIRS += reference
@@ -38,7 +39,8 @@ gnutls_TEXINFOS = gnutls.texi signatures.texi fdl.texi lgpl.texi	\
 	examples/ex-serv-export.c examples/ex-serv-anon.c		\
 	examples/ex-serv-pgp.c examples/ex-serv-srp.c			\
 	examples/ex-alert.c examples/ex-x509-info.c examples/ex-crq.c	\
-	examples/ex-pkcs12.c
+	examples/ex-pkcs12.c						\
+	guile.texi
 
 # Images.  Make sure there are eps + png + pdf of each.
 gnutls_TEXINFOS += layers.eps layers.png layers.pdf
@@ -108,3 +110,33 @@ ia-api.texi: ../libextra/ia-api.texi
 
 error_codes.texi: ../lib/gnutls_errors.c ../src/errcodes.c
 	-../src/errcodes > error_codes.texi
+
+
+guile_texi     = core.c.texi extra.c.texi
+BUILT_SOURCES  = $(guile_texi)
+CLEANFILES     = $(guile_texi)
+EXTRA_DIST    += $(guile_texi)
+
+if HAVE_GUILE
+
+#
+# Guile documentation extraction from C code.
+#
+
+GUILE_FOR_BUILD = $(GUILE) -L $(top_srcdir)/guile/modules
+
+SNARF_CPPFLAGS = -I$(top_srcdir)/guile/src -I$(top_builddir)/guile/src
+
+
+%.c.texi: $(top_srcdir)/guile/src/%.c
+	$(GUILE_FOR_BUILD) -l "$(srcdir)/extract-guile-c-doc.scm"	\
+	   -e '(apply main (cdr (command-line)))'			\
+	   -- "$^" "$(CPP)" "$(SNARF_CPPFLAGS)"				\
+	   > "$@"
+
+else !HAVE_GUILE
+
+%.c.texi:
+	echo "(Guile not available, documentation not generated.)" > $@
+
+endif !HAVE_GUILE
diff --git a/doc/extract-guile-c-doc.scm b/doc/extract-guile-c-doc.scm
new file mode 100644
index 0000000000..de90a158eb
--- /dev/null
+++ b/doc/extract-guile-c-doc.scm
@@ -0,0 +1,71 @@
+;;; extract-c-doc.scm  --  Output Texinfo from "snarffed" C files.
+;;;
+;;; Copyright 2006, 2007  Free Software Foundation
+;;;
+;;;
+;;; This program 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.
+;;;
+;;; This program 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 this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA
+
+;;; Written by Ludovic Courtès <ludo@chbouib.org>.
+
+(use-modules (system documentation c-snarf)
+             (system documentation output)
+
+             (srfi srfi-1))
+
+(define (main . args)
+  ;; Arguments:
+  ;;
+  ;; 1. C file to be processed;
+  ;; 2. how to invoke the CPP (e.g., "cpp -E");
+  ;; 3. additional CPP flags (e.g., "-I /usr/local/include");
+  ;; 4. optionally, a list of Scheme procedure names whose documentation is
+  ;;    to be output.  If no such list is passed, then documentation for
+  ;;    all the Scheme functions available in the C source file is issued.
+  ;;
+  (let* ((file (car args))
+         (cpp+args (string-tokenize (cadr args)))
+         (cpp (car cpp+args))
+         (cpp-flags (apply string-append (caddr args)
+                           " -DSCM_MAGIC_SNARF_DOCS "
+                           (cdr cpp+args)))
+         (procs (cdddr args)))
+    ;;(format (current-error-port) "cpp-flags: ~a~%" cpp-flags)
+    (format (current-error-port) "extracting Texinfo doc from `~a'...  "
+            file)
+
+    ;; Don't mention the name of C functions.
+    (*document-c-functions?* #f)
+
+    (let ((proc-doc-list
+           (run-cpp-and-extract-snarfing file cpp
+                                         (string-tokenize cpp-flags))))
+      (display (apply string-append
+                      (map procedure-texi-documentation
+                           (if (null? procs)
+                               proc-doc-list
+                               (filter (lambda (proc-doc)
+                                         (let ((proc-name
+                                                (assq-ref proc-doc
+                                                          'scheme-name)))
+                                           (member proc-name procs)))
+                                       proc-doc-list))))))
+    (format (current-error-port) "done.~%")
+    (exit 0)))
+
+
+;;; Local Variables:
+;;; mode: scheme
+;;; coding: latin-1
+;;; End:
diff --git a/doc/gnutls.texi b/doc/gnutls.texi
index dc3d45ba12..57a1089dcc 100644
--- a/doc/gnutls.texi
+++ b/doc/gnutls.texi
@@ -65,34 +65,35 @@ Documentation License''.
 @contents
 
 @ifnottex
-@node Top
+@node Top, Preface, (dir), (dir)
 @top GNU TLS
 
 @insertcopying
 @end ifnottex
 
 @menu
-* Preface::
-* The Library::
-* Introduction to TLS::
-* Authentication methods::
-* More on certificate authentication::
-* How to use TLS in application protocols::
-* How to use GnuTLS in applications::
-* Included programs::
-* Function reference::
-* Certificate to XML convertion functions::
-* All the supported ciphersuites in GnuTLS::
-* Internal architecture of GnuTLS::
-* Copying Information::
-* Concept Index::
+* Preface::                     
+* The Library::                 
+* Introduction to TLS::         
+* Authentication methods::      
+* More on certificate authentication::  
+* How to use TLS in application protocols::  
+* How to use GnuTLS in applications::  
+* Included programs::           
+* Function reference::          
+* Certificate to XML convertion functions::  
+* All the supported ciphersuites in GnuTLS::  
+* Guile Bindings::              
+* Internal architecture of GnuTLS::  
+* Copying Information::         
+* Concept Index::               
 * Function and Data Index::
 @c * @mybibnode{}::
-* Bibliography::
+* Bibliography::                
 @end menu
 
 
-@node Preface
+@node Preface, The Library, Top, Top
 @chapter Preface
 
 This document tries to demonstrate and explain the @acronym{GnuTLS}
@@ -121,7 +122,7 @@ Updated versions of the @acronym{GnuTLS} software and this document
 will be available from @url{http://www.gnutls.org/} and
 @url{http://www.gnu.org/software/gnutls/}.
 
-@node The Library
+@node The Library, Introduction to TLS, Preface, Top
 @chapter The Library
 
 In brief @acronym{GnuTLS} can be described as a library which offers an API
@@ -187,7 +188,7 @@ small library, with the required features, can be generated.
 * Callback functions::
 @end menu
 
-@node General Idea
+@node General Idea, Error handling, The Library, The Library
 @section General Idea
 
 A brief description of how @acronym{GnuTLS} works internally is shown
@@ -234,7 +235,7 @@ and if the session ID sent by the client, matches a stored session,
 the stored session will be retrieved, and the new session will be a
 resumed one, and will share the same session ID with the previous one.
 
-@node Error handling
+@node Error handling, Memory handling, General Idea, The Library
 @section Error handling
 
 In @acronym{GnuTLS} most functions return an integer type as a result.  In
@@ -257,7 +258,7 @@ If any non fatal errors, that require an action, are to be returned by
 a function, these error codes will be documented in the function's
 reference.  @xref{Error Codes}, for all the error codes.
 
-@node Memory handling
+@node Memory handling, Callback functions, Error handling, The Library
 @section Memory handling
 
 @acronym{GnuTLS} internally handles heap allocated objects
@@ -275,7 +276,7 @@ cases where even the system's swap memory is not considered
 secure. See the documentation of @acronym{Libgcrypt} for more
 information.
 
-@node Callback functions
+@node Callback functions,  , Memory handling, The Library
 @section Callback functions
 @cindex Callback functions
 
@@ -308,7 +309,7 @@ should allocate and free memory using the functions shown below.
 
 @end itemize
 
-@node Introduction to TLS
+@node Introduction to TLS, Authentication methods, The Library, Top
 @chapter Introduction to @acronym{TLS}
 
 @acronym{TLS} stands for ``Transport Layer Security'' and is the
@@ -336,7 +337,7 @@ differences of these protocols are minor. Older protocols such as
 * On SSL 2 and older protocols::
 @end menu
 
-@node TLS layers
+@node TLS layers, The transport layer, Introduction to TLS, Introduction to TLS
 @section TLS layers
 @cindex TLS Layers
 
@@ -358,7 +359,7 @@ protocol.  The protocol layering in TLS is shown in the figure below.
 
 @image{layers,12cm,8cm}
 
-@node The transport layer
+@node The transport layer, The TLS record protocol, TLS layers, Introduction to TLS
 @section The transport layer
 @cindex Transport protocol
 
@@ -404,7 +405,7 @@ will use the Berkeley Sockets functions.  In this case
 work, thus making it easy to add @acronym{TLS} support to existing
 TCP/IP servers.
 
-@node The TLS record protocol
+@node The TLS record protocol, The TLS Alert Protocol, The transport layer, Introduction to TLS
 @section The TLS record protocol
 @cindex Record protocol
 
@@ -439,7 +440,7 @@ just after the handshake protocol has finished.
 * Weaknesses and countermeasures::
 @end menu
 
-@node Encryption algorithms used in the record layer
+@node Encryption algorithms used in the record layer, Compression algorithms used in the record layer, The TLS record protocol, The TLS record protocol
 @subsection Encryption algorithms used in the record layer
 @cindex Symmetric encryption algorithms
 
@@ -489,7 +490,7 @@ bits of data.
 
 @end table
 
-@node Compression algorithms used in the record layer
+@node Compression algorithms used in the record layer, Weaknesses and countermeasures, Encryption algorithms used in the record layer, The TLS record protocol
 @subsection Compression algorithms used in the record layer
 @cindex Compression algorithms
 
@@ -524,7 +525,7 @@ and the private extensions are enabled.
 
 @end table
 
-@node Weaknesses and countermeasures
+@node Weaknesses and countermeasures,  , Compression algorithms used in the record layer, The TLS record protocol
 @subsection Weaknesses and countermeasures
 
 Some weaknesses that may affect the security of the Record layer have
@@ -551,7 +552,7 @@ Those weaknesses were solved in @acronym{TLS} 1.1 @xcite{RFC4346} which is imple
 in @acronym{GnuTLS}. For a detailed discussion see the archives of the
 TLS Working Group mailing list and the paper @xcite{CBCATT}.
 
-@node The TLS Alert Protocol
+@node The TLS Alert Protocol, The TLS Handshake Protocol, The TLS record protocol, Introduction to TLS
 @section The TLS Alert Protocol
 @anchor{The Alert Protocol}
 @cindex Alert protocol
@@ -586,7 +587,7 @@ Returns the name, in a character array, of the given alert.
 
 @end table
 
-@node The TLS Handshake Protocol
+@node The TLS Handshake Protocol, TLS Extensions, The TLS Alert Protocol, Introduction to TLS
 @section The TLS Handshake Protocol
 @anchor{The Handshake Protocol}
 @cindex Handshake protocol
@@ -744,7 +745,7 @@ It might also be useful to be able to check for expired sessions in
 order to remove them, and save space. The function
 @ref{gnutls_db_check_entry} is provided for that reason.
 
-@node TLS Extensions
+@node TLS Extensions, On SSL 2 and older protocols, The TLS Handshake Protocol, Introduction to TLS
 @section TLS Extensions
 @cindex TLS Extensions
 
@@ -786,7 +787,7 @@ begins within the first handshake packet.  The functions
 used to enable this extension, or to retrieve the name sent by a
 client.
 
-@node On SSL 2 and older protocols
+@node On SSL 2 and older protocols,  , TLS Extensions, Introduction to TLS
 @section On SSL 2 and older protocols
 @cindex SSL 2
 
@@ -833,7 +834,7 @@ Other protocols such as Microsoft's @acronym{PCT} 1 and @acronym{PCT}
 2 were not implemented because they were also abandoned and deprecated
 by @acronym{SSL} 3.0 and later @acronym{TLS} 1.0.
 
-@node Authentication methods
+@node Authentication methods, More on certificate authentication, Introduction to TLS, Top
 @chapter Authentication methods
 
 The @acronym{TLS} protocol provides confidentiality and encryption,
@@ -862,7 +863,7 @@ are:
 * Parameters stored in credentials::
 @end menu
 
-@node Certificate authentication
+@node Certificate authentication, Anonymous authentication, Authentication methods, Authentication methods
 @section Certificate authentication
 
 @subsection Authentication using @acronym{X.509} certificates
@@ -1011,7 +1012,7 @@ Signature Standard.
 
 @end table
 
-@node Anonymous authentication
+@node Anonymous authentication, Authentication using SRP, Certificate authentication, Authentication methods
 @section Anonymous authentication
 @cindex Anonymous authentication
 
@@ -1036,7 +1037,7 @@ This algorithm exchanges Diffie Hellman parameters.
 
 @end table
 
-@node Authentication using SRP
+@node Authentication using SRP, Authentication using PSK, Anonymous authentication, Authentication methods
 @section Authentication using @acronym{SRP}
 @cindex @acronym{SRP} authentication
 
@@ -1123,7 +1124,7 @@ manipulate the required parameters for @acronym{SRP} authentication is
 also included.  @xref{srptool}, for more information.
 
 
-@node Authentication using PSK
+@node Authentication using PSK, Authentication and credentials, Authentication using SRP, Authentication methods
 @section Authentication using @acronym{PSK}
 @cindex @acronym{PSK} authentication
 
@@ -1175,7 +1176,7 @@ are included in @acronym{GnuTLS}, and may be used to generate and
 maintain @acronym{PSK} keys.
 
 
-@node Authentication and credentials
+@node Authentication and credentials, Parameters stored in credentials, Authentication using PSK, Authentication methods
 @section Authentication and credentials
 
 In @acronym{GnuTLS} every key exchange method is associated with a
@@ -1217,7 +1218,7 @@ Key exchange algorithms and the corresponding credential types:
 
 @end multitable
 
-@node Parameters stored in credentials
+@node Parameters stored in credentials,  , Authentication and credentials, Authentication methods
 @section Parameters stored in credentials
 
 Several parameters such as the ones used for Diffie-Hellman
@@ -1276,7 +1277,7 @@ int main()
 @}
 @end example
 
-@node More on certificate authentication
+@node More on certificate authentication, How to use TLS in application protocols, Authentication methods, Top
 @chapter More on certificate authentication
 @anchor{Certificate Authentication}
 @cindex Certificate authentication
@@ -1287,7 +1288,7 @@ int main()
 * Digital signatures::
 @end menu
 
-@node The X.509 trust model
+@node The X.509 trust model, The OpenPGP trust model, More on certificate authentication, More on certificate authentication
 @section The @acronym{X.509} trust model
 @cindex @acronym{X.509} certificates
 
@@ -1312,7 +1313,7 @@ handling @acronym{X.509} certificates is described at section
 * PKCS #12 structures::
 @end menu
 
-@node X.509 certificates
+@node X.509 certificates, Verifying X.509 certificate paths, The X.509 trust model, The X.509 trust model
 @subsection @acronym{X.509} certificates
 
 An @acronym{X.509} certificate usually contains information about the
@@ -1402,7 +1403,7 @@ functions for @acronym{X.509} certificate handling have their prototypes in
 @file{gnutls/x509.h}. An example program to demonstrate the @acronym{X.509}
 parsing capabilities can be found at section @ref{ex:x509-info}.
 
-@node Verifying X.509 certificate paths
+@node Verifying X.509 certificate paths, PKCS #10 certificate requests, X.509 certificates, The X.509 trust model
 @subsection Verifying @acronym{X.509} certificate paths
 @cindex Verifying certificate paths
 
@@ -1485,7 +1486,7 @@ about the peer's identity. It is required to verify if the
 certificate's owner is the one you expect. For more information consult @xcite{RFC2818} 
 and section @ref{ex:verify} for an example.
 
-@node PKCS #10 certificate requests
+@node PKCS #10 certificate requests, PKCS #12 structures, Verifying X.509 certificate paths, The X.509 trust model
 @subsection @acronym{PKCS} #10 certificate requests
 @cindex Certificate requests
 @cindex @acronym{PKCS} #10
@@ -1501,7 +1502,7 @@ In @acronym{GnuTLS} the @acronym{PKCS} #10 structures are handled
 using the @code{gnutls_x509_crq_t} type.  An example of a certificate
 request generation can be found at section @ref{ex:crq}.
 
-@node PKCS #12 structures
+@node PKCS #12 structures,  , PKCS #10 certificate requests, The X.509 trust model
 @subsection @acronym{PKCS} #12 structures
 @cindex @acronym{PKCS} #12
 
@@ -1519,7 +1520,7 @@ in order for its data to be accessed.
 An example of a @acronym{PKCS} #12 structure generation can be found
 at section @ref{ex:pkcs12}.
 
-@node The OpenPGP trust model
+@node The OpenPGP trust model, Digital signatures, The X.509 trust model, More on certificate authentication
 @section The @acronym{OpenPGP} trust model
 @cindex @acronym{OpenPGP} Keys
 
@@ -1597,13 +1598,13 @@ These algorithms have been broken and should not be trusted.
 
 @end table
 
-@node Digital signatures
+@node Digital signatures,  , The OpenPGP trust model, More on certificate authentication
 @section Digital signatures
 @cindex Digital signatures
 @include signatures.texi
 
 
-@node How to use TLS in application protocols
+@node How to use TLS in application protocols, How to use GnuTLS in applications, More on certificate authentication, Top
 @chapter How to use @acronym{TLS} in application protocols
 
 This chapter is intended to provide some hints on how to use the
@@ -1616,7 +1617,7 @@ but may be extended to other ones too.
 * Upward negotiation::
 @end menu
 
-@node Separate ports
+@node Separate ports, Upward negotiation, How to use TLS in application protocols, How to use TLS in application protocols
 @section Separate ports
 
 Traditionally @acronym{SSL} was used in application protocols by
@@ -1643,7 +1644,7 @@ service, which is unnecessary complication. Due to the fact that there
 is a limitation on the available privileged ports, this approach was
 soon obsoleted.
 
-@node Upward negotiation
+@node Upward negotiation,  , Separate ports, How to use TLS in application protocols
 @section Upward negotiation
 
 Other application protocols@footnote{See LDAP, IMAP etc.}  use a
@@ -1734,7 +1735,7 @@ starts, in order to send the correct certificate, use the correct
 password file@footnote{in @acronym{SRP} authentication}, or anything
 else!
 
-@node How to use GnuTLS in applications
+@node How to use GnuTLS in applications, Included programs, How to use TLS in application protocols, Top
 @chapter How to use @acronym{GnuTLS} in applications
 @anchor{examples}
 @cindex Example programs
@@ -1748,7 +1749,7 @@ else!
 * Compatibility with the OpenSSL library::
 @end menu
 
-@node Preparation
+@node Preparation, Multi-threaded applications, How to use GnuTLS in applications, How to use GnuTLS in applications
 @section Preparation
 
 To use @acronym{GnuTLS}, you have to perform some changes to your
@@ -1761,7 +1762,7 @@ the following subsections.
 * Building the source::
 @end menu
 
-@node Headers
+@node Headers, Version check, Preparation, Preparation
 @subsection Headers
 
 All the data types and functions of the @acronym{GnuTLS} library are
@@ -1773,7 +1774,7 @@ The extra functionality of the @acronym{GnuTLS-extra} library is
 available by including the header file @file{gnutls/extra.h} in your
 programs.
 
-@node Version check
+@node Version check, Building the source, Headers, Preparation
 @subsection Version check
 
 It is often desirable to check that the version of `gnutls' used is
@@ -1783,7 +1784,7 @@ with the dynamic linker an old version is actually used.  So you may
 want to check that the version is okay right after program startup.
 See the function @ref{gnutls_check_version}.
 
-@node Building the source
+@node Building the source,  , Version check, Preparation
 @subsection Building the source
 
 If you want to compile a source file including the `gnutls/gnutls.h'
@@ -1829,7 +1830,7 @@ specifying both options to `libgnutls-config':
 gcc -o foo foo.c `libgnutls-config --cflags --libs`
 @end example
 
-@node Multi-threaded applications
+@node Multi-threaded applications, Client examples, Preparation, How to use GnuTLS in applications
 @section Multi-threaded applications
 
 Although the @acronym{GnuTLS} library is thread safe by design, some
@@ -1893,7 +1894,7 @@ int main()
 @end example
 @end itemize
 
-@node Client examples
+@node Client examples, Server examples, Multi-threaded applications, How to use GnuTLS in applications
 @section Client examples
 
 This section contains examples of @acronym{TLS} and @acronym{SSL}
@@ -1914,7 +1915,7 @@ implemented by another example.
 * Helper function for TCP connections::
 @end menu
 
-@node Simple client example with anonymous authentication
+@node Simple client example with anonymous authentication, Simple client example with X.509 certificate support, Client examples, Client examples
 @subsection Simple client example with anonymous authentication
 
 The simplest client using TLS is the one that doesn't do any
@@ -1925,7 +1926,7 @@ However, the data is integrity and privacy protected.
 
 @verbatiminclude examples/ex-client1.c
 
-@node Simple client example with X.509 certificate support
+@node Simple client example with X.509 certificate support, Obtaining session information, Simple client example with anonymous authentication, Client examples
 @subsection Simple client example with @acronym{X.509} certificate support
 
 Let's assume now that we want to create a TCP client which
@@ -1938,7 +1939,7 @@ redefining them.
 
 @verbatiminclude examples/ex-client2.c
 
-@node Obtaining session information
+@node Obtaining session information, Verifying peer's certificate, Simple client example with X.509 certificate support, Client examples
 @subsection Obtaining session information
 
 Most of the times it is desirable to know the security properties of
@@ -1949,7 +1950,7 @@ if called after a successful @ref{gnutls_handshake}.
 
 @verbatiminclude examples/ex-session-info.c
 
-@node Verifying peer's certificate
+@node Verifying peer's certificate, Using a callback to select the certificate to use, Obtaining session information, Client examples
 @subsection Verifying peer's certificate
 @anchor{ex:verify}
 
@@ -1967,7 +1968,7 @@ verification output.
 
 @verbatiminclude examples/ex-verify.c
 
-@node Using a callback to select the certificate to use
+@node Using a callback to select the certificate to use, Client with Resume capability example, Verifying peer's certificate, Client examples
 @subsection Using a callback to select the certificate to use
 
 There are cases where a client holds several certificate and key
@@ -1977,7 +1978,7 @@ certificate selection callback.
 
 @verbatiminclude examples/ex-cert-select.c
 
-@node Client with Resume capability example
+@node Client with Resume capability example, Simple client example with SRP authentication, Using a callback to select the certificate to use, Client examples
 @subsection Client with Resume capability example
 @anchor{ex:resume-client}
 
@@ -1988,7 +1989,7 @@ establish a new connection using the previously negotiated data.
 
 @verbatiminclude examples/ex-client-resume.c
 
-@node Simple client example with SRP authentication
+@node Simple client example with SRP authentication, Simple client example with TLS/IA support, Client with Resume capability example, Client examples
 @subsection Simple client example with @acronym{SRP} authentication
 
 The following client is a very simple @acronym{SRP} @acronym{TLS}
@@ -1998,7 +1999,7 @@ itself using a certificate, and in that case it has to be verified.
 
 @verbatiminclude examples/ex-client-srp.c
 
-@node Simple client example with TLS/IA support
+@node Simple client example with TLS/IA support, Simple client example with authorization support, Simple client example with SRP authentication, Client examples
 @subsection Simple client example with @acronym{TLS/IA} support
 
 The following client is a simple client which uses the
@@ -2006,7 +2007,7 @@ The following client is a simple client which uses the
 
 @verbatiminclude examples/ex-client-tlsia.c
 
-@node Simple client example with authorization support
+@node Simple client example with authorization support, Helper function for TCP connections, Simple client example with TLS/IA support, Client examples
 @subsection Simple client example with authorization support
 
 The following client require that the server sends authorization data,
@@ -2015,7 +2016,7 @@ For authentication, X.509 is used.
 
 @verbatiminclude examples/ex-client-authz.c
 
-@node Helper function for TCP connections
+@node Helper function for TCP connections,  , Simple client example with authorization support, Client examples
 @subsection Helper function for TCP connections
 
 This helper function abstracts away TCP connection handling from the
@@ -2023,7 +2024,7 @@ other examples.  It is required to build some examples.
 
 @verbatiminclude examples/tcp.c
 
-@node Server examples
+@node Server examples, Miscellaneous examples, Client examples, How to use GnuTLS in applications
 @section Server examples
 
 This section contains examples of @acronym{TLS} and @acronym{SSL}
@@ -2038,7 +2039,7 @@ servers, using @acronym{GnuTLS}.
 * Echo Server with authorization support::
 @end menu
 
-@node Echo Server with X.509 authentication
+@node Echo Server with X.509 authentication, Echo Server with X.509 authentication II, Server examples, Server examples
 @subsection Echo Server with @acronym{X.509} authentication
 
 This example is a very simple echo server which supports
@@ -2046,7 +2047,7 @@ This example is a very simple echo server which supports
 
 @verbatiminclude examples/ex-serv1.c
 
-@node Echo Server with X.509 authentication II
+@node Echo Server with X.509 authentication II, Echo Server with OpenPGP authentication, Echo Server with X.509 authentication, Server examples
 @subsection Echo Server with @acronym{X.509} authentication II
 
 The following example is a server which supports @acronym{X.509}
@@ -2055,7 +2056,7 @@ the DHE ciphersuites and session resuming.
 
 @verbatiminclude examples/ex-serv-export.c
 
-@node Echo Server with OpenPGP authentication
+@node Echo Server with OpenPGP authentication, Echo Server with SRP authentication, Echo Server with X.509 authentication II, Server examples
 @subsection Echo Server with @acronym{OpenPGP} authentication
 @cindex @acronym{OpenPGP} Server
 
@@ -2067,7 +2068,7 @@ them to keep these examples as simple as possible.
 
 @verbatiminclude examples/ex-serv-pgp.c
 
-@node Echo Server with SRP authentication
+@node Echo Server with SRP authentication, Echo Server with anonymous authentication, Echo Server with OpenPGP authentication, Server examples
 @subsection Echo Server with @acronym{SRP} authentication
 
 This is a server which supports @acronym{SRP} authentication. It is
@@ -2076,7 +2077,7 @@ server. Here it is separate for simplicity.
 
 @verbatiminclude examples/ex-serv-srp.c
 
-@node Echo Server with anonymous authentication
+@node Echo Server with anonymous authentication, Echo Server with authorization support, Echo Server with SRP authentication, Server examples
 @subsection Echo Server with anonymous authentication
 
 This example server support anonymous authentication, and could be
@@ -2084,7 +2085,7 @@ used to serve the example client for anonymous authentication.
 
 @verbatiminclude examples/ex-serv-anon.c
 
-@node Echo Server with authorization support
+@node Echo Server with authorization support,  , Echo Server with anonymous authentication, Server examples
 @subsection Echo Server with authorization support
 
 This example server support authorization data, and can be used to
@@ -2092,7 +2093,7 @@ serve the example client with authorization support.
 
 @verbatiminclude examples/ex-serv-authz.c
 
-@node Miscellaneous examples
+@node Miscellaneous examples, Compatibility with the OpenSSL library, Server examples, How to use GnuTLS in applications
 @section Miscellaneous examples
 
 @menu
@@ -2102,7 +2103,7 @@ serve the example client with authorization support.
 * PKCS #12 structure generation::
 @end menu
 
-@node Checking for an alert
+@node Checking for an alert, X.509 certificate parsing example, Miscellaneous examples, Miscellaneous examples
 @subsection Checking for an alert
 
 This is a function that checks if an alert has been received in the
@@ -2110,7 +2111,7 @@ current session.
 
 @verbatiminclude examples/ex-alert.c
 
-@node X.509 certificate parsing example
+@node X.509 certificate parsing example, Certificate request generation, Checking for an alert, Miscellaneous examples
 @subsection @acronym{X.509} certificate parsing example
 @anchor{ex:x509-info}
 
@@ -2120,7 +2121,7 @@ information about it.
 
 @verbatiminclude examples/ex-x509-info.c
 
-@node Certificate request generation
+@node Certificate request generation, PKCS #12 structure generation, X.509 certificate parsing example, Miscellaneous examples
 @subsection Certificate request generation
 @anchor{ex:crq}
 
@@ -2130,7 +2131,7 @@ which should return a signed certificate.
 
 @verbatiminclude examples/ex-crq.c
 
-@node PKCS #12 structure generation
+@node PKCS #12 structure generation,  , Certificate request generation, Miscellaneous examples
 @subsection @acronym{PKCS} #12 structure generation
 @anchor{ex:pkcs12}
 
@@ -2139,7 +2140,7 @@ structure.
 
 @verbatiminclude examples/ex-pkcs12.c
 
-@node Compatibility with the OpenSSL library
+@node Compatibility with the OpenSSL library,  , Miscellaneous examples, How to use GnuTLS in applications
 @section Compatibility with the OpenSSL library
 @cindex OpenSSL
 
@@ -2162,7 +2163,7 @@ Current limitations imposed by the compatibility layer include:
 
 @end itemize
 
-@node Included programs
+@node Included programs, Function reference, How to use GnuTLS in applications, Top
 @chapter Included programs
 
 Included with @acronym{GnuTLS} are also a few command line tools that
@@ -2177,7 +2178,7 @@ application.  The applications are discussed in this chapter.
 * Invoking certtool::
 @end menu
 
-@node Invoking srptool
+@node Invoking srptool, Invoking gnutls-cli, Included programs, Included programs
 @section Invoking srptool
 @anchor{srptool}
 @cindex srptool
@@ -2222,7 +2223,7 @@ $ srptool --passwd /etc/tpasswd \
 
 @end itemize
 
-@node Invoking gnutls-cli
+@node Invoking gnutls-cli, Invoking gnutls-cli-debug, Invoking srptool, Included programs
 @section Invoking gnutls-cli
 @cindex gnutls-cli
 
@@ -2281,7 +2282,7 @@ Usage:  gnutls-cli [options] hostname
      --copyright              prints the program's license
 @end verbatim
 
-@node Invoking gnutls-cli-debug
+@node Invoking gnutls-cli-debug, Invoking gnutls-serv, Invoking gnutls-cli, Included programs
 @section Invoking gnutls-cli-debug
 @cindex gnutls-cli-debug
 
@@ -2329,7 +2330,7 @@ Checking for SRP authentication support (TLS extension)... yes
 Checking for OpenPGP authentication support (TLS extension)... no
 @end smallexample
 
-@node Invoking gnutls-serv
+@node Invoking gnutls-serv, Invoking certtool, Invoking gnutls-cli-debug, Included programs
 @section Invoking gnutls-serv
 @cindex gnutls-serv
 
@@ -2556,7 +2557,7 @@ gnutls-serv --http \
             --pskpasswd psk-passwd.txt
 @end example
 
-@node Invoking certtool
+@node Invoking certtool,  , Invoking gnutls-serv, Included programs
 @section Invoking certtool
 @cindex certtool
 
@@ -2829,7 +2830,7 @@ signing_key
 #time_stamping_key
 @end example
 
-@node Function reference
+@node Function reference, Certificate to XML convertion functions, Included programs, Top
 @chapter Function reference
 @cindex Function reference
 
@@ -2842,7 +2843,7 @@ signing_key
 * Error codes and descriptions::
 @end menu
 
-@node Core functions
+@node Core functions, X.509 certificate functions, Function reference, Function reference
 @section Core functions
 
 The prototypes for the following functions lie in
@@ -2850,7 +2851,7 @@ The prototypes for the following functions lie in
 
 @include gnutls-api.texi
 
-@node X.509 certificate functions
+@node X.509 certificate functions, GnuTLS-extra functions, Core functions, Function reference
 @section @acronym{X.509} certificate functions
 @anchor{sec:x509api}
 @cindex @acronym{X.509} Functions
@@ -2860,7 +2861,7 @@ Their prototypes lie in @file{gnutls/x509.h}.
 
 @include x509-api.texi
 
-@node GnuTLS-extra functions
+@node GnuTLS-extra functions, OpenPGP functions, X.509 certificate functions, Function reference
 @section @acronym{GnuTLS-extra} functions
 @cindex @acronym{GnuTLS-extra} functions
 
@@ -2870,7 +2871,7 @@ called @code{gnutls-extra}. The prototypes for this library lie in
 
 @include gnutls-extra-api.texi
 
-@node OpenPGP functions
+@node OpenPGP functions, TLS Inner Application (TLS/IA) functions, GnuTLS-extra functions, Function reference
 @section @acronym{OpenPGP} functions
 @cindex @acronym{OpenPGP} functions
 @anchor{sec:openpgpapi}
@@ -2882,7 +2883,7 @@ to be able to use these functions (@pxref{GnuTLS-extra functions}).
 
 @include pgp-api.texi
 
-@node TLS Inner Application (TLS/IA) functions
+@node TLS Inner Application (TLS/IA) functions, Error codes and descriptions, OpenPGP functions, Function reference
 @section @acronym{TLS} Inner Application (@acronym{TLS/IA}) functions
 @cindex @acronym{TLS} Inner Application (@acronym{TLS/IA}) functions
 @cindex Inner Application (@acronym{TLS/IA}) functions
@@ -2939,7 +2940,7 @@ client functions with the corresponding server functions.
 
 @include ia-api.texi
 
-@node Error codes and descriptions
+@node Error codes and descriptions,  , TLS Inner Application (TLS/IA) functions, Function reference
 @section Error codes and descriptions
 @anchor{Error Codes}
 @cindex Error codes
@@ -2951,7 +2952,7 @@ expressions.
 
 @include error_codes.texi
 
-@node Certificate to XML convertion functions
+@node Certificate to XML convertion functions, All the supported ciphersuites in GnuTLS, Function reference, Top
 @chapter Certificate to @acronym{XML} convertion functions
 @cindex Certificate to XML convertion
 
@@ -2971,7 +2972,7 @@ functions:
 * An OpenPGP key::
 @end menu
 
-@node An X.509 certificate
+@node An X.509 certificate, An OpenPGP key, Certificate to XML convertion functions, Certificate to XML convertion functions
 @section An @acronym{X.509} certificate
 
 @smallexample
@@ -3174,7 +3175,7 @@ functions:
 </gnutls:x509:certificate>
 @end smallexample
 
-@node An OpenPGP key
+@node An OpenPGP key,  , An X.509 certificate, Certificate to XML convertion functions
 @section An @acronym{OpenPGP} key
 
 @smallexample
@@ -3255,7 +3256,7 @@ functions:
 </gnutls:openpgp:key>
 @end smallexample
 
-@node All the supported ciphersuites in GnuTLS
+@node All the supported ciphersuites in GnuTLS, Guile Bindings, Certificate to XML convertion functions, Top
 @chapter All the supported ciphersuites in @acronym{GnuTLS}
 @anchor{ciphersuites}
 @cindex Ciphersuites
@@ -3388,13 +3389,21 @@ functions:
 
 @end multitable
 
-@node Internal architecture of GnuTLS
+
+@c
+@c Guile Bindings
+@c
+
+@include guile.texi
+
+
+@node Internal architecture of GnuTLS, Copying Information, Guile Bindings, Top
 @chapter Internal architecture of GnuTLS
 @cindex Internal architecture
 @include internals.texi
 
 
-@node Copying Information
+@node Copying Information, Concept Index, Internal architecture of GnuTLS, Top
 @appendix Copying Information
 
 @menu
@@ -3407,17 +3416,17 @@ functions:
 @include lgpl.texi
 @include gpl.texi
 
-@node Concept Index
+@node Concept Index, Function and Data Index, Copying Information, Top
 @unnumbered Concept Index
 
 @printindex cp
 
-@node Function and Data Index
+@node Function and Data Index, Bibliography, Concept Index, Top
 @unnumbered Function and Data Index
 
 @printindex fn
 
-@node Bibliography
+@node Bibliography,  , Function and Data Index, Top
 @unnumbered Bibliography
 
 @table @asis
diff --git a/doc/guile.texi b/doc/guile.texi
new file mode 100644
index 0000000000..104351e746
--- /dev/null
+++ b/doc/guile.texi
@@ -0,0 +1,544 @@
+@c Documentation of the GNU Guile bindings.
+
+@node Guile Bindings
+@chapter Guile Bindings
+
+This chapter describes the @uref{http://www.gnu.org/software/guile/,
+GNU Guile} Scheme programming interface to GnuTLS.  The reader is
+assumed to have basic knowledge of the protocol and library.  Details
+missing from this document may be found in @ref{Function reference,
+the C API reference}.
+
+At this stage, not all the C functions are available from Scheme, but
+a large subset thereof is available.
+
+
+@menu
+* Conventions::                 Naming conventions and other idiosyncrasies.
+* Examples::                    Quick start.
+* Guile Reference::             The Scheme GnuTLS programming interface.
+@end menu
+
+@c *********************************************************************
+@node Conventions, Examples, Guile Bindings, Guile Bindings
+@section Conventions
+
+This chapter details the conventions used by Guile API, as well as
+specificities of the mapping of the C API to Scheme.
+
+@menu
+* Enumerates and Constants::      Representation of C-side constants.
+* Procedure Names::               Naming conventions.
+* Representation of Binary Data:: Binary data buffers.
+* Input and Output::              Input and output.
+* Error Handling::                Exceptions.
+@end menu
+
+@node Enumerates and Constants, Procedure Names, Conventions, Conventions
+@subsection Enumerates and Constants
+
+@cindex enumerate
+@cindex constant
+
+Lots of enumerates and constants are used in the GnuTLS C API.  For
+each C enumerate type, a disjoint Scheme type is used---thus,
+enumerate values and constants are not represented by Scheme symbols
+nor by integers.  This makes it impossible to use an enumerate value
+of the wrong type on the Scheme side: such errors are automatically
+detected by type-checking.
+
+The enumerate values are bound to variables exported by the
+@code{(gnutls)} and @code{(gnutls extra)} modules.  These variables
+are named according to the following convention:
+
+@itemize
+@item All variable names are lower-case; the underscore @code{_}
+character used in the C API is replaced by hyphen @code{-}.
+@item All variable names are prepended by the name of the enumerate
+type and the slash @code{/} character.
+@item In some cases, the variable name is made more explicit than the
+one of the C API, e.g., by avoid abbreviations.
+@end itemize
+
+Consider for instance this C-side enumerate:
+
+@example
+typedef enum
+@{
+  GNUTLS_CRD_CERTIFICATE = 1,
+  GNUTLS_CRD_ANON,
+  GNUTLS_CRD_SRP,
+  GNUTLS_CRD_PSK,
+  GNUTLS_CRD_IA
+@} gnutls_credentials_type_t;
+@end example
+
+The corresponding Scheme values are bound to the following variables
+exported by the @code{(gnutls)} module:
+
+@example
+credentials/certificate
+credentials/anonymous
+credentials/srp
+credentials/psk
+credentials/ia
+@end example
+
+Hopefully, most variable names can be deduced from this convention.
+
+Scheme-side ``enumerate'' values can be compared using @code{eq?}
+(@pxref{Equality, equality predicates,, guile, The GNU Guile Reference
+Manual}).  Consider the following example:
+
+@findex session-cipher
+
+@example
+(let ((session (make-session connection-end/client)))
+
+  ;;
+  ;; ...
+  ;;
+
+  ;; Check the ciphering algorithm currently used by SESSION.
+  (if (eq? cipher/arcfour (session-cipher session))
+      (format #t "We're using the ARCFOUR algorithm")))
+@end example
+
+In addition, all enumerate values can be converted to a human-readable
+string, in a type-specific way.  For instance, @code{(cipher->string
+cipher/arcfour)} yields @code{"ARCFOUR 128"}, while
+@code{(key-usage->string key-usage/digital-signature)} yields
+@code{"digital-signature"}.  Note that these strings may not be
+sufficient for use in a user interface since they are fairly concise
+and not internationalized.
+
+
+@node Procedure Names, Representation of Binary Data, Enumerates and Constants, Conventions
+@subsection Procedure Names
+
+Unlike C functions in GnuTLS, the corresponding Scheme procedures are
+named in a way that is close to natural English.  Abbreviations are
+also avoided.  For instance, the Scheme procedure corresponding to
+@code{gnutls_certificate_set_dh_params} is named
+@code{set-certificate-credentials-dh-parameters!}.  The @code{gnutls_}
+prefix is always omitted from variable names since a similar effect
+can be achieved using Guile's nifty binding renaming facilities,
+should it be needed (@pxref{Using Guile Modules,,, guile, The GNU
+Guile Reference Manual}).
+
+Often Scheme procedure names differ from C function names in a way
+that makes it clearer what objects they operate on.  For example, the
+Scheme procedure named @code{set-session-transport-port!} corresponds
+to @code{gnutls_transport_set_ptr}, making it clear that this
+procedure applies to session.
+
+@node Representation of Binary Data, Input and Output, Procedure Names, Conventions
+@subsection Representation of Binary Data
+
+Many procedures operate on binary data.  For instance,
+@code{pkcs3-import-dh-parameters} expects binary data as input and,
+similarly, procedures like @code{pkcs1-export-rsa-parameters} return
+binary data.
+
+@cindex SRFI-4
+@cindex homogeneous vector
+
+Binary data is represented on the Scheme side using SRFI-4 homogeneous
+vectors (@pxref{SRFI-4,,, guile, The GNU Guile Reference Manual}).
+Although any type of homogeneous vector may be used, @code{u8vector}s
+(i.e., vectors of bytes) are highly recommended.
+
+As an example, generating and then exporting RSA parameters in the PEM
+format can be done as follows:
+
+@findex make-rsa-parameters
+@findex pkcs1-export-rsa-parameters
+@vindex x509-certificate-format/pem
+
+@example
+(let* ((rsa-params (make-rsa-parameters 1024))
+       (raw-data
+        (pkcs1-export-rsa-parameters rsa-params
+                                     x509-certificate-format/pem)))
+  (uniform-vector-write raw-data (open-output-file "some-file.pem")))
+@end example
+
+For an example of OpenPGP key import from a file, see @ref{Importing
+OpenPGP Keys}.
+
+
+@node Input and Output, Error Handling, Representation of Binary Data, Conventions
+@subsection Input and Output
+
+@findex set-session-transport-port!
+@findex set-session-transport-fd!
+
+The underlying transport of a TLS session can be any Scheme
+input/output port (@pxref{Ports and File Descriptors,,, guile, The GNU
+Guile Reference Manual}).  This has to be specified using
+@code{set-session-transport-port!}.
+
+However, for better performance, a raw file descriptor can be
+specified, using @code{set-session-transport-fd!}.  For instance, if
+the transport layer is a socket port over an OS-provided socket, you
+can use the @code{port->fdes} or @code{fileno} procedure to obtain the
+underlying file descriptor and pass it to
+@code{set-session-transport-fd!}  (@pxref{Ports and File Descriptors,
+@code{port->fdes} and @code{fileno},, guile, The GNU Guile Reference
+Manual}).  This would work as follows:
+
+@example
+(let ((socket (socket PF_INET SOCK_STREAM 0))
+      (session (make-session connection-end/client)))
+
+  ;;
+  ;; Establish a TCP connection...
+  ;;
+
+  ;; Use the file descriptor that underlies SOCKET.
+  (set-session-transport-fd! session (fileno socket)))
+@end example
+
+@findex session-record-port
+
+Once a TLS session is established, data can be communicated through it
+(i.e., @emph{via} the TLS record layer) using the port returned by
+@code{session-record-port}:
+
+@example
+(let ((session (make-session connection-end/client)))
+
+  ;;
+  ;; Initialize the various parameters of SESSION, set up
+  ;; a network connection, etc...
+  ;;
+
+  (let ((i/o (session-record-port session)))
+    (write "Hello peer!" i/o)
+    (let ((greetings (read i/o)))
+
+      ;; ...
+
+      (bye session close-request/rdwr))))
+@end example
+
+@findex record-send
+@findex record-receive!
+
+A lower-level I/O API is provided by @code{record-send} and
+@code{record-receive!} which take an SRFI-4 vector to represent the
+data sent or received.  While it might improve performance, it is much
+less convenient than the above and should rarely be needed.
+
+
+@node Error Handling,  , Input and Output, Conventions
+@subsection Error Handling
+
+@cindex exceptions
+@cindex errors
+@cindex @code{gnutls-error}
+@findex error->string
+
+GnuTLS errors are implemented as Scheme exceptions (@pxref{Exceptions,
+exceptions in Guile,, guile, The GNU Guile Reference Manual}).  Each
+time a GnuTLS function returns an error, an exception with key
+@code{gnutls-error} is raised.  The additional arguments that are
+thrown include an error code and the name of the GnuTLS procedure that
+raised the exception.  The error code is pretty much like an enumerate
+value: it is one of the @code{error/} variables exported by the
+@code{(gnutls)} module (@pxref{Enumerates and Constants}).  Exceptions
+can be turned into error messages using the @code{error->string}
+procedure.
+
+The following examples illustrates how GnuTLS exceptions can be
+handled:
+
+@example
+(let ((session (make-session connection-end/server)))
+
+  ;;
+  ;; ...
+  ;;
+
+  (catch 'gnutls-error
+    (lambda ()
+      (handshake session))
+    (lambda (key err function . currently-unused)
+      (format (current-error-port)
+              "a GnuTLS error was raised by `~a': ~a~%"
+              function (error->string err)))))
+@end example
+
+Again, error values can be compared using @code{eq?}:
+
+@example
+    ;; `gnutls-error' handler.
+    (lambda (key err function . currently-unused)
+      (if (eq? err error/fatal-alert-received)
+          (format (current-error-port)
+                  "a fatal alert was caught!~%")
+          (format (current-error-port)
+                  "something bad happened: ~a~%"
+                  (error->string err))))
+@end example
+
+Note that the @code{catch} handler is currently passed only 3
+arguments but future versions might provide it with additional
+arguments.  Thus, it must be prepared to handle more than 3 arguments,
+as in this example.
+
+
+@c *********************************************************************
+@node Examples, Guile Reference, Conventions, Guile Bindings
+@section Examples
+
+This chapter lists examples that illustrate common use cases.
+
+@menu
+* Anonymous Authentication::    Simplest client and server.
+* OpenPGP Authentication::      Using OpenPGP-based authentication.
+* Importing OpenPGP Keys::      Importing keys from files.
+@end menu
+
+@node Anonymous Authentication, OpenPGP Authentication, Examples, Examples
+@subsection Anonymous Authentication
+
+@dfn{Anonymous authentication} is very easy to use.  No certificates
+are needed by the communicating parties.  Yet, it allows them to
+benefit from end-to-end encryption and integrity checks.
+
+The client-side code would look like this (assuming @var{some-socket}
+is bound to an open socket port):
+
+@vindex connection-end/client
+@vindex kx/anon-dh
+@vindex close-request/rdwr
+
+@example
+;; Client-side.
+
+(let ((client (make-session connection-end/client)))
+  ;; Use the default settings.
+  (set-session-default-priority! client)
+
+  ;; Don't use certificate-based authentication.
+  (set-session-certificate-type-priority! client '())
+
+  ;; Request the "anonymous Diffie-Hellman" key exchange method.
+  (set-session-kx-priority! client (list kx/anon-dh))
+
+  ;; Specify the underlying socket.
+  (set-session-transport-fd! client (fileno some-socket))
+
+  ;; Create anonymous credentials.
+  (set-session-credentials! client
+                            (make-anonymous-client-credentials))
+
+  ;; Perform the TLS handshake with the server.
+  (handshake client)
+
+  ;; Send data over the TLS record layer.
+  (write "hello, world!" (session-record-port client))
+
+  ;; Terminate the TLS session.
+  (bye client close-request/rdwr))
+@end example
+
+The corresponding server would look like this (again, assuming
+@var{some-socket} is bound to a socket port):
+
+@vindex connection-end/server
+
+@example
+;; Server-side.
+
+(let ((server (make-session connection-end/server)))
+  (set-session-default-priority! server)
+  (set-session-certificate-type-priority! server '())
+  (set-session-kx-priority! server (list kx/anon-dh))
+
+  ;; Specify the underlying transport socket.
+  (set-session-transport-fd! server (fileno some-socket))
+
+  ;; Create anonymous credentials.
+  (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))
+
+  ;; Perform the TLS handshake with the client.
+  (handshake server)
+
+  ;; Receive data over the TLS record layer.
+  (let ((message (read (session-record-port server))))
+    (format #t "received the following message: ~a~%"
+            message)
+
+    (bye server close-request/rdwr)))
+@end example
+
+This is it!
+
+
+@node OpenPGP Authentication, Importing OpenPGP Keys, Anonymous Authentication, Examples
+@subsection OpenPGP Authentication
+
+GnuTLS allows users to authenticate using OpenPGP certificates.  The
+relevant procedures are provided by the @code{(gnutls extra)} module.
+Using OpenPGP-based authentication is not more complicated than using
+anonymous authentication.  It requires a bit of extra work, though, to
+import the OpenPGP public and private key of the client/server.  Key
+import is omitted here and is left as an exercise to the reader
+(@pxref{Importing OpenPGP Keys}).
+
+Assuming @var{some-socket} is bound to an open socket port and
+@var{pub} and @var{sec} are bound to the client's OpenPGP public and
+secret key, respectively, client-side code would look like this:
+
+@vindex certificate-type/openpgp
+
+@example
+;; Client-side.
+
+(define %certs (list certificate-type/openpgp))
+
+(let ((client (make-session connection-end/client))
+      (cred   (make-certificate-credentials)))
+  (set-session-default-priority! client)
+
+  ;; Choose OpenPGP certificates.
+  (set-session-certificate-type-priority! client %certs)
+
+  ;; Prepare appropriate client credentials.
+  (set-certificate-credentials-openpgp-keys! cred pub sec)
+  (set-session-credentials! client cred)
+
+  ;; Specify the underlying transport socket.
+  (set-session-transport-fd! client (fileno some-socket))
+
+  (handshake client)
+  (write "hello, world!" (session-record-port client))
+  (bye client close-request/rdwr))
+@end example
+
+Similarly, server-side code would be along these lines:
+
+@example
+;; Server-side.
+
+(define %certs (list certificate-type/openpgp))
+
+(let ((server (make-session connection-end/server))
+      (rsa    (make-rsa-parameters 1024))
+      (dh     (make-dh-parameters 1024)))
+  (set-session-default-priority! server)
+
+  ;; Choose OpenPGP certificates.
+  (set-session-certificate-type-priority! server %certs)
+
+  (let ((cred (make-certificate-credentials)))
+    ;; Prepare credentials with RSA and Diffie-Hellman parameters.
+    (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-transport-fd! server (fileno some-socket))
+
+  (handshake server)
+  (let ((msg (read (session-record-port server))))
+    (format #t "received: ~a~%" msg)
+
+    (bye server close-request/rdwr)))
+@end example
+
+In practice, generating RSA parameters (and Diffie-Hellman parameters)
+can time a long time.  Thus, you may want to generate them once and
+store them in a file for future re-use (@pxref{Core Interface,
+@code{pkcs1-export-rsa-parameters} and
+@code{pkcs1-import-rsa-parameters}}).
+
+@node Importing OpenPGP Keys,  , OpenPGP Authentication, Examples
+@subsection Importing OpenPGP Keys
+
+The following example provides a simple way of importing
+``ASCII-armored'' OpenPGP keys from files, using the
+@code{import-openpgp-public-key} and @code{import-openpgp-private-key}
+procedures provided by the @code{(gnutls extra)} module.
+
+@vindex openpgp-key-format/base64
+@vindex openpgp-key-format/raw
+
+@example
+(use-modules (srfi srfi-4)
+             (gnutls extra))
+
+(define (import-key-from-file import-proc file)
+  ;; Import OpenPGP key from FILE using IMPORT-PROC.
+
+  ;; Prepare a u8vector large enough to hold the raw
+  ;; key contents.
+  (let* ((size (stat:size (stat path)))
+         (raw  (make-u8vector size)))
+
+    ;; Fill in the u8vector with the contents of FILE.
+    (uniform-vector-read! raw (open-input-file file))
+
+    ;; Pass the u8vector to the import procedure.
+    (import-proc raw openpgp-key-format/base64)))
+
+
+(define (import-public-key-from-file file)
+  (import-key-from-file import-openpgp-public-key file))
+
+(define (import-private-key-from-file file)
+  (import-key-from-file import-openpgp-private-key file))
+@end example
+
+The procedures @code{import-public-key-from-file} and
+@code{import-private-key-from-file} can be passed a file name.  They
+return an OpenPGP public key and private key object, respectively
+(@pxref{Extra Interface, OpenPGP key objects}).
+
+
+@c *********************************************************************
+@node Guile Reference,  , Examples, Guile Bindings
+@section Guile Reference
+
+This chapter documents GnuTLS Scheme procedures available to Guile
+programmers.
+
+@menu
+* Core Interface::              Bindings for core GnuTLS.
+* Extra Interface::             Bindings for GnuTLS-Extra.
+@end menu
+
+@node Core Interface, Extra Interface, Guile Reference, Guile Reference
+@subsection Core Interface
+
+This section lists the Scheme procedures exported by the
+@code{(gnutls)} module (@pxref{The Guile module system,,, guile, The
+GNU Guile Reference Manual}).  This module is licenced under the GNU
+Lesser General Public Licence, version 2.1 or later.
+
+@include core.c.texi
+
+@node Extra Interface,  , Core Interface, Guile Reference
+@subsection Extra Interface
+
+This section lists the Scheme procedures exported by the @code{(gnutls
+extra)} module.  This module is licenced under the GNU General Public
+Licence, version 2 or later.
+
+@include extra.c.texi
+
+
+
+@ignore
+;;; arch-tag: ee5f2081-9153-48fc-b4ee-2024381c65d7
+@end ignore
+
+@c Local Variables:
+@c ispell-local-dictionary: "american"
+@c End:
diff --git a/guile/Makefile.am b/guile/Makefile.am
new file mode 100644
index 0000000000..3e3e9f3306
--- /dev/null
+++ b/guile/Makefile.am
@@ -0,0 +1,18 @@
+#  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
+
+SUBDIRS = modules src tests
diff --git a/guile/modules/Makefile.am b/guile/modules/Makefile.am
new file mode 100644
index 0000000000..85cf709790
--- /dev/null
+++ b/guile/modules/Makefile.am
@@ -0,0 +1,28 @@
+#  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
+
+guilemoduledir = $(GUILE_SITE)
+
+nobase_dist_guilemodule_DATA = gnutls.scm gnutls/extra.scm
+
+documentation_modules = system/documentation/README		\
+		        system/documentation/c-snarf.scm	\
+                        system/documentation/output.scm
+
+EXTRA_DIST = gnutls/build/enums.scm gnutls/build/smobs.scm	\
+	     gnutls/build/utils.scm gnutls/build/priorities.scm	\
+             $(documentation_modules)
diff --git a/guile/modules/gnutls.scm b/guile/modules/gnutls.scm
new file mode 100644
index 0000000000..f98c4cf48a
--- /dev/null
+++ b/guile/modules/gnutls.scm
@@ -0,0 +1,384 @@
+;;; 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>
+
+(define-module (gnutls)
+  ;; Note: The export list must be manually kept in sync with the build
+  ;; system.
+  :export (;; versioning
+           gnutls-version
+
+           ;; sessions
+           session?
+           make-session bye handshake rehandshake
+           alert-get alert-send
+           session-cipher session-kx session-mac session-protocol
+           session-compression-method session-certificate-type
+           session-authentication-type session-server-authentication-type
+           session-client-authentication-type
+           session-peer-certificate-chain session-our-certificate-chain
+           set-session-transport-fd! set-session-transport-port!
+           set-session-credentials! set-server-session-certificate-request!
+
+           ;; anonymous credentials
+           anonymous-client-credentials? anonymous-server-credentials?
+           make-anonymous-client-credentials make-anonymous-server-credentials
+           set-anonymous-server-dh-parameters!
+
+           ;; certificate credentials
+           certificate-credentials? make-certificate-credentials
+           set-certificate-credentials-dh-parameters!
+           set-certificate-credentials-rsa-export-parameters!
+           set-certificate-credentials-x509-key-files!
+           set-certificate-credentials-x509-trust-file!
+           set-certificate-credentials-x509-crl-file!
+           set-certificate-credentials-x509-key-data!
+           set-certificate-credentials-x509-trust-data!
+           set-certificate-credentials-x509-crl-data!
+           set-certificate-credentials-x509-keys!
+           set-certificate-credentials-verify-limits!
+           set-certificate-credentials-verify-flags!
+           peer-certificate-status
+
+           ;; SRP credentials
+           srp-client-credentials? srp-server-credentials?
+           make-srp-client-credentials make-srp-server-credentials
+           set-srp-client-credentials!
+           set-srp-server-credentials-files!
+           server-session-srp-username
+           srp-base64-encode srp-base64-decode
+
+           ;; PSK credentials
+           psk-client-credentials? psk-server-credentials?
+           make-psk-client-credentials make-psk-server-credentials
+           set-psk-client-credentials!
+           set-psk-server-credentials-file!
+           server-session-psk-username
+
+           ;; priority functions
+           set-session-cipher-priority! set-session-mac-priority!
+           set-session-compression-method-priority!
+           set-session-kx-priority! set-session-protocol-priority!
+           set-session-certificate-type-priority!
+           set-session-default-priority! set-session-default-export-priority!
+
+           ;; DH
+           set-session-dh-prime-bits!
+           make-dh-parameters dh-parameters?
+           pkcs3-import-dh-parameters pkcs3-export-dh-parameters
+
+           ;; RSA
+           make-rsa-parameters rsa-parameters?
+           pkcs1-import-rsa-parameters pkcs1-export-rsa-parameters
+
+           ;; X.509
+           x509-certificate? x509-private-key?
+           import-x509-certificate  x509-certificate-matches-hostname?
+           x509-certificate-dn x509-certificate-dn-oid
+           x509-certificate-issuer-dn x509-certificate-issuer-dn-oid
+           x509-certificate-signature-algorithm x509-certificate-version
+           x509-certificate-key-id x509-certificate-authority-key-id
+           x509-certificate-subject-key-id
+           x509-certificate-subject-alternative-name
+           x509-certificate-public-key-algorithm x509-certificate-key-usage
+           import-x509-private-key pkcs8-import-x509-private-key
+
+           ;; record layer
+           record-send record-receive!
+           session-record-port
+
+           ;; debugging
+           set-log-procedure! set-log-level!
+
+           ;; enum->string functions
+           cipher->string kx->string params->string credentials->string
+           mac->string digest->string compression-method->string
+           connection-end->string alert-level->string
+           alert-description->string handshake-description->string
+           certificate-status->string close-request->string
+           protocol->string certificate-type->string
+           x509-certificate-format->string
+           x509-subject-alternative-name->string pk-algorithm->string
+           sign-algorithm->string psk-key-format->string key-usage->string
+           certificate-verify->string error->string
+           cipher-suite->string
+
+           ;; enum values
+           cipher/null
+           cipher/arcfour cipher/arcfour-128
+           cipher/3des-cbc
+           cipher/aes-128-cbc cipher/rijndael-cbc cipher/rijndael-128-cbc
+           cipher/aes-256-cbc cipher/rijndael-256-cbc
+           cipher/arcfour-40
+           cipher/rc2-40-cbc
+           cipher/des-cbc
+           kx/rsa
+           kx/dhe-dss
+           kx/dhe-rsa
+           kx/anon-dh
+           kx/srp
+           kx/rsa-export
+           kx/srp-rsa
+           kx/srp-dss
+           kx/psk
+           kx/dhe-dss
+           params/rsa-export
+           params/dh
+           credentials/certificate
+           credentials/anon
+           credentials/anonymous
+           credentials/srp
+           credentials/psk
+           credentials/ia
+           mac/unknown
+           mac/null
+           mac/md5
+           mac/sha1
+           mac/rmd160
+           mac/md2
+           digest/null
+           digest/md5
+           digest/sha1
+           digest/rmd160
+           digest/md2
+           compression-method/null
+           compression-method/deflate
+           compression-method/lzo
+           connection-end/server
+           connection-end/client
+           alert-level/warning
+           alert-level/fatal
+           alert-description/close-notify
+           alert-description/unexpected-message
+           alert-description/bad-record-mac
+           alert-description/decryption-failed
+           alert-description/record-overflow
+           alert-description/decompression-failure
+           alert-description/handshake-failure
+           alert-description/ssl3-no-certificate
+           alert-description/bad-certificate
+           alert-description/unsupported-certificate
+           alert-description/certificate-revoked
+           alert-description/certificate-expired
+           alert-description/certificate-unknown
+           alert-description/illegal-parameter
+           alert-description/unknown-ca
+           alert-description/access-denied
+           alert-description/decode-error
+           alert-description/decrypt-error
+           alert-description/export-restriction
+           alert-description/protocol-version
+           alert-description/insufficient-security
+           alert-description/internal-error
+           alert-description/user-canceled
+           alert-description/no-renegotiation
+           alert-description/unsupported-extension
+           alert-description/certificate-unobtainable
+           alert-description/unrecognized-name
+           alert-description/unknown-srp-username
+           alert-description/missing-srp-username
+           alert-description/inner-application-failure
+           alert-description/inner-application-verification
+           handshake-description/hello-request
+           handshake-description/client-hello
+           handshake-description/server-hello
+           handshake-description/certificate-pkt
+           handshake-description/server-key-exchange
+           handshake-description/certificate-request
+           handshake-description/server-hello-done
+           handshake-description/certificate-verify
+           handshake-description/client-key-exchange
+           handshake-description/finished
+           certificate-status/invalid
+           certificate-status/revoked
+           certificate-status/signer-not-found
+           certificate-status/signer-not-ca
+           certificate-status/insecure-algorithm
+           certificate-request/ignore
+           certificate-request/request
+           certificate-request/require
+           close-request/rdwr
+           close-request/wr
+           protocol/ssl-3
+           protocol/tls-1.0
+           protocol/tls-1.1
+           protocol/version-unknown
+           certificate-type/x509
+           certificate-type/openpgp
+           x509-certificate-format/der
+           x509-certificate-format/pem
+           x509-subject-alternative-name/dnsname
+           x509-subject-alternative-name/rfc822name
+           x509-subject-alternative-name/uri
+           x509-subject-alternative-name/ipaddress
+           pk-algorithm/rsa
+           pk-algorithm/dsa
+           pk-algorithm/unknown
+           sign-algorithm/unknown
+           sign-algorithm/rsa-sha1
+           sign-algorithm/dsa-sha1
+           sign-algorithm/rsa-md5
+           sign-algorithm/rsa-md2
+           sign-algorithm/rsa-rmd160
+           psk-key-format/raw
+           psk-key-format/hex
+           key-usage/digital-signature
+           key-usage/non-repudiation
+           key-usage/key-encipherment
+           key-usage/data-encipherment
+           key-usage/key-agreement
+           key-usage/key-cert-sign
+           key-usage/crl-sign
+           key-usage/encipher-only
+           key-usage/decipher-only
+           certificate-verify/disable-ca-sign
+           certificate-verify/allow-x509-v1-ca-crt
+           certificate-verify/allow-x509-v1-ca-certificate
+           certificate-verify/do-not-allow-same
+           certificate-verify/allow-any-x509-v1-ca-crt
+           certificate-verify/allow-any-x509-v1-ca-certificate
+           certificate-verify/allow-sign-rsa-md2
+           certificate-verify/allow-sign-rsa-md5
+
+           error/success
+           error/unknown-compression-algorithm
+           error/unknown-cipher-type
+           error/large-packet
+           error/unsupported-version-packet
+           error/unexpected-packet-length
+           error/invalid-session
+           error/fatal-alert-received
+           error/unexpected-packet
+           error/warning-alert-received
+           error/error-in-finished-packet
+           error/unexpected-handshake-packet
+           error/unknown-cipher-suite
+           error/unwanted-algorithm
+           error/mpi-scan-failed
+           error/decryption-failed
+           error/memory-error
+           error/decompression-failed
+           error/compression-failed
+           error/again
+           error/expired
+           error/db-error
+           error/srp-pwd-error
+           error/insufficient-credentials
+           error/insuficient-credentials
+           error/insufficient-cred
+           error/insuficient-cred
+           error/hash-failed
+           error/base64-decoding-error
+           error/mpi-print-failed
+           error/rehandshake
+           error/got-application-data
+           error/record-limit-reached
+           error/encryption-failed
+           error/pk-encryption-failed
+           error/pk-decryption-failed
+           error/pk-sign-failed
+           error/x509-unsupported-critical-extension
+           error/key-usage-violation
+           error/no-certificate-found
+           error/invalid-request
+           error/short-memory-buffer
+           error/interrupted
+           error/push-error
+           error/pull-error
+           error/received-illegal-parameter
+           error/requested-data-not-available
+           error/pkcs1-wrong-pad
+           error/received-illegal-extension
+           error/internal-error
+           error/dh-prime-unacceptable
+           error/file-error
+           error/too-many-empty-packets
+           error/unknown-pk-algorithm
+           error/init-libextra
+           error/library-version-mismatch
+           error/no-temporary-rsa-params
+           error/lzo-init-failed
+           error/no-compression-algorithms
+           error/no-cipher-suites
+           error/openpgp-getkey-failed
+           error/pk-sig-verify-failed
+           error/illegal-srp-username
+           error/srp-pwd-parsing-error
+           error/no-temporary-dh-params
+           error/asn1-element-not-found
+           error/asn1-identifier-not-found
+           error/asn1-der-error
+           error/asn1-value-not-found
+           error/asn1-generic-error
+           error/asn1-value-not-valid
+           error/asn1-tag-error
+           error/asn1-tag-implicit
+           error/asn1-type-any-error
+           error/asn1-syntax-error
+           error/asn1-der-overflow
+           error/openpgp-trustdb-version-unsupported
+           error/openpgp-uid-revoked
+           error/certificate-error
+           error/x509-certificate-error
+           error/certificate-key-mismatch
+           error/unsupported-certificate-type
+           error/x509-unknown-san
+           error/openpgp-fingerprint-unsupported
+           error/x509-unsupported-attribute
+           error/unknown-hash-algorithm
+           error/unknown-pkcs-content-type
+           error/unknown-pkcs-bag-type
+           error/invalid-password
+           error/mac-verify-failed
+           error/constraint-error
+           error/warning-ia-iphf-received
+           error/warning-ia-fphf-received
+           error/ia-verify-failed
+           error/base64-encoding-error
+           error/incompatible-gcrypt-library
+           error/incompatible-crypto-library
+           error/incompatible-libtasn1-library
+           error/openpgp-keyring-error
+           error/x509-unsupported-oid
+           error/random-failed
+           error/unimplemented-feature))
+
+(load-extension "libguile-gnutls-v-0" "scm_init_gnutls")
+
+;; Renaming.
+(define protocol/ssl-3 protocol/ssl3)
+(define protocol/tls-1.0 protocol/tls1-0)
+(define protocol/tls-1.1 protocol/tls1-1)
+
+;; Aliases.
+(define credentials/anonymous   credentials/anon)
+(define cipher/rijndael-256-cbc cipher/aes-256-cbc)
+(define cipher/rijndael-128-cbc cipher/aes-128-cbc)
+(define cipher/rijndael-cbc     cipher/aes-128-cbc)
+(define cipher/arcfour-128      cipher/arcfour)
+(define certificate-verify/allow-any-x509-v1-ca-certificate
+  certificate-verify/allow-any-x509-v1-ca-crt)
+(define certificate-verify/allow-x509-v1-ca-certificate
+  certificate-verify/allow-x509-v1-ca-crt)
+
+;;; Local Variables:
+;;; mode: scheme
+;;; coding: latin-1
+;;; End:
+
+;;; arch-tag: 3394732c-d9fa-48dd-a093-9fba3a325b8b
diff --git a/guile/modules/gnutls/build/enums.scm b/guile/modules/gnutls/build/enums.scm
new file mode 100644
index 0000000000..e09ef4f7c7
--- /dev/null
+++ b/guile/modules/gnutls/build/enums.scm
@@ -0,0 +1,596 @@
+;;; 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>
+
+(define-module (gnutls build enums)
+  :use-module (srfi srfi-1)
+  :use-module (srfi srfi-9)
+  :use-module (gnutls build utils)
+
+  :export (make-enum-type enum-type-subsystem enum-type-value-alist
+           enum-type-c-type enum-type-get-name-function
+           enum-type-automatic-get-name-function
+           enum-type-smob-name
+           enum-type-to-c-function enum-type-from-c-function
+
+           output-enum-smob-definitions output-enum-definitions
+           output-enum-declarations
+           output-enum-definition-function output-c->enum-converter
+           output-enum->c-converter
+
+           %cipher-enum %mac-enum %compression-method-enum %kx-enum
+           %protocol-enum %certificate-type-enum
+
+           %gnutls-enums %gnutls-extra-enums))
+
+;;;
+;;; This module helps with the creation of bindings for the C enumerate
+;;; types.  It aims at providing strong typing (i.e., one cannot use an
+;;; enumerate value of the wrong type) along with authenticity checks (i.e.,
+;;; values of a given enumerate type cannot be forged---for instance, one
+;;; cannot use some random integer as an enumerate value).  Additionally,
+;;; Scheme enums representing the same C enum value should be `eq?'.
+;;;
+;;; To that end, Scheme->C conversions are optimized (a simple
+;;; `SCM_SMOB_DATA'), since that is the most common usage pattern.
+;;; Conversely, C->Scheme conversions take time proportional to the number of
+;;; value in the enum type.
+;;;
+
+
+;;;
+;;; Enumeration tools.
+;;;
+
+(define-record-type <enum-type>
+  (%make-enum-type subsystem c-type enum-map get-name value-prefix)
+  enum-type?
+  (subsystem    enum-type-subsystem)
+  (enum-map     enum-type-value-alist)
+  (c-type       enum-type-c-type)
+  (get-name     enum-type-get-name-function)
+  (value-prefix enum-type-value-prefix))
+
+
+(define (make-enum-type subsystem c-type values get-name . value-prefix)
+  ;; Return a new enumeration type.
+  (let ((value-prefix (if (null? value-prefix)
+                          #f
+                          (car value-prefix))))
+    (%make-enum-type subsystem c-type
+                     (make-enum-map subsystem values value-prefix)
+                     get-name value-prefix)))
+
+
+(define (make-enum-map subsystem values value-prefix)
+  ;; Return an alist mapping C enum values (strings) to Scheme symbols.
+  (define (value-symbol->string value)
+    (string-upcase (scheme-symbol->c-name value)))
+
+  (define (make-c-name value)
+    (case value-prefix
+      ((#f)
+       ;; automatically derive the C value name.
+       (string-append "GNUTLS_" (string-upcase (symbol->string subsystem))
+                      "_" (value-symbol->string value)))
+      (else
+       (string-append value-prefix (value-symbol->string value)))))
+
+  (map (lambda (value)
+         (cons (make-c-name value) value))
+       values))
+
+(define (enum-type-smob-name enum)
+  ;; Return the C name of the smob type for ENUM.
+  (string-append "scm_tc16_gnutls_"
+                 (scheme-symbol->c-name (enum-type-subsystem enum))
+                 "_enum"))
+
+(define (enum-type-smob-list enum)
+  ;; Return the name of the C variable holding a list of value (SMOBs) for
+  ;; ENUM.  This list is used when converting from C to Scheme.
+  (string-append "scm_gnutls_"
+                 (scheme-symbol->c-name (enum-type-subsystem enum))
+                 "_enum_values"))
+
+(define (enum-type-to-c-function enum)
+  ;; Return the name of the C `scm_to_' function for ENUM.
+  (string-append "scm_to_gnutls_"
+                 (scheme-symbol->c-name (enum-type-subsystem enum))))
+
+(define (enum-type-from-c-function enum)
+  ;; Return the name of the C `scm_from_' function for ENUM.
+  (string-append "scm_from_gnutls_"
+                 (scheme-symbol->c-name (enum-type-subsystem enum))))
+
+(define (enum-type-automatic-get-name-function enum)
+  ;; Return the name of an automatically-generated C function that returns a
+  ;; string describing the given enum value of type ENUM.
+  (string-append "scm_gnutls_"
+                 (scheme-symbol->c-name (enum-type-subsystem enum))
+                 "_to_c_string"))
+
+
+;;;
+;;; C code generation.
+;;;
+
+(define (output-enum-smob-definitions enum port)
+  (let ((smob     (enum-type-smob-name enum))
+        (get-name (enum-type-get-name-function enum)))
+    (format port "SCM_GLOBAL_SMOB (~a, \"~a\", 0);~%"
+            smob (enum-type-subsystem enum))
+    (format port "SCM ~a = SCM_EOL;~%"
+            (enum-type-smob-list enum))
+
+    (if (not (string? get-name))
+        ;; Generate a "get name" function.
+        (output-enum-get-name-function enum port))
+
+    ;; Generate the printer and `->string' function.
+    (let ((get-name (or get-name
+                        (enum-type-automatic-get-name-function enum))))
+      (let ((subsystem (scheme-symbol->c-name (enum-type-subsystem enum))))
+        ;; SMOB printer.
+        (format port "SCM_SMOB_PRINT (~a, ~a_print, obj, port, pstate)~%{~%"
+                smob subsystem)
+        (format port "  scm_puts (\"#<gnutls-~a-enum \", port);~%"
+                (enum-type-subsystem enum))
+        (format port "  scm_puts (~a (~a (obj, 1, \"~a_print\")), port);~%"
+                get-name (enum-type-to-c-function enum) subsystem)
+        (format port "  scm_puts (\">\", port);~%")
+        (format port "  return 1;~%")
+        (format port "}~%")
+
+        ;; Enum-to-string.
+        (format port "SCM_DEFINE (scm_gnutls_~a_to_string, \"~a->string\", "
+                subsystem (enum-type-subsystem enum))
+        (format port "1, 0, 0,~%")
+        (format port "            (SCM enumval),~%")
+        (format port "            \"Return a string describing ")
+        (format port "@var{enumval}, a @code{~a} value.\")~%"
+                (enum-type-subsystem enum))
+        (format port "#define FUNC_NAME s_scm_gnutls_~a_to_string~%"
+                subsystem)
+        (format port "{~%")
+        (format port "  ~a c_enum;~%"
+                (enum-type-c-type enum))
+        (format port "  const char *c_string;~%")
+        (format port "  c_enum = ~a (enumval, 1, FUNC_NAME);~%"
+                (enum-type-to-c-function enum))
+        (format port "  c_string = ~a (c_enum);~%"
+                get-name)
+        (format port "  return (scm_from_locale_string (c_string));~%")
+        (format port "}~%")
+        (format port "#undef FUNC_NAME~%")))))
+
+(define (output-enum-definitions enum port)
+  ;; Output to PORT the Guile C code that defines the values of ENUM-ALIST.
+  (let ((subsystem (scheme-symbol->c-name (enum-type-subsystem enum))))
+    (format port "  enum_values = SCM_EOL;~%")
+    (for-each (lambda (c+scheme)
+                (format port "  SCM_NEWSMOB (enum_smob, ~a, "
+                        (enum-type-smob-name enum))
+                (format port "(scm_t_bits) ~a);~%"
+                        (car c+scheme))
+                (format port "  enum_values = scm_cons (enum_smob, ")
+                (format port "enum_values);~%")
+                (format port "  scm_c_define (\"~a\", enum_smob);~%"
+                        (symbol-append (enum-type-subsystem enum) '/
+                                       (cdr c+scheme))))
+              (enum-type-value-alist enum))
+    (format port "  ~a = scm_permanent_object (enum_values);~%"
+            (enum-type-smob-list enum))))
+
+(define (output-enum-declarations enum port)
+  ;; Issue header file declarations needed for the inline functions that
+  ;; handle ENUM values.
+  (format port "SCM_API scm_t_bits ~a;~%"
+          (enum-type-smob-name enum))
+  (format port "SCM_API SCM ~a;~%"
+          (enum-type-smob-list enum)))
+
+(define (output-enum-definition-function enums port)
+  ;; Output a C function that does all the `scm_c_define ()' for the enums
+  ;; listed in ENUMS.
+  (format port "static inline void~%scm_gnutls_define_enums (void)~%{~%")
+  (format port "  SCM enum_values, enum_smob;~%")
+  (for-each (lambda (enum)
+              (output-enum-definitions enum port))
+            enums)
+  (format port "}~%"))
+
+(define (output-c->enum-converter enum port)
+  ;; Output a C->Scheme converted for ENUM.  This works by walking the list
+  ;; of available enum values (SMOBs) for ENUM and then returning the
+  ;; matching SMOB, so that users can then compare enums using `eq?'.  While
+  ;; this may look inefficient, this shouldn't be a problem since (i)
+  ;; conversion in that direction is rarely needed and (ii) the number of
+  ;; values per enum is expected to be small.
+  (format port "static inline SCM~%~a (~a c_obj)~%{~%"
+          (enum-type-from-c-function enum)
+          (enum-type-c-type enum))
+  (format port "  SCM pair, result = SCM_BOOL_F;~%")
+  (format port "  for (pair = ~a; scm_is_pair (pair); "
+          (enum-type-smob-list enum))
+  (format port "pair = SCM_CDR (pair))~%")
+  (format port "    {~%")
+  (format port "      SCM enum_smob;~%")
+  (format port "      enum_smob = SCM_CAR (pair);~%")
+  (format port "      if ((~a) SCM_SMOB_DATA (enum_smob) == c_obj)~%"
+          (enum-type-c-type enum))
+  (format port "        {~%")
+  (format port "          result = enum_smob;~%")
+  (format port "          break;~%")
+  (format port "        }~%")
+  (format port "    }~%")
+  (format port "  return result;~%")
+  (format port "}~%"))
+
+(define (output-enum->c-converter enum port)
+  (let* ((c-type-name (enum-type-c-type enum))
+         (subsystem   (scheme-symbol->c-name (enum-type-subsystem enum))))
+
+    (format port
+            "static inline ~a~%~a (SCM obj, unsigned pos, const char *func)~%"
+            c-type-name (enum-type-to-c-function enum))
+    (format port "#define FUNC_NAME func~%")
+    (format port "{~%")
+    (format port "  SCM_VALIDATE_SMOB (pos, obj, ~a);~%"
+            (string-append "gnutls_" subsystem "_enum"))
+    (format port "  return ((~a) SCM_SMOB_DATA (obj));~%"
+            c-type-name)
+    (format port "}~%")
+    (format port "#undef FUNC_NAME~%")))
+
+(define (output-enum-get-name-function enum port)
+  ;; Output a C function that, when passed a C ENUM value, returns a C string
+  ;; representing that value.
+  (let ((function (enum-type-automatic-get-name-function enum)))
+    (format port
+            "static const char *~%~a (~a c_obj)~%"
+            function (enum-type-c-type enum))
+    (format port "{~%")
+    (format port "  static const struct ")
+    (format port "{ ~a value; const char *name; } "
+            (enum-type-c-type enum))
+    (format port "table[] =~%")
+    (format port "    {~%")
+    (for-each (lambda (c+scheme)
+                (format port "       { ~a, \"~a\" },~%"
+                        (car c+scheme) (cdr c+scheme)))
+              (enum-type-value-alist enum))
+    (format port "    };~%")
+    (format port "  unsigned i;~%")
+    (format port "  const char *name = NULL;~%")
+    (format port "  for (i = 0; i < ~a; i++)~%"
+            (length (enum-type-value-alist enum)))
+    (format port "    {~%")
+    (format port "      if (table[i].value == c_obj)~%")
+    (format port "        {~%")
+    (format port "          name = table[i].name;~%")
+    (format port "          break;~%")
+    (format port "        }~%")
+    (format port "    }~%")
+    (format port "  return (name);~%")
+    (format port "}~%")))
+
+
+;;;
+;;; Actual enumerations.
+;;;
+
+(define %cipher-enum
+  (make-enum-type 'cipher "gnutls_cipher_algorithm_t"
+                  '(null arcfour 3des-cbc aes-128-cbc aes-256-cbc
+                    arcfour-40 rc2-40-cbc des-cbc)
+                  "gnutls_cipher_get_name"))
+
+(define %kx-enum
+  (make-enum-type 'kx "gnutls_kx_algorithm_t"
+                  '(rsa dhe-dss dhe-rsa anon-dh srp rsa-export
+                    srp-rsa srp-dss psk dhe-dss)
+                  "gnutls_kx_get_name"))
+
+(define %params-enum
+  (make-enum-type 'params "gnutls_params_type_t"
+                  '(rsa-export dh)
+                  #f))
+
+(define %credentials-enum
+  (make-enum-type 'credentials "gnutls_credentials_type_t"
+                  '(certificate anon srp psk ia)
+                  #f
+                  "GNUTLS_CRD_"))
+
+(define %mac-enum
+  (make-enum-type 'mac "gnutls_mac_algorithm_t"
+                  '(unknown null md5 sha1 rmd160 md2)
+                  "gnutls_mac_get_name"))
+
+(define %digest-enum
+  (make-enum-type 'digest "gnutls_digest_algorithm_t"
+                  '(null md5 sha1 rmd160 md2)
+                  #f
+                  "GNUTLS_DIG_"))
+
+(define %compression-method-enum
+  (make-enum-type 'compression-method "gnutls_compression_method_t"
+                  '(null deflate lzo)
+                  "gnutls_compression_get_name"
+                  "GNUTLS_COMP_"))
+
+(define %connection-end-enum
+  (make-enum-type 'connection-end "gnutls_connection_end_t"
+                  '(server client)
+                  #f
+                  "GNUTLS_"))
+
+(define %alert-level-enum
+  (make-enum-type 'alert-level "gnutls_alert_level_t"
+                  '(warning fatal)
+                  #f
+                  "GNUTLS_AL_"))
+
+(define %alert-description-enum
+  (make-enum-type 'alert-description "gnutls_alert_description_t"
+                  '(close-notify unexpected-message bad-record-mac
+decryption-failed record-overflow decompression-failure handshake-failure
+ssl3-no-certificate bad-certificate unsupported-certificate
+certificate-revoked certificate-expired certificate-unknown illegal-parameter
+unknown-ca access-denied decode-error decrypt-error export-restriction
+protocol-version insufficient-security internal-error user-canceled
+no-renegotiation unsupported-extension certificate-unobtainable
+unrecognized-name unknown-srp-username missing-srp-username
+inner-application-failure inner-application-verification)
+                  #f
+                  "GNUTLS_A_"))
+
+(define %handshake-description-enum
+  (make-enum-type 'handshake-description "gnutls_handshake_description_t"
+                  '(hello-request client-hello server-hello certificate-pkt
+                    server-key-exchange certificate-request server-hello-done
+                    certificate-verify client-key-exchange finished)
+                  #f
+                  "GNUTLS_HANDSHAKE_"))
+
+(define %certificate-status-enum
+  (make-enum-type 'certificate-status "gnutls_certificate_status_t"
+                  '(invalid revoked signer-not-found signer-not-ca
+                    insecure-algorithm)
+                  #f
+                  "GNUTLS_CERT_"))
+
+(define %certificate-request-enum
+  (make-enum-type 'certificate-request "gnutls_certificate_request_t"
+                  '(ignore request require)
+                  #f
+                  "GNUTLS_CERT_"))
+
+;; XXX: Broken naming convention.
+; (define %openpgp-key-status-enum
+;   (make-enum-type 'openpgp-key-status "gnutls_openpgp_key_status_t"
+;                   '(key fingerprint)
+;                   #f
+;                   "GNUTLS_OPENPGP_"))
+
+(define %close-request-enum
+  (make-enum-type 'close-request "gnutls_close_request_t"
+                  '(rdwr wr) ;; FIXME: Check the meaning and rename
+                  #f
+                  "GNUTLS_SHUT_"))
+
+(define %protocol-enum
+  (make-enum-type 'protocol "gnutls_protocol_t"
+                  '(ssl3 tls1-0 tls1-1 version-unknown)
+                  #f
+                  "GNUTLS_"))
+
+(define %certificate-type-enum
+  (make-enum-type 'certificate-type "gnutls_certificate_type_t"
+                  '(x509 openpgp)
+                  "gnutls_certificate_type_get_name"
+                  "GNUTLS_CRT_"))
+
+(define %x509-certificate-format-enum
+  (make-enum-type 'x509-certificate-format "gnutls_x509_crt_fmt_t"
+                  '(der pem)
+                  #f
+                  "GNUTLS_X509_FMT_"))
+
+(define %x509-subject-alternative-name-enum
+  (make-enum-type 'x509-subject-alternative-name
+                  "gnutls_x509_subject_alt_name_t"
+                  '(dnsname rfc822name uri ipaddress)
+                  #f
+                  "GNUTLS_SAN_"))
+
+(define %pk-algorithm-enum
+  (make-enum-type 'pk-algorithm "gnutls_pk_algorithm_t"
+                  '(unknown rsa dsa)
+                  "gnutls_pk_algorithm_get_name"
+                  "GNUTLS_PK_"))
+
+(define %sign-algorithm-enum
+  (make-enum-type 'sign-algorithm "gnutls_sign_algorithm_t"
+                  '(unknown rsa-sha1 dsa-sha1 rsa-md5 rsa-md2
+                    rsa-rmd160)
+                  "gnutls_sign_algorithm_get_name"
+                  "GNUTLS_SIGN_"))
+
+(define %psk-key-format-enum
+  (make-enum-type 'psk-key-format "gnutls_psk_key_flags"
+                  '(raw hex)
+                  #f
+                  "GNUTLS_PSK_KEY_"))
+
+(define %key-usage-enum
+  ;; Not actually an enum on the C side.
+  (make-enum-type 'key-usage "int"
+                  '(digital-signature non-repudiation key-encipherment
+                    data-encipherment key-agreement key-cert-sign
+                    crl-sign encipher-only decipher-only)
+                  #f
+                  "GNUTLS_KEY_"))
+
+(define %certificate-verify-enum
+  (make-enum-type 'certificate-verify "gnutls_certificate_verify_flags"
+                  '(disable-ca-sign allow-x509-v1-ca-crt
+                    do-not-allow-same allow-any-x509-v1-ca-crt
+                    allow-sign-rsa-md2 allow-sign-rsa-md5)
+                  #f
+                  "GNUTLS_VERIFY_"))
+
+(define %error-enum
+  (make-enum-type 'error "int"
+                  '(
+success
+unknown-compression-algorithm
+unknown-cipher-type
+large-packet
+unsupported-version-packet
+unexpected-packet-length
+invalid-session
+fatal-alert-received
+unexpected-packet
+warning-alert-received
+error-in-finished-packet
+unexpected-handshake-packet
+unknown-cipher-suite
+unwanted-algorithm
+mpi-scan-failed
+decryption-failed
+memory-error
+decompression-failed
+compression-failed
+again
+expired
+db-error
+srp-pwd-error
+insufficient-credentials
+insuficient-credentials
+insufficient-cred
+insuficient-cred
+hash-failed
+base64-decoding-error
+mpi-print-failed
+rehandshake
+got-application-data
+record-limit-reached
+encryption-failed
+pk-encryption-failed
+pk-decryption-failed
+pk-sign-failed
+x509-unsupported-critical-extension
+key-usage-violation
+no-certificate-found
+invalid-request
+short-memory-buffer
+interrupted
+push-error
+pull-error
+received-illegal-parameter
+requested-data-not-available
+pkcs1-wrong-pad
+received-illegal-extension
+internal-error
+dh-prime-unacceptable
+file-error
+too-many-empty-packets
+unknown-pk-algorithm
+init-libextra
+library-version-mismatch
+no-temporary-rsa-params
+lzo-init-failed
+no-compression-algorithms
+no-cipher-suites
+openpgp-getkey-failed
+pk-sig-verify-failed
+illegal-srp-username
+srp-pwd-parsing-error
+no-temporary-dh-params
+asn1-element-not-found
+asn1-identifier-not-found
+asn1-der-error
+asn1-value-not-found
+asn1-generic-error
+asn1-value-not-valid
+asn1-tag-error
+asn1-tag-implicit
+asn1-type-any-error
+asn1-syntax-error
+asn1-der-overflow
+openpgp-trustdb-version-unsupported
+openpgp-uid-revoked
+certificate-error
+x509-certificate-error
+certificate-key-mismatch
+unsupported-certificate-type
+x509-unknown-san
+openpgp-fingerprint-unsupported
+x509-unsupported-attribute
+unknown-hash-algorithm
+unknown-pkcs-content-type
+unknown-pkcs-bag-type
+invalid-password
+mac-verify-failed
+constraint-error
+warning-ia-iphf-received
+warning-ia-fphf-received
+ia-verify-failed
+base64-encoding-error
+incompatible-gcrypt-library
+incompatible-crypto-library
+incompatible-libtasn1-library
+openpgp-keyring-error
+x509-unsupported-oid
+random-failed
+unimplemented-feature)
+                  "gnutls_strerror"
+                  "GNUTLS_E_"))
+
+
+(define %openpgp-key-format-enum
+  (make-enum-type 'openpgp-key-format "gnutls_openpgp_key_fmt"
+                  '(raw base64)
+                  #f
+                  "GNUTLS_OPENPGP_FMT_"))
+
+
+(define %gnutls-enums
+  ;; All enums.
+  (list %cipher-enum %kx-enum %params-enum %credentials-enum %mac-enum
+        %digest-enum %compression-method-enum %connection-end-enum
+        %alert-level-enum %alert-description-enum %handshake-description-enum
+        %certificate-status-enum %certificate-request-enum
+        %close-request-enum %protocol-enum %certificate-type-enum
+        %x509-certificate-format-enum %x509-subject-alternative-name-enum
+        %pk-algorithm-enum %sign-algorithm-enum
+        %psk-key-format-enum %key-usage-enum %certificate-verify-enum
+        %error-enum))
+
+(define %gnutls-extra-enums
+  ;; All enums for GnuTLS-extra (GPL).
+  (list %openpgp-key-format-enum))
+
+;;; Local Variables:
+;;; mode: scheme
+;;; coding: latin-1
+;;; End:
+
+;;; arch-tag: 9e3eb6bb-61a5-4e85-861f-1914ab9677b0
diff --git a/guile/modules/gnutls/build/priorities.scm b/guile/modules/gnutls/build/priorities.scm
new file mode 100644
index 0000000000..419364acd2
--- /dev/null
+++ b/guile/modules/gnutls/build/priorities.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>
+
+(define-module (gnutls build priorities)
+  :use-module (srfi srfi-9)
+  :use-module (gnutls build utils)
+  :use-module (gnutls build enums)
+  :export (output-session-set-priority-function %gnutls-priorities))
+
+;;;
+;;; Helpers to generate the `gnutls_XXX_set_priority ()' wrappers.
+;;;
+
+
+
+;;;
+;;; Priority functions.
+;;;
+
+(define-record-type <session-priority>
+  (make-session-priority enum-type c-setter)
+  session-priority?
+  (enum-type        session-priority-enum-type)
+  (c-setter         session-priority-c-setter)
+  (c-getter         session-priority-c-getter))
+
+
+;;;
+;;; C code generation.
+;;;
+
+(define (output-session-set-priority-function priority port)
+  (let* ((enum   (session-priority-enum-type priority))
+         (setter (session-priority-c-setter priority))
+         (c-name (scheme-symbol->c-name (enum-type-subsystem enum))))
+    (format port "SCM_DEFINE (scm_gnutls_set_session_~a_priority_x,~%"
+            c-name)
+    (format port "            \"set-session-~a-priority!\", 2, 0, 0,~%"
+            (enum-type-subsystem enum))
+    (format port "            (SCM session, SCM items),~%")
+    (format port "            \"Use @var{items} (a list) as the list of \"~%")
+    (format port "            \"preferred ~a for @var{session}.\")~%"
+            (enum-type-subsystem enum))
+    (format port "#define FUNC_NAME s_scm_gnutls_set_session_~a_priority_x~%"
+            c-name)
+    (format port "{~%")
+    (format port "  gnutls_session_t c_session;~%")
+    (format port "  ~a *c_items;~%"
+            (enum-type-c-type enum))
+    (format port "  long int c_len, i;~%")
+    (format port "  c_session = scm_to_gnutls_session (session, 1, FUNC_NAME);~%")
+    (format port "  SCM_VALIDATE_LIST_COPYLEN (2, items, c_len);~%")
+    (format port "  c_items = (~a *) alloca (sizeof (* c_items) * c_len);~%"
+            (enum-type-c-type enum))
+    (format port "  for (i = 0; i < c_len; i++, items = SCM_CDR (items))~%")
+    (format port "    c_items[i] = ~a (SCM_CAR (items), 2, FUNC_NAME);~%"
+            (enum-type-to-c-function enum))
+    (format port "  c_items[c_len] = (~a) 0;~%"
+            (enum-type-c-type enum))
+    (format port "  ~a (c_session, (int *) c_items);~%"
+            setter)
+    (format port "  return SCM_UNSPECIFIED;~%")
+    (format port "}~%")
+    (format port "#undef FUNC_NAME~%")))
+
+
+;;;
+;;; Actual priority functions.
+;;;
+
+(define %gnutls-priorities
+  (map make-session-priority
+       (list %cipher-enum %mac-enum %compression-method-enum %kx-enum
+             %protocol-enum %certificate-type-enum)
+       (list "gnutls_cipher_set_priority" "gnutls_mac_set_priority"
+             "gnutls_compression_set_priority" "gnutls_kx_set_priority"
+             "gnutls_protocol_set_priority"
+             "gnutls_certificate_type_set_priority")))
+
+
+;;; Local Variables:
+;;; mode: scheme
+;;; coding: latin-1
+;;; End:
+
+;;; arch-tag: a9cdcc92-6dcf-4d63-afec-6dc16334e379
diff --git a/guile/modules/gnutls/build/smobs.scm b/guile/modules/gnutls/build/smobs.scm
new file mode 100644
index 0000000000..a21cb583f0
--- /dev/null
+++ b/guile/modules/gnutls/build/smobs.scm
@@ -0,0 +1,238 @@
+;;; Help produce Guile wrappers for GnuTLS types.
+;;;
+;;; 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>
+
+(define-module (gnutls build smobs)
+  :use-module (srfi srfi-9)
+  :use-module (srfi srfi-13)
+  :use-module (gnutls build utils)
+  :export (make-smob-type smob-type-tag smob-free-function
+           smob-type-predicate-scheme-name
+           smob-type-from-c-function smob-type-to-c-function
+
+           output-smob-type-definition output-smob-type-declaration
+           output-smob-type-predicate
+           output-c->smob-converter output-smob->c-converter
+
+           %gnutls-smobs %gnutls-extra-smobs))
+
+
+;;;
+;;; SMOB types.
+;;;
+
+(define-record-type <smob-type>
+  (%make-smob-type c-name scm-name free-function)
+  smob-type?
+  (c-name         smob-type-c-name)
+  (scm-name       smob-type-scheme-name)
+  (free-function  smob-type-free-function))
+
+(define (make-smob-type c-name scm-name . free-function)
+  (%make-smob-type c-name scm-name
+                   (if (null? free-function)
+                       (string-append "gnutls_"
+                                      (scheme-symbol->c-name scm-name)
+                                      "_deinit")
+                       (car free-function))))
+
+(define (smob-type-tag type)
+  ;; Return the name of the C variable holding the type tag for TYPE.
+  (string-append "scm_tc16_gnutls_"
+                 (scheme-symbol->c-name (smob-type-scheme-name type))))
+
+(define (smob-type-predicate-scheme-name type)
+  ;; Return a string denoting the Scheme name of TYPE's type predicate.
+  (string-append (symbol->string (smob-type-scheme-name type)) "?"))
+
+(define (smob-type-to-c-function type)
+  ;; Return the name of the C `scm_to_' function for SMOB.
+  (string-append "scm_to_gnutls_"
+                 (scheme-symbol->c-name (smob-type-scheme-name type))))
+
+(define (smob-type-from-c-function type)
+  ;; Return the name of the C `scm_from_' function for SMOB.
+  (string-append "scm_from_gnutls_"
+                 (scheme-symbol->c-name (smob-type-scheme-name type))))
+
+
+;;;
+;;; C code generation.
+;;;
+
+(define (output-smob-type-definition type port)
+  (format port "SCM_GLOBAL_SMOB (~a, \"~a\", 0);~%"
+          (smob-type-tag type)
+          (smob-type-scheme-name type))
+
+  (format port "SCM_SMOB_FREE (~a, ~a_free, obj)~%{~%"
+          (smob-type-tag type)
+          (scheme-symbol->c-name (smob-type-scheme-name type)))
+  (format port "  ~a c_obj;~%"
+          (smob-type-c-name type))
+  (format port "  c_obj = (~a) SCM_SMOB_DATA (obj);~%"
+          (smob-type-c-name type))
+  (format port "  ~a (c_obj);~%"
+          (smob-type-free-function type))
+  (format port "  return 0;~%")
+  (format port "}~%"))
+
+(define (output-smob-type-declaration type port)
+  ;; Issue a header file declaration for the SMOB type tag of TYPE.
+  (format port "SCM_API scm_t_bits ~a;~%"
+          (smob-type-tag type)))
+
+(define (output-smob-type-predicate type port)
+  (define (texi-doc-string)
+    (string-append "Return true if @var{obj} is of type @code{"
+                   (symbol->string (smob-type-scheme-name type))
+                   "}."))
+
+  (let ((c-name (string-append "scm_gnutls_"
+                               (string-map (lambda (chr)
+                                             (if (char=? chr #\-)
+                                                 #\_
+                                                 chr))
+                                           (symbol->string
+                                            (smob-type-scheme-name type)))
+                               "_p")))
+    (format port "SCM_DEFINE (~a, \"~a\", 1, 0, 0,~%"
+            c-name (smob-type-predicate-scheme-name type))
+    (format port "            (SCM obj),~%")
+    (format port "            \"~a\")~%"
+            (texi-doc-string))
+    (format port "#define FUNC_NAME s_~a~%"
+            c-name)
+    (format port "{~%")
+    (format port "  return (scm_from_bool (SCM_SMOB_PREDICATE (~a, obj)));~%"
+            (smob-type-tag type))
+    (format port "}~%#undef FUNC_NAME~%")))
+
+(define (output-c->smob-converter type port)
+  (format port "static inline SCM~%~a (~a c_obj)~%{~%"
+          (smob-type-from-c-function type)
+          (smob-type-c-name type))
+  (format port "  SCM_RETURN_NEWSMOB (~a, (scm_t_bits) c_obj);~%"
+          (smob-type-tag type))
+  (format port "}~%"))
+
+(define (output-smob->c-converter type port)
+  (format port "static inline ~a~%~a (SCM obj, "
+          (smob-type-c-name type)
+          (smob-type-to-c-function type))
+  (format port "unsigned pos, const char *func)~%")
+  (format port "#define FUNC_NAME func~%")
+  (format port "{~%")
+  (format port "  SCM_VALIDATE_SMOB (pos, obj, ~a);~%"
+          (string-append "gnutls_"
+                         (scheme-symbol->c-name (smob-type-scheme-name type))))
+  (format port "  return ((~a) SCM_SMOB_DATA (obj));~%"
+          (smob-type-c-name type))
+  (format port "}~%")
+  (format port "#undef FUNC_NAME~%"))
+
+
+;;;
+;;; Actual SMOB types.
+;;;
+
+(define %session-smob
+  (make-smob-type "gnutls_session_t" 'session
+                  "gnutls_deinit"))
+
+(define %anonymous-client-credentials-smob
+  (make-smob-type "gnutls_anon_client_credentials_t" 'anonymous-client-credentials
+                  "gnutls_anon_free_client_credentials"))
+
+(define %anonymous-server-credentials-smob
+  (make-smob-type "gnutls_anon_server_credentials_t" 'anonymous-server-credentials
+                  "gnutls_anon_free_server_credentials"))
+
+(define %dh-parameters-smob
+  (make-smob-type "gnutls_dh_params_t" 'dh-parameters
+                  "gnutls_dh_params_deinit"))
+
+(define %rsa-parameters-smob
+  (make-smob-type "gnutls_rsa_params_t" 'rsa-parameters
+                  "gnutls_rsa_params_deinit"))
+
+(define %certificate-credentials-smob
+  (make-smob-type "gnutls_certificate_credentials_t" 'certificate-credentials
+                  "gnutls_certificate_free_credentials"))
+
+(define %srp-server-credentials-smob
+  (make-smob-type "gnutls_srp_server_credentials_t" 'srp-server-credentials
+                  "gnutls_srp_free_server_credentials"))
+
+(define %srp-client-credentials-smob
+  (make-smob-type "gnutls_srp_client_credentials_t" 'srp-client-credentials
+                  "gnutls_srp_free_client_credentials"))
+
+(define %psk-server-credentials-smob
+  (make-smob-type "gnutls_psk_server_credentials_t" 'psk-server-credentials
+                  "gnutls_psk_free_server_credentials"))
+
+(define %psk-client-credentials-smob
+  (make-smob-type "gnutls_psk_client_credentials_t" 'psk-client-credentials
+                  "gnutls_psk_free_client_credentials"))
+
+(define %x509-certificate-smob
+  (make-smob-type "gnutls_x509_crt_t" 'x509-certificate
+                  "gnutls_x509_crt_deinit"))
+
+(define %x509-private-key-smob
+  (make-smob-type "gnutls_x509_privkey_t" 'x509-private-key
+                  "gnutls_x509_privkey_deinit"))
+
+(define %openpgp-public-key-smob
+  (make-smob-type "gnutls_openpgp_key_t" 'openpgp-public-key
+                  "gnutls_openpgp_key_deinit"))
+
+(define %openpgp-private-key-smob
+  (make-smob-type "gnutls_openpgp_privkey_t" 'openpgp-private-key
+                  "gnutls_openpgp_privkey_deinit"))
+
+(define %openpgp-keyring-smob
+  (make-smob-type "gnutls_openpgp_keyring_t" 'openpgp-keyring
+                  "gnutls_openpgp_keyring_deinit"))
+
+
+(define %gnutls-smobs
+  ;; All SMOB types.
+  (list %session-smob %anonymous-client-credentials-smob
+        %anonymous-server-credentials-smob %dh-parameters-smob
+        %rsa-parameters-smob
+        %certificate-credentials-smob
+        %srp-server-credentials-smob %srp-client-credentials-smob
+        %psk-server-credentials-smob %psk-client-credentials-smob
+        %x509-certificate-smob %x509-private-key-smob))
+
+(define %gnutls-extra-smobs
+  ;; All SMOB types for GnuTLS-extra (GPL).
+  (list %openpgp-public-key-smob %openpgp-private-key-smob
+        %openpgp-keyring-smob))
+
+
+;;; Local Variables:
+;;; mode: scheme
+;;; coding: latin-1
+;;; End:
+
+;;; arch-tag: 26bf79ef-6dee-45f2-9e9d-2d209c518278
diff --git a/guile/modules/gnutls/build/utils.scm b/guile/modules/gnutls/build/utils.scm
new file mode 100644
index 0000000000..dedd6ec3a5
--- /dev/null
+++ b/guile/modules/gnutls/build/utils.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>
+
+(define-module (gnutls build utils)
+  :use-module (srfi srfi-13)
+  :export (scheme-symbol->c-name))
+
+;;;
+;;; Common utilities for the binding generation code.
+;;;
+
+
+;;;
+;;; Utilities.
+;;;
+
+(define (scheme-symbol->c-name sym)
+  ;; Turn SYM, a symbol denoting a Scheme name, into a string denoting a C
+  ;; name.
+  (string-map (lambda (chr)
+                (if (eq? chr #\-) #\_ chr))
+              (symbol->string sym)))
+
+
+;;; Local Variables:
+;;; mode: scheme
+;;; coding: latin-1
+;;; End:
+
+;;; arch-tag: 56919ee1-7cce-46b9-b90f-ae6fbcfe4159
diff --git a/guile/modules/gnutls/extra.scm b/guile/modules/gnutls/extra.scm
new file mode 100644
index 0000000000..73f89b2215
--- /dev/null
+++ b/guile/modules/gnutls/extra.scm
@@ -0,0 +1,59 @@
+;;; 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>
+
+(define-module (gnutls extra)
+
+;;; Important note: As written above, this part of the code is ditributed
+;;; under the GPL, not the LGPL.
+
+  :use-module (gnutls)
+
+  :export (;; OpenPGP keys
+           openpgp-public-key? openpgp-private-key?
+           import-openpgp-public-key import-openpgp-private-key
+           openpgp-public-key-id openpgp-public-key-id!
+           openpgp-public-key-fingerprint openpgp-public-key-fingerprint!
+           openpgp-public-key-name openpgp-public-key-names
+           openpgp-public-key-algorithm openpgp-public-key-version
+           openpgp-public-key-usage
+
+           ;; OpenPGP keyrings
+           openpgp-keyring? import-openpgp-keyring
+           openpgp-keyring-contains-key-id?
+
+           ;; certificate credentials
+           set-certificate-credentials-openpgp-keys!
+
+           ;; enum->string functions
+           openpgp-key-format->string
+
+           ;; enum values
+           openpgp-key-format/raw
+           openpgp-key-format/base64))
+
+
+(load-extension "libguile-gnutls-extra-v-0" "scm_init_gnutls_extra")
+
+;;; Local Variables:
+;;; mode: scheme
+;;; coding: latin-1
+;;; End:
+
+;;; arch-tag: 2eb7693e-a221-41d3-8a14-a57426e9e670
diff --git a/guile/modules/system/documentation/README b/guile/modules/system/documentation/README
new file mode 100644
index 0000000000..de45e2e503
--- /dev/null
+++ b/guile/modules/system/documentation/README
@@ -0,0 +1,15 @@
+C Documentation Snarfing Modules
+--------------------------------
+
+This modules provide allow the extraction of Texinfo documentation
+strings from C files---this is usually referred to as ``doc snarfing''
+in Guile terms.
+
+They were stolen from Guile-Reader 0.3:
+
+  http://www.nongnu.org/guile-reader/
+
+It was only slightly modified.
+
+
+Ludovic Courtès <ludo@chbouib.org>.
diff --git a/guile/modules/system/documentation/c-snarf.scm b/guile/modules/system/documentation/c-snarf.scm
new file mode 100644
index 0000000000..c0ca2e819b
--- /dev/null
+++ b/guile/modules/system/documentation/c-snarf.scm
@@ -0,0 +1,189 @@
+;;; c-snarf.scm  --  Parsing documentation "snarffed" from C files.
+;;;
+;;; Copyright 2006  Free Software Foundation
+;;;
+;;;
+;;; This program 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.
+;;;
+;;; This program 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 this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA
+
+(define-module (system documentation c-snarf)
+  :use-module (ice-9 popen)
+  :use-module (ice-9 rdelim)
+
+  :use-module (srfi srfi-13)
+  :use-module (srfi srfi-14)
+  :use-module (srfi srfi-39)
+
+  :export (run-cpp-and-extract-snarfing
+           parse-snarfing
+           parse-snarfed-line snarf-line?))
+
+;;; Author:  Ludovic Courtès
+;;;
+;;; Commentary:
+;;;
+;;; This module provides tools to parse and otherwise manipulate
+;;; documentation "snarffed" from C files, i.e., information obtained by
+;;; running the C preprocessor with the @code{-DSCM_MAGIC_SNARF_DOCS} flag.
+;;;
+;;; Code:
+
+
+
+;;;
+;;; High-level API.
+;;;
+
+(define (run-cpp-and-extract-snarfing file cpp cflags)
+  (let ((pipe (apply open-pipe* OPEN_READ cpp file cflags)))
+    (parse-snarfing pipe)))
+
+
+;;;
+;;; Parsing magic-snarffed CPP output.
+;;;
+
+(define (snarf-line? line)
+  "Return true if @var{line} (a string) can be considered a line produced by
+the @code{snarf.h} snarfing macros."
+  (and (>= (string-length line) 4)
+       (string=? (substring line 0 4) "^^ {")))
+
+(define (parse-c-argument-list arg-string)
+  "Parse @var{arg-string} (a string representing a ANSI C argument list,
+e.g., @var{(const SCM first, SCM second_arg)}) and return a list of strings
+denoting the argument names."
+  (define %c-symbol-char-set
+    (char-set-adjoin char-set:letter+digit #\_))
+
+  (let loop ((args (string-tokenize (string-trim-both arg-string #\space)
+				    %c-symbol-char-set))
+	     (type? #t)
+	     (result '()))
+    (if (null? args)
+	(reverse! result)
+	(let ((the-arg (car args)))
+	  (cond ((and type? (string=? the-arg "const"))
+		 (loop (cdr args) type? result))
+		((and type? (string=? the-arg "SCM"))
+		 (loop (cdr args) (not type?) result))
+                (type? ;; any other type, e.g., `void'
+                 (loop (cdr args) (not type?) result))
+		(else
+		 (loop (cdr args) (not type?) (cons the-arg result))))))))
+
+(define (parse-documentation-item item)
+  "Parse @var{item} (a string), a single function string produced by the C
+preprocessor.  The result is an alist whose keys represent specific aspects
+of a procedure's documentation: @code{c-name}, @code{scheme-name},
+ @code{documentation} (a Texinfo documentation string), etc."
+
+  (define (read-strings)
+    ;; Read several subsequent strings and return their concatenation.
+    (let loop ((str (read))
+               (result '()))
+      (if (or (eof-object? str)
+              (not (string? str)))
+          (string-concatenate (reverse! result))
+          (loop (read) (cons str result)))))
+
+  ;;(format (current-error-port) "doc-item: ~a~%" item)
+  (let* ((item (string-trim-both item #\space))
+	 (space (string-index item #\space)))
+    (if (not space)
+	(error "invalid documentation item" item)
+	(let ((kind (substring item 0 space))
+	      (rest (substring item space (string-length item))))
+	  (cond ((string=? kind "cname")
+		 (cons 'c-name (string-trim-both rest #\space)))
+		((string=? kind "fname")
+		 (cons 'scheme-name
+                       (with-input-from-string rest read-strings)))
+		((string=? kind "type")
+		 (cons 'type (with-input-from-string rest read)))
+		((string=? kind "location")
+		 (cons 'location
+		       (with-input-from-string rest
+			 (lambda ()
+			   (let loop ((str (read))
+				      (result '()))
+			     (if (eof-object? str)
+				 (reverse! result)
+				 (loop (read) (cons str result))))))))
+		((string=? kind "arglist")
+		 (cons 'arguments
+		       (parse-c-argument-list rest)))
+		((string=? kind "argsig")
+		 (cons 'signature
+		       (with-input-from-string rest
+			 (lambda ()
+			   (let ((req (read)) (opt (read)) (rst? (read)))
+			     (list (cons 'required req)
+				   (cons 'optional opt)
+				   (cons 'rest?    (= 1 rst?))))))))
+		(else
+		 ;; docstring (may consist of several C strings which we
+		 ;; assume to be equivalent to Scheme strings)
+		 (cons 'documentation
+		       (with-input-from-string item read-strings))))))))
+
+(define (parse-snarfed-line line)
+  "Parse @var{line}, a string that contains documentation returned for a
+single function by the C preprocessor with the @code{-DSCM_MAGIC_SNARF_DOCS}
+option.  @var{line} is assumed to obey the @code{snarf-line?} predicate."
+  (define (caret-split str)
+    (let loop ((str str)
+	       (result '()))
+      (if (string=? str "")
+	  (reverse! result)
+	  (let ((caret (string-index str #\^))
+		(len (string-length str)))
+	    (if caret
+		(if (and (> (- len caret) 0)
+			 (eq? (string-ref str (+ caret 1)) #\^))
+		    (loop (substring str (+ 2 caret) len)
+			  (cons (string-take str (- caret 1)) result))
+		    (error "single caret not allowed" str))
+		(loop "" (cons str result)))))))
+
+  (let ((items (caret-split (substring line 4
+				       (- (string-length line) 4)))))
+    (map parse-documentation-item items)))
+
+
+(define (parse-snarfing port)
+  "Read C preprocessor (where the @code{SCM_MAGIC_SNARF_DOCS} macro is
+defined) output from @var{port} a return a list of alist, each of which
+contains information about a specific function described in the C
+preprocessor output."
+  (let loop ((line (read-line port))
+	     (result '()))
+    ;;(format (current-error-port) "line: ~a~%" line)
+    (if (eof-object? line)
+	result
+	(cond ((snarf-line? line)
+	       (loop (read-line port)
+		     (cons (parse-snarfed-line line) result)))
+	      (else
+	       (loop (read-line port) result))))))
+
+
+;;; c-snarf.scm ends here
+
+;;; Local Variables:
+;;; mode: scheme
+;;; coding: latin-1
+;;; End:
+
+;;; arch-tag: dcba2446-ee43-46d8-a47e-e6e12f121988
diff --git a/guile/modules/system/documentation/output.scm b/guile/modules/system/documentation/output.scm
new file mode 100644
index 0000000000..b760dc7bec
--- /dev/null
+++ b/guile/modules/system/documentation/output.scm
@@ -0,0 +1,176 @@
+;;; output.scm  --  Output documentation "snarffed" from C files in Texi/GDF.
+;;;
+;;; Copyright 2006, 2007  Free Software Foundation
+;;;
+;;;
+;;; This program 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.
+;;;
+;;; This program 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 this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA
+
+(define-module (system documentation output)
+  :use-module (srfi srfi-1)
+  :use-module (srfi srfi-13)
+  :use-module (srfi srfi-39)
+  :autoload   (system documentation c-snarf) (run-cpp-and-extract-snarfing)
+
+  :export (schemify-name scheme-procedure-texi-line
+           procedure-gdf-string procedure-texi-documentation
+           output-procedure-texi-documentation-from-c-file
+           *document-c-functions?*))
+
+;;; Author:  Ludovic Courtès
+;;;
+;;; Commentary:
+;;;
+;;; This module provides support function to issue Texinfo or GDF (Guile
+;;; Documentation Format) documentation from "snarffed" C files.
+;;;
+;;; Code:
+
+
+;;;
+;;; Utility.
+;;;
+
+(define (schemify-name str)
+  "Turn @var{str}, a C variable or function name, into a more ``Schemey''
+form, e.g., one with dashed instead of underscores, etc."
+  (string-map (lambda (chr)
+                (if (eq? chr #\_)
+                    #\-
+                    chr))
+              (if (string-suffix? "_p" str)
+                  (string-append (substring str 0
+                                            (- (string-length str) 2))
+                                 "?")
+                  str)))
+
+
+;;;
+;;; Issuing Texinfo and GDF-formatted doc (i.e., `guile-procedures.texi').
+;;; GDF = Guile Documentation Format
+;;;
+
+(define *document-c-functions?*
+  ;; Whether to mention C function names along with Scheme procedure names.
+  (make-parameter #t))
+
+(define (scheme-procedure-texi-line proc-name args
+                                    required-args optional-args
+                                    rest-arg?)
+  "Return a Texinfo string describing the Scheme procedure named
+@var{proc-name}, whose arguments are listed in @var{args} (a list of strings)
+and whose signature is defined by @var{required-args}, @var{optional-args}
+and @var{rest-arg?}."
+  (string-append "@deffn {Scheme Procedure} " proc-name " "
+                 (string-join (take args required-args) " ")
+                 (string-join (take (drop args required-args)
+                                    (+ optional-args
+                                       (if rest-arg? 1 0)))
+                              " [" 'prefix)
+                 (if rest-arg? "...]" "")
+                 (make-string optional-args #\])))
+
+(define (procedure-gdf-string proc-doc)
+  "Issue a Texinfo/GDF docstring corresponding to @var{proc-doc}, a
+documentation alist as returned by @code{parse-snarfed-line}.  To produce
+actual GDF-formatted doc, the resulting string must be processed by
+@code{makeinfo}."
+  (let* ((proc-name     (assq-ref proc-doc 'scheme-name))
+         (args          (assq-ref proc-doc 'arguments))
+         (signature     (assq-ref proc-doc 'signature))
+         (required-args (assq-ref signature 'required))
+         (optional-args (assq-ref signature 'optional))
+         (rest-arg?     (assq-ref signature 'rest?))
+         (location      (assq-ref proc-doc 'location))
+         (file-name     (car location))
+         (line          (cadr location))
+         (documentation (assq-ref proc-doc 'documentation)))
+    (string-append "" ;; form feed
+                   proc-name (string #\newline)
+                   (format #f "@c snarfed from ~a:~a~%"
+                           file-name line)
+
+                   (scheme-procedure-texi-line proc-name
+                                               (map schemify-name args)
+                                               required-args optional-args
+                                               rest-arg?)
+
+                   (string #\newline)
+                   documentation (string #\newline)
+                   "@end deffn" (string #\newline))))
+
+(define (procedure-texi-documentation proc-doc)
+  "Issue a Texinfo docstring corresponding to @var{proc-doc}, a documentation
+alist as returned by @var{parse-snarfed-line}.  The resulting Texinfo string
+is meant for use in a manual since it also documents the corresponding C
+function."
+  (let* ((proc-name     (assq-ref proc-doc 'scheme-name))
+         (c-name        (assq-ref proc-doc 'c-name))
+         (args          (assq-ref proc-doc 'arguments))
+         (signature     (assq-ref proc-doc 'signature))
+         (required-args (assq-ref signature 'required))
+         (optional-args (assq-ref signature 'optional))
+         (rest-arg?     (assq-ref signature 'rest?))
+         (location      (assq-ref proc-doc 'location))
+         (file-name     (car location))
+         (line          (cadr location))
+         (documentation (assq-ref proc-doc 'documentation)))
+  (string-append (string #\newline)
+		 (format #f "@c snarfed from ~a:~a~%"
+			 file-name line)
+
+                 ;; document the Scheme procedure
+                 (scheme-procedure-texi-line proc-name
+                                             (map schemify-name args)
+                                             required-args optional-args
+                                             rest-arg?)
+                 (string #\newline)
+
+                 (if (*document-c-functions?*)
+                     (string-append
+                      ;; document the C function
+                      "@deffnx {C Function} " c-name " ("
+                      (if (null? args)
+                          "void"
+                          (string-join (map (lambda (arg)
+                                              (string-append "SCM " arg))
+                                            args)
+                                       ", "))
+                      ")" (string #\newline))
+                     "")
+
+		 documentation (string #\newline)
+                 "@end deffn" (string #\newline))))
+
+
+;;;
+;;; Very high-level interface.
+;;;
+
+(define (output-procedure-texi-documentation-from-c-file c-file cpp cflags
+                                                         port)
+  (for-each (lambda (texi-string)
+              (display texi-string port))
+            (map procedure-texi-documentation
+                 (run-cpp-and-extract-snarfing cpp c-file cflags))))
+
+
+;;; output.scm ends here
+
+;;; Local Variables:
+;;; mode: scheme
+;;; coding: latin-1
+;;; End:
+
+;;; arch-tag: 20ca493a-6f1a-4d7f-9d24-ccce0d32df49
diff --git a/guile/pre-inst-guile.in b/guile/pre-inst-guile.in
new file mode 100644
index 0000000000..62bac03e03
--- /dev/null
+++ b/guile/pre-inst-guile.in
@@ -0,0 +1,29 @@
+#!/bin/sh
+
+# Copyright (C) 2007  Free Software Foundation
+#
+# This program 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.
+#
+# This program 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 this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA
+
+# Sets up the execution environment needed to run the test programs
+# and produce the documentation.
+
+
+GUILE_LOAD_PATH="@abs_top_srcdir@/guile/modules:$GUILE_LOAD_PATH"
+export GUILE_LOAD_PATH
+
+exec @abs_top_builddir@/libtool --mode=execute		                    \
+       -dlopen "@abs_top_builddir@/guile/src/libguile-gnutls-v-0.la"        \
+       -dlopen "@abs_top_builddir@/guile/src/libguile-gnutls-extra-v-0.la"  \
+       @GUILE@ "$@"
diff --git a/guile/src/Makefile.am b/guile/src/Makefile.am
new file mode 100644
index 0000000000..a960c66af1
--- /dev/null
+++ b/guile/src/Makefile.am
@@ -0,0 +1,104 @@
+#  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
+
+GUILE_FOR_BUILD = $(GUILE) -L $(top_srcdir)/modules
+
+noinst_HEADERS = errors.h utils.h
+
+EXTRA_DIST =					\
+  make-enum-map.scm make-smob-types.scm		\
+  make-enum-header.scm make-smob-header.scm	\
+  make-session-priorities.scm
+
+BUILT_SOURCES = enum-map.i.c smob-types.i.c enums.h smobs.h	\
+		priorities.i.c					\
+		extra-smobs.h extra-enums.h			\
+		extra-enum-map.i.c extra-smob-types.i.c		\
+                core.c.x errors.c.x extra.c.x
+
+CLEANFILES = $(BUILT_SOURCES)
+
+lib_LTLIBRARIES = libguile-gnutls-v-0.la libguile-gnutls-extra-v-0.la
+
+GNULIB_LDFLAGS = -L$(top_builddir)/lgl -llgnu
+GNULIB_CFLAGS  = -I$(top_builddir)/lgl -I$(top_srcdir)/lgl
+
+libguile_gnutls_v_0_la_SOURCES = core.c errors.c utils.c
+libguile_gnutls_v_0_la_CFLAGS =				\
+  $(GNULIB_CFLAGS) $(GUILE_CFLAGS) $(LIBGNUTLS_CFLAGS)
+libguile_gnutls_v_0_la_LDFLAGS =			\
+  $(GNULIB_LDFLAGS) $(GUILE_LDFLAGS) $(LIBGNUTLS_LIBS)
+
+libguile_gnutls_extra_v_0_la_SOURCES = extra.c
+libguile_gnutls_extra_v_0_la_CFLAGS =		\
+  $(GNULIB_CFLAGS) $(GUILE_CFLAGS)		\
+  $(LIBGNUTLS_CFLAGS) $(LIBGNUTLS_EXTRA_CFLAGS)
+libguile_gnutls_extra_v_0_la_LDFLAGS =		\
+  $(GNULIB_LDFLAGS) $(GUILE_LDFLAGS)		\
+  $(LIBGNUTLS_LIBS) $(LIBGNUTLS_EXTRA_LIBS)	\
+  -L$(builddir) -lguile-gnutls-v-0
+
+AM_CPPFLAGS = -I$(builddir)
+
+if HAVE_GCC
+
+# Generated `.x' files and Guile's `scm_c_define_gsubr ()' require
+# `-Wno-strict-prototypes'.
+libguile_gnutls_v_0_la_CFLAGS += -Wno-strict-prototypes
+libguile_gnutls_extra_v_0_la_CFLAGS += -Wno-strict-prototypes
+
+endif
+
+enums.h: $(srcdir)/make-enum-header.scm
+	$(GUILE_FOR_BUILD) $^ > $@
+
+enum-map.i.c: $(srcdir)/make-enum-map.scm
+	$(GUILE_FOR_BUILD) $^ > $@
+
+smobs.h: $(srcdir)/make-smob-header.scm
+	$(GUILE_FOR_BUILD) $^ > $@
+
+smob-types.i.c: $(srcdir)/make-smob-types.scm
+	$(GUILE_FOR_BUILD) $^ > $@
+
+priorities.i.c: $(srcdir)/make-session-priorities.scm
+	$(GUILE_FOR_BUILD) $^ > $@
+
+
+# GnuTLS-extra
+
+extra-enums.h: $(srcdir)/make-enum-header.scm
+	$(GUILE_FOR_BUILD) $^ extra > $@
+
+extra-enum-map.i.c: $(srcdir)/make-enum-map.scm
+	$(GUILE_FOR_BUILD) $^ extra > $@
+
+extra-smobs.h: $(srcdir)/make-smob-header.scm
+	$(GUILE_FOR_BUILD) $^ extra > $@
+
+extra-smob-types.i.c: $(srcdir)/make-smob-types.scm
+	$(GUILE_FOR_BUILD) $^ extra > $@
+
+
+# C file snarfing.
+
+snarfcppopts = $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) \
+	       $(CFLAGS) $(AM_CFLAGS)
+
+SUFFIXES = .x
+%.c.x: %.c
+	$(guile_snarf) -o $@ $< $(snarfcppopts)
diff --git a/guile/src/core.c b/guile/src/core.c
new file mode 100644
index 0000000000..d620a31f17
--- /dev/null
+++ b/guile/src/core.c
@@ -0,0 +1,2759 @@
+/* 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>.  */
+
+#include <stdio.h>
+#include <string.h>
+#include <gnutls/gnutls.h>
+#include <libguile.h>
+
+#include <alloca.h>
+
+#include "enums.h"
+#include "smobs.h"
+#include "errors.h"
+#include "utils.h"
+
+
+
+/* SMOB and enums type definitions.  */
+#include "enum-map.i.c"
+#include "smob-types.i.c"
+
+const char scm_gnutls_array_error_message[] =
+   "cannot handle non-contiguous array: ~A";
+
+
+/* Data that are attached to `gnutls_session_t' objects.
+
+   We need to keep several pieces of information along with each session:
+
+     - A boolean indicating whether its underlying transport is a file
+       descriptor or Scheme port.  This is used to decide whether to leave
+       "Guile mode" when invoking `gnutls_record_recv ()'.
+
+     - The record port attached to the session (returned by
+       `session-record-port').  This is so that several calls to
+       `session-record-port' return the same port.
+
+   Currently, this information is maintained into a pair.  The whole pair is
+   marked by the session mark procedure.  */
+
+#define SCM_GNUTLS_MAKE_SESSION_DATA()		\
+  scm_cons (SCM_BOOL_F, SCM_BOOL_F);
+#define SCM_GNUTLS_SET_SESSION_DATA(c_session, data)			\
+  gnutls_session_set_ptr (c_session, (void *) SCM_UNPACK (data))
+#define SCM_GNUTLS_SESSION_DATA(c_session)			\
+  SCM_PACK ((scm_t_bits) gnutls_session_get_ptr (c_session))
+
+#define SCM_GNUTLS_SET_SESSION_TRANSPORT_IS_FD(c_session, c_is_fd)	\
+  SCM_SETCAR (SCM_GNUTLS_SESSION_DATA (c_session),			\
+	      scm_from_bool (c_is_fd))
+#define SCM_GNUTLS_SET_SESSION_RECORD_PORT(c_session, port)	\
+  SCM_SETCDR (SCM_GNUTLS_SESSION_DATA (c_session), port);
+
+#define SCM_GNUTLS_SESSION_TRANSPORT_IS_FD(c_session)		\
+  scm_to_bool (SCM_CAR (SCM_GNUTLS_SESSION_DATA (c_session)))
+#define SCM_GNUTLS_SESSION_RECORD_PORT(c_session)	\
+  SCM_CDR (SCM_GNUTLS_SESSION_DATA (c_session))
+
+
+
+/* Bindings.  */
+
+/* Mark the data associated with SESSION.  */
+SCM_SMOB_MARK (scm_tc16_gnutls_session, mark_session, session)
+{
+  gnutls_session_t c_session;
+
+  c_session = scm_to_gnutls_session (session, 1, "mark_session");
+
+  return (SCM_GNUTLS_SESSION_DATA (c_session));
+}
+
+SCM_DEFINE (scm_gnutls_version, "gnutls-version", 0, 0, 0,
+	    (void),
+	    "Return a string denoting the version number of the underlying "
+	    "GnuTLS library, e.g., @code{\"1.7.2\"}.")
+#define FUNC_NAME s_scm_gnutls_version
+{
+  return (scm_from_locale_string (gnutls_check_version (NULL)));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_make_session, "make-session", 1, 0, 0,
+	    (SCM end),
+	    "Return a new session for connection end @var{end}, either "
+	    "@code{connection-end/server} or @code{connection-end/client}.")
+#define FUNC_NAME s_scm_gnutls_make_session
+{
+  int err;
+  gnutls_session_t c_session;
+  gnutls_connection_end_t c_end;
+  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);
+
+  if (EXPECT_FALSE (err))
+    scm_gnutls_error (err, FUNC_NAME);
+
+  SCM_GNUTLS_SET_SESSION_DATA (c_session, session_data);
+
+  return (scm_from_gnutls_session (c_session));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_bye, "bye", 2, 0, 0,
+	    (SCM session, SCM how),
+	    "Close @var{session} according to @var{how}.")
+#define FUNC_NAME s_scm_gnutls_bye
+{
+  int err;
+  gnutls_session_t c_session;
+  gnutls_close_request_t c_how;
+
+  c_session = scm_to_gnutls_session (session, 1, FUNC_NAME);
+  c_how = scm_to_gnutls_close_request (how, 2, FUNC_NAME);
+
+  err = gnutls_bye (c_session, c_how);
+  if (EXPECT_FALSE (err))
+    scm_gnutls_error (err, FUNC_NAME);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_handshake, "handshake", 1, 0, 0,
+	    (SCM session),
+	    "Perform a handshake for @var{session}.")
+#define FUNC_NAME s_scm_gnutls_handshake
+{
+  int err;
+  gnutls_session_t c_session;
+
+  c_session = scm_to_gnutls_session (session, 1, FUNC_NAME);
+
+  err = gnutls_handshake (c_session);
+  if (EXPECT_FALSE (err))
+    scm_gnutls_error (err, FUNC_NAME);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_rehandshake, "rehandshake", 1, 0, 0,
+	    (SCM session),
+	    "Perform a re-handshaking for @var{session}.")
+#define FUNC_NAME s_scm_gnutls_rehandshake
+{
+  int err;
+  gnutls_session_t c_session;
+
+  c_session = scm_to_gnutls_session (session, 1, FUNC_NAME);
+
+  err = gnutls_rehandshake (c_session);
+  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,
+	    (SCM session),
+	    "Get an aleter from @var{session}.")
+#define FUNC_NAME s_scm_gnutls_alert_get
+{
+  gnutls_session_t c_session;
+  gnutls_alert_description_t c_alert;
+
+  c_session = scm_to_gnutls_session (session, 1, FUNC_NAME);
+
+  c_alert = gnutls_alert_get (c_session);
+
+  return (scm_from_gnutls_alert_description (c_alert));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_alert_send, "alert-send", 3, 0, 0,
+	    (SCM session, SCM level, SCM alert),
+	    "Send @var{alert} via @var{session}.")
+#define FUNC_NAME s_scm_gnutls_alert_send
+{
+  int err;
+  gnutls_session_t c_session;
+  gnutls_alert_level_t c_level;
+  gnutls_alert_description_t c_alert;
+
+  c_session = scm_to_gnutls_session (session, 1, FUNC_NAME);
+  c_level = scm_to_gnutls_alert_level (level, 2, FUNC_NAME);
+  c_alert = scm_to_gnutls_alert_description (alert, 3, FUNC_NAME);
+
+  err = gnutls_alert_send (c_session, c_level, c_alert);
+  if (EXPECT_FALSE (err))
+    scm_gnutls_error (err, FUNC_NAME);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+/* FIXME: Omitting `alert-send-appropriate'.  */
+
+
+/* Session accessors.  */
+
+SCM_DEFINE (scm_gnutls_session_cipher, "session-cipher", 1, 0, 0,
+	    (SCM session),
+	    "Return @var{session}'s cipher.")
+#define FUNC_NAME s_scm_gnutls_session_cipher
+{
+  gnutls_session_t c_session;
+  gnutls_cipher_algorithm_t c_cipher;
+
+  c_session = scm_to_gnutls_session (session, 1, FUNC_NAME);
+
+  c_cipher = gnutls_cipher_get (c_session);
+
+  return (scm_from_gnutls_cipher (c_cipher));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_session_kx, "session-kx", 1, 0, 0,
+	    (SCM session),
+	    "Return @var{session}'s kx.")
+#define FUNC_NAME s_scm_gnutls_session_kx
+{
+  gnutls_session_t c_session;
+  gnutls_kx_algorithm_t c_kx;
+
+  c_session = scm_to_gnutls_session (session, 1, FUNC_NAME);
+
+  c_kx = gnutls_kx_get (c_session);
+
+  return (scm_from_gnutls_kx (c_kx));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_session_mac, "session-mac", 1, 0, 0,
+	    (SCM session),
+	    "Return @var{session}'s MAC.")
+#define FUNC_NAME s_scm_gnutls_session_mac
+{
+  gnutls_session_t c_session;
+  gnutls_mac_algorithm_t c_mac;
+
+  c_session = scm_to_gnutls_session (session, 1, FUNC_NAME);
+
+  c_mac = gnutls_mac_get (c_session);
+
+  return (scm_from_gnutls_mac (c_mac));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_session_compression_method,
+	    "session-compression-method", 1, 0, 0,
+	    (SCM session),
+	    "Return @var{session}'s compression method.")
+#define FUNC_NAME s_scm_gnutls_session_compression_method
+{
+  gnutls_session_t c_session;
+  gnutls_compression_method_t c_comp;
+
+  c_session = scm_to_gnutls_session (session, 1, FUNC_NAME);
+
+  c_comp = gnutls_compression_get (c_session);
+
+  return (scm_from_gnutls_compression_method (c_comp));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_session_certificate_type,
+	    "session-certificate-type", 1, 0, 0,
+	    (SCM session),
+	    "Return @var{session}'s certificate type.")
+#define FUNC_NAME s_scm_gnutls_session_certificate_type
+{
+  gnutls_session_t c_session;
+  gnutls_certificate_type_t c_cert;
+
+  c_session = scm_to_gnutls_session (session, 1, FUNC_NAME);
+
+  c_cert = gnutls_certificate_type_get (c_session);
+
+  return (scm_from_gnutls_certificate_type (c_cert));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_session_protocol, "session-protocol", 1, 0, 0,
+	    (SCM session),
+	    "Return the protocol used by @var{session}.")
+#define FUNC_NAME s_scm_gnutls_session_protocol
+{
+  gnutls_session_t c_session;
+  gnutls_protocol_t c_protocol;
+
+  c_session = scm_to_gnutls_session (session, 1, FUNC_NAME);
+
+  c_protocol = gnutls_protocol_get_version (c_session);
+
+  return (scm_from_gnutls_protocol (c_protocol));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_session_authentication_type,
+	    "session-authentication-type",
+	    1, 0, 0,
+	    (SCM session),
+	    "Return the authentication type (a @code{credential-type} value) "
+	    "used by @var{session}.")
+#define FUNC_NAME s_scm_gnutls_session_authentication_type
+{
+  gnutls_session_t c_session;
+  gnutls_credentials_type_t c_auth;
+
+  c_session = scm_to_gnutls_session (session, 1, FUNC_NAME);
+
+  c_auth = gnutls_auth_get_type (c_session);
+
+  return (scm_from_gnutls_credentials (c_auth));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_session_server_authentication_type,
+	    "session-server-authentication-type",
+	    1, 0, 0,
+	    (SCM session),
+	    "Return the server authentication type (a "
+	    "@code{credential-type} value) used in @var{session}.")
+#define FUNC_NAME s_scm_gnutls_session_server_authentication_type
+{
+  gnutls_session_t c_session;
+  gnutls_credentials_type_t c_auth;
+
+  c_session = scm_to_gnutls_session (session, 1, FUNC_NAME);
+
+  c_auth = gnutls_auth_server_get_type (c_session);
+
+  return (scm_from_gnutls_credentials (c_auth));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_session_client_authentication_type,
+	    "session-client-authentication-type",
+	    1, 0, 0,
+	    (SCM session),
+	    "Return the client authentication type (a "
+	    "@code{credential-type} value) used in @var{session}.")
+#define FUNC_NAME s_scm_gnutls_session_client_authentication_type
+{
+  gnutls_session_t c_session;
+  gnutls_credentials_type_t c_auth;
+
+  c_session = scm_to_gnutls_session (session, 1, FUNC_NAME);
+
+  c_auth = gnutls_auth_client_get_type (c_session);
+
+  return (scm_from_gnutls_credentials (c_auth));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_session_peer_certificate_chain,
+	    "session-peer-certificate-chain",
+	    1, 0, 0,
+	    (SCM session),
+	    "Return the a list of certificates in raw format (u8vectors) "
+	    "where the first one is the peer's certificate.  In the case "
+	    "of OpenPGP, there is always exactly one certificate.  In the "
+	    "case of X.509, subsequent certificates indicate form a "
+	    "certificate chain.  Return the empty list if no certificate "
+	    "was sent.")
+#define FUNC_NAME s_scm_gnutls_session_peer_certificate_chain
+{
+  SCM result;
+  gnutls_session_t c_session;
+  const gnutls_datum_t *c_cert;
+  unsigned int c_list_size;
+
+  c_session = scm_to_gnutls_session (session, 1, FUNC_NAME);
+
+  c_cert = gnutls_certificate_get_peers (c_session, &c_list_size);
+
+  if (EXPECT_FALSE (c_cert == NULL))
+    result = SCM_EOL;
+  else
+    {
+      SCM pair;
+      unsigned int i;
+
+      result = scm_make_list (scm_from_uint (c_list_size), SCM_UNSPECIFIED);
+
+      for (i = 0, pair = result;
+	   i < c_list_size;
+	   i++, pair = SCM_CDR (pair))
+	{
+	  unsigned char *c_cert_copy;
+
+	  c_cert_copy = (unsigned char *) malloc (c_cert[i].size);
+	  if (EXPECT_FALSE (c_cert_copy == NULL))
+	    scm_gnutls_error (GNUTLS_E_MEMORY_ERROR, FUNC_NAME);
+
+	  memcpy (c_cert_copy, c_cert[i].data, c_cert[i].size);
+
+	  SCM_SETCAR (pair, scm_take_u8vector (c_cert_copy, c_cert[i].size));
+	}
+    }
+
+  return result;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_session_our_certificate_chain,
+	    "session-our-certificate-chain",
+	    1, 0, 0,
+	    (SCM session),
+	    "Return our certificate chain for @var{session} (as sent to "
+	    "the peer) in raw format (a u8vector).  In the case of OpenPGP "
+	    "there is exactly one certificate.  Return the empty list "
+	    "if no certificate was used.")
+#define FUNC_NAME s_scm_gnutls_session_our_certificate_chain
+{
+  SCM result;
+  gnutls_session_t c_session;
+  const gnutls_datum_t *c_cert;
+  unsigned char *c_cert_copy;
+
+  c_session = scm_to_gnutls_session (session, 1, FUNC_NAME);
+
+  /* XXX: Currently, the C function actually returns only one certificate.
+     Future versions of the API may provide the full certificate chain, as
+     for `gnutls_certificate_get_peers ()'.  */
+  c_cert = gnutls_certificate_get_ours (c_session);
+
+  if (EXPECT_FALSE (c_cert == NULL))
+    result = SCM_EOL;
+  else
+    {
+      c_cert_copy = (unsigned char *) malloc (c_cert->size);
+      if (EXPECT_FALSE (c_cert_copy == NULL))
+	scm_gnutls_error (GNUTLS_E_MEMORY_ERROR, FUNC_NAME);
+
+      memcpy (c_cert_copy, c_cert->data, c_cert->size);
+
+      result = scm_list_1 (scm_take_u8vector (c_cert_copy, c_cert->size));
+    }
+
+  return result;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_set_server_session_certificate_request_x,
+	    "set-server-session-certificate-request!",
+	    2, 0, 0,
+	    (SCM session, SCM request),
+	    "Tell how @var{session}, a server-side session, should deal "
+	    "with certificate requests.  @var{request} should be either "
+	    "@code{certificate-request/request} or "
+	    "@code{certificate-request/require}.")
+#define FUNC_NAME s_scm_gnutls_set_server_session_certificate_request_x
+{
+  gnutls_session_t c_session;
+  gnutls_certificate_status_t c_request;
+
+  c_session = scm_to_gnutls_session (session, 1, FUNC_NAME);
+  c_request = scm_to_gnutls_certificate_request (request, 2, FUNC_NAME);
+
+  gnutls_certificate_server_set_request (c_session, c_request);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+
+/* Choice of a protocol and cipher suite.  */
+
+#include "priorities.i.c"
+
+SCM_DEFINE (scm_gnutls_set_default_priority_x,
+	    "set-session-default-priority!", 1, 0, 0,
+	    (SCM session),
+	    "Have @var{session} use the default priorities.")
+#define FUNC_NAME s_scm_gnutls_set_default_priority_x
+{
+  gnutls_session_t c_session;
+
+  c_session = scm_to_gnutls_session (session, 1, FUNC_NAME);
+  gnutls_set_default_priority (c_session);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_set_default_export_priority_x,
+	    "set-session-default-export-priority!", 1, 0, 0,
+	    (SCM session),
+	    "Have @var{session} use the default export priorities.")
+#define FUNC_NAME s_scm_gnutls_set_default_export_priority_x
+{
+  gnutls_session_t c_session;
+
+  c_session = scm_to_gnutls_session (session, 1, FUNC_NAME);
+  gnutls_set_default_export_priority (c_session);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_cipher_suite_to_string, "cipher-suite->string",
+	    3, 0, 0,
+	    (SCM kx, SCM cipher, SCM mac),
+	    "Return the name of the given cipher suite.")
+#define FUNC_NAME s_scm_gnutls_cipher_suite_to_string
+{
+  gnutls_kx_algorithm_t c_kx;
+  gnutls_cipher_algorithm_t c_cipher;
+  gnutls_mac_algorithm_t c_mac;
+  const char *c_name;
+
+  c_kx = scm_to_gnutls_kx (kx, 1, FUNC_NAME);
+  c_cipher = scm_to_gnutls_cipher (cipher, 2, FUNC_NAME);
+  c_mac = scm_to_gnutls_mac (mac, 3, FUNC_NAME);
+
+  c_name = gnutls_cipher_suite_get_name (c_kx, c_cipher, c_mac);
+
+  return (scm_from_locale_string (c_name));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_set_session_credentials_x, "set-session-credentials!",
+	    2, 0, 0,
+	    (SCM session, SCM cred),
+	    "Use @var{cred} as @var{session}'s credentials.")
+#define FUNC_NAME s_scm_gnutls_set_session_credentials_x
+{
+  int err = 0;
+  gnutls_session_t c_session;
+
+  c_session = scm_to_gnutls_session (session, 1, FUNC_NAME);
+
+  if (SCM_SMOB_PREDICATE (scm_tc16_gnutls_certificate_credentials, cred))
+    {
+      gnutls_certificate_credentials_t c_cred;
+
+      c_cred = scm_to_gnutls_certificate_credentials (cred, 2,
+						      FUNC_NAME);
+      err = gnutls_credentials_set (c_session, GNUTLS_CRD_CERTIFICATE, c_cred);
+    }
+  else if (SCM_SMOB_PREDICATE (scm_tc16_gnutls_anonymous_client_credentials, cred))
+    {
+      gnutls_anon_client_credentials_t c_cred;
+
+      c_cred = scm_to_gnutls_anonymous_client_credentials (cred, 2,
+							   FUNC_NAME);
+      err = gnutls_credentials_set (c_session, GNUTLS_CRD_ANON, c_cred);
+    }
+  else if (SCM_SMOB_PREDICATE (scm_tc16_gnutls_anonymous_server_credentials,
+			       cred))
+    {
+      gnutls_anon_server_credentials_t c_cred;
+
+      c_cred = scm_to_gnutls_anonymous_server_credentials (cred, 2,
+							   FUNC_NAME);
+      err = gnutls_credentials_set (c_session, GNUTLS_CRD_ANON, c_cred);
+    }
+  else if (SCM_SMOB_PREDICATE (scm_tc16_gnutls_srp_client_credentials,
+			       cred))
+    {
+      gnutls_srp_client_credentials_t c_cred;
+
+      c_cred = scm_to_gnutls_srp_client_credentials (cred, 2,
+						     FUNC_NAME);
+      err = gnutls_credentials_set (c_session, GNUTLS_CRD_SRP, c_cred);
+    }
+  else if (SCM_SMOB_PREDICATE (scm_tc16_gnutls_srp_server_credentials,
+			       cred))
+    {
+      gnutls_srp_server_credentials_t c_cred;
+
+      c_cred = scm_to_gnutls_srp_server_credentials (cred, 2,
+						     FUNC_NAME);
+      err = gnutls_credentials_set (c_session, GNUTLS_CRD_SRP, c_cred);
+    }
+  else if (SCM_SMOB_PREDICATE (scm_tc16_gnutls_psk_client_credentials,
+			       cred))
+    {
+      gnutls_psk_client_credentials_t c_cred;
+
+      c_cred = scm_to_gnutls_psk_client_credentials (cred, 2,
+						     FUNC_NAME);
+      err = gnutls_credentials_set (c_session, GNUTLS_CRD_PSK, c_cred);
+    }
+  else if (SCM_SMOB_PREDICATE (scm_tc16_gnutls_psk_server_credentials,
+			       cred))
+    {
+      gnutls_psk_server_credentials_t c_cred;
+
+      c_cred = scm_to_gnutls_psk_server_credentials (cred, 2,
+						     FUNC_NAME);
+      err = gnutls_credentials_set (c_session, GNUTLS_CRD_PSK, c_cred);
+    }
+  else
+    scm_wrong_type_arg (FUNC_NAME, 2, cred);
+
+  if (EXPECT_FALSE (err))
+    scm_gnutls_error (err, FUNC_NAME);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+
+/* Record layer.  */
+
+SCM_DEFINE (scm_gnutls_record_send, "record-send", 2, 0, 0,
+	    (SCM session, SCM array),
+	    "Send the record constituted by @var{array} through "
+	    "@var{session}.")
+#define FUNC_NAME s_scm_gnutls_record_send
+{
+  SCM result;
+  ssize_t c_result;
+  gnutls_session_t c_session;
+  scm_t_array_handle c_handle;
+  const char *c_array;
+  size_t c_len;
+
+  c_session = scm_to_gnutls_session (session, 1, FUNC_NAME);
+  SCM_VALIDATE_ARRAY (2, array);
+
+  c_array = scm_gnutls_get_array (array, &c_handle, &c_len,
+				  FUNC_NAME);
+
+  c_result = gnutls_record_send (c_session, c_array, c_len);
+
+  scm_gnutls_release_array (&c_handle);
+
+  if (EXPECT_TRUE (c_result >= 0))
+    result = scm_from_ssize_t (c_result);
+  else
+    scm_gnutls_error (c_result, FUNC_NAME);
+
+  return (result);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_record_receive_x, "record-receive!", 2, 0, 0,
+	    (SCM session, SCM array),
+	    "Receive data from @var{session} into @var{array}, a uniform "
+	    "homogeneous array.  Return the number of bytes actually "
+	    "received.")
+#define FUNC_NAME s_scm_gnutls_record_receive_x
+{
+  SCM result;
+  ssize_t c_result;
+  gnutls_session_t c_session;
+  scm_t_array_handle c_handle;
+  char *c_array;
+  size_t c_len;
+
+  c_session = scm_to_gnutls_session (session, 1, FUNC_NAME);
+  SCM_VALIDATE_ARRAY (2, array);
+
+  c_array = scm_gnutls_get_writable_array (array, &c_handle, &c_len,
+					   FUNC_NAME);
+
+  c_result = gnutls_record_recv (c_session, c_array, c_len);
+
+  scm_gnutls_release_array (&c_handle);
+
+  if (EXPECT_TRUE (c_result >= 0))
+    result = scm_from_ssize_t (c_result);
+  else
+    scm_gnutls_error (c_result, FUNC_NAME);
+
+  return (result);
+}
+#undef FUNC_NAME
+
+
+/* The session record port type.  */
+static scm_t_bits session_record_port_type;
+
+/* Return the session associated with PORT.  */
+#define SCM_GNUTLS_SESSION_RECORD_PORT_SESSION(_port) \
+  (SCM_PACK (SCM_STREAM (_port)))
+
+/* Size of a session port's input buffer.  */
+#define SCM_GNUTLS_SESSION_RECORD_PORT_BUFFER_SIZE 4096
+
+/* Hint for the `scm_gc_' functions.  */
+static const char session_record_port_gc_hint[] = "gnutls-session-record-port";
+
+/* Mark the session associated with PORT.  */
+static SCM
+mark_session_record_port (SCM port)
+{
+  return (SCM_GNUTLS_SESSION_RECORD_PORT_SESSION (port));
+}
+
+static size_t
+free_session_record_port (SCM port)
+#define FUNC_NAME "free_session_record_port"
+{
+  SCM session;
+  scm_t_port *c_port;
+
+  session = SCM_GNUTLS_SESSION_RECORD_PORT_SESSION (port);
+
+  /* SESSION _can_ be invalid at this point: it can be freed in the same GC
+     cycle as PORT, just before PORT.  Thus, we need to check whether SESSION
+     still points to a session SMOB.  */
+  if (SCM_SMOB_PREDICATE (scm_tc16_gnutls_session, session))
+    {
+      /* SESSION is still valid.  Disassociate PORT from SESSION.  */
+      gnutls_session_t c_session;
+
+      c_session = scm_to_gnutls_session (session, 1, FUNC_NAME);
+      SCM_GNUTLS_SET_SESSION_RECORD_PORT (c_session, SCM_BOOL_F);
+    }
+
+  /* Free the input buffer of PORT.  */
+  c_port = SCM_PTAB_ENTRY (port);
+  scm_gc_free (c_port->read_buf, c_port->read_buf_size,
+	       session_record_port_gc_hint);
+
+  return 0;
+}
+#undef FUNC_NAME
+
+/* Data passed to `do_fill_port ()'.  */
+typedef struct
+{
+  scm_t_port *c_port;
+  gnutls_session_t c_session;
+} fill_port_data_t;
+
+/* Actually fill a session record port (see below).  */
+static void *
+do_fill_port (void *data)
+{
+  int chr;
+  ssize_t result;
+  scm_t_port *c_port;
+  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);
+  if (EXPECT_TRUE (result > 0))
+    {
+      c_port->read_pos = c_port->read_buf;
+      c_port->read_end = c_port->read_buf + result;
+      chr = (int) *c_port->read_buf;
+    }
+  else if (result == 0)
+    chr = EOF;
+  else
+    scm_gnutls_error (result, "fill_session_record_port_input");
+
+  return ((void *) chr);
+}
+
+/* Fill in the input buffer of PORT.  */
+static int
+fill_session_record_port_input (SCM port)
+#define FUNC_NAME "fill_session_record_port_input"
+{
+  int chr;
+  scm_t_port *c_port = SCM_PTAB_ENTRY (port);
+
+  if (c_port->read_pos >= c_port->read_end)
+    {
+      SCM session;
+      fill_port_data_t c_args;
+      gnutls_session_t c_session;
+
+      session = SCM_GNUTLS_SESSION_RECORD_PORT_SESSION (port);
+      c_session = scm_to_gnutls_session (session, 1, FUNC_NAME);
+
+      c_args.c_session = c_session;
+      c_args.c_port = c_port;
+
+      if (SCM_GNUTLS_SESSION_TRANSPORT_IS_FD (c_session))
+	/* SESSION's underlying transport is a raw file descriptor, so we
+	   must leave "Guile mode" to allow the GC to run.  */
+	chr = (int) scm_without_guile (do_fill_port, &c_args);
+      else
+	/* SESSION's underlying transport is a port, so don't leave "Guile
+	   mode".  */
+	chr = (int) do_fill_port (&c_args);
+    }
+  else
+    chr = (int) *c_port->read_pos;
+
+  return chr;
+}
+#undef FUNC_NAME
+
+/* Write SIZE octets from DATA to PORT.  */
+static void
+write_to_session_record_port (SCM port, const void *data, size_t size)
+#define FUNC_NAME "write_to_session_record_port"
+{
+  SCM session;
+  gnutls_session_t c_session;
+  ssize_t c_result;
+  size_t c_sent = 0;
+
+  session = SCM_GNUTLS_SESSION_RECORD_PORT_SESSION (port);
+  c_session = scm_to_gnutls_session (session, 1, FUNC_NAME);
+
+  while (c_sent < size)
+    {
+      c_result = gnutls_record_send (c_session, (char *) data + c_sent,
+				     size - c_sent);
+      if (EXPECT_FALSE (c_result < 0))
+	scm_gnutls_error (c_result, FUNC_NAME);
+      else
+	c_sent += c_result;
+    }
+}
+#undef FUNC_NAME
+
+/* Return a new session port for SESSION.  */
+static inline SCM
+make_session_record_port (SCM session)
+{
+  SCM port;
+  scm_t_port *c_port;
+  unsigned char *c_port_buf;
+  const unsigned long mode_bits = SCM_OPN | SCM_RDNG | SCM_WRTNG;
+
+  c_port_buf =
+    (unsigned char *) scm_gc_malloc (SCM_GNUTLS_SESSION_RECORD_PORT_BUFFER_SIZE,
+				     session_record_port_gc_hint);
+
+  /* Create a new port.  */
+  port = scm_new_port_table_entry (session_record_port_type);
+  c_port = SCM_PTAB_ENTRY (port);
+
+  /* Mark PORT as open, readable and writable (hmm, how elegant...).  */
+  SCM_SET_CELL_TYPE (port, session_record_port_type | mode_bits);
+
+  /* Associate it with SESSION.  */
+  SCM_SETSTREAM (port, SCM_UNPACK (session));
+
+  c_port->read_pos = c_port->read_end = c_port->read_buf = c_port_buf;
+  c_port->read_buf_size = SCM_GNUTLS_SESSION_RECORD_PORT_BUFFER_SIZE;
+
+  c_port->write_buf = c_port->write_pos = &c_port->shortbuf;
+  c_port->write_buf_size = 1;
+
+  return (port);
+}
+
+SCM_DEFINE (scm_gnutls_session_record_port, "session-record-port", 1, 0, 0,
+	    (SCM session),
+	    "Return a read-write port that may be used to communicate over "
+	    "@var{session}.  All invocations of @code{session-port} on a "
+	    "given session return the same object (in the sense of "
+	    "@code{eq?}).")
+#define FUNC_NAME s_scm_gnutls_session_record_port
+{
+  SCM port;
+  gnutls_session_t c_session;
+
+  c_session = scm_to_gnutls_session (session, 1, FUNC_NAME);
+  port = SCM_GNUTLS_SESSION_RECORD_PORT (c_session);
+
+  if (!SCM_PORTP (port))
+    {
+      /* Lazily create a new session port.  */
+      port = make_session_record_port (session);
+      SCM_GNUTLS_SET_SESSION_RECORD_PORT (c_session, port);
+    }
+
+  return (port);
+}
+#undef FUNC_NAME
+
+/* Create the session port type.  */
+static inline void
+scm_init_gnutls_session_record_port_type (void)
+{
+  session_record_port_type =
+    scm_make_port_type ("gnutls-session-port",
+			fill_session_record_port_input,
+			write_to_session_record_port);
+  scm_set_port_mark (session_record_port_type, mark_session_record_port);
+  scm_set_port_free (session_record_port_type, free_session_record_port);
+}
+
+
+/* Transport.  */
+
+SCM_DEFINE (scm_gnutls_set_session_transport_fd_x, "set-session-transport-fd!",
+	    2, 0, 0,
+	    (SCM session, SCM fd),
+	    "Use file descriptor @var{fd} as the underlying transport for "
+	    "@var{session}.")
+#define FUNC_NAME s_scm_gnutls_set_session_transport_fd_x
+{
+  gnutls_session_t c_session;
+  int c_fd;
+
+  c_session = scm_to_gnutls_session (session, 1, FUNC_NAME);
+  c_fd = (int) scm_to_uint (fd);
+
+  gnutls_transport_set_ptr (c_session, (gnutls_transport_ptr_t) c_fd);
+
+  SCM_GNUTLS_SET_SESSION_TRANSPORT_IS_FD (c_session, 1);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+/* Pull SIZE octets from TRANSPORT (a Scheme port) into DATA.  */
+static ssize_t
+pull_from_port (gnutls_transport_ptr_t transport, void *data, size_t size)
+{
+  SCM port;
+  ssize_t result;
+
+  port = SCM_PACK ((scm_t_bits) transport);
+
+  result = scm_c_read (port, data, size);
+
+  return ((ssize_t) result);
+}
+
+/* Write SIZE octets from DATA to TRANSPORT (a Scheme port).  */
+static ssize_t
+push_to_port (gnutls_transport_ptr_t transport, const void *data,
+	      size_t size)
+{
+  SCM port;
+
+  port = SCM_PACK ((scm_t_bits) transport);
+
+  scm_c_write (port, data, size);
+
+  /* All we can do is assume that all SIZE octets were written.  */
+  return (size);
+}
+
+SCM_DEFINE (scm_gnutls_set_session_transport_port_x,
+	    "set-session-transport-port!",
+	    2, 0, 0,
+	    (SCM session, SCM port),
+	    "Use @var{port} as the input/output port for @var{session}.")
+#define FUNC_NAME s_scm_gnutls_set_session_transport_port_x
+{
+  gnutls_session_t c_session;
+
+  c_session = scm_to_gnutls_session (session, 1, FUNC_NAME);
+  SCM_VALIDATE_PORT (2, port);
+
+  /* Note: We do not attempt to optimize the case where PORT is a file port
+     (i.e., over a file descriptor), because of port buffering issues.  Users
+     are expected to explicitly use `set-session-transport-fd!' and `fileno'
+     when they wish to do it.  */
+
+  gnutls_transport_set_ptr (c_session,
+			    (gnutls_transport_ptr_t) SCM_UNPACK (port));
+  gnutls_transport_set_push_function (c_session, push_to_port);
+  gnutls_transport_set_pull_function (c_session, pull_from_port);
+
+  SCM_GNUTLS_SET_SESSION_TRANSPORT_IS_FD (c_session, 0);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+
+/* Diffie-Hellman.  */
+
+typedef int (* pkcs_export_function_t) (void *, gnutls_x509_crt_fmt_t,
+					unsigned char *, size_t *);
+
+/* Hint for the `scm_gc' functions.  */
+static const char pkcs_export_gc_hint[] = "gnutls-pkcs-export";
+
+
+/* Export DH/RSA parameters PARAMS through EXPORT, using format FORMAT.
+   Return a `u8vector'.  */
+static inline SCM
+pkcs_export_parameters (pkcs_export_function_t export,
+			void *params, gnutls_x509_crt_fmt_t format,
+			const char *func_name)
+#define FUNC_NAME func_name
+{
+  int err;
+  unsigned char *output;
+  size_t output_len, output_total_len = 4096;
+
+  output = (unsigned char *) scm_gc_malloc (output_total_len,
+					    pkcs_export_gc_hint);
+  do
+    {
+      output_len = output_total_len;
+      err = export (params, format, output, &output_len);
+
+      if (err == GNUTLS_E_SHORT_MEMORY_BUFFER)
+	{
+	  output = scm_gc_realloc (output, output_total_len,
+				   output_total_len * 2,
+				   pkcs_export_gc_hint);
+	  output_total_len *= 2;
+	}
+    }
+  while (err == GNUTLS_E_SHORT_MEMORY_BUFFER);
+
+  if (EXPECT_FALSE (err))
+    {
+      scm_gc_free (output, output_total_len, pkcs_export_gc_hint);
+      scm_gnutls_error (err, FUNC_NAME);
+    }
+
+  if (output_len != output_total_len)
+    /* Shrink the output buffer.  */
+    output = scm_gc_realloc (output, output_total_len,
+			     output_len, pkcs_export_gc_hint);
+
+  return (scm_take_u8vector (output, output_len));
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_gnutls_make_dh_parameters, "make-dh-parameters", 1, 0, 0,
+	    (SCM bits),
+	    "Return new Diffie-Hellman parameters.")
+#define FUNC_NAME s_scm_gnutls_make_dh_parameters
+{
+  int err;
+  unsigned c_bits;
+  gnutls_dh_params_t c_dh_params;
+
+  c_bits = scm_to_uint (bits);
+
+  err = gnutls_dh_params_init (&c_dh_params);
+  if (EXPECT_FALSE (err))
+    scm_gnutls_error (err, FUNC_NAME);
+
+  err = gnutls_dh_params_generate2 (c_dh_params, c_bits);
+  if (EXPECT_FALSE (err))
+    {
+      gnutls_dh_params_deinit (c_dh_params);
+      scm_gnutls_error (err, FUNC_NAME);
+    }
+
+  return (scm_from_gnutls_dh_parameters (c_dh_params));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_pkcs3_import_dh_parameters,
+	    "pkcs3-import-dh-parameters",
+	    2, 0, 0,
+	    (SCM array, SCM format),
+	    "Import Diffie-Hellman parameters in PKCS3 format (further "
+	    "specified by @var{format}, an @code{x509-certificate-format} "
+	    "value) from @var{array} (a homogeneous array) and return a "
+	    "new @code{dh-params} object.")
+#define FUNC_NAME s_scm_gnutls_pkcs3_import_dh_parameters
+{
+  int err;
+  gnutls_x509_crt_fmt_t c_format;
+  gnutls_dh_params_t c_dh_params;
+  scm_t_array_handle c_handle;
+  const char *c_array;
+  size_t c_len;
+  gnutls_datum_t c_datum;
+
+  c_format = scm_to_gnutls_x509_certificate_format (format, 2, FUNC_NAME);
+
+  c_array = scm_gnutls_get_array (array, &c_handle, &c_len, FUNC_NAME);
+  c_datum.data = (unsigned char *) c_array;
+  c_datum.size = c_len;
+
+  err = gnutls_dh_params_init (&c_dh_params);
+  if (EXPECT_FALSE (err))
+    {
+      scm_gnutls_release_array (&c_handle);
+      scm_gnutls_error (err, FUNC_NAME);
+    }
+
+  err = gnutls_dh_params_import_pkcs3 (c_dh_params, &c_datum, c_format);
+  scm_gnutls_release_array (&c_handle);
+
+  if (EXPECT_FALSE (err))
+    {
+      gnutls_dh_params_deinit (c_dh_params);
+      scm_gnutls_error (err, FUNC_NAME);
+    }
+
+  return (scm_from_gnutls_dh_parameters (c_dh_params));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_pkcs3_export_dh_parameters,
+	    "pkcs3-export-dh-parameters",
+	    2, 0, 0,
+	    (SCM dh_params, SCM format),
+	    "Export Diffie-Hellman parameters @var{dh_params} in PKCS3 "
+	    "format according for @var{format} (an "
+	    "@code{x509-certificate-format} value).  Return a "
+	    "@code{u8vector} containing the result.")
+#define FUNC_NAME s_scm_gnutls_pkcs3_export_dh_parameters
+{
+  SCM result;
+  gnutls_dh_params_t c_dh_params;
+  gnutls_x509_crt_fmt_t c_format;
+
+  c_dh_params = scm_to_gnutls_dh_parameters (dh_params, 1, FUNC_NAME);
+  c_format = scm_to_gnutls_x509_certificate_format (format, 2, FUNC_NAME);
+
+  result = pkcs_export_parameters ((pkcs_export_function_t)
+				   gnutls_dh_params_export_pkcs3,
+				   (void *) c_dh_params,
+				   c_format, FUNC_NAME);
+
+  return (result);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_set_session_dh_prime_bits_x,
+	    "set-session-dh-prime-bits!", 2, 0, 0,
+	    (SCM session, SCM bits),
+	    "Use @var{bits} DH prime bits for @var{session}.")
+#define FUNC_NAME s_scm_gnutls_set_session_dh_prime_bits_x
+{
+  unsigned int c_bits;
+  gnutls_session_t c_session;
+
+  c_session = scm_to_gnutls_session (session, 1, FUNC_NAME);
+  c_bits = scm_to_uint (bits);
+
+  gnutls_dh_set_prime_bits (c_session, c_bits);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+
+/* Anonymous credentials.  */
+
+SCM_DEFINE (scm_gnutls_make_anon_server_credentials,
+	    "make-anonymous-server-credentials",
+	    0, 0, 0, (void),
+	    "Return anonymous server credentials.")
+#define FUNC_NAME s_scm_gnutls_make_anon_server_credentials
+{
+  int err;
+  gnutls_anon_server_credentials_t c_cred;
+
+  err = gnutls_anon_allocate_server_credentials (&c_cred);
+
+  if (EXPECT_FALSE (err))
+    scm_gnutls_error (err, FUNC_NAME);
+
+  return (scm_from_gnutls_anonymous_server_credentials (c_cred));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_make_anon_client_credentials,
+	    "make-anonymous-client-credentials",
+	    0, 0, 0, (void),
+	    "Return anonymous client credentials.")
+#define FUNC_NAME s_scm_gnutls_make_anon_client_credentials
+{
+  int err;
+  gnutls_anon_client_credentials_t c_cred;
+
+  err = gnutls_anon_allocate_client_credentials (&c_cred);
+
+  if (EXPECT_FALSE (err))
+    scm_gnutls_error (err, FUNC_NAME);
+
+  return (scm_from_gnutls_anonymous_client_credentials (c_cred));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_set_anonymous_server_dh_parameters_x,
+	    "set-anonymous-server-dh-parameters!", 2, 0, 0,
+	    (SCM cred, SCM dh_params),
+	    "Set the Diffie-Hellman parameters of anonymous server "
+	    "credentials @var{cred}.")
+#define FUNC_NAME s_scm_gnutls_set_anonymous_server_dh_parameters_x
+{
+  gnutls_dh_params_t c_dh_params;
+  gnutls_anon_server_credentials_t c_cred;
+
+  c_cred = scm_to_gnutls_anonymous_server_credentials (cred, 1,
+						       FUNC_NAME);
+  c_dh_params = scm_to_gnutls_dh_parameters (dh_params, 2,
+					     FUNC_NAME);
+
+  gnutls_anon_set_server_dh_params (c_cred, c_dh_params);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+
+/* RSA parameters.  */
+
+SCM_DEFINE (scm_gnutls_make_rsa_parameters, "make-rsa-parameters", 1, 0, 0,
+	    (SCM bits),
+	    "Return new RSA parameters.")
+#define FUNC_NAME s_scm_gnutls_make_rsa_parameters
+{
+  int err;
+  unsigned c_bits;
+  gnutls_rsa_params_t c_rsa_params;
+
+  c_bits = scm_to_uint (bits);
+
+  err = gnutls_rsa_params_init (&c_rsa_params);
+  if (EXPECT_FALSE (err))
+    scm_gnutls_error (err, FUNC_NAME);
+
+  err = gnutls_rsa_params_generate2 (c_rsa_params, c_bits);
+  if (EXPECT_FALSE (err))
+    {
+      gnutls_rsa_params_deinit (c_rsa_params);
+      scm_gnutls_error (err, FUNC_NAME);
+    }
+
+  return (scm_from_gnutls_rsa_parameters (c_rsa_params));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_pkcs1_import_rsa_parameters,
+	    "pkcs1-import-rsa-parameters",
+	    2, 0, 0,
+	    (SCM array, SCM format),
+	    "Import Diffie-Hellman parameters in PKCS1 format (further "
+	    "specified by @var{format}, an @code{x509-certificate-format} "
+	    "value) from @var{array} (a homogeneous array) and return a "
+	    "new @code{rsa-params} object.")
+#define FUNC_NAME s_scm_gnutls_pkcs1_import_rsa_parameters
+{
+  int err;
+  gnutls_x509_crt_fmt_t c_format;
+  gnutls_rsa_params_t c_rsa_params;
+  scm_t_array_handle c_handle;
+  const char *c_array;
+  size_t c_len;
+  gnutls_datum_t c_datum;
+
+  c_format = scm_to_gnutls_x509_certificate_format (format, 2, FUNC_NAME);
+
+  c_array = scm_gnutls_get_array (array, &c_handle, &c_len, FUNC_NAME);
+  c_datum.data = (unsigned char *) c_array;
+  c_datum.size = c_len;
+
+  err = gnutls_rsa_params_init (&c_rsa_params);
+  if (EXPECT_FALSE (err))
+    {
+      scm_gnutls_release_array (&c_handle);
+      scm_gnutls_error (err, FUNC_NAME);
+    }
+
+  err = gnutls_rsa_params_import_pkcs1 (c_rsa_params, &c_datum, c_format);
+  scm_gnutls_release_array (&c_handle);
+
+  if (EXPECT_FALSE (err))
+    {
+      gnutls_rsa_params_deinit (c_rsa_params);
+      scm_gnutls_error (err, FUNC_NAME);
+    }
+
+  return (scm_from_gnutls_rsa_parameters (c_rsa_params));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_pkcs1_export_rsa_parameters,
+	    "pkcs1-export-rsa-parameters",
+	    2, 0, 0,
+	    (SCM rsa_params, SCM format),
+	    "Export Diffie-Hellman parameters @var{rsa_params} in PKCS1 "
+	    "format according for @var{format} (an "
+	    "@code{x509-certificate-format} value).  Return a "
+	    "@code{u8vector} containing the result.")
+#define FUNC_NAME s_scm_gnutls_pkcs1_export_rsa_parameters
+{
+  SCM result;
+  gnutls_rsa_params_t c_rsa_params;
+  gnutls_x509_crt_fmt_t c_format;
+
+  c_rsa_params = scm_to_gnutls_rsa_parameters (rsa_params, 1, FUNC_NAME);
+  c_format = scm_to_gnutls_x509_certificate_format (format, 2, FUNC_NAME);
+
+  result = pkcs_export_parameters ((pkcs_export_function_t)
+				   gnutls_rsa_params_export_pkcs1,
+				   (void *) c_rsa_params,
+				   c_format, FUNC_NAME);
+
+  return (result);
+}
+#undef FUNC_NAME
+
+
+/* Certificate credentials.  */
+
+typedef int (* certificate_set_file_function_t) (gnutls_certificate_credentials_t,
+						 const char *,
+						 gnutls_x509_crt_fmt_t);
+
+typedef int (* certificate_set_data_function_t) (gnutls_certificate_credentials_t,
+						 const gnutls_datum_t *,
+						 gnutls_x509_crt_fmt_t);
+
+/* Helper function to implement the `set-file!' functions.  */
+static inline unsigned int
+set_certificate_file (certificate_set_file_function_t set_file,
+		      SCM cred, SCM file, SCM format,
+		      const char *func_name)
+#define FUNC_NAME func_name
+{
+  int err;
+  char *c_file;
+  size_t c_file_len;
+
+  gnutls_certificate_credentials_t c_cred;
+  gnutls_x509_crt_fmt_t c_format;
+
+  c_cred = scm_to_gnutls_certificate_credentials (cred, 1, FUNC_NAME);
+  SCM_VALIDATE_STRING (2, file);
+  c_format = scm_to_gnutls_x509_certificate_format (format, 3, FUNC_NAME);
+
+  c_file_len = scm_c_string_length (file);
+  c_file = (char *) alloca (c_file_len + 1);
+
+  (void) scm_to_locale_stringbuf (file, c_file, c_file_len + 1);
+  c_file[c_file_len] = '\0';
+
+  err = set_file (c_cred, c_file, c_format);
+  if (EXPECT_FALSE (err < 0))
+    scm_gnutls_error (err, FUNC_NAME);
+
+  /* Return the number of certificates processed.  */
+  return ((unsigned int) err);
+}
+#undef FUNC_NAME
+
+/* Helper function implementing the `set-data!' functions.  */
+static inline unsigned int
+set_certificate_data (certificate_set_data_function_t set_data,
+		      SCM cred, SCM data, SCM format,
+		      const char *func_name)
+#define FUNC_NAME func_name
+{
+  int err;
+  gnutls_certificate_credentials_t c_cred;
+  gnutls_x509_crt_fmt_t c_format;
+  gnutls_datum_t c_datum;
+  scm_t_array_handle c_handle;
+  const char *c_data;
+  size_t c_len;
+
+  c_cred = scm_to_gnutls_certificate_credentials (cred, 1, FUNC_NAME);
+  SCM_VALIDATE_ARRAY (2, data);
+  c_format = scm_to_gnutls_x509_certificate_format (format, 3, FUNC_NAME);
+
+  c_data = scm_gnutls_get_array (data, &c_handle, &c_len, FUNC_NAME);
+  c_datum.data = (unsigned char *) c_data;
+  c_datum.size = c_len;
+
+  err = set_data (c_cred, &c_datum, c_format);
+  scm_gnutls_release_array (&c_handle);
+
+  if (EXPECT_FALSE (err < 0))
+    scm_gnutls_error (err, FUNC_NAME);
+
+  /* Return the number of certificates processed.  */
+  return ((unsigned int) err);
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_gnutls_make_certificate_credentials,
+	    "make-certificate-credentials",
+	    0, 0, 0,
+	    (void),
+	    "Return new certificate credentials (i.e., for use with "
+	    "either X.509 or OpenPGP certificates.")
+#define FUNC_NAME s_scm_gnutls_make_certificate_credentials
+{
+  int err;
+  gnutls_certificate_credentials_t c_cred;
+
+  err = gnutls_certificate_allocate_credentials (&c_cred);
+  if (err)
+    scm_gnutls_error (err, FUNC_NAME);
+
+  return (scm_from_gnutls_certificate_credentials (c_cred));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_set_certificate_credentials_dh_params_x,
+	    "set-certificate-credentials-dh-parameters!",
+	    2, 0, 0,
+	    (SCM cred, SCM dh_params),
+	    "Use Diffie-Hellman parameters @var{dh_params} for "
+	    "certificate credentials @var{cred}.")
+#define FUNC_NAME s_scm_gnutls_set_certificate_credentials_dh_params_x
+{
+  gnutls_dh_params_t c_dh_params;
+  gnutls_certificate_credentials_t c_cred;
+
+  c_cred = scm_to_gnutls_certificate_credentials (cred, 1, FUNC_NAME);
+  c_dh_params = scm_to_gnutls_dh_parameters (dh_params, 2, FUNC_NAME);
+
+  gnutls_certificate_set_dh_params (c_cred, c_dh_params);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_set_certificate_credentials_rsa_export_params_x,
+	    "set-certificate-credentials-rsa-export-parameters!",
+	    2, 0, 0,
+	    (SCM cred, SCM rsa_params),
+	    "Use RSA parameters @var{rsa_params} for certificate "
+	    "credentials @var{cred}.")
+#define FUNC_NAME s_scm_gnutls_set_certificate_credentials_rsa_export_params_x
+{
+  gnutls_rsa_params_t c_rsa_params;
+  gnutls_certificate_credentials_t c_cred;
+
+  c_cred = scm_to_gnutls_certificate_credentials (cred, 1, FUNC_NAME);
+  c_rsa_params = scm_to_gnutls_rsa_parameters (rsa_params, 2, FUNC_NAME);
+
+  gnutls_certificate_set_rsa_export_params (c_cred, c_rsa_params);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_set_certificate_credentials_x509_key_files_x,
+	    "set-certificate-credentials-x509-key-files!",
+	    4, 0, 0,
+	    (SCM cred, SCM cert_file, SCM key_file, SCM format),
+	    "Use @var{file} as the password file for PSK server "
+	    "credentials @var{cred}.")
+#define FUNC_NAME s_scm_gnutls_set_certificate_credentials_x509_key_files_x
+{
+  int err;
+  gnutls_certificate_credentials_t c_cred;
+  gnutls_x509_crt_fmt_t c_format;
+  char *c_cert_file, *c_key_file;
+  size_t c_cert_file_len, c_key_file_len;
+
+  c_cred = scm_to_gnutls_certificate_credentials (cred, 1, FUNC_NAME);
+  SCM_VALIDATE_STRING (2, cert_file);
+  SCM_VALIDATE_STRING (3, key_file);
+  c_format = scm_to_gnutls_x509_certificate_format (format, 2, FUNC_NAME);
+
+  c_cert_file_len = scm_c_string_length (cert_file);
+  c_cert_file = (char *) alloca (c_cert_file_len + 1);
+
+  c_key_file_len = scm_c_string_length  (key_file);
+  c_key_file = (char *) alloca (c_key_file_len + 1);
+
+  (void) scm_to_locale_stringbuf (cert_file, c_cert_file,
+				  c_cert_file_len + 1);
+  c_cert_file[c_cert_file_len] = '\0';
+  (void) scm_to_locale_stringbuf (key_file, c_key_file,
+				  c_key_file_len + 1);
+  c_key_file[c_key_file_len] = '\0';
+
+  err = gnutls_certificate_set_x509_key_file (c_cred, c_cert_file, c_key_file,
+					      c_format);
+  if (EXPECT_FALSE (err))
+    scm_gnutls_error (err, FUNC_NAME);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_set_certificate_credentials_x509_trust_file_x,
+	    "set-certificate-credentials-x509-trust-file!",
+	    3, 0, 0,
+	    (SCM cred, SCM file, SCM format),
+	    "Use @var{file} as the X.509 trust file for certificate "
+	    "credentials @var{cred}.  On success, return the number of "
+	    "certificates processed.")
+#define FUNC_NAME s_scm_gnutls_set_certificate_credentials_x509_trust_file_x
+{
+  unsigned int count;
+
+  count = set_certificate_file (gnutls_certificate_set_x509_trust_file,
+				cred, file, format,
+				FUNC_NAME);
+
+  return scm_from_uint (count);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_set_certificate_credentials_x509_crl_file_x,
+	    "set-certificate-credentials-x509-crl-file!",
+	    3, 0, 0,
+	    (SCM cred, SCM file, SCM format),
+	    "Use @var{file} as the X.509 CRL (certificate revocation list) "
+	    "file for certificate credentials @var{cred}.  On success, "
+	    "return the number of CRLs processed.")
+#define FUNC_NAME s_scm_gnutls_set_certificate_credentials_x509_crl_file_x
+{
+  unsigned int count;
+
+  count = set_certificate_file (gnutls_certificate_set_x509_crl_file,
+				cred, file, format,
+				FUNC_NAME);
+
+  return scm_from_uint (count);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_set_certificate_credentials_x509_trust_data_x,
+	    "set-certificate-credentials-x509-trust-data!",
+	    3, 0, 0,
+	    (SCM cred, SCM data, SCM format),
+	    "Use @var{data} (a uniform array) as the X.509 trust "
+	    "database for @var{cred}.  On success, return the number "
+	    "of certificates processed.")
+#define FUNC_NAME s_scm_gnutls_set_certificate_credentials_x509_trust_data_x
+{
+  unsigned int count;
+
+  count = set_certificate_data (gnutls_certificate_set_x509_trust_mem,
+				cred, data, format,
+				FUNC_NAME);
+
+  return scm_from_uint (count);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_set_certificate_credentials_x509_crl_data_x,
+	    "set-certificate-credentials-x509-crl-data!",
+	    3, 0, 0,
+	    (SCM cred, SCM data, SCM format),
+	    "Use @var{data} (a uniform array) as the X.509 CRL "
+	    "(certificate revocation list) database for @var{cred}.  "
+	    "On success, return the number of CRLs processed.")
+#define FUNC_NAME s_scm_gnutls_set_certificate_credentials_x509_crl_data_x
+{
+  unsigned int count;
+
+  count = set_certificate_data (gnutls_certificate_set_x509_crl_mem,
+				cred, data, format,
+				FUNC_NAME);
+
+  return scm_from_uint (count);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_set_certificate_credentials_x509_key_data_x,
+	    "set-certificate-credentials-x509-key-data!",
+	    4, 0, 0,
+	    (SCM cred, SCM cert, SCM key, SCM format),
+	    "Use X.509 certificate @var{cert} and private key @var{key}, "
+	    "both uniform arrays containing the X.509 certificate and key "
+	    "in format @var{format}, for certificate credentials "
+	    "@var{cred}.")
+#define FUNC_NAME s_scm_gnutls_set_certificate_credentials_x509_key_data_x
+{
+  int err;
+  gnutls_x509_crt_fmt_t c_format;
+  gnutls_certificate_credentials_t c_cred;
+  gnutls_datum_t c_cert_d, c_key_d;
+  scm_t_array_handle c_cert_handle, c_key_handle;
+  const char *c_cert, *c_key;
+  size_t c_cert_len, c_key_len;
+
+  c_cred = scm_to_gnutls_certificate_credentials (cred, 1, FUNC_NAME);
+  c_format = scm_to_gnutls_x509_certificate_format (format, 4, FUNC_NAME);
+  SCM_VALIDATE_ARRAY (2, cert);
+  SCM_VALIDATE_ARRAY (3, key);
+
+  /* FIXME: If the second call fails, an exception is raised and
+     C_CERT_HANDLE is not released.  */
+  c_cert = scm_gnutls_get_array (cert, &c_cert_handle, &c_cert_len,
+				 FUNC_NAME);
+  c_key  = scm_gnutls_get_array (key, &c_key_handle, &c_key_len,
+				 FUNC_NAME);
+
+  c_cert_d.data = (unsigned char *) c_cert;
+  c_cert_d.size = c_cert_len;
+  c_key_d.data  = (unsigned char *) c_key;
+  c_key_d.size  = c_key_len;
+
+  err = gnutls_certificate_set_x509_key_mem (c_cred, &c_cert_d, &c_key_d,
+					     c_format);
+  scm_gnutls_release_array (&c_cert_handle);
+  scm_gnutls_release_array (&c_key_handle);
+
+  if (EXPECT_FALSE (err))
+    scm_gnutls_error (err, FUNC_NAME);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_set_certificate_credentials_x509_keys_x,
+	    "set-certificate-credentials-x509-keys!",
+	    3, 0, 0,
+	    (SCM cred, SCM certs, SCM privkey),
+	    "Have certificate credentials @var{cred} use the X.509 "
+	    "certificates listed in @var{certs} and X.509 private key "
+	    "@var{privkey}.")
+#define FUNC_NAME s_scm_gnutls_set_certificate_credentials_x509_keys_x
+{
+  int err;
+  gnutls_x509_crt_t *c_certs;
+  gnutls_x509_privkey_t c_key;
+  gnutls_certificate_credentials_t c_cred;
+  long int c_cert_count, i;
+
+  c_cred = scm_to_gnutls_certificate_credentials (cred, 1, FUNC_NAME);
+  SCM_VALIDATE_LIST_COPYLEN (2, certs, c_cert_count);
+  c_key = scm_to_gnutls_x509_private_key (privkey, 3, FUNC_NAME);
+
+  c_certs = (gnutls_x509_crt_t *) alloca (c_cert_count * sizeof (* c_certs));
+  for (i = 0;
+       scm_is_pair (certs);
+       certs = SCM_CDR (certs), i++)
+    {
+      c_certs[i] = scm_to_gnutls_x509_certificate (SCM_CAR (certs),
+						   2, FUNC_NAME);
+    }
+
+  err = gnutls_certificate_set_x509_key (c_cred, c_certs, c_cert_count,
+					 c_key);
+  if (EXPECT_FALSE (err))
+    scm_gnutls_error (err, FUNC_NAME);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_set_certificate_credentials_verify_limits_x,
+	    "set-certificate-credentials-verify-limits!",
+	    3, 0, 0,
+	    (SCM cred, SCM max_bits, SCM max_depth),
+	    "Set the verification limits of @code{peer-certificate-status} "
+	    "for certificate credentials @var{cred} to @var{max_bits} "
+	    "bits for an acceptable certificate and @var{max_depth} "
+	    "as the maximum depth of a certificate chain.")
+#define FUNC_NAME s_scm_gnutls_set_certificate_credentials_verify_limits_x
+{
+  gnutls_certificate_credentials_t c_cred;
+  unsigned int c_max_bits, c_max_depth;
+
+  c_cred = scm_to_gnutls_certificate_credentials (cred, 1, FUNC_NAME);
+  c_max_bits = scm_to_uint (max_bits);
+  c_max_depth = scm_to_uint (max_depth);
+
+  gnutls_certificate_set_verify_limits (c_cred, c_max_bits, c_max_depth);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_set_certificate_credentials_verify_flags_x,
+	    "set-certificate-credentials-verify-flags!",
+	    1, 0, 1,
+	    (SCM cred, SCM flags),
+	    "Set the certificate verification flags to @var{flags}, a "
+	    "series of @code{certificate-verify} values.")
+#define FUNC_NAME s_scm_gnutls_set_certificate_credentials_verify_flags_x
+{
+  unsigned int c_flags, c_pos;
+  gnutls_certificate_credentials_t c_cred;
+
+  c_cred = scm_to_gnutls_certificate_credentials (cred, 1, FUNC_NAME);
+
+  for (c_flags = 0, c_pos = 2;
+       !scm_is_null (flags);
+       flags = SCM_CDR (flags), c_pos++)
+    {
+      c_flags |= (unsigned int)
+	scm_to_gnutls_certificate_verify (SCM_CAR (flags), c_pos, FUNC_NAME);
+    }
+
+  gnutls_certificate_set_verify_flags (c_cred, c_flags);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_peer_certificate_status, "peer-certificate-status",
+	    1, 0, 0,
+	    (SCM session),
+	    "Verify the peer certificate for @var{session} and return "
+	    "a list of @code{certificate-status} values (such as "
+	    "@code{certificate-status/revoked}), or the empty list if "
+	    "the certificate is valid.")
+#define FUNC_NAME s_scm_gnutls_peer_certificate_status
+{
+  int err;
+  unsigned int c_status;
+  gnutls_session_t c_session;
+  SCM result = SCM_EOL;
+
+  c_session = scm_to_gnutls_session (session, 1, FUNC_NAME);
+
+  err = gnutls_certificate_verify_peers2 (c_session, &c_status);
+  if (EXPECT_FALSE (err))
+    scm_gnutls_error (err, FUNC_NAME);
+
+#define MATCH_STATUS(_value)						\
+  if (c_status & (_value))						\
+    {									\
+      result = scm_cons (scm_from_gnutls_certificate_status (_value),	\
+			 result);					\
+      c_status &= ~(_value);						\
+    }
+
+  MATCH_STATUS (GNUTLS_CERT_INVALID);
+  MATCH_STATUS (GNUTLS_CERT_REVOKED);
+  MATCH_STATUS (GNUTLS_CERT_SIGNER_NOT_FOUND);
+  MATCH_STATUS (GNUTLS_CERT_SIGNER_NOT_CA);
+  MATCH_STATUS (GNUTLS_CERT_INSECURE_ALGORITHM);
+
+  if (EXPECT_FALSE (c_status != 0))
+    /* XXX: We failed to interpret one of the status flags.  */
+    scm_gnutls_error (GNUTLS_E_UNIMPLEMENTED_FEATURE, FUNC_NAME);
+
+#undef MATCH_STATUS
+
+  return (result);
+}
+#undef FUNC_NAME
+
+
+/* SRP credentials.  */
+
+SCM_DEFINE (scm_gnutls_make_srp_server_credentials,
+	    "make-srp-server-credentials",
+	    0, 0, 0,
+	    (void),
+	    "Return new SRP server credentials.")
+#define FUNC_NAME s_scm_gnutls_make_srp_server_credentials
+{
+  int err;
+  gnutls_srp_server_credentials_t c_cred;
+
+  err = gnutls_srp_allocate_server_credentials (&c_cred);
+  if (EXPECT_FALSE (err))
+    scm_gnutls_error (err, FUNC_NAME);
+
+  return (scm_from_gnutls_srp_server_credentials (c_cred));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_set_srp_server_credentials_files_x,
+	    "set-srp-server-credentials-files!",
+	    3, 0, 0,
+	    (SCM cred, SCM password_file, SCM password_conf_file),
+	    "Set the credentials files for @var{cred}, an SRP server "
+	    "credentials object.")
+#define FUNC_NAME s_scm_gnutls_set_srp_server_credentials_files_x
+{
+  int err;
+  gnutls_srp_server_credentials_t c_cred;
+  char *c_password_file, *c_password_conf_file;
+  size_t c_password_file_len, c_password_conf_file_len;
+
+  c_cred = scm_to_gnutls_srp_server_credentials (cred, 1, FUNC_NAME);
+  SCM_VALIDATE_STRING (2, password_file);
+  SCM_VALIDATE_STRING (3, password_conf_file);
+
+  c_password_file_len = scm_c_string_length (password_file);
+  c_password_conf_file_len = scm_c_string_length (password_conf_file);
+
+  c_password_file = (char *) alloca (c_password_file_len + 1);
+  c_password_conf_file = (char *) alloca (c_password_conf_file_len + 1);
+
+  (void) scm_to_locale_stringbuf (password_file, c_password_file,
+				  c_password_file_len + 1);
+  c_password_file[c_password_file_len] = '\0';
+  (void) scm_to_locale_stringbuf (password_conf_file, c_password_conf_file,
+				  c_password_conf_file_len + 1);
+  c_password_conf_file[c_password_conf_file_len] = '\0';
+
+  err = gnutls_srp_set_server_credentials_file (c_cred, c_password_file,
+						c_password_conf_file);
+  if (EXPECT_FALSE (err))
+    scm_gnutls_error (err, FUNC_NAME);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_make_srp_client_credentials,
+	    "make-srp-client-credentials",
+	    0, 0, 0,
+	    (void),
+	    "Return new SRP client credentials.")
+#define FUNC_NAME s_scm_gnutls_make_srp_client_credentials
+{
+  int err;
+  gnutls_srp_client_credentials_t c_cred;
+
+  err = gnutls_srp_allocate_client_credentials (&c_cred);
+  if (EXPECT_FALSE (err))
+    scm_gnutls_error (err, FUNC_NAME);
+
+  return (scm_from_gnutls_srp_client_credentials (c_cred));
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_gnutls_set_srp_client_credentials_x,
+	    "set-srp-client-credentials!",
+	    3, 0, 0,
+	    (SCM cred, SCM username, SCM password),
+	    "Use @var{username} and @var{password} as the credentials "
+	    "for @var{cred}, a client-side SRP credentials object.")
+#define FUNC_NAME s_scm_gnutls_make_srp_client_credentials
+{
+  int err;
+  gnutls_srp_client_credentials_t c_cred;
+  char *c_username, *c_password;
+  size_t c_username_len, c_password_len;
+
+  c_cred = scm_to_gnutls_srp_client_credentials (cred, 1, FUNC_NAME);
+  SCM_VALIDATE_STRING (2, username);
+  SCM_VALIDATE_STRING (3, password);
+
+  c_username_len = scm_c_string_length (username);
+  c_password_len = scm_c_string_length (password);
+
+  c_username = (char *) alloca (c_username_len + 1);
+  c_password = (char *) alloca (c_password_len + 1);
+
+  (void) scm_to_locale_stringbuf (username, c_username,
+				  c_username_len + 1);
+  c_username[c_username_len] = '\0';
+  (void) scm_to_locale_stringbuf (password, c_password,
+				  c_password_len + 1);
+  c_password[c_password_len] = '\0';
+
+  err = gnutls_srp_set_client_credentials (c_cred, c_username,
+					   c_password);
+  if (EXPECT_FALSE (err))
+    scm_gnutls_error (err, FUNC_NAME);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_server_session_srp_username,
+	    "server-session-srp-username",
+	    1, 0, 0,
+	    (SCM session),
+	    "Return the SRP username used in @var{session} (a server-side "
+	    "session).")
+#define FUNC_NAME s_scm_gnutls_server_session_srp_username
+{
+  SCM result;
+  const char *c_username;
+  gnutls_session_t c_session;
+
+  c_session = scm_to_gnutls_session (session, 1, FUNC_NAME);
+  c_username = gnutls_srp_server_get_username (c_session);
+
+  if (EXPECT_FALSE (c_username == NULL))
+    result = SCM_BOOL_F;
+  else
+    result = scm_from_locale_string (c_username);
+
+  return (result);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_srp_base64_encode, "srp-base64-encode",
+	    1, 0, 0,
+	    (SCM str),
+	    "Encode @var{str} using SRP's base64 algorithm.  Return "
+	    "the encoded string.")
+#define FUNC_NAME s_scm_gnutls_srp_base64_encode
+{
+  int err;
+  char *c_str, *c_result;
+  size_t c_str_len, c_result_len, c_result_actual_len;
+  gnutls_datum_t c_str_d;
+
+  SCM_VALIDATE_STRING (1, str);
+
+  c_str_len = scm_c_string_length (str);
+  c_str = (char *) alloca (c_str_len + 1);
+  (void) scm_to_locale_stringbuf (str, c_str, c_str_len + 1);
+  c_str[c_str_len] = '\0';
+
+  /* Typical size ratio is 4/3 so 3/2 is an upper bound.  */
+  c_result_len = (c_str_len * 3) / 2;
+  c_result = (char *) scm_malloc (c_result_len);
+  if (EXPECT_FALSE (c_result == NULL))
+    scm_gnutls_error (GNUTLS_E_MEMORY_ERROR, FUNC_NAME);
+
+  c_str_d.data = (unsigned char *) c_str;
+  c_str_d.size = c_str_len;
+
+  do
+    {
+      c_result_actual_len = c_result_len;
+      err = gnutls_srp_base64_encode (&c_str_d, c_result,
+				      &c_result_actual_len);
+      if (err == GNUTLS_E_SHORT_MEMORY_BUFFER)
+	{
+	  char *c_new_buf;
+
+	  c_new_buf = scm_realloc (c_result, c_result_len * 2);
+	  if (EXPECT_FALSE (c_new_buf == NULL))
+	    {
+	      free (c_result);
+	      scm_gnutls_error (GNUTLS_E_MEMORY_ERROR, FUNC_NAME);
+	    }
+	  else
+	    c_result = c_new_buf, c_result_len *= 2;
+	}
+    }
+  while (EXPECT_FALSE (err == GNUTLS_E_SHORT_MEMORY_BUFFER));
+
+  if (EXPECT_FALSE (err))
+    scm_gnutls_error (err, FUNC_NAME);
+
+  if (c_result_actual_len + 1 < c_result_len)
+    /* Shrink the buffer.  */
+    c_result = scm_realloc (c_result, c_result_actual_len + 1);
+
+  c_result[c_result_actual_len] = '\0';
+
+  return (scm_take_locale_string (c_result));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_srp_base64_decode, "srp-base64-decode",
+	    1, 0, 0,
+	    (SCM str),
+	    "Decode @var{str}, an SRP-base64 encoded string, and return "
+	    "the decoded string.")
+#define FUNC_NAME s_scm_gnutls_srp_base64_decode
+{
+  int err;
+  char *c_str, *c_result;
+  size_t c_str_len, c_result_len, c_result_actual_len;
+  gnutls_datum_t c_str_d;
+
+  SCM_VALIDATE_STRING (1, str);
+
+  c_str_len = scm_c_string_length (str);
+  c_str = (char *) alloca (c_str_len + 1);
+  (void) scm_to_locale_stringbuf (str, c_str, c_str_len + 1);
+  c_str[c_str_len] = '\0';
+
+  /* We assume that the decoded string is smaller than the encoded
+     string.  */
+  c_result_len = c_str_len;
+  c_result = (char *) alloca (c_result_len);
+
+  c_str_d.data = (unsigned char *) c_str;
+  c_str_d.size = c_str_len;
+
+  c_result_actual_len = c_result_len;
+  err = gnutls_srp_base64_decode (&c_str_d, c_result,
+				  &c_result_actual_len);
+  if (EXPECT_FALSE (err))
+    scm_gnutls_error (err, FUNC_NAME);
+
+  c_result[c_result_actual_len] = '\0';
+
+  return (scm_from_locale_string (c_result));
+}
+#undef FUNC_NAME
+
+
+/* PSK credentials.  */
+
+SCM_DEFINE (scm_gnutls_make_psk_server_credentials,
+	    "make-psk-server-credentials",
+	    0, 0, 0,
+	    (void),
+	    "Return new PSK server credentials.")
+#define FUNC_NAME s_scm_gnutls_make_psk_server_credentials
+{
+  int err;
+  gnutls_psk_server_credentials_t c_cred;
+
+  err = gnutls_psk_allocate_server_credentials (&c_cred);
+  if (EXPECT_FALSE (err))
+    scm_gnutls_error (err, FUNC_NAME);
+
+  return (scm_from_gnutls_psk_server_credentials (c_cred));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_set_psk_server_credentials_file_x,
+	    "set-psk-server-credentials-file!",
+	    2, 0, 0,
+	    (SCM cred, SCM file),
+	    "Use @var{file} as the password file for PSK server "
+	    "credentials @var{cred}.")
+#define FUNC_NAME s_scm_gnutls_set_psk_server_credentials_file_x
+{
+  int err;
+  gnutls_psk_server_credentials_t c_cred;
+  char *c_file;
+  size_t c_file_len;
+
+  c_cred = scm_to_gnutls_psk_server_credentials (cred, 1, FUNC_NAME);
+  SCM_VALIDATE_STRING (2, file);
+
+  c_file_len = scm_c_string_length (file);
+  c_file = (char *) alloca (c_file_len + 1);
+
+  (void) scm_to_locale_stringbuf (file, c_file, c_file_len + 1);
+  c_file[c_file_len] = '\0';
+
+  err = gnutls_psk_set_server_credentials_file (c_cred, c_file);
+  if (EXPECT_FALSE (err))
+    scm_gnutls_error (err, FUNC_NAME);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_make_psk_client_credentials,
+	    "make-psk-client-credentials",
+	    0, 0, 0,
+	    (void),
+	    "Return a new PSK client credentials object.")
+#define FUNC_NAME s_scm_gnutls_make_psk_client_credentials
+{
+  int err;
+  gnutls_psk_client_credentials_t c_cred;
+
+  err = gnutls_psk_allocate_client_credentials (&c_cred);
+  if (EXPECT_FALSE (err))
+    scm_gnutls_error (err, FUNC_NAME);
+
+  return (scm_from_gnutls_psk_client_credentials (c_cred));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_set_psk_client_credentials_x,
+	    "set-psk-client-credentials!",
+	    4, 0, 0,
+	    (SCM cred, SCM username, SCM key, SCM key_format),
+	    "Set the client credentials for @var{cred}, a PSK client "
+	    "credentials object.")
+#define FUNC_NAME s_scm_gnutls_set_psk_client_credentials_x
+{
+  int err;
+  gnutls_psk_client_credentials_t c_cred;
+  gnutls_psk_key_flags c_key_format;
+  scm_t_array_handle c_handle;
+  const char *c_key;
+  char *c_username;
+  size_t c_username_len, c_key_len;
+  gnutls_datum_t c_datum;
+
+  c_cred = scm_to_gnutls_psk_client_credentials (cred, 1, FUNC_NAME);
+  SCM_VALIDATE_STRING (2, username);
+  SCM_VALIDATE_ARRAY (3, key);
+  c_key_format = scm_to_gnutls_psk_key_format (key_format, 4, FUNC_NAME);
+
+  c_username_len = scm_c_string_length (username);
+  c_username = (char *) alloca (c_username_len + 1);
+
+  (void) scm_to_locale_stringbuf (username, c_username,
+				  c_username_len + 1);
+  c_username[c_username_len] = '\0';
+
+  c_key = scm_gnutls_get_array (key, &c_handle, &c_key_len, FUNC_NAME);
+  c_datum.data = (unsigned char *) c_key;
+  c_datum.size = c_key_len;
+
+  err = gnutls_psk_set_client_credentials (c_cred, c_username,
+					   &c_datum, c_key_format);
+  scm_gnutls_release_array (&c_handle);
+
+  if (EXPECT_FALSE (err))
+    scm_gnutls_error (err, FUNC_NAME);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_server_session_psk_username,
+	    "server-session-psk-username",
+	    1, 0, 0,
+	    (SCM session),
+	    "Return the username associated with PSK server session "
+	    "@var{session}.")
+#define FUNC_NAME s_scm_gnutls_server_session_psk_username
+{
+  SCM result;
+  const char *c_username;
+  gnutls_session_t c_session;
+
+  c_session = scm_to_gnutls_session (session, 1, FUNC_NAME);
+  c_username = gnutls_srp_server_get_username (c_session);
+
+  if (EXPECT_FALSE (c_username == NULL))
+    result = SCM_BOOL_F;
+  else
+    result = scm_from_locale_string (c_username);
+
+  return (result);
+}
+#undef FUNC_NAME
+
+
+/* X.509 certificates.  */
+
+SCM_DEFINE (scm_gnutls_import_x509_certificate, "import-x509-certificate",
+	    2, 0, 0,
+	    (SCM data, SCM format),
+	    "Return a new X.509 certificate object resulting from the "
+	    "import of @var{data} (a uniform array) according to "
+	    "@var{format}.")
+#define FUNC_NAME s_scm_gnutls_import_x509_certificate
+{
+  int err;
+  gnutls_x509_crt_t c_cert;
+  gnutls_x509_crt_fmt_t c_format;
+  gnutls_datum_t c_data_d;
+  scm_t_array_handle c_data_handle;
+  const char *c_data;
+  size_t c_data_len;
+
+  SCM_VALIDATE_ARRAY (1, data);
+  c_format = scm_to_gnutls_x509_certificate_format (format, 2, FUNC_NAME);
+
+  c_data = scm_gnutls_get_array (data, &c_data_handle, &c_data_len,
+				 FUNC_NAME);
+  c_data_d.data = (unsigned char *) c_data;
+  c_data_d.size = c_data_len;
+
+  err = gnutls_x509_crt_init (&c_cert);
+  if (EXPECT_FALSE (err))
+    {
+      scm_gnutls_release_array (&c_data_handle);
+      scm_gnutls_error (err, FUNC_NAME);
+    }
+
+  err = gnutls_x509_crt_import (c_cert, &c_data_d, c_format);
+  scm_gnutls_release_array (&c_data_handle);
+
+  if (EXPECT_FALSE (err))
+    {
+      gnutls_x509_crt_deinit (c_cert);
+      scm_gnutls_error (err, FUNC_NAME);
+    }
+
+  return (scm_from_gnutls_x509_certificate (c_cert));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_import_x509_private_key, "import-x509-private-key",
+	    2, 0, 0,
+	    (SCM data, SCM format),
+	    "Return a new X.509 private key object resulting from the "
+	    "import of @var{data} (a uniform array) according to "
+	    "@var{format}.")
+#define FUNC_NAME s_scm_gnutls_import_x509_private_key
+{
+  int err;
+  gnutls_x509_privkey_t c_key;
+  gnutls_x509_crt_fmt_t c_format;
+  gnutls_datum_t c_data_d;
+  scm_t_array_handle c_data_handle;
+  const char *c_data;
+  size_t c_data_len;
+
+  SCM_VALIDATE_ARRAY (1, data);
+  c_format = scm_to_gnutls_x509_certificate_format (format, 2, FUNC_NAME);
+
+  c_data = scm_gnutls_get_array (data, &c_data_handle, &c_data_len,
+				 FUNC_NAME);
+  c_data_d.data = (unsigned char *) c_data;
+  c_data_d.size = c_data_len;
+
+  err = gnutls_x509_privkey_init (&c_key);
+  if (EXPECT_FALSE (err))
+    {
+      scm_gnutls_release_array (&c_data_handle);
+      scm_gnutls_error (err, FUNC_NAME);
+    }
+
+  err = gnutls_x509_privkey_import (c_key, &c_data_d, c_format);
+  scm_gnutls_release_array (&c_data_handle);
+
+  if (EXPECT_FALSE (err))
+    {
+      gnutls_x509_privkey_deinit (c_key);
+      scm_gnutls_error (err, FUNC_NAME);
+    }
+
+  return (scm_from_gnutls_x509_private_key (c_key));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_pkcs8_import_x509_private_key,
+	    "pkcs8-import-x509-private-key",
+	    2, 2, 0,
+	    (SCM data, SCM format, SCM pass, SCM encrypted),
+	    "Return a new X.509 private key object resulting from the "
+	    "import of @var{data} (a uniform array) according to "
+	    "@var{format}.  Optionally, if @var{pass} is not @code{#f}, "
+	    "it should be a string denoting a passphrase.  "
+	    "@var{encrypted} tells whether the private key is encrypted "
+	    "(@code{#t} by default).")
+#define FUNC_NAME s_scm_gnutls_pkcs8_import_x509_private_key
+{
+  int err;
+  gnutls_x509_privkey_t c_key;
+  gnutls_x509_crt_fmt_t c_format;
+  unsigned int c_flags;
+  gnutls_datum_t c_data_d;
+  scm_t_array_handle c_data_handle;
+  const char *c_data;
+  char *c_pass;
+  size_t c_data_len, c_pass_len;
+
+  SCM_VALIDATE_ARRAY (1, data);
+  c_format = scm_to_gnutls_x509_certificate_format (format, 2, FUNC_NAME);
+  if ((pass == SCM_UNDEFINED) || (scm_is_false (pass)))
+    c_pass = NULL;
+  else
+    {
+      c_pass_len = scm_c_string_length (pass);
+      c_pass = (char *) alloca (c_pass_len + 1);
+      (void) scm_to_locale_stringbuf (pass, c_pass, c_pass_len + 1);
+      c_pass[c_pass_len] = '\0';
+    }
+
+  if (encrypted == SCM_UNDEFINED)
+    c_flags = 0;
+  else
+    {
+      SCM_VALIDATE_BOOL (4, encrypted);
+      if (scm_is_true (encrypted))
+	c_flags = 0;
+      else
+	c_flags = GNUTLS_PKCS8_PLAIN;
+    }
+
+  c_data = scm_gnutls_get_array (data, &c_data_handle, &c_data_len,
+				 FUNC_NAME);
+  c_data_d.data = (unsigned char *) c_data;
+  c_data_d.size = c_data_len;
+
+  err = gnutls_x509_privkey_init (&c_key);
+  if (EXPECT_FALSE (err))
+    {
+      scm_gnutls_release_array (&c_data_handle);
+      scm_gnutls_error (err, FUNC_NAME);
+    }
+
+  err = gnutls_x509_privkey_import_pkcs8 (c_key, &c_data_d, c_format, c_pass,
+					  c_flags);
+  scm_gnutls_release_array (&c_data_handle);
+
+  if (EXPECT_FALSE (err))
+    {
+      gnutls_x509_privkey_deinit (c_key);
+      scm_gnutls_error (err, FUNC_NAME);
+    }
+
+  return (scm_from_gnutls_x509_private_key (c_key));
+}
+#undef FUNC_NAME
+
+/* Provide the body of a `get_dn' function.  */
+#define X509_CERTIFICATE_DN_FUNCTION_BODY(get_the_dn)		\
+  int err;							\
+  gnutls_x509_crt_t c_cert;					\
+  char *c_dn;							\
+  size_t c_dn_len;						\
+								\
+  c_cert = scm_to_gnutls_x509_certificate (cert, 1, FUNC_NAME);	\
+								\
+  /* Get the DN size.  */					\
+  (void) get_the_dn (c_cert, NULL, &c_dn_len);			\
+								\
+  /* Get the DN itself.  */					\
+  c_dn = (char *) alloca (c_dn_len);				\
+  err = get_the_dn (c_cert, c_dn, &c_dn_len);			\
+								\
+  if (EXPECT_FALSE (err))					\
+    scm_gnutls_error (err, FUNC_NAME);				\
+								\
+  /* XXX: The returned string is actually ASCII or UTF-8.  */	\
+  return (scm_from_locale_string (c_dn));
+
+SCM_DEFINE (scm_gnutls_x509_certificate_dn, "x509-certificate-dn",
+	    1, 0, 0,
+	    (SCM cert),
+	    "Return the distinguished name (DN) of X.509 certificate "
+	    "@var{cert}.  The form of the DN is as described in @uref{"
+	    "http://tools.ietf.org/html/rfc2253, RFC 2253}.")
+#define FUNC_NAME s_scm_gnutls_x509_certificate_dn
+{
+  X509_CERTIFICATE_DN_FUNCTION_BODY (gnutls_x509_crt_get_dn);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_x509_certificate_issuer_dn,
+	    "x509-certificate-issuer-dn",
+	    1, 0, 0,
+	    (SCM cert),
+	    "Return the distinguished name (DN) of X.509 certificate "
+	    "@var{cert}.")
+#define FUNC_NAME s_scm_gnutls_x509_certificate_issuer_dn
+{
+  X509_CERTIFICATE_DN_FUNCTION_BODY (gnutls_x509_crt_get_issuer_dn);
+}
+#undef FUNC_NAME
+
+#undef X509_CERTIFICATE_DN_FUNCTION_BODY
+
+
+/* Provide the body of a `get_dn_oid' function.  */
+#define X509_CERTIFICATE_DN_OID_FUNCTION_BODY(get_dn_oid)		\
+  int err;								\
+  gnutls_x509_crt_t c_cert;						\
+  unsigned int c_index;							\
+  char *c_oid;								\
+  size_t c_oid_actual_len, c_oid_len;					\
+  SCM result;								\
+									\
+  c_cert = scm_to_gnutls_x509_certificate (cert, 1, FUNC_NAME);		\
+  c_index = scm_to_uint (index);					\
+									\
+  c_oid_len = 256;							\
+  c_oid = scm_malloc (c_oid_len);					\
+									\
+  do									\
+    {									\
+      c_oid_actual_len = c_oid_len;					\
+      err = get_dn_oid (c_cert, c_index, c_oid, &c_oid_actual_len);	\
+      if (err == GNUTLS_E_SHORT_MEMORY_BUFFER)				\
+	{								\
+	  c_oid = scm_realloc (c_oid, c_oid_len * 2);			\
+	  c_oid_len *= 2;						\
+	}								\
+    }									\
+  while (err == GNUTLS_E_SHORT_MEMORY_BUFFER);				\
+									\
+  if (EXPECT_FALSE (err))						\
+    {									\
+      free (c_oid);							\
+									\
+      if (err == GNUTLS_E_REQUESTED_DATA_NOT_AVAILABLE)			\
+	result = SCM_BOOL_F;						\
+      else								\
+	scm_gnutls_error (err, FUNC_NAME);				\
+    }									\
+  else									\
+    {									\
+      if (c_oid_actual_len < c_oid_len)					\
+	c_oid = scm_realloc (c_oid, c_oid_actual_len);			\
+									\
+      result = scm_take_locale_string (c_oid);				\
+    }									\
+									\
+  return result;
+
+SCM_DEFINE (scm_gnutls_x509_certificate_dn_oid, "x509-certificate-dn-oid",
+	    2, 0, 0,
+	    (SCM cert, SCM index),
+	    "Return OID (a string) at @var{index} from @var{cert}.  "
+	    "Return @code{#f} if no OID is available at @var{index}.")
+#define FUNC_NAME s_scm_gnutls_x509_certificate_dn_oid
+{
+  X509_CERTIFICATE_DN_OID_FUNCTION_BODY (gnutls_x509_crt_get_dn_oid);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_x509_certificate_issuer_dn_oid,
+	    "x509-certificate-issuer-dn-oid",
+	    2, 0, 0,
+	    (SCM cert, SCM index),
+	    "Return the OID (a string) at @var{index} from @var{cert}'s "
+	    "issuer DN.  Return @code{#f} if no OID is available at "
+	    "@var{index}.")
+#define FUNC_NAME s_scm_gnutls_x509_certificate_issuer_dn_oid
+{
+  X509_CERTIFICATE_DN_OID_FUNCTION_BODY (gnutls_x509_crt_get_issuer_dn_oid);
+}
+#undef FUNC_NAME
+
+#undef X509_CERTIFICATE_DN_OID_FUNCTION_BODY
+
+
+SCM_DEFINE (scm_gnutls_x509_certificate_matches_hostname_p,
+	    "x509-certificate-matches-hostname?",
+	    2, 0, 0,
+	    (SCM cert, SCM hostname),
+	    "Return true if @var{cert} matches @var{hostname}, a string "
+	    "denoting a DNS host name.  This is the basic implementation "
+	    "of @uref{http://tools.ietf.org/html/rfc2818, RFC 2818} (aka. "
+	    "HTTPS).")
+#define FUNC_NAME s_scm_gnutls_x509_certificate_matches_hostname_p
+{
+  SCM result;
+  gnutls_x509_crt_t c_cert;
+  char *c_hostname;
+  size_t c_hostname_len;
+
+  c_cert = scm_to_gnutls_x509_certificate (cert, 1, FUNC_NAME);
+  SCM_VALIDATE_STRING (2, hostname);
+
+  c_hostname_len = scm_c_string_length (hostname);
+  c_hostname = (char *) alloca (c_hostname_len + 1);
+
+  (void) scm_to_locale_stringbuf (hostname, c_hostname, c_hostname_len + 1);
+  c_hostname[c_hostname_len] = '\0';
+
+  if (gnutls_x509_crt_check_hostname (c_cert, c_hostname))
+    result = SCM_BOOL_T;
+  else
+    result = SCM_BOOL_F;
+
+  return result;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_x509_certificate_signature_algorithm,
+	    "x509-certificate-signature-algorithm",
+	    1, 0, 0,
+	    (SCM cert),
+	    "Return the signature algorithm used by @var{cert} (i.e., "
+	    "one of the @code{sign-algorithm/} values).")
+#define FUNC_NAME s_scm_gnutls_x509_certificate_signature_algorithm
+{
+  int c_result;
+  gnutls_x509_crt_t c_cert;
+
+  c_cert = scm_to_gnutls_x509_certificate (cert, 1, FUNC_NAME);
+
+  c_result = gnutls_x509_crt_get_signature_algorithm (c_cert);
+  if (EXPECT_FALSE (c_result < 0))
+    scm_gnutls_error (c_result, FUNC_NAME);
+
+  return (scm_from_gnutls_sign_algorithm (c_result));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_x509_certificate_public_key_algorithm,
+	    "x509-certificate-public-key-algorithm",
+	    1, 0, 0,
+	    (SCM cert),
+	    "Return two values: the public key algorithm (i.e., "
+	    "one of the @code{pk-algorithm/} values) of @var{cert} "
+	    "and the number of bits used.")
+#define FUNC_NAME s_scm_gnutls_x509_certificate_public_key_algorithm
+{
+  gnutls_x509_crt_t c_cert;
+  gnutls_pk_algorithm_t c_pk;
+  unsigned int c_bits;
+
+  c_cert = scm_to_gnutls_x509_certificate (cert, 1, FUNC_NAME);
+
+  c_pk = gnutls_x509_crt_get_pk_algorithm (c_cert, &c_bits);
+
+  return (scm_values (scm_list_2 (scm_from_gnutls_pk_algorithm (c_pk),
+				  scm_from_uint (c_bits))));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_x509_certificate_key_usage,
+	    "x509-certificate-key-usage",
+	    1, 0, 0,
+	    (SCM cert),
+	    "Return the key usage of @var{cert} (i.e., a list of "
+	    "@code{key-usage/} values), or the empty list if @var{cert} "
+	    "does not contain such information.")
+#define FUNC_NAME s_scm_gnutls_x509_certificate_key_usage
+{
+  int err;
+  SCM usage;
+  gnutls_x509_crt_t c_cert;
+  unsigned int c_usage, c_critical;
+
+  c_cert = scm_to_gnutls_x509_certificate (cert, 1, FUNC_NAME);
+
+  err = gnutls_x509_crt_get_key_usage (c_cert, &c_usage, &c_critical);
+  if (EXPECT_FALSE (err))
+    {
+      if (err == GNUTLS_E_REQUESTED_DATA_NOT_AVAILABLE)
+	usage = SCM_EOL;
+      else
+	scm_gnutls_error (err, FUNC_NAME);
+    }
+  else
+    usage = scm_from_gnutls_key_usage_flags (c_usage);
+
+  return usage;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_x509_certificate_version, "x509-certificate-version",
+	    1, 0, 0,
+	    (SCM cert),
+	    "Return the version of @var{cert}.")
+#define FUNC_NAME s_scm_gnutls_x509_certificate_version
+{
+  int c_result;
+  gnutls_x509_crt_t c_cert;
+
+  c_cert = scm_to_gnutls_x509_certificate (cert, 1, FUNC_NAME);
+
+  c_result = gnutls_x509_crt_get_version (c_cert);
+  if (EXPECT_FALSE (c_result < 0))
+    scm_gnutls_error (c_result, FUNC_NAME);
+
+  return (scm_from_int (c_result));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_x509_certificate_key_id, "x509-certificate-key-id",
+	    1, 0, 0,
+	    (SCM cert),
+	    "Return a statistically unique ID (a u8vector) for @var{cert} "
+	    "that depends on its public key parameters.  This is normally "
+	    "a 20-byte SHA-1 hash.")
+#define FUNC_NAME s_scm_gnutls_x509_certificate_key_id
+{
+  int err;
+  SCM result;
+  scm_t_array_handle c_id_handle;
+  gnutls_x509_crt_t c_cert;
+  scm_t_uint8 *c_id;
+  size_t c_id_len = 20;
+
+  c_cert = scm_to_gnutls_x509_certificate (cert, 1, FUNC_NAME);
+
+  result = scm_make_u8vector (scm_from_uint (c_id_len), SCM_INUM0);
+  scm_array_get_handle (result, &c_id_handle);
+  c_id = scm_array_handle_u8_writable_elements (&c_id_handle);
+
+  err = gnutls_x509_crt_get_key_id (c_cert, 0, c_id, &c_id_len);
+  scm_array_handle_release (&c_id_handle);
+
+  if (EXPECT_FALSE (err))
+    scm_gnutls_error (err, FUNC_NAME);
+
+  return result;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_x509_certificate_authority_key_id,
+	    "x509-certificate-authority-key-id",
+	    1, 0, 0,
+	    (SCM cert),
+	    "Return the key ID (a u8vector) of the X.509 certificate "
+	    "authority of @var{cert}.")
+#define FUNC_NAME s_scm_gnutls_x509_certificate_authority_key_id
+{
+  int err;
+  SCM result;
+  scm_t_array_handle c_id_handle;
+  gnutls_x509_crt_t c_cert;
+  scm_t_uint8 *c_id;
+  size_t c_id_len = 20;
+
+  c_cert = scm_to_gnutls_x509_certificate (cert, 1, FUNC_NAME);
+
+  result = scm_make_u8vector (scm_from_uint (c_id_len), SCM_INUM0);
+  scm_array_get_handle (result, &c_id_handle);
+  c_id = scm_array_handle_u8_writable_elements (&c_id_handle);
+
+  err = gnutls_x509_crt_get_authority_key_id (c_cert, c_id, &c_id_len,
+					      NULL);
+  scm_array_handle_release (&c_id_handle);
+
+  if (EXPECT_FALSE (err))
+    scm_gnutls_error (err, FUNC_NAME);
+
+  return result;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_x509_certificate_subject_key_id,
+	    "x509-certificate-subject-key-id",
+	    1, 0, 0,
+	    (SCM cert),
+	    "Return the subject key ID (a u8vector) for @var{cert}.")
+#define FUNC_NAME s_scm_gnutls_x509_certificate_subject_key_id
+{
+  int err;
+  SCM result;
+  scm_t_array_handle c_id_handle;
+  gnutls_x509_crt_t c_cert;
+  scm_t_uint8 *c_id;
+  size_t c_id_len = 20;
+
+  c_cert = scm_to_gnutls_x509_certificate (cert, 1, FUNC_NAME);
+
+  result = scm_make_u8vector (scm_from_uint (c_id_len), SCM_INUM0);
+  scm_array_get_handle (result, &c_id_handle);
+  c_id = scm_array_handle_u8_writable_elements (&c_id_handle);
+
+  err = gnutls_x509_crt_get_subject_key_id (c_cert, c_id, &c_id_len,
+					    NULL);
+  scm_array_handle_release (&c_id_handle);
+
+  if (EXPECT_FALSE (err))
+    scm_gnutls_error (err, FUNC_NAME);
+
+  return result;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_x509_certificate_subject_alternative_name,
+	    "x509-certificate-subject-alternative-name",
+	    2, 0, 0,
+	    (SCM cert, SCM index),
+	    "Return two values: the alternative name type for @var{cert} "
+	    "(i.e., one of the @code{x509-subject-alternative-name/} values) "
+	    "and the actual subject alternative name (a string) at "
+	    "@var{index}. Both values are @code{#f} if no alternative name "
+	    "is available at @var{index}.")
+#define FUNC_NAME s_scm_gnutls_x509_certificate_subject_alternative_name
+{
+  int err;
+  SCM result;
+  gnutls_x509_crt_t c_cert;
+  unsigned int c_index;
+  char *c_name;
+  size_t c_name_len = 512, c_name_actual_len;
+
+  c_cert = scm_to_gnutls_x509_certificate (cert, 1, FUNC_NAME);
+  c_index = scm_to_uint (index);
+
+  c_name = scm_malloc (c_name_len);
+  do
+    {
+      c_name_actual_len = c_name_len;
+      err = gnutls_x509_crt_get_subject_alt_name (c_cert, c_index,
+						  c_name, &c_name_actual_len,
+						  NULL);
+      if (err == GNUTLS_E_SHORT_MEMORY_BUFFER)
+	{
+	  c_name = scm_realloc (c_name, c_name_len * 2);
+	  c_name_len *= 2;
+	}
+    }
+  while (err == GNUTLS_E_SHORT_MEMORY_BUFFER);
+
+  if (EXPECT_FALSE (err < 0))
+    {
+      free (c_name);
+
+      if (err == GNUTLS_E_REQUESTED_DATA_NOT_AVAILABLE)
+	result = scm_values (scm_list_2 (SCM_BOOL_F, SCM_BOOL_F));
+      else
+	scm_gnutls_error (err, FUNC_NAME);
+    }
+  else
+    {
+      if (c_name_actual_len < c_name_len)
+	c_name = scm_realloc (c_name, c_name_actual_len);
+
+      result =
+	scm_values (scm_list_2
+		    (scm_from_gnutls_x509_subject_alternative_name (err),
+		     scm_take_locale_string (c_name)));
+    }
+
+  return result;
+}
+#undef FUNC_NAME
+
+
+/* Debugging.  */
+
+static SCM log_procedure = SCM_BOOL_F;
+
+static void
+scm_gnutls_log (int level, const char *str)
+{
+  if (scm_is_true (log_procedure))
+    (void) scm_call_2 (log_procedure, scm_from_int (level),
+		       scm_from_locale_string (str));
+}
+
+SCM_DEFINE (scm_gnutls_set_log_procedure_x, "set-log-procedure!",
+	    1, 0, 0,
+	    (SCM proc),
+	    "Use @var{proc} (a two-argument procedure) as the global "
+	    "GnuTLS log procedure.")
+#define FUNC_NAME s_scm_gnutls_set_log_procedure_x
+{
+  SCM_VALIDATE_PROC (1, proc);
+
+  if (scm_is_true (log_procedure))
+    (void) scm_gc_unprotect_object (log_procedure);
+
+  log_procedure = scm_gc_protect_object (proc);
+  gnutls_global_set_log_function (scm_gnutls_log);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_set_log_level_x, "set-log-level!", 1, 0, 0,
+	    (SCM level),
+	    "Enable GnuTLS logging up to @var{level} (an integer).")
+#define FUNC_NAME s_scm_gnutls_set_log_level_x
+{
+  unsigned int c_level;
+
+  c_level = scm_to_uint (level);
+  gnutls_global_set_log_level (c_level);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+
+/* Initialization.  */
+
+void
+scm_init_gnutls (void)
+{
+#include "core.c.x"
+
+  (void) gnutls_global_init ();
+
+  scm_gnutls_define_enums ();
+
+  scm_init_gnutls_error ();
+
+  scm_init_gnutls_session_record_port_type ();
+}
+
+/* arch-tag: 58420abe-0769-4684-b522-da7f32f4474c
+ */
diff --git a/guile/src/errors.c b/guile/src/errors.c
new file mode 100644
index 0000000000..fdc46c4a9b
--- /dev/null
+++ b/guile/src/errors.c
@@ -0,0 +1,53 @@
+/* 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>.  */
+
+#include <libguile.h>
+#include <gnutls/gnutls.h>
+
+#include "errors.h"
+#include "enums.h"
+
+SCM_SYMBOL (gnutls_error_key, "gnutls-error");
+
+void
+scm_gnutls_error (int c_err, const char *c_func)
+{
+  SCM err, func;
+
+  /* Note: If error code C_ERR is unknown, then ERR will be `#f'.  */
+  err = scm_from_gnutls_error (c_err);
+  func = scm_from_locale_symbol (c_func);
+
+  (void) scm_throw (gnutls_error_key, scm_list_2 (err, func));
+
+  /* XXX: This is actually never reached, but since the Guile headers don't
+     declare `scm_throw ()' as `noreturn', we must add this to avoid GCC's
+     complaints.  */
+  abort ();
+}
+
+
+void
+scm_init_gnutls_error (void)
+{
+#include "errors.c.x"
+}
+
+/* arch-tag: 48f07ecf-65c4-480c-b043-a51eab592d6b
+ */
diff --git a/guile/src/errors.h b/guile/src/errors.h
new file mode 100644
index 0000000000..c360899f34
--- /dev/null
+++ b/guile/src/errors.h
@@ -0,0 +1,31 @@
+/* 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  */
+
+#ifndef GUILE_GNUTLS_ERRORS_H
+#define GUILE_GNUTLS_ERRORS_H
+
+#include <libguile.h>
+
+#include "utils.h"
+
+SCM_API void scm_gnutls_error (int, const char *) NO_RETURN;
+SCM_API void scm_init_gnutls_error (void);
+
+#endif
+
+/* arch-tag: e7a92e44-b399-4c85-99d4-2dd3564600f7
+ */
diff --git a/guile/src/extra.c b/guile/src/extra.c
new file mode 100644
index 0000000000..440e6c3099
--- /dev/null
+++ b/guile/src/extra.c
@@ -0,0 +1,544 @@
+/* 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.  */
+
+/* Important note: As written above, this part of the code is ditributed
+   under the GPL, not the LGPL.  */
+
+/* Written by Ludovic Courtès <ludo@chbouib.org>.  */
+
+
+#include <stdio.h>
+#include <gnutls/gnutls.h>
+#include <gnutls/extra.h>
+#include <gnutls/openpgp.h>
+#include <libguile.h>
+
+#include <alloca.h>
+
+#include "errors.h"
+#include "utils.h"
+#include "smobs.h"
+#include "enums.h"
+#include "extra-enums.h"
+#include "extra-smobs.h"
+
+
+
+/* SMOB and enums type definitions.  */
+
+#include "extra-smob-types.i.c"
+#include "extra-enum-map.i.c"
+
+
+/* OpenPGP keys.  */
+
+
+/* Maximum size we support for the name of OpenPGP keys.  */
+#define GUILE_GNUTLS_MAX_OPENPGP_NAME_LENGTH  2048
+
+SCM_DEFINE (scm_gnutls_import_openpgp_public_key, "import-openpgp-public-key",
+	    2, 0, 0,
+	    (SCM data, SCM format),
+	    "Return a new OpenPGP public key object resulting from the "
+	    "import of @var{data} (a uniform array) according to "
+	    "@var{format}.")
+#define FUNC_NAME s_scm_gnutls_import_openpgp_public_key
+{
+  int err;
+  gnutls_openpgp_key_t c_key;
+  gnutls_openpgp_key_fmt c_format;
+  gnutls_datum_t c_data_d;
+  scm_t_array_handle c_data_handle;
+  const char *c_data;
+  size_t c_data_len;
+
+  SCM_VALIDATE_ARRAY (1, data);
+  c_format = scm_to_gnutls_openpgp_key_format (format, 2, FUNC_NAME);
+
+  c_data = scm_gnutls_get_array (data, &c_data_handle, &c_data_len,
+				 FUNC_NAME);
+  c_data_d.data = (unsigned char *) c_data;
+  c_data_d.size = c_data_len;
+
+  err = gnutls_openpgp_key_init (&c_key);
+  if (EXPECT_FALSE (err))
+    {
+      scm_gnutls_release_array (&c_data_handle);
+      scm_gnutls_error (err, FUNC_NAME);
+    }
+
+  err = gnutls_openpgp_key_import (c_key, &c_data_d, c_format);
+  scm_gnutls_release_array (&c_data_handle);
+
+  if (EXPECT_FALSE (err))
+    {
+      gnutls_openpgp_key_deinit (c_key);
+      scm_gnutls_error (err, FUNC_NAME);
+    }
+
+  return (scm_from_gnutls_openpgp_public_key (c_key));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_import_openpgp_private_key, "import-openpgp-private-key",
+	    2, 1, 0,
+	    (SCM data, SCM format, SCM pass),
+	    "Return a new OpenPGP private key object resulting from the "
+	    "import of @var{data} (a uniform array) according to "
+	    "@var{format}.  Optionally, a passphrase may be provided.")
+#define FUNC_NAME s_scm_gnutls_import_openpgp_private_key
+{
+  int err;
+  gnutls_openpgp_privkey_t c_key;
+  gnutls_openpgp_key_fmt c_format;
+  gnutls_datum_t c_data_d;
+  scm_t_array_handle c_data_handle;
+  const char *c_data;
+  char *c_pass;
+  size_t c_data_len, c_pass_len;
+
+  SCM_VALIDATE_ARRAY (1, data);
+  c_format = scm_to_gnutls_openpgp_key_format (format, 2, FUNC_NAME);
+  if ((pass == SCM_UNDEFINED) || (scm_is_false (pass)))
+    c_pass = NULL;
+  else
+    {
+      c_pass_len = scm_c_string_length (pass);
+      c_pass = (char *) alloca (c_pass_len + 1);
+      (void) scm_to_locale_stringbuf (pass, c_pass, c_pass_len + 1);
+      c_pass[c_pass_len] = '\0';
+    }
+
+  c_data = scm_gnutls_get_array (data, &c_data_handle, &c_data_len,
+				 FUNC_NAME);
+  c_data_d.data = (unsigned char *) c_data;
+  c_data_d.size = c_data_len;
+
+  err = gnutls_openpgp_privkey_init (&c_key);
+  if (EXPECT_FALSE (err))
+    {
+      scm_gnutls_release_array (&c_data_handle);
+      scm_gnutls_error (err, FUNC_NAME);
+    }
+
+  err = gnutls_openpgp_privkey_import (c_key, &c_data_d, c_format, c_pass,
+				       0 /* currently unused */);
+  scm_gnutls_release_array (&c_data_handle);
+
+  if (EXPECT_FALSE (err))
+    {
+      gnutls_openpgp_privkey_deinit (c_key);
+      scm_gnutls_error (err, FUNC_NAME);
+    }
+
+  return (scm_from_gnutls_openpgp_private_key (c_key));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_openpgp_public_key_id, "openpgp-public-key-id",
+	    1, 0, 0,
+	    (SCM key),
+	    "Return the ID (an 8-element u8vector) of public key "
+	    "@var{key}.")
+#define FUNC_NAME s_scm_gnutls_openpgp_public_key_id
+{
+  int err;
+  unsigned char *c_id;
+  gnutls_openpgp_key_t c_key;
+
+  c_key = scm_to_gnutls_openpgp_public_key (key, 1, FUNC_NAME);
+
+  c_id = (unsigned char * ) malloc (8);
+  if (c_id == NULL)
+    scm_gnutls_error (GNUTLS_E_MEMORY_ERROR, FUNC_NAME);
+
+  err = gnutls_openpgp_key_get_id (c_key, c_id);
+  if (EXPECT_FALSE (err))
+    scm_gnutls_error (err, FUNC_NAME);
+
+  return (scm_take_u8vector (c_id, 8));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_openpgp_public_key_id_x, "openpgp-public-key-id!",
+	    2, 0, 0,
+	    (SCM key, SCM id),
+	    "Store the ID (an 8 byte sequence) of public key "
+	    "@var{key} in @var{id} (a u8vector).")
+#define FUNC_NAME s_scm_gnutls_openpgp_public_key_id_x
+{
+  int err;
+  char *c_id;
+  scm_t_array_handle c_id_handle;
+  size_t c_id_size;
+  gnutls_openpgp_key_t c_key;
+
+  c_key = scm_to_gnutls_openpgp_public_key (key, 1, FUNC_NAME);
+  c_id = scm_gnutls_get_writable_array (id, &c_id_handle, &c_id_size,
+					FUNC_NAME);
+
+  if (EXPECT_FALSE (c_id_size < 8))
+    {
+      scm_gnutls_release_array (&c_id_handle);
+      scm_misc_error (FUNC_NAME, "ID vector too small: ~A",
+		      scm_list_1 (id));
+    }
+
+  err = gnutls_openpgp_key_get_id (c_key, (unsigned char *) c_id);
+  scm_gnutls_release_array (&c_id_handle);
+
+  if (EXPECT_FALSE (err))
+    scm_gnutls_error (err, FUNC_NAME);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_openpgp_public_key_fingerpint_x,
+	    "openpgp-public-key-fingerprint!",
+	    2, 0, 0,
+	    (SCM key, SCM fpr),
+	    "Store in @var{fpr} (a u8vector) the fingerprint of @var{key}.  "
+	    "Return the number of bytes stored in @var{fpr}.")
+#define FUNC_NAME s_scm_gnutls_openpgp_public_key_fingerpint_x
+{
+  int err;
+  gnutls_openpgp_key_t c_key;
+  char *c_fpr;
+  scm_t_array_handle c_fpr_handle;
+  size_t c_fpr_len, c_actual_len = 0;
+
+  c_key = scm_to_gnutls_openpgp_public_key (key, 1, FUNC_NAME);
+  SCM_VALIDATE_ARRAY (2, fpr);
+
+  c_fpr = scm_gnutls_get_writable_array (fpr, &c_fpr_handle, &c_fpr_len,
+					 FUNC_NAME);
+
+  err = gnutls_openpgp_key_get_fingerprint (c_key, c_fpr, &c_actual_len);
+  scm_gnutls_release_array (&c_fpr_handle);
+
+  if (EXPECT_FALSE (err))
+    scm_gnutls_error (err, FUNC_NAME);
+
+  return (scm_from_size_t (c_actual_len));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_openpgp_public_key_fingerprint,
+	    "openpgp-public-key-fingerprint",
+	    1, 0, 0,
+	    (SCM key),
+	    "Return a new u8vector denoting the fingerprint of "
+	    "@var{key}.")
+#define FUNC_NAME s_scm_gnutls_openpgp_public_key_fingerprint
+{
+  int err;
+  gnutls_openpgp_key_t c_key;
+  unsigned char *c_fpr;
+  size_t c_fpr_len, c_actual_len;
+
+  c_key = scm_to_gnutls_openpgp_public_key (key, 1, FUNC_NAME);
+
+  /* V4 fingerprints are 160-bit SHA-1 hashes (see RFC2440).  */
+  c_fpr_len = 20;
+  c_fpr = (unsigned char *) malloc (c_fpr_len);
+  if (EXPECT_FALSE (c_fpr == NULL))
+    scm_gnutls_error (GNUTLS_E_MEMORY_ERROR, FUNC_NAME);
+
+  do
+    {
+      c_actual_len = 0;
+      err = gnutls_openpgp_key_get_fingerprint (c_key, c_fpr,
+						&c_actual_len);
+      if (err == GNUTLS_E_SHORT_MEMORY_BUFFER)
+	{
+	  /* Grow C_FPR.  */
+	  unsigned char *c_new;
+
+	  c_new = (unsigned char *) realloc (c_fpr, c_fpr_len * 2);
+	  if (EXPECT_FALSE (c_new == NULL))
+	    {
+	      free (c_fpr);
+	      scm_gnutls_error (GNUTLS_E_MEMORY_ERROR, FUNC_NAME);
+	    }
+	  else
+	    {
+	      c_fpr_len *= 2;
+	      c_fpr = c_new;
+	    }
+	}
+    }
+  while (err == GNUTLS_E_SHORT_MEMORY_BUFFER);
+
+  if (EXPECT_FALSE (err))
+    {
+      free (c_fpr);
+      scm_gnutls_error (err, FUNC_NAME);
+    }
+
+  if (c_actual_len < c_fpr_len)
+    /* Shrink C_FPR.  */
+    c_fpr = realloc (c_fpr, c_actual_len);
+
+  return (scm_take_u8vector (c_fpr, c_actual_len));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_openpgp_public_key_name, "openpgp-public-key-name",
+	    2, 0, 0,
+	    (SCM key, SCM index),
+	    "Return the @var{index}th name of @var{key}.")
+#define FUNC_NAME s_scm_gnutls_openpgp_public_key_name
+{
+  int err;
+  gnutls_openpgp_key_t c_key;
+  int c_index;
+  char c_name[GUILE_GNUTLS_MAX_OPENPGP_NAME_LENGTH];
+  size_t c_name_len = sizeof (c_name);
+
+  c_key = scm_to_gnutls_openpgp_public_key (key, 1, FUNC_NAME);
+  c_index = scm_to_int (index);
+
+  err = gnutls_openpgp_key_get_name (c_key, c_index, c_name,
+				     &c_name_len);
+  if (EXPECT_FALSE (err))
+    scm_gnutls_error (err, FUNC_NAME);
+
+  /* XXX: The name is really UTF-8.  */
+  return (scm_from_locale_string (c_name));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_openpgp_public_key_names, "openpgp-public-key-names",
+	    1, 0, 0,
+	    (SCM key),
+	    "Return the list of names for @var{key}.")
+#define FUNC_NAME s_scm_gnutls_openpgp_public_key_names
+{
+  int err;
+  SCM result = SCM_EOL;
+  gnutls_openpgp_key_t c_key;
+  int c_index = 0;
+  char c_name[GUILE_GNUTLS_MAX_OPENPGP_NAME_LENGTH];
+  size_t c_name_len = sizeof (c_name);
+
+  c_key = scm_to_gnutls_openpgp_public_key (key, 1, FUNC_NAME);
+
+  do
+    {
+      err = gnutls_openpgp_key_get_name (c_key, c_index, c_name,
+					 &c_name_len);
+      if (!err)
+	{
+	  result = scm_cons (scm_from_locale_string (c_name),
+			     result);
+	  c_index++;
+	}
+    }
+  while (!err);
+
+  if (EXPECT_FALSE (err != GNUTLS_E_REQUESTED_DATA_NOT_AVAILABLE))
+    scm_gnutls_error (err, FUNC_NAME);
+
+  return (scm_reverse_x (result, SCM_EOL));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_openpgp_public_key_algorithm,
+	    "openpgp-public-key-algorithm",
+	    1, 0, 0,
+	    (SCM key),
+	    "Return two values: the public key algorithm used by "
+	    "@var{key} and the number of bits used.")
+#define FUNC_NAME s_scm_gnutls_openpgp_public_key_algorithm
+{
+  gnutls_openpgp_key_t c_key;
+  unsigned int c_bits;
+  gnutls_pk_algorithm_t c_algo;
+
+  c_key = scm_to_gnutls_openpgp_public_key (key, 1, FUNC_NAME);
+  c_algo = gnutls_openpgp_key_get_pk_algorithm (c_key, &c_bits);
+
+  return (scm_values (scm_list_2 (scm_from_gnutls_pk_algorithm (c_algo),
+				  scm_from_uint (c_bits))));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_openpgp_public_key_version,
+	    "openpgp-public-key-version",
+	    1, 0, 0,
+	    (SCM key),
+	    "Return the version of the OpenPGP message format (RFC2440) "
+	    "honored by @var{key}.")
+#define FUNC_NAME s_scm_gnutls_openpgp_public_key_version
+{
+  int c_version;
+  gnutls_openpgp_key_t c_key;
+
+  c_key = scm_to_gnutls_openpgp_public_key (key, 1, FUNC_NAME);
+  c_version = gnutls_openpgp_key_get_version (c_key);
+
+  return (scm_from_int (c_version));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_openpgp_public_key_usage, "openpgp-public-key-usage",
+	    1, 0, 0,
+	    (SCM key),
+	    "Return a list of values denoting the key usage of @var{key}.")
+#define FUNC_NAME s_scm_gnutls_openpgp_public_key_usage
+{
+  int err;
+  unsigned int c_usage = 0;
+  gnutls_openpgp_key_t c_key;
+
+  c_key = scm_to_gnutls_openpgp_public_key (key, 1, FUNC_NAME);
+
+  err = gnutls_openpgp_key_get_key_usage (c_key, &c_usage);
+  if (EXPECT_FALSE (err))
+    scm_gnutls_error (err, FUNC_NAME);
+
+  return (scm_from_gnutls_key_usage_flags (c_usage));
+}
+#undef FUNC_NAME
+
+
+
+/* OpenPGP keyrings.  */
+
+SCM_DEFINE (scm_gnutls_import_openpgp_keyring, "import-openpgp-keyring",
+	    2, 0, 0,
+	    (SCM data, SCM format),
+	    "Import @var{data} (a u8vector) according to @var{format} "
+	    "and return the imported keyring.")
+#define FUNC_NAME s_scm_gnutls_import_openpgp_keyring
+{
+  int err;
+  gnutls_openpgp_keyring_t c_keyring;
+  gnutls_openpgp_key_fmt c_format;
+  gnutls_datum_t c_data_d;
+  scm_t_array_handle c_data_handle;
+  const char *c_data;
+  size_t c_data_len;
+
+  SCM_VALIDATE_ARRAY (1, data);
+  c_format = scm_to_gnutls_openpgp_key_format (format, 2, FUNC_NAME);
+
+  c_data = scm_gnutls_get_array (data, &c_data_handle, &c_data_len,
+				 FUNC_NAME);
+
+  c_data_d.data = (unsigned char *) c_data;
+  c_data_d.size = c_data_len;
+
+  err = gnutls_openpgp_keyring_init (&c_keyring);
+  if (EXPECT_FALSE (err))
+    {
+      scm_gnutls_release_array (&c_data_handle);
+      scm_gnutls_error (err, FUNC_NAME);
+    }
+
+  err = gnutls_openpgp_keyring_import (c_keyring, &c_data_d, c_format);
+  scm_gnutls_release_array (&c_data_handle);
+
+  if (EXPECT_FALSE (err))
+    {
+      gnutls_openpgp_keyring_deinit (c_keyring);
+      scm_gnutls_error (err, FUNC_NAME);
+    }
+
+  return (scm_from_gnutls_openpgp_keyring (c_keyring));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_openpgp_keyring_contains_key_id_p,
+	    "openpgp-keyring-contains-key-id?",
+	    2, 0, 0,
+	    (SCM keyring, SCM id),
+	    "Return @code{#f} if key ID @var{id} is in @var{keyring}, "
+	    "@code{#f} otherwise.")
+#define FUNC_NAME s_scm_gnutls_openpgp_keyring_contains_key_id_p
+{
+  int c_result;
+  gnutls_openpgp_keyring_t c_keyring;
+  scm_t_array_handle c_id_handle;
+  const char *c_id;
+  size_t c_id_len;
+
+  c_keyring = scm_to_gnutls_openpgp_keyring (keyring, 1, FUNC_NAME);
+  SCM_VALIDATE_ARRAY (1, id);
+
+  c_id = scm_gnutls_get_array (id, &c_id_handle, &c_id_len,
+			       FUNC_NAME);
+  if (EXPECT_FALSE (c_id_len != 8))
+    {
+      scm_gnutls_release_array (&c_id_handle);
+      scm_wrong_type_arg (FUNC_NAME, 1, id);
+    }
+
+  c_result = gnutls_openpgp_keyring_check_id (c_keyring,
+					      (unsigned char *) c_id,
+					      0 /* unused */);
+
+  scm_gnutls_release_array (&c_id_handle);
+
+  return (scm_from_bool (c_result == 0));
+}
+#undef FUNC_NAME
+
+
+/* Certificates.  */
+
+SCM_DEFINE (scm_gnutls_set_certificate_credentials_openpgp_keys_x,
+	    "set-certificate-credentials-openpgp-keys!",
+	    3, 0, 0,
+	    (SCM cred, SCM pub, SCM sec),
+	    "Use public key @var{pub} and secret key @var{sec} in "
+	    "certificate credentials @var{cred}.")
+#define FUNC_NAME s_scm_gnutls_set_certificate_credentials_openpgp_keys_x
+{
+  int err;
+  gnutls_certificate_credentials_t c_cred;
+  gnutls_openpgp_key_t c_pub;
+  gnutls_openpgp_privkey_t c_sec;
+
+  c_cred = scm_to_gnutls_certificate_credentials (cred, 1, FUNC_NAME);
+  c_pub = scm_to_gnutls_openpgp_public_key (pub, 2, FUNC_NAME);
+  c_sec = scm_to_gnutls_openpgp_private_key (sec, 3, FUNC_NAME);
+
+  err = gnutls_certificate_set_openpgp_key (c_cred, c_pub, c_sec);
+  if (EXPECT_FALSE (err))
+    scm_gnutls_error (err, FUNC_NAME);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+
+/* Initialization.  */
+
+void
+scm_init_gnutls_extra (void)
+{
+#include "extra.c.x"
+
+  (void) gnutls_global_init_extra ();
+
+  scm_gnutls_define_enums ();
+}
+
+/* arch-tag: 655f308d-5643-4bc7-9db4-1f84bd902bef
+ */
diff --git a/guile/src/make-enum-header.scm b/guile/src/make-enum-header.scm
new file mode 100644
index 0000000000..d7e7aeede8
--- /dev/null
+++ b/guile/src/make-enum-header.scm
@@ -0,0 +1,66 @@
+;;; Help produce Guile wrappers for GnuTLS types.
+;;;
+;;; 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>.
+
+
+(use-modules (gnutls build enums))
+
+
+;;;
+;;; The program.
+;;;
+
+(define (main . args)
+  (define extra? (not (null? args)))
+
+  (let ((port (current-output-port))
+        (enums (if (not extra?)
+                   %gnutls-enums
+                   %gnutls-extra-enums)))
+    (format port "/* Automatically generated, do not edit.  */~%~%")
+    (format port "#ifndef GUILE_GNUTLS_~aENUMS_H~%"
+            (if extra? "EXTRA_" ""))
+    (format port "#define GUILE_GNUTLS_~aENUMS_H~%"
+            (if extra? "EXTRA_" ""))
+
+    (format port "#include \"config.h\"~%")
+    (format port "#include <gnutls/gnutls.h>~%")
+    (format port "#include <gnutls/x509.h>~%")
+
+    (if extra?
+        (begin
+          (format port "#include <gnutls/extra.h>~%")
+          (format port "#include <gnutls/openpgp.h>~%")))
+
+    (for-each (lambda (enum)
+                (output-enum-declarations enum port)
+                (output-enum->c-converter enum port)
+                (output-c->enum-converter enum port))
+              enums)
+    (format port "#endif~%")))
+
+(apply main (cdr (command-line)))
+
+;;; Local Variables:
+;;; mode: scheme
+;;; coding: latin-1
+;;; End:
+
+;;; arch-tag: 07d834ca-e823-4663-9143-6d22704fbb5b
diff --git a/guile/src/make-enum-map.scm b/guile/src/make-enum-map.scm
new file mode 100644
index 0000000000..27c8d6f9ce
--- /dev/null
+++ b/guile/src/make-enum-map.scm
@@ -0,0 +1,47 @@
+;;; Help produce Guile wrappers for GnuTLS types.
+;;;
+;;; 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>.
+
+
+(use-modules (gnutls build enums))
+
+
+;;;
+;;; The program.
+;;;
+
+(define (main . args)
+  (let ((port (current-output-port))
+        (enums (if (null? args)
+                   %gnutls-enums
+                   %gnutls-extra-enums)))
+    (for-each (lambda (enum)
+                (output-enum-smob-definitions enum port))
+              enums)
+    (output-enum-definition-function enums port)))
+
+(apply main (cdr (command-line)))
+
+;;; Local Variables:
+;;; mode: scheme
+;;; coding: latin-1
+;;; End:
+
+;;; arch-tag: 3deb7d3a-005d-4f83-a72a-7382ef1e74a0
diff --git a/guile/src/make-session-priorities.scm b/guile/src/make-session-priorities.scm
new file mode 100644
index 0000000000..059254b5f9
--- /dev/null
+++ b/guile/src/make-session-priorities.scm
@@ -0,0 +1,43 @@
+;;; Help produce Guile wrappers for GnuTLS types.
+;;;
+;;; 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>.
+
+
+(use-modules (gnutls build priorities))
+
+
+;;;
+;;; The program.
+;;;
+
+(define (main . args)
+  (let ((port (current-output-port)))
+    (for-each (lambda (priority)
+                (output-session-set-priority-function priority port))
+              %gnutls-priorities)))
+
+(main)
+
+;;; Local Variables:
+;;; mode: scheme
+;;; coding: latin-1
+;;; End:
+
+;;; arch-tag: 026228de-e6d6-421b-bf2f-aaf9630d6b73
diff --git a/guile/src/make-smob-header.scm b/guile/src/make-smob-header.scm
new file mode 100644
index 0000000000..64a2b67fac
--- /dev/null
+++ b/guile/src/make-smob-header.scm
@@ -0,0 +1,56 @@
+;;; Help produce Guile wrappers for GnuTLS types.
+;;;
+;;; 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>.
+
+
+(use-modules (gnutls build smobs))
+
+
+;;;
+;;; The program.
+;;;
+
+(define (main . args)
+  (define extra? (not (null? args)))
+
+  (let ((port (current-output-port))
+        (enums (if (not extra?)
+                   %gnutls-smobs
+                   %gnutls-extra-smobs)))
+    (format port "/* Automatically generated, do not edit.  */~%~%")
+    (format port "#ifndef GUILE_GNUTLS_~aSMOBS_H~%"
+            (if extra? "EXTRA_" ""))
+    (format port "#define GUILE_GNUTLS_~aSMOBS_H~%"
+            (if extra? "EXTRA_" ""))
+    (for-each (lambda (type)
+                (output-smob-type-declaration type port)
+                (output-c->smob-converter type port)
+                (output-smob->c-converter type port))
+              enums)
+    (format port "#endif~%")))
+
+(apply main (cdr (command-line)))
+
+;;; Local Variables:
+;;; mode: scheme
+;;; coding: latin-1
+;;; End:
+
+;;; arch-tag: 7ae9c82f-a423-4251-9a58-6e2581267567
diff --git a/guile/src/make-smob-types.scm b/guile/src/make-smob-types.scm
new file mode 100644
index 0000000000..71a0c4347f
--- /dev/null
+++ b/guile/src/make-smob-types.scm
@@ -0,0 +1,46 @@
+;;; Help produce Guile wrappers for GnuTLS types.
+;;;
+;;; 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>.
+
+
+(use-modules (gnutls build smobs))
+
+
+;;;
+;;; The program.
+;;;
+
+(define (main . args)
+  (let ((port (current-output-port)))
+    (for-each (lambda (type)
+                (output-smob-type-definition type port)
+                (output-smob-type-predicate type port))
+              (if (null? args)
+                  %gnutls-smobs
+                  %gnutls-extra-smobs))))
+
+(apply main (cdr (command-line)))
+
+;;; Local Variables:
+;;; mode: scheme
+;;; coding: latin-1
+;;; End:
+
+;;; arch-tag: 364811a0-6d0a-431a-ae50-d2f7dc529903
diff --git a/guile/src/utils.c b/guile/src/utils.c
new file mode 100644
index 0000000000..b388e06ff4
--- /dev/null
+++ b/guile/src/utils.c
@@ -0,0 +1,65 @@
+/* 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>.  */
+
+#include "utils.h"
+
+#include <gnutls/gnutls.h>
+#include <libguile.h>
+
+#include <alloca.h>
+
+#include "enums.h"
+#include "errors.h"
+
+SCM
+scm_from_gnutls_key_usage_flags (unsigned int c_usage)
+{
+  SCM usage = SCM_EOL;
+
+#define MATCH_USAGE(_value)					\
+  if (c_usage & (_value))					\
+    {								\
+      usage = scm_cons (scm_from_gnutls_key_usage (_value),	\
+			usage);					\
+      c_usage &= ~(_value);					\
+    }
+
+  /* when the key is to be used for signing: */
+  MATCH_USAGE (GNUTLS_KEY_DIGITAL_SIGNATURE);
+  MATCH_USAGE (GNUTLS_KEY_NON_REPUDIATION);
+  /* when the key is to be used for encryption: */
+  MATCH_USAGE (GNUTLS_KEY_KEY_ENCIPHERMENT);
+  MATCH_USAGE (GNUTLS_KEY_DATA_ENCIPHERMENT);
+  MATCH_USAGE (GNUTLS_KEY_KEY_AGREEMENT);
+  MATCH_USAGE (GNUTLS_KEY_KEY_CERT_SIGN);
+  MATCH_USAGE (GNUTLS_KEY_CRL_SIGN);
+  MATCH_USAGE (GNUTLS_KEY_ENCIPHER_ONLY);
+  MATCH_USAGE (GNUTLS_KEY_DECIPHER_ONLY);
+
+  if (EXPECT_FALSE (c_usage != 0))
+    /* XXX: We failed to interpret one of the usage flags.  */
+    scm_gnutls_error (GNUTLS_E_UNIMPLEMENTED_FEATURE, __FUNCTION__);
+
+#undef MATCH_USAGE
+
+  return usage;
+}
+
+/* arch-tag: a55fe230-ead7-495d-ab11-dfe18452ca2a
+ */
diff --git a/guile/src/utils.h b/guile/src/utils.h
new file mode 100644
index 0000000000..8a30ff5987
--- /dev/null
+++ b/guile/src/utils.h
@@ -0,0 +1,118 @@
+/* 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  */
+
+#ifndef GUILE_GNUTLS_UTILS_H
+#define GUILE_GNUTLS_UTILS_H
+
+/* Common utilities.  */
+
+#include "config.h"
+#include <libguile.h>
+
+
+/* Compiler twiddling.  */
+
+#ifdef __GNUC__
+# define EXPECT    __builtin_expect
+# define NO_RETURN __attribute__ ((__noreturn__))
+#else
+# define EXPECT(_expr, _value) (_expr)
+# define NO_RETURN
+#endif
+
+#define EXPECT_TRUE(_expr)  EXPECT ((_expr), 1)
+#define EXPECT_FALSE(_expr) EXPECT ((_expr), 0)
+
+
+/* Arrays as byte vectors.  */
+
+extern const char scm_gnutls_array_error_message[];
+
+/* Initialize C_HANDLE and C_LEN and return the contiguous C array
+   corresponding to ARRAY.  */
+static inline const char *
+scm_gnutls_get_array (SCM array, scm_t_array_handle *c_handle, size_t *c_len,
+		      const char *func_name)
+{
+  const char *c_array = NULL;
+  const scm_t_array_dim *c_dims;
+
+  scm_array_get_handle (array, c_handle);
+  c_dims = scm_array_handle_dims (c_handle);
+  if ((scm_array_handle_rank (c_handle) != 1) || (c_dims->inc != 1))
+    {
+      scm_array_handle_release (c_handle);
+      scm_misc_error (func_name, scm_gnutls_array_error_message,
+		      scm_list_1 (array));
+    }
+  else
+    {
+      size_t c_elem_size;
+
+      c_elem_size = scm_array_handle_uniform_element_size (c_handle);
+      *c_len = c_elem_size * (c_dims->ubnd - c_dims->lbnd + 1);
+
+      c_array = (char *) scm_array_handle_uniform_elements (c_handle);
+    }
+
+  return (c_array);
+}
+
+/* Initialize C_HANDLE and C_LEN and return the contiguous C array
+   corresponding to ARRAY.  The returned array can be written to.  */
+static inline char *
+scm_gnutls_get_writable_array (SCM array, scm_t_array_handle *c_handle,
+			       size_t *c_len,
+			       const char *func_name)
+{
+  char *c_array = NULL;
+  const scm_t_array_dim *c_dims;
+
+  scm_array_get_handle (array, c_handle);
+  c_dims = scm_array_handle_dims (c_handle);
+  if ((scm_array_handle_rank (c_handle) != 1) || (c_dims->inc != 1))
+    {
+      scm_array_handle_release (c_handle);
+      scm_misc_error (func_name, scm_gnutls_array_error_message,
+		      scm_list_1 (array));
+    }
+  else
+    {
+      size_t c_elem_size;
+
+      c_elem_size = scm_array_handle_uniform_element_size (c_handle);
+      *c_len = c_elem_size * (c_dims->ubnd - c_dims->lbnd + 1);
+
+      c_array = (char *) scm_array_handle_uniform_writable_elements (c_handle);
+    }
+
+  return (c_array);
+}
+
+#define scm_gnutls_release_array  scm_array_handle_release
+
+
+
+/* Type conversion.  */
+
+/* Return a list corresponding to the key usage values ORed in C_USAGE.  */
+SCM_API SCM scm_from_gnutls_key_usage_flags (unsigned int c_usage);
+
+#endif
+
+/* arch-tag: a33400bc-b5e3-429e-80e0-6ff14cab79e7
+ */
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-----