Started Guile integration.

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

10 files changed, 1833 insertions, 0 deletions

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