diff options
Diffstat (limited to 'guile/src/extra.c')
| -rw-r--r-- | guile/src/extra.c | 544 |
1 files changed, 544 insertions, 0 deletions
diff --git a/guile/src/extra.c b/guile/src/extra.c new file mode 100644 index 0000000000..440e6c3099 --- /dev/null +++ b/guile/src/extra.c @@ -0,0 +1,544 @@ +/* GNUTLS-EXTRA --- Guile bindings for GNUTLS-EXTRA. + Copyright (C) 2007 Free Software Foundation + + GNUTLS-EXTRA is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + GNUTLS-EXTRA is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with GNUTLS-EXTRA; if not, write to the Free Software + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ + +/* Important note: As written above, this part of the code is ditributed + under the GPL, not the LGPL. */ + +/* Written by Ludovic Courtès <ludo@chbouib.org>. */ + + +#include <stdio.h> +#include <gnutls/gnutls.h> +#include <gnutls/extra.h> +#include <gnutls/openpgp.h> +#include <libguile.h> + +#include <alloca.h> + +#include "errors.h" +#include "utils.h" +#include "smobs.h" +#include "enums.h" +#include "extra-enums.h" +#include "extra-smobs.h" + + + +/* SMOB and enums type definitions. */ + +#include "extra-smob-types.i.c" +#include "extra-enum-map.i.c" + + +/* OpenPGP keys. */ + + +/* Maximum size we support for the name of OpenPGP keys. */ +#define GUILE_GNUTLS_MAX_OPENPGP_NAME_LENGTH 2048 + +SCM_DEFINE (scm_gnutls_import_openpgp_public_key, "import-openpgp-public-key", + 2, 0, 0, + (SCM data, SCM format), + "Return a new OpenPGP public key object resulting from the " + "import of @var{data} (a uniform array) according to " + "@var{format}.") +#define FUNC_NAME s_scm_gnutls_import_openpgp_public_key +{ + int err; + gnutls_openpgp_key_t c_key; + gnutls_openpgp_key_fmt c_format; + gnutls_datum_t c_data_d; + scm_t_array_handle c_data_handle; + const char *c_data; + size_t c_data_len; + + SCM_VALIDATE_ARRAY (1, data); + c_format = scm_to_gnutls_openpgp_key_format (format, 2, FUNC_NAME); + + c_data = scm_gnutls_get_array (data, &c_data_handle, &c_data_len, + FUNC_NAME); + c_data_d.data = (unsigned char *) c_data; + c_data_d.size = c_data_len; + + err = gnutls_openpgp_key_init (&c_key); + if (EXPECT_FALSE (err)) + { + scm_gnutls_release_array (&c_data_handle); + scm_gnutls_error (err, FUNC_NAME); + } + + err = gnutls_openpgp_key_import (c_key, &c_data_d, c_format); + scm_gnutls_release_array (&c_data_handle); + + if (EXPECT_FALSE (err)) + { + gnutls_openpgp_key_deinit (c_key); + scm_gnutls_error (err, FUNC_NAME); + } + + return (scm_from_gnutls_openpgp_public_key (c_key)); +} +#undef FUNC_NAME + +SCM_DEFINE (scm_gnutls_import_openpgp_private_key, "import-openpgp-private-key", + 2, 1, 0, + (SCM data, SCM format, SCM pass), + "Return a new OpenPGP private key object resulting from the " + "import of @var{data} (a uniform array) according to " + "@var{format}. Optionally, a passphrase may be provided.") +#define FUNC_NAME s_scm_gnutls_import_openpgp_private_key +{ + int err; + gnutls_openpgp_privkey_t c_key; + gnutls_openpgp_key_fmt c_format; + gnutls_datum_t c_data_d; + scm_t_array_handle c_data_handle; + const char *c_data; + char *c_pass; + size_t c_data_len, c_pass_len; + + SCM_VALIDATE_ARRAY (1, data); + c_format = scm_to_gnutls_openpgp_key_format (format, 2, FUNC_NAME); + if ((pass == SCM_UNDEFINED) || (scm_is_false (pass))) + c_pass = NULL; + else + { + c_pass_len = scm_c_string_length (pass); + c_pass = (char *) alloca (c_pass_len + 1); + (void) scm_to_locale_stringbuf (pass, c_pass, c_pass_len + 1); + c_pass[c_pass_len] = '\0'; + } + + c_data = scm_gnutls_get_array (data, &c_data_handle, &c_data_len, + FUNC_NAME); + c_data_d.data = (unsigned char *) c_data; + c_data_d.size = c_data_len; + + err = gnutls_openpgp_privkey_init (&c_key); + if (EXPECT_FALSE (err)) + { + scm_gnutls_release_array (&c_data_handle); + scm_gnutls_error (err, FUNC_NAME); + } + + err = gnutls_openpgp_privkey_import (c_key, &c_data_d, c_format, c_pass, + 0 /* currently unused */); + scm_gnutls_release_array (&c_data_handle); + + if (EXPECT_FALSE (err)) + { + gnutls_openpgp_privkey_deinit (c_key); + scm_gnutls_error (err, FUNC_NAME); + } + + return (scm_from_gnutls_openpgp_private_key (c_key)); +} +#undef FUNC_NAME + +SCM_DEFINE (scm_gnutls_openpgp_public_key_id, "openpgp-public-key-id", + 1, 0, 0, + (SCM key), + "Return the ID (an 8-element u8vector) of public key " + "@var{key}.") +#define FUNC_NAME s_scm_gnutls_openpgp_public_key_id +{ + int err; + unsigned char *c_id; + gnutls_openpgp_key_t c_key; + + c_key = scm_to_gnutls_openpgp_public_key (key, 1, FUNC_NAME); + + c_id = (unsigned char * ) malloc (8); + if (c_id == NULL) + scm_gnutls_error (GNUTLS_E_MEMORY_ERROR, FUNC_NAME); + + err = gnutls_openpgp_key_get_id (c_key, c_id); + if (EXPECT_FALSE (err)) + scm_gnutls_error (err, FUNC_NAME); + + return (scm_take_u8vector (c_id, 8)); +} +#undef FUNC_NAME + +SCM_DEFINE (scm_gnutls_openpgp_public_key_id_x, "openpgp-public-key-id!", + 2, 0, 0, + (SCM key, SCM id), + "Store the ID (an 8 byte sequence) of public key " + "@var{key} in @var{id} (a u8vector).") +#define FUNC_NAME s_scm_gnutls_openpgp_public_key_id_x +{ + int err; + char *c_id; + scm_t_array_handle c_id_handle; + size_t c_id_size; + gnutls_openpgp_key_t c_key; + + c_key = scm_to_gnutls_openpgp_public_key (key, 1, FUNC_NAME); + c_id = scm_gnutls_get_writable_array (id, &c_id_handle, &c_id_size, + FUNC_NAME); + + if (EXPECT_FALSE (c_id_size < 8)) + { + scm_gnutls_release_array (&c_id_handle); + scm_misc_error (FUNC_NAME, "ID vector too small: ~A", + scm_list_1 (id)); + } + + err = gnutls_openpgp_key_get_id (c_key, (unsigned char *) c_id); + scm_gnutls_release_array (&c_id_handle); + + if (EXPECT_FALSE (err)) + scm_gnutls_error (err, FUNC_NAME); + + return SCM_UNSPECIFIED; +} +#undef FUNC_NAME + +SCM_DEFINE (scm_gnutls_openpgp_public_key_fingerpint_x, + "openpgp-public-key-fingerprint!", + 2, 0, 0, + (SCM key, SCM fpr), + "Store in @var{fpr} (a u8vector) the fingerprint of @var{key}. " + "Return the number of bytes stored in @var{fpr}.") +#define FUNC_NAME s_scm_gnutls_openpgp_public_key_fingerpint_x +{ + int err; + gnutls_openpgp_key_t c_key; + char *c_fpr; + scm_t_array_handle c_fpr_handle; + size_t c_fpr_len, c_actual_len = 0; + + c_key = scm_to_gnutls_openpgp_public_key (key, 1, FUNC_NAME); + SCM_VALIDATE_ARRAY (2, fpr); + + c_fpr = scm_gnutls_get_writable_array (fpr, &c_fpr_handle, &c_fpr_len, + FUNC_NAME); + + err = gnutls_openpgp_key_get_fingerprint (c_key, c_fpr, &c_actual_len); + scm_gnutls_release_array (&c_fpr_handle); + + if (EXPECT_FALSE (err)) + scm_gnutls_error (err, FUNC_NAME); + + return (scm_from_size_t (c_actual_len)); +} +#undef FUNC_NAME + +SCM_DEFINE (scm_gnutls_openpgp_public_key_fingerprint, + "openpgp-public-key-fingerprint", + 1, 0, 0, + (SCM key), + "Return a new u8vector denoting the fingerprint of " + "@var{key}.") +#define FUNC_NAME s_scm_gnutls_openpgp_public_key_fingerprint +{ + int err; + gnutls_openpgp_key_t c_key; + unsigned char *c_fpr; + size_t c_fpr_len, c_actual_len; + + c_key = scm_to_gnutls_openpgp_public_key (key, 1, FUNC_NAME); + + /* V4 fingerprints are 160-bit SHA-1 hashes (see RFC2440). */ + c_fpr_len = 20; + c_fpr = (unsigned char *) malloc (c_fpr_len); + if (EXPECT_FALSE (c_fpr == NULL)) + scm_gnutls_error (GNUTLS_E_MEMORY_ERROR, FUNC_NAME); + + do + { + c_actual_len = 0; + err = gnutls_openpgp_key_get_fingerprint (c_key, c_fpr, + &c_actual_len); + if (err == GNUTLS_E_SHORT_MEMORY_BUFFER) + { + /* Grow C_FPR. */ + unsigned char *c_new; + + c_new = (unsigned char *) realloc (c_fpr, c_fpr_len * 2); + if (EXPECT_FALSE (c_new == NULL)) + { + free (c_fpr); + scm_gnutls_error (GNUTLS_E_MEMORY_ERROR, FUNC_NAME); + } + else + { + c_fpr_len *= 2; + c_fpr = c_new; + } + } + } + while (err == GNUTLS_E_SHORT_MEMORY_BUFFER); + + if (EXPECT_FALSE (err)) + { + free (c_fpr); + scm_gnutls_error (err, FUNC_NAME); + } + + if (c_actual_len < c_fpr_len) + /* Shrink C_FPR. */ + c_fpr = realloc (c_fpr, c_actual_len); + + return (scm_take_u8vector (c_fpr, c_actual_len)); +} +#undef FUNC_NAME + +SCM_DEFINE (scm_gnutls_openpgp_public_key_name, "openpgp-public-key-name", + 2, 0, 0, + (SCM key, SCM index), + "Return the @var{index}th name of @var{key}.") +#define FUNC_NAME s_scm_gnutls_openpgp_public_key_name +{ + int err; + gnutls_openpgp_key_t c_key; + int c_index; + char c_name[GUILE_GNUTLS_MAX_OPENPGP_NAME_LENGTH]; + size_t c_name_len = sizeof (c_name); + + c_key = scm_to_gnutls_openpgp_public_key (key, 1, FUNC_NAME); + c_index = scm_to_int (index); + + err = gnutls_openpgp_key_get_name (c_key, c_index, c_name, + &c_name_len); + if (EXPECT_FALSE (err)) + scm_gnutls_error (err, FUNC_NAME); + + /* XXX: The name is really UTF-8. */ + return (scm_from_locale_string (c_name)); +} +#undef FUNC_NAME + +SCM_DEFINE (scm_gnutls_openpgp_public_key_names, "openpgp-public-key-names", + 1, 0, 0, + (SCM key), + "Return the list of names for @var{key}.") +#define FUNC_NAME s_scm_gnutls_openpgp_public_key_names +{ + int err; + SCM result = SCM_EOL; + gnutls_openpgp_key_t c_key; + int c_index = 0; + char c_name[GUILE_GNUTLS_MAX_OPENPGP_NAME_LENGTH]; + size_t c_name_len = sizeof (c_name); + + c_key = scm_to_gnutls_openpgp_public_key (key, 1, FUNC_NAME); + + do + { + err = gnutls_openpgp_key_get_name (c_key, c_index, c_name, + &c_name_len); + if (!err) + { + result = scm_cons (scm_from_locale_string (c_name), + result); + c_index++; + } + } + while (!err); + + if (EXPECT_FALSE (err != GNUTLS_E_REQUESTED_DATA_NOT_AVAILABLE)) + scm_gnutls_error (err, FUNC_NAME); + + return (scm_reverse_x (result, SCM_EOL)); +} +#undef FUNC_NAME + +SCM_DEFINE (scm_gnutls_openpgp_public_key_algorithm, + "openpgp-public-key-algorithm", + 1, 0, 0, + (SCM key), + "Return two values: the public key algorithm used by " + "@var{key} and the number of bits used.") +#define FUNC_NAME s_scm_gnutls_openpgp_public_key_algorithm +{ + gnutls_openpgp_key_t c_key; + unsigned int c_bits; + gnutls_pk_algorithm_t c_algo; + + c_key = scm_to_gnutls_openpgp_public_key (key, 1, FUNC_NAME); + c_algo = gnutls_openpgp_key_get_pk_algorithm (c_key, &c_bits); + + return (scm_values (scm_list_2 (scm_from_gnutls_pk_algorithm (c_algo), + scm_from_uint (c_bits)))); +} +#undef FUNC_NAME + +SCM_DEFINE (scm_gnutls_openpgp_public_key_version, + "openpgp-public-key-version", + 1, 0, 0, + (SCM key), + "Return the version of the OpenPGP message format (RFC2440) " + "honored by @var{key}.") +#define FUNC_NAME s_scm_gnutls_openpgp_public_key_version +{ + int c_version; + gnutls_openpgp_key_t c_key; + + c_key = scm_to_gnutls_openpgp_public_key (key, 1, FUNC_NAME); + c_version = gnutls_openpgp_key_get_version (c_key); + + return (scm_from_int (c_version)); +} +#undef FUNC_NAME + +SCM_DEFINE (scm_gnutls_openpgp_public_key_usage, "openpgp-public-key-usage", + 1, 0, 0, + (SCM key), + "Return a list of values denoting the key usage of @var{key}.") +#define FUNC_NAME s_scm_gnutls_openpgp_public_key_usage +{ + int err; + unsigned int c_usage = 0; + gnutls_openpgp_key_t c_key; + + c_key = scm_to_gnutls_openpgp_public_key (key, 1, FUNC_NAME); + + err = gnutls_openpgp_key_get_key_usage (c_key, &c_usage); + if (EXPECT_FALSE (err)) + scm_gnutls_error (err, FUNC_NAME); + + return (scm_from_gnutls_key_usage_flags (c_usage)); +} +#undef FUNC_NAME + + + +/* OpenPGP keyrings. */ + +SCM_DEFINE (scm_gnutls_import_openpgp_keyring, "import-openpgp-keyring", + 2, 0, 0, + (SCM data, SCM format), + "Import @var{data} (a u8vector) according to @var{format} " + "and return the imported keyring.") +#define FUNC_NAME s_scm_gnutls_import_openpgp_keyring +{ + int err; + gnutls_openpgp_keyring_t c_keyring; + gnutls_openpgp_key_fmt c_format; + gnutls_datum_t c_data_d; + scm_t_array_handle c_data_handle; + const char *c_data; + size_t c_data_len; + + SCM_VALIDATE_ARRAY (1, data); + c_format = scm_to_gnutls_openpgp_key_format (format, 2, FUNC_NAME); + + c_data = scm_gnutls_get_array (data, &c_data_handle, &c_data_len, + FUNC_NAME); + + c_data_d.data = (unsigned char *) c_data; + c_data_d.size = c_data_len; + + err = gnutls_openpgp_keyring_init (&c_keyring); + if (EXPECT_FALSE (err)) + { + scm_gnutls_release_array (&c_data_handle); + scm_gnutls_error (err, FUNC_NAME); + } + + err = gnutls_openpgp_keyring_import (c_keyring, &c_data_d, c_format); + scm_gnutls_release_array (&c_data_handle); + + if (EXPECT_FALSE (err)) + { + gnutls_openpgp_keyring_deinit (c_keyring); + scm_gnutls_error (err, FUNC_NAME); + } + + return (scm_from_gnutls_openpgp_keyring (c_keyring)); +} +#undef FUNC_NAME + +SCM_DEFINE (scm_gnutls_openpgp_keyring_contains_key_id_p, + "openpgp-keyring-contains-key-id?", + 2, 0, 0, + (SCM keyring, SCM id), + "Return @code{#f} if key ID @var{id} is in @var{keyring}, " + "@code{#f} otherwise.") +#define FUNC_NAME s_scm_gnutls_openpgp_keyring_contains_key_id_p +{ + int c_result; + gnutls_openpgp_keyring_t c_keyring; + scm_t_array_handle c_id_handle; + const char *c_id; + size_t c_id_len; + + c_keyring = scm_to_gnutls_openpgp_keyring (keyring, 1, FUNC_NAME); + SCM_VALIDATE_ARRAY (1, id); + + c_id = scm_gnutls_get_array (id, &c_id_handle, &c_id_len, + FUNC_NAME); + if (EXPECT_FALSE (c_id_len != 8)) + { + scm_gnutls_release_array (&c_id_handle); + scm_wrong_type_arg (FUNC_NAME, 1, id); + } + + c_result = gnutls_openpgp_keyring_check_id (c_keyring, + (unsigned char *) c_id, + 0 /* unused */); + + scm_gnutls_release_array (&c_id_handle); + + return (scm_from_bool (c_result == 0)); +} +#undef FUNC_NAME + + +/* Certificates. */ + +SCM_DEFINE (scm_gnutls_set_certificate_credentials_openpgp_keys_x, + "set-certificate-credentials-openpgp-keys!", + 3, 0, 0, + (SCM cred, SCM pub, SCM sec), + "Use public key @var{pub} and secret key @var{sec} in " + "certificate credentials @var{cred}.") +#define FUNC_NAME s_scm_gnutls_set_certificate_credentials_openpgp_keys_x +{ + int err; + gnutls_certificate_credentials_t c_cred; + gnutls_openpgp_key_t c_pub; + gnutls_openpgp_privkey_t c_sec; + + c_cred = scm_to_gnutls_certificate_credentials (cred, 1, FUNC_NAME); + c_pub = scm_to_gnutls_openpgp_public_key (pub, 2, FUNC_NAME); + c_sec = scm_to_gnutls_openpgp_private_key (sec, 3, FUNC_NAME); + + err = gnutls_certificate_set_openpgp_key (c_cred, c_pub, c_sec); + if (EXPECT_FALSE (err)) + scm_gnutls_error (err, FUNC_NAME); + + return SCM_UNSPECIFIED; +} +#undef FUNC_NAME + + +/* Initialization. */ + +void +scm_init_gnutls_extra (void) +{ +#include "extra.c.x" + + (void) gnutls_global_init_extra (); + + scm_gnutls_define_enums (); +} + +/* arch-tag: 655f308d-5643-4bc7-9db4-1f84bd902bef + */ |