[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[SCM] GNU gnutls branch, master, updated. gnutls_3_0_5-26-g6e47f60
|
From: |
Ludovic Courtès |
|
Subject: |
[SCM] GNU gnutls branch, master, updated. gnutls_3_0_5-26-g6e47f60 |
|
Date: |
Thu, 03 Nov 2011 23:36:31 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU gnutls".
http://git.savannah.gnu.org/cgit/gnutls.git/commit/?id=6e47f6043aa7c25055e43b2a9d5322db63604d52
The branch, master has been updated
via 6e47f6043aa7c25055e43b2a9d5322db63604d52 (commit)
via 9d31ac4504a6cbaa1cf701efed301961f4ad5359 (commit)
via 76da5a03009ed11ecf255178a6184bef3cbb35ea (commit)
via 0e655812ba68e9acf28970eccced65b6f870e770 (commit)
via 30ac29b1ab63363367fca586373373d95f8eb15e (commit)
via 996accb26da18b07e115ed62da1683768abcc3c8 (commit)
via 92e8e071d322b9822167390546115e9b20b84fb9 (commit)
via 6fc13e2285a988b97764a8ea080961d80a603310 (commit)
from 10cbbd52fba11ce69cd69641c7b4a176e673d23e (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 6e47f6043aa7c25055e43b2a9d5322db63604d52
Author: Ludovic Courtès <address@hidden>
Date: Fri Nov 4 00:35:33 2011 +0100
guile: Rename `libguile-gnutls-v-2.la' to `guile-gnutls-v-2.la'.
commit 9d31ac4504a6cbaa1cf701efed301961f4ad5359
Author: Ludovic Courtès <address@hidden>
Date: Fri Nov 4 00:27:19 2011 +0100
guile: Install libguile-gnutls under $(libdir)/guile/X.Y.
commit 76da5a03009ed11ecf255178a6184bef3cbb35ea
Author: Ludovic Courtès <address@hidden>
Date: Thu Nov 3 23:57:49 2011 +0100
guile: Rename to `libguile-gnutls-v-2'.
commit 0e655812ba68e9acf28970eccced65b6f870e770
Author: Ludovic Courtès <address@hidden>
Date: Thu Nov 3 23:54:21 2011 +0100
doc: Make it clear that both Guile 1.8 and 2.0 are supported.
commit 30ac29b1ab63363367fca586373373d95f8eb15e
Author: Ludovic Courtès <address@hidden>
Date: Thu Nov 3 23:50:34 2011 +0100
guile: Update doc to reflect the removal of (gnutls extra).
commit 996accb26da18b07e115ed62da1683768abcc3c8
Author: Ludovic Courtès <address@hidden>
Date: Thu Nov 3 23:45:41 2011 +0100
guile: Remove uses of (gnutls extra) from the tests.
commit 92e8e071d322b9822167390546115e9b20b84fb9
Author: Ludovic Courtès <address@hidden>
Date: Thu Nov 3 23:58:19 2011 +0100
guile: Merge the (gnutls extra) module in (gnutls); deprecate it.
commit 6fc13e2285a988b97764a8ea080961d80a603310
Author: Ludovic Courtès <address@hidden>
Date: Thu Nov 3 23:25:08 2011 +0100
Reverting "Drop guile libgnutls-extra stuff."
-----------------------------------------------------------------------
Summary of changes:
.gitignore | 1 +
configure.ac | 7 +
doc/Makefile.am | 14 +-
doc/gnutls-guile.texi | 57 +---
guile/modules/Makefile.am | 11 +-
guile/modules/{gnutls.scm => gnutls.in} | 34 ++-
guile/modules/gnutls/build/enums.scm | 8 +-
guile/modules/gnutls/build/smobs.scm | 10 +-
guile/modules/gnutls/extra.scm | 15 +-
guile/pre-inst-guile.in | 5 +-
guile/src/Makefile.am | 13 +-
guile/src/core.c | 490 +++++++++++++++++++++++++++
guile/src/extra.c | 550 -------------------------------
guile/src/make-enum-header.scm | 19 +-
guile/src/make-enum-map.scm | 6 +-
guile/src/make-smob-header.scm | 14 +-
guile/src/make-smob-types.scm | 6 +-
guile/tests/openpgp-auth.scm | 1 -
guile/tests/openpgp-keyring.scm | 2 +-
guile/tests/openpgp-keys.scm | 1 -
20 files changed, 598 insertions(+), 666 deletions(-)
rename guile/modules/{gnutls.scm => gnutls.in} (92%)
delete mode 100644 guile/src/extra.c
diff --git a/.gitignore b/.gitignore
index b080bde..56873f6 100644
--- a/.gitignore
+++ b/.gitignore
@@ -300,6 +300,7 @@ guile/Makefile
guile/Makefile.in
guile/modules/Makefile
guile/modules/Makefile.in
+guile/modules/gnutls.scm
guile/src/Makefile
guile/src/Makefile.in
guile/src/libguile-gnutls-extra-v-1.la
diff --git a/configure.ac b/configure.ac
index ddc5bc8..2a55de5 100644
--- a/configure.ac
+++ b/configure.ac
@@ -377,6 +377,13 @@ if test "$opt_guile_bindings" = "yes"; then
AC_CHECK_FUNCS([scm_gc_malloc_pointerless])
CFLAGS="$save_CFLAGS"
LIBS="$save_LIBS"
+
+ # The place where guile-gnutls.la will go.
+ AC_MSG_CHECKING([the Guile effective version])
+ guile_effective_version="`$GUILE -c '(display (effective-version))'`"
+ AC_MSG_RESULT([$guile_effective_version])
+ guileextensiondir="$libdir/guile/$guile_effective_version"
+ AC_SUBST([guileextensiondir])
else
AC_MSG_RESULT([no])
AC_MSG_WARN([A sufficiently recent GNU Guile not found. Guile
bindings not built.])
diff --git a/doc/Makefile.am b/doc/Makefile.am
index 65027a1..2619eb8 100644
--- a/doc/Makefile.am
+++ b/doc/Makefile.am
@@ -170,7 +170,7 @@ enums.texi: $(srcdir)/../lib/includes/gnutls/*.h
# Guile texinfos.
-guile_texi = core.c.texi extra.c.texi
+guile_texi = core.c.texi
BUILT_SOURCES = $(guile_texi)
MAINTAINERCLEANFILES += $(guile_texi)
EXTRA_DIST += $(guile_texi) extract-guile-c-doc.scm
@@ -195,23 +195,11 @@ core.c.texi: $(top_srcdir)/guile/src/core.c
-- "$^" "$(CPP)" "$(SNARF_CPPFLAGS) $(CPPFLAGS)" \
> "$@"
-extra.c.texi: $(top_srcdir)/guile/src/extra.c
- $(MAKE) -C ../guile/src built-sources && \
- $(GUILE_FOR_BUILD) -l "$(srcdir)/extract-guile-c-doc.scm" \
- -e '(apply main (cdr (command-line)))' \
- -- "$^" "$(CPP)" "$(SNARF_CPPFLAGS) $(CPPFLAGS)" \
- > "$@"
-
-
else !HAVE_GUILE
core.c.texi:
echo "(Guile not available, documentation not generated.)" > $@
-extra.c.texi:
- echo "(Guile not available, documentation not generated.)" > $@
-
-
endif !HAVE_GUILE
clean-am:
diff --git a/doc/gnutls-guile.texi b/doc/gnutls-guile.texi
index 915aa97..eff631c 100644
--- a/doc/gnutls-guile.texi
+++ b/doc/gnutls-guile.texi
@@ -83,11 +83,13 @@ a large subset thereof is available.
@node Guile Preparations
@chapter Guile Preparations
-The GnuTLS Guile bindings are by default installed under the GnuTLS
-installation directory (e.g., typically
address@hidden/usr/local/share/guile/site/}). Normally Guile will not find
-the module there without help. You may experience something like
-this:
+The GnuTLS Guile bindings are available for both the 1.8 and 2.0 stable
+series of Guile.
+
+By default they are installed under the GnuTLS installation directory,
+typically @file{/usr/local/share/guile/site/}). Normally Guile
+will not find the module there without help. You may experience
+something like this:
@example
$ guile
@@ -196,7 +198,7 @@ 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
address@hidden(gnutls)} and @code{(gnutls extra)} modules. These variables
address@hidden(gnutls)} module. These variables
are named according to the following convention:
@itemize
@@ -532,8 +534,7 @@ This is it!
@node OpenPGP Authentication Guile Example
@section OpenPGP Authentication Guile Example
-GnuTLS allows users to authenticate using OpenPGP certificates. The
-relevant procedures are provided by the @code{(gnutls extra)} module.
+GnuTLS allows users to authenticate using OpenPGP certificates.
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
@@ -603,7 +604,8 @@ Similarly, server-side code would be along these lines:
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}}).
+store them in a file for future re-use (@pxref{Guile Reference,
address@hidden and @code{pkcs1-import-rsa-parameters}}).
@node Importing OpenPGP Keys Guile Example
@section Importing OpenPGP Keys Guile Example
@@ -611,14 +613,14 @@ store them in a file for future re-use (@pxref{Core
Interface, @code{pkcs1-expor
The following example provides a simple way of importing
``ASCII-armored'' OpenPGP keys from files, using the
@code{import-openpgp-certificate} and @code{import-openpgp-private-key}
-procedures provided by the @code{(gnutls extra)} module.
+procedures.
@vindex openpgp-certificate-format/base64
@vindex openpgp-certificate-format/raw
@example
(use-modules (srfi srfi-4)
- (gnutls extra))
+ (gnutls))
(define (import-key-from-file import-proc file)
;; Import OpenPGP key from FILE using IMPORT-PROC.
@@ -645,46 +647,19 @@ procedures provided by the @code{(gnutls extra)} module.
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}).
+(@pxref{Guile Reference, OpenPGP key objects}).
@c *********************************************************************
@node Guile Reference
@chapter Guile Reference
-This chapter documents GnuTLS Scheme procedures available to Guile
-programmers.
-
address@hidden
-* Core Interface:: Bindings for core GnuTLS.
-* Extra Interface:: Bindings for GnuTLS-Extra.
address@hidden menu
-
address@hidden Core Interface
address@hidden Core Interface
-
-This section lists the Scheme procedures exported by the
+This chapter lists the GnuTLS 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.
+GNU Guile Reference Manual}).
@include core.c.texi
address@hidden Extra Interface
address@hidden 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 3 or later.
-
address@hidden extra.c.texi
-
-
-
address@hidden
-;;; arch-tag: ee5f2081-9153-48fc-b4ee-2024381c65d7
address@hidden ignore
-
@c Local Variables:
@c ispell-local-dictionary: "american"
@c End:
diff --git a/guile/modules/Makefile.am b/guile/modules/Makefile.am
index d1b1cac..ebe1d6e 100644
--- a/guile/modules/Makefile.am
+++ b/guile/modules/Makefile.am
@@ -17,7 +17,8 @@
guilemoduledir = $(GUILE_SITE)
-nobase_dist_guilemodule_DATA = gnutls.scm gnutls/extra.scm
+nobase_nodist_guilemodule_DATA = gnutls.scm
+nobase_dist_guilemodule_DATA = gnutls/extra.scm
documentation_modules = system/documentation/README \
system/documentation/c-snarf.scm \
@@ -26,4 +27,12 @@ documentation_modules = system/documentation/README
\
EXTRA_DIST = gnutls/build/enums.scm gnutls/build/smobs.scm \
gnutls/build/utils.scm gnutls/build/priorities.scm \
gnutls/build/tests.scm \
+ gnutls.in \
$(documentation_modules)
+
+CLEANFILES = gnutls.scm
+
+.in.scm:
+ cat "$^" | $(SED) -e's|address@hidden@]|$(guileextensiondir)|g' \
+ > "address@hidden"
+ mv "address@hidden" "$@"
diff --git a/guile/modules/gnutls.scm b/guile/modules/gnutls.in
similarity index 92%
rename from guile/modules/gnutls.scm
rename to guile/modules/gnutls.in
index cecc3fd..56e3137 100644
--- a/guile/modules/gnutls.scm
+++ b/guile/modules/gnutls.in
@@ -15,7 +15,7 @@
;;; 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 <address@hidden>
+;;; Written by Ludovic Courtès <address@hidden>
(define-module (gnutls)
;; Note: The export list must be manually kept in sync with the build
@@ -357,9 +357,37 @@
error/openpgp-keyring-error
error/x509-unsupported-oid
error/random-failed
- error/unimplemented-feature))
+ error/unimplemented-feature
-(load-extension "libguile-gnutls-v-1" "scm_init_gnutls")
+ ;; OpenPGP keys (formerly in GnuTLS-extra)
+ openpgp-certificate? openpgp-private-key?
+ import-openpgp-certificate import-openpgp-private-key
+ openpgp-certificate-id openpgp-certificate-id!
+ openpgp-certificate-fingerprint openpgp-certificate-fingerprint!
+ openpgp-certificate-name openpgp-certificate-names
+ openpgp-certificate-algorithm openpgp-certificate-version
+ openpgp-certificate-usage
+
+ ;; OpenPGP keyrings
+ openpgp-keyring? import-openpgp-keyring
+ openpgp-keyring-contains-key-id?
+
+ ;; certificate credentials
+ set-certificate-credentials-openpgp-keys!
+
+ ;; enum->string functions
+ openpgp-certificate-format->string
+
+ ;; enum values
+ openpgp-certificate-format/raw
+ openpgp-certificate-format/base64))
+
+(define %libdir
+ (or (getenv "GNUTLS_GUILE_EXTENSION_DIR")
+ "@guileextensiondir@"))
+
+(load-extension (string-append %libdir "/guile-gnutls-v-2")
+ "scm_init_gnutls")
;; Renaming.
(define protocol/ssl-3 protocol/ssl3)
diff --git a/guile/modules/gnutls/build/enums.scm
b/guile/modules/gnutls/build/enums.scm
index c170a64..5277646 100644
--- a/guile/modules/gnutls/build/enums.scm
+++ b/guile/modules/gnutls/build/enums.scm
@@ -36,7 +36,7 @@
%cipher-enum %mac-enum %compression-method-enum %kx-enum
%protocol-enum %certificate-type-enum
- %gnutls-enums %gnutls-extra-enums))
+ %gnutls-enums))
;;;
;;; This module helps with the creation of bindings for the C enumerate
@@ -579,11 +579,9 @@ unimplemented-feature)
%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))
+ %error-enum
-(define %gnutls-extra-enums
- ;; All enums for GnuTLS-extra (GPL).
- (list %openpgp-certificate-format-enum))
+ %openpgp-certificate-format-enum))
;;; Local Variables:
;;; mode: scheme
diff --git a/guile/modules/gnutls/build/smobs.scm
b/guile/modules/gnutls/build/smobs.scm
index f20e223..8df455a 100644
--- a/guile/modules/gnutls/build/smobs.scm
+++ b/guile/modules/gnutls/build/smobs.scm
@@ -1,7 +1,7 @@
;;; Help produce Guile wrappers for GnuTLS types.
;;;
;;; GnuTLS --- Guile bindings for GnuTLS.
-;;; Copyright (C) 2007, 2010 Free Software Foundation, Inc.
+;;; Copyright (C) 2007, 2010, 2011 Free Software Foundation, Inc.
;;;
;;; GnuTLS is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public
@@ -31,7 +31,7 @@
output-smob-type-predicate
output-c->smob-converter output-smob->c-converter
- %gnutls-smobs %gnutls-extra-smobs))
+ %gnutls-smobs))
;;;
@@ -222,11 +222,9 @@
%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))
+ %x509-certificate-smob %x509-private-key-smob
-(define %gnutls-extra-smobs
- ;; All SMOB types for GnuTLS-extra (GPL).
- (list %openpgp-certificate-smob %openpgp-private-key-smob
+ %openpgp-certificate-smob %openpgp-private-key-smob
%openpgp-keyring-smob))
diff --git a/guile/modules/gnutls/extra.scm b/guile/modules/gnutls/extra.scm
index b47f490..be8f7bb 100644
--- a/guile/modules/gnutls/extra.scm
+++ b/guile/modules/gnutls/extra.scm
@@ -1,5 +1,5 @@
;;; GnuTLS-extra --- Guile bindings for GnuTLS-EXTRA.
-;;; Copyright (C) 2007, 2010 Free Software Foundation, Inc.
+;;; Copyright (C) 2007, 2010, 2011 Free Software Foundation, Inc.
;;;
;;; 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
@@ -20,12 +20,9 @@
(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
+ :re-export (;; OpenPGP keys
openpgp-certificate? openpgp-private-key?
import-openpgp-certificate import-openpgp-private-key
openpgp-certificate-id openpgp-certificate-id!
@@ -49,7 +46,13 @@
openpgp-certificate-format/base64))
-(load-extension "libguile-gnutls-extra-v-1" "scm_init_gnutls_extra")
+
+;;;
+;;; This module will be removed in a future version.
+;;;
+
+(issue-deprecation-warning
+ "The (gnutls extra) module is deprecated; use (gnutls) instead")
;;;
diff --git a/guile/pre-inst-guile.in b/guile/pre-inst-guile.in
index 078597c..12789d7 100644
--- a/guile/pre-inst-guile.in
+++ b/guile/pre-inst-guile.in
@@ -23,6 +23,9 @@
GUILE_LOAD_PATH="@abs_top_srcdir@/guile/modules:$GUILE_LOAD_PATH"
export GUILE_LOAD_PATH
+GNUTLS_GUILE_EXTENSION_DIR="@abs_top_srcdir@/guile/src"
+export GNUTLS_GUILE_EXTENSION_DIR
+
exec @abs_top_builddir@/libtool --mode=execute \
- -dlopen "@abs_top_builddir@/guile/src/libguile-gnutls-v-1.la" \
+ -dlopen "@abs_top_builddir@/guile/src/guile-gnutls-v-2.la" \
@GUILE@ "$@"
diff --git a/guile/src/Makefile.am b/guile/src/Makefile.am
index f26b3bc..06d24e0 100644
--- a/guile/src/Makefile.am
+++ b/guile/src/Makefile.am
@@ -1,5 +1,5 @@
# GnuTLS --- Guile bindings for GnuTLS.
-# Copyright (C) 2007-2011 Free Software Foundation, Inc.
+# Copyright (C) 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
#
# GnuTLS is free software; you can redistribute it and/or
# modify it under the terms of the GNU Lesser General Public
@@ -31,7 +31,8 @@ BUILT_SOURCES = enum-map.i.c smob-types.i.c enums.h smobs.h
\
CLEANFILES = $(BUILT_SOURCES)
-lib_LTLIBRARIES = libguile-gnutls-v-1.la
+guileextension_LTLIBRARIES = guile-gnutls-v-2.la
+guile_gnutls_v_2_la_LDFLAGS = -module
# Linking against GnuTLS.
GNUTLS_CORE_LIBS = $(top_builddir)/lib/libgnutls.la
@@ -41,16 +42,17 @@ GNULIB_LIBS = $(top_builddir)/gl/libgnu.la
GNULIB_CFLAGS = -I$(top_builddir)/gl -I$(top_srcdir)/gl
-libguile_gnutls_v_1_la_SOURCES = core.c errors.c utils.c
-libguile_gnutls_v_1_la_CFLAGS = \
+guile_gnutls_v_2_la_SOURCES = core.c errors.c utils.c
+guile_gnutls_v_2_la_CFLAGS = \
$(AM_CFLAGS) $(GNULIB_CFLAGS) $(GUILE_CFLAGS)
-libguile_gnutls_v_1_la_LIBADD = \
+guile_gnutls_v_2_la_LIBADD = \
$(GNUTLS_CORE_LIBS) $(GNULIB_LIBS) \
$(GUILE_LDFLAGS)
AM_CPPFLAGS = \
-I$(top_srcdir)/lib/includes \
-I$(top_builddir)/lib/includes \
+ -I$(top_srcdir)/extra/includes \
-I$(top_builddir) \
-I$(builddir)
@@ -87,6 +89,7 @@ smob-types.i.c: $(srcdir)/make-smob-types.scm
priorities.i.c: $(srcdir)/make-session-priorities.scm
$(GUILE_FOR_BUILD) $^ > $@
+
# C file snarfing.
# `$(GUILE_CFLAGS)' may contain a series of `-I' switches so it must be
diff --git a/guile/src/core.c b/guile/src/core.c
index ba9ffab..3b81268 100644
--- a/guile/src/core.c
+++ b/guile/src/core.c
@@ -25,6 +25,7 @@
#include <stdint.h>
#include <string.h>
#include <gnutls/gnutls.h>
+#include <gnutls/openpgp.h>
#include <libguile.h>
#include <alloca.h>
@@ -2795,6 +2796,495 @@ SCM_DEFINE
(scm_gnutls_x509_certificate_subject_alternative_name,
#undef FUNC_NAME
+/* 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_certificate,
+ "import-openpgp-certificate", 2, 0, 0, (SCM data, SCM format),
+ "Return a new OpenPGP certificate object resulting from the "
+ "import of @var{data} (a uniform array) according to "
+ "@var{format}.")
+#define FUNC_NAME s_scm_gnutls_import_openpgp_certificate
+{
+ int err;
+ gnutls_openpgp_crt_t c_key;
+ gnutls_openpgp_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_openpgp_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_openpgp_crt_init (&c_key);
+ if (EXPECT_FALSE (err))
+ {
+ scm_gnutls_release_array (&c_data_handle);
+ scm_gnutls_error (err, FUNC_NAME);
+ }
+
+ err = gnutls_openpgp_crt_import (c_key, &c_data_d, c_format);
+ scm_gnutls_release_array (&c_data_handle);
+
+ if (EXPECT_FALSE (err))
+ {
+ gnutls_openpgp_crt_deinit (c_key);
+ scm_gnutls_error (err, FUNC_NAME);
+ }
+
+ return (scm_from_gnutls_openpgp_certificate (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_crt_fmt_t 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_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';
+ }
+
+ 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_certificate_id, "openpgp-certificate-id",
+ 1, 0, 0,
+ (SCM key),
+ "Return the ID (an 8-element u8vector) of certificate "
+ "@var{key}.")
+#define FUNC_NAME s_scm_gnutls_openpgp_certificate_id
+{
+ int err;
+ unsigned char *c_id;
+ gnutls_openpgp_crt_t c_key;
+
+ c_key = scm_to_gnutls_openpgp_certificate (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_crt_get_key_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_certificate_id_x, "openpgp-certificate-id!",
+ 2, 0, 0,
+ (SCM key, SCM id),
+ "Store the ID (an 8 byte sequence) of certificate "
+ "@var{key} in @var{id} (a u8vector).")
+#define FUNC_NAME s_scm_gnutls_openpgp_certificate_id_x
+{
+ int err;
+ char *c_id;
+ scm_t_array_handle c_id_handle;
+ size_t c_id_size;
+ gnutls_openpgp_crt_t c_key;
+
+ c_key = scm_to_gnutls_openpgp_certificate (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_crt_get_key_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_certificate_fingerpint_x,
+ "openpgp-certificate-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_certificate_fingerpint_x
+{
+ int err;
+ gnutls_openpgp_crt_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_certificate (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_crt_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_certificate_fingerprint,
+ "openpgp-certificate-fingerprint",
+ 1, 0, 0,
+ (SCM key),
+ "Return a new u8vector denoting the fingerprint of " "@var{key}.")
+#define FUNC_NAME s_scm_gnutls_openpgp_certificate_fingerprint
+{
+ int err;
+ gnutls_openpgp_crt_t c_key;
+ unsigned char *c_fpr;
+ size_t c_fpr_len, c_actual_len;
+
+ c_key = scm_to_gnutls_openpgp_certificate (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_crt_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_certificate_name, "openpgp-certificate-name",
+ 2, 0, 0,
+ (SCM key, SCM index),
+ "Return the @var{index}th name of @var{key}.")
+#define FUNC_NAME s_scm_gnutls_openpgp_certificate_name
+{
+ int err;
+ gnutls_openpgp_crt_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_certificate (key, 1, FUNC_NAME);
+ c_index = scm_to_int (index);
+
+ err = gnutls_openpgp_crt_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_certificate_names, "openpgp-certificate-names",
+ 1, 0, 0, (SCM key), "Return the list of names for @var{key}.")
+#define FUNC_NAME s_scm_gnutls_openpgp_certificate_names
+{
+ int err;
+ SCM result = SCM_EOL;
+ gnutls_openpgp_crt_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_certificate (key, 1, FUNC_NAME);
+
+ do
+ {
+ err = gnutls_openpgp_crt_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_certificate_algorithm,
+ "openpgp-certificate-algorithm",
+ 1, 0, 0,
+ (SCM key),
+ "Return two values: the certificate algorithm used by "
+ "@var{key} and the number of bits used.")
+#define FUNC_NAME s_scm_gnutls_openpgp_certificate_algorithm
+{
+ gnutls_openpgp_crt_t c_key;
+ unsigned int c_bits;
+ gnutls_pk_algorithm_t c_algo;
+
+ c_key = scm_to_gnutls_openpgp_certificate (key, 1, FUNC_NAME);
+ c_algo = gnutls_openpgp_crt_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_certificate_version,
+ "openpgp-certificate-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_certificate_version
+{
+ int c_version;
+ gnutls_openpgp_crt_t c_key;
+
+ c_key = scm_to_gnutls_openpgp_certificate (key, 1, FUNC_NAME);
+ c_version = gnutls_openpgp_crt_get_version (c_key);
+
+ return (scm_from_int (c_version));
+}
+
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_openpgp_certificate_usage, "openpgp-certificate-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_certificate_usage
+{
+ int err;
+ unsigned int c_usage = 0;
+ gnutls_openpgp_crt_t c_key;
+
+ c_key = scm_to_gnutls_openpgp_certificate (key, 1, FUNC_NAME);
+
+ err = gnutls_openpgp_crt_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_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_openpgp_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_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
+
+
+/* OpenPGP 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 certificate @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_crt_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_certificate (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
+
+
+
/* Debugging. */
static SCM log_procedure = SCM_BOOL_F;
diff --git a/guile/src/extra.c b/guile/src/extra.c
deleted file mode 100644
index ae4117f..0000000
--- a/guile/src/extra.c
+++ /dev/null
@@ -1,550 +0,0 @@
-/* GnuTLS-extra --- Guile bindings for GnuTLS-extra.
- Copyright (C) 2007, 2009, 2010 Free Software Foundation, Inc.
-
- 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 3 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 <address@hidden>. */
-
-#ifdef HAVE_CONFIG_H
-#include <config.h>
-#endif
-
-#include <stdio.h>
-#include <gnutls/gnutls.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_certificate,
- "import-openpgp-certificate", 2, 0, 0, (SCM data, SCM format),
- "Return a new OpenPGP certificate object resulting from the "
- "import of @var{data} (a uniform array) according to "
- "@var{format}.")
-#define FUNC_NAME s_scm_gnutls_import_openpgp_certificate
-{
- int err;
- gnutls_openpgp_crt_t c_key;
- gnutls_openpgp_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_openpgp_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_openpgp_crt_init (&c_key);
- if (EXPECT_FALSE (err))
- {
- scm_gnutls_release_array (&c_data_handle);
- scm_gnutls_error (err, FUNC_NAME);
- }
-
- err = gnutls_openpgp_crt_import (c_key, &c_data_d, c_format);
- scm_gnutls_release_array (&c_data_handle);
-
- if (EXPECT_FALSE (err))
- {
- gnutls_openpgp_crt_deinit (c_key);
- scm_gnutls_error (err, FUNC_NAME);
- }
-
- return (scm_from_gnutls_openpgp_certificate (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_crt_fmt_t 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_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';
- }
-
- 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_certificate_id, "openpgp-certificate-id",
- 1, 0, 0,
- (SCM key),
- "Return the ID (an 8-element u8vector) of certificate "
- "@var{key}.")
-#define FUNC_NAME s_scm_gnutls_openpgp_certificate_id
-{
- int err;
- unsigned char *c_id;
- gnutls_openpgp_crt_t c_key;
-
- c_key = scm_to_gnutls_openpgp_certificate (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_crt_get_key_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_certificate_id_x, "openpgp-certificate-id!",
- 2, 0, 0,
- (SCM key, SCM id),
- "Store the ID (an 8 byte sequence) of certificate "
- "@var{key} in @var{id} (a u8vector).")
-#define FUNC_NAME s_scm_gnutls_openpgp_certificate_id_x
-{
- int err;
- char *c_id;
- scm_t_array_handle c_id_handle;
- size_t c_id_size;
- gnutls_openpgp_crt_t c_key;
-
- c_key = scm_to_gnutls_openpgp_certificate (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_crt_get_key_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_certificate_fingerpint_x,
- "openpgp-certificate-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_certificate_fingerpint_x
-{
- int err;
- gnutls_openpgp_crt_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_certificate (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_crt_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_certificate_fingerprint,
- "openpgp-certificate-fingerprint",
- 1, 0, 0,
- (SCM key),
- "Return a new u8vector denoting the fingerprint of " "@var{key}.")
-#define FUNC_NAME s_scm_gnutls_openpgp_certificate_fingerprint
-{
- int err;
- gnutls_openpgp_crt_t c_key;
- unsigned char *c_fpr;
- size_t c_fpr_len, c_actual_len;
-
- c_key = scm_to_gnutls_openpgp_certificate (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_crt_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_certificate_name, "openpgp-certificate-name",
- 2, 0, 0,
- (SCM key, SCM index),
- "Return the @var{index}th name of @var{key}.")
-#define FUNC_NAME s_scm_gnutls_openpgp_certificate_name
-{
- int err;
- gnutls_openpgp_crt_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_certificate (key, 1, FUNC_NAME);
- c_index = scm_to_int (index);
-
- err = gnutls_openpgp_crt_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_certificate_names, "openpgp-certificate-names",
- 1, 0, 0, (SCM key), "Return the list of names for @var{key}.")
-#define FUNC_NAME s_scm_gnutls_openpgp_certificate_names
-{
- int err;
- SCM result = SCM_EOL;
- gnutls_openpgp_crt_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_certificate (key, 1, FUNC_NAME);
-
- do
- {
- err = gnutls_openpgp_crt_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_certificate_algorithm,
- "openpgp-certificate-algorithm",
- 1, 0, 0,
- (SCM key),
- "Return two values: the certificate algorithm used by "
- "@var{key} and the number of bits used.")
-#define FUNC_NAME s_scm_gnutls_openpgp_certificate_algorithm
-{
- gnutls_openpgp_crt_t c_key;
- unsigned int c_bits;
- gnutls_pk_algorithm_t c_algo;
-
- c_key = scm_to_gnutls_openpgp_certificate (key, 1, FUNC_NAME);
- c_algo = gnutls_openpgp_crt_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_certificate_version,
- "openpgp-certificate-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_certificate_version
-{
- int c_version;
- gnutls_openpgp_crt_t c_key;
-
- c_key = scm_to_gnutls_openpgp_certificate (key, 1, FUNC_NAME);
- c_version = gnutls_openpgp_crt_get_version (c_key);
-
- return (scm_from_int (c_version));
-}
-
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_gnutls_openpgp_certificate_usage, "openpgp-certificate-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_certificate_usage
-{
- int err;
- unsigned int c_usage = 0;
- gnutls_openpgp_crt_t c_key;
-
- c_key = scm_to_gnutls_openpgp_certificate (key, 1, FUNC_NAME);
-
- err = gnutls_openpgp_crt_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_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_openpgp_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_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 certificate @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_crt_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_certificate (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.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
index 4329be4..908cc14 100644
--- a/guile/src/make-enum-header.scm
+++ b/guile/src/make-enum-header.scm
@@ -1,7 +1,7 @@
;;; Help produce Guile wrappers for GnuTLS types.
;;;
;;; GnuTLS --- Guile bindings for GnuTLS.
-;;; Copyright (C) 2007, 2008, 2010 Free Software Foundation, Inc.
+;;; Copyright (C) 2007, 2008, 2010, 2011 Free Software Foundation, Inc.
;;;
;;; GnuTLS is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public
@@ -28,27 +28,18 @@
;;;
(define (main . args)
- (define extra? (not (null? args)))
-
(let ((port (current-output-port))
- (enums (if (not extra?)
- %gnutls-enums
- %gnutls-extra-enums)))
+ (enums %gnutls-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 "#ifndef GUILE_GNUTLS_ENUMS_H~%")
+ (format port "#define GUILE_GNUTLS_ENUMS_H~%")
(format port "#ifdef HAVE_CONFIG_H~%")
(format port "# include <config.h>~%")
(format port "#endif~%~%")
(format port "#include <gnutls/gnutls.h>~%")
(format port "#include <gnutls/x509.h>~%")
-
- (if extra?
- (begin
- (format port "#include <gnutls/openpgp.h>~%")))
+ (format port "#include <gnutls/openpgp.h>~%")
(for-each (lambda (enum)
(output-enum-declarations enum port)
diff --git a/guile/src/make-enum-map.scm b/guile/src/make-enum-map.scm
index 0e4b7a7..99cb9cf 100644
--- a/guile/src/make-enum-map.scm
+++ b/guile/src/make-enum-map.scm
@@ -1,7 +1,7 @@
;;; Help produce Guile wrappers for GnuTLS types.
;;;
;;; GnuTLS --- Guile bindings for GnuTLS.
-;;; Copyright (C) 2007, 2010 Free Software Foundation, Inc.
+;;; Copyright (C) 2007, 2010, 2011 Free Software Foundation, Inc.
;;;
;;; GnuTLS is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public
@@ -29,9 +29,7 @@
(define (main . args)
(let ((port (current-output-port))
- (enums (if (null? args)
- %gnutls-enums
- %gnutls-extra-enums)))
+ (enums %gnutls-enums))
(for-each (lambda (enum)
(output-enum-smob-definitions enum port))
enums)
diff --git a/guile/src/make-smob-header.scm b/guile/src/make-smob-header.scm
index 24d554d..9103af6 100644
--- a/guile/src/make-smob-header.scm
+++ b/guile/src/make-smob-header.scm
@@ -1,7 +1,7 @@
;;; Help produce Guile wrappers for GnuTLS types.
;;;
;;; GnuTLS --- Guile bindings for GnuTLS.
-;;; Copyright (C) 2007, 2010 Free Software Foundation, Inc.
+;;; Copyright (C) 2007, 2010, 2011 Free Software Foundation, Inc.
;;;
;;; GnuTLS is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public
@@ -28,17 +28,11 @@
;;;
(define (main . args)
- (define extra? (not (null? args)))
-
(let ((port (current-output-port))
- (enums (if (not extra?)
- %gnutls-smobs
- %gnutls-extra-smobs)))
+ (enums %gnutls-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_" ""))
+ (format port "#ifndef GUILE_GNUTLS_SMOBS_H~%")
+ (format port "#define GUILE_GNUTLS_SMOBS_H~%")
(for-each (lambda (type)
(output-smob-type-declaration type port)
(output-c->smob-converter type port)
diff --git a/guile/src/make-smob-types.scm b/guile/src/make-smob-types.scm
index 0256d9a..117168d 100644
--- a/guile/src/make-smob-types.scm
+++ b/guile/src/make-smob-types.scm
@@ -1,7 +1,7 @@
;;; Help produce Guile wrappers for GnuTLS types.
;;;
;;; GnuTLS --- Guile bindings for GnuTLS.
-;;; Copyright (C) 2007, 2010 Free Software Foundation, Inc.
+;;; Copyright (C) 2007, 2010, 2011 Free Software Foundation, Inc.
;;;
;;; GnuTLS is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public
@@ -32,9 +32,7 @@
(for-each (lambda (type)
(output-smob-type-definition type port)
(output-smob-type-predicate type port))
- (if (null? args)
- %gnutls-smobs
- %gnutls-extra-smobs))))
+ %gnutls-smobs)))
(apply main (cdr (command-line)))
diff --git a/guile/tests/openpgp-auth.scm b/guile/tests/openpgp-auth.scm
index 9e3a3e4..412a686 100644
--- a/guile/tests/openpgp-auth.scm
+++ b/guile/tests/openpgp-auth.scm
@@ -24,7 +24,6 @@
;;;
(use-modules (gnutls)
- (gnutls extra)
(gnutls build tests)
(srfi srfi-4))
diff --git a/guile/tests/openpgp-keyring.scm b/guile/tests/openpgp-keyring.scm
index 576a9db..e04e545 100644
--- a/guile/tests/openpgp-keyring.scm
+++ b/guile/tests/openpgp-keyring.scm
@@ -23,7 +23,7 @@
;;; Exercise the OpenPGP keyring API part of GnuTLS-extra.
;;;
-(use-modules (gnutls extra) (gnutls)
+(use-modules (gnutls)
(gnutls build tests)
(srfi srfi-1)
(srfi srfi-4))
diff --git a/guile/tests/openpgp-keys.scm b/guile/tests/openpgp-keys.scm
index 2ded32d..3dfc6d4 100644
--- a/guile/tests/openpgp-keys.scm
+++ b/guile/tests/openpgp-keys.scm
@@ -24,7 +24,6 @@
;;;
(use-modules (gnutls)
- (gnutls extra)
(gnutls build tests)
(srfi srfi-1)
(srfi srfi-4)
hooks/post-receive
--
GNU gnutls
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [SCM] GNU gnutls branch, master, updated. gnutls_3_0_5-26-g6e47f60,
Ludovic Courtès <=