X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/6ddd819467d1d9d0e78f13e5a15c1af9125ae67b..e6013e8c8f3de0ca39c17a2da95346b4a320e6d0:/src/gnutls.c diff --git a/src/gnutls.c b/src/gnutls.c index f945778cc9..864cac5f51 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -1,5 +1,5 @@ /* GnuTLS glue for GNU Emacs. - Copyright (C) 2010-2014 Free Software Foundation, Inc. + Copyright (C) 2010-2015 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -35,28 +35,8 @@ along with GNU Emacs. If not, see . */ static bool emacs_gnutls_handle_error (gnutls_session_t, int); -static Lisp_Object Qgnutls_dll; -static Lisp_Object Qgnutls_code; -static Lisp_Object Qgnutls_anon, Qgnutls_x509pki; -static Lisp_Object Qgnutls_e_interrupted, Qgnutls_e_again, - Qgnutls_e_invalid_session, Qgnutls_e_not_ready_for_handshake; static bool gnutls_global_initialized; -/* The following are for the property list of `gnutls-boot'. */ -static Lisp_Object QCgnutls_bootprop_priority; -static Lisp_Object QCgnutls_bootprop_trustfiles; -static Lisp_Object QCgnutls_bootprop_keylist; -static Lisp_Object QCgnutls_bootprop_crlfiles; -static Lisp_Object QCgnutls_bootprop_callbacks; -static Lisp_Object QCgnutls_bootprop_loglevel; -static Lisp_Object QCgnutls_bootprop_hostname; -static Lisp_Object QCgnutls_bootprop_min_prime_bits; -static Lisp_Object QCgnutls_bootprop_verify_flags; -static Lisp_Object QCgnutls_bootprop_verify_error; - -/* Callback keys for `gnutls-boot'. Unused currently. */ -static Lisp_Object QCgnutls_bootprop_callbacks_verify; - static void gnutls_log_function (int, const char *); static void gnutls_log_function2 (int, const char *, const char *); #ifdef HAVE_GNUTLS3 @@ -142,6 +122,8 @@ DEF_DLL_FN (void, gnutls_transport_set_push_function, (gnutls_session_t, gnutls_push_func)); DEF_DLL_FN (int, gnutls_x509_crt_check_hostname, (gnutls_x509_crt_t, const char *)); +DEF_DLL_FN (int, gnutls_x509_crt_check_issuer, + (gnutls_x509_crt_t, gnutls_x509_crt_t)); DEF_DLL_FN (void, gnutls_x509_crt_deinit, (gnutls_x509_crt_t)); DEF_DLL_FN (int, gnutls_x509_crt_import, (gnutls_x509_crt_t, const gnutls_datum_t *, @@ -256,6 +238,7 @@ init_gnutls_functions (void) LOAD_DLL_FN (library, gnutls_transport_set_pull_function); LOAD_DLL_FN (library, gnutls_transport_set_push_function); LOAD_DLL_FN (library, gnutls_x509_crt_check_hostname); + LOAD_DLL_FN (library, gnutls_x509_crt_check_issuer); LOAD_DLL_FN (library, gnutls_x509_crt_deinit); LOAD_DLL_FN (library, gnutls_x509_crt_import); LOAD_DLL_FN (library, gnutls_x509_crt_init); @@ -349,6 +332,7 @@ init_gnutls_functions (void) # define gnutls_transport_set_pull_function fn_gnutls_transport_set_pull_function # define gnutls_transport_set_push_function fn_gnutls_transport_set_push_function # define gnutls_x509_crt_check_hostname fn_gnutls_x509_crt_check_hostname +# define gnutls_x509_crt_check_issuer fn_gnutls_x509_crt_check_issuer # define gnutls_x509_crt_deinit fn_gnutls_x509_crt_deinit # define gnutls_x509_crt_get_activation_time fn_gnutls_x509_crt_get_activation_time # define gnutls_x509_crt_get_dn fn_gnutls_x509_crt_get_dn @@ -715,7 +699,8 @@ See also `gnutls-boot'. */) DEFUN ("gnutls-errorp", Fgnutls_errorp, Sgnutls_errorp, 1, 1, 0, doc: /* Return t if ERROR indicates a GnuTLS problem. ERROR is an integer or a symbol with an integer `gnutls-code' property. -usage: (gnutls-errorp ERROR) */) +usage: (gnutls-errorp ERROR) */ + attributes: const) (Lisp_Object err) { if (EQ (err, Qt)) return Qnil; @@ -1001,6 +986,10 @@ DEFUN ("gnutls-peer-status-warning-describe", Fgnutls_peer_status_warning_descri if (EQ (status_symbol, intern (":self-signed"))) return build_string ("certificate signer was not found (self-signed)"); + if (EQ (status_symbol, intern (":unknown-ca"))) + return build_string ("the certificate was signed by an unknown " + "and therefore untrusted authority"); + if (EQ (status_symbol, intern (":not-ca"))) return build_string ("certificate signer is not a CA"); @@ -1045,7 +1034,7 @@ The return value is a property list with top-level keys :warnings and warnings = Fcons (intern (":revoked"), warnings); if (verification & GNUTLS_CERT_SIGNER_NOT_FOUND) - warnings = Fcons (intern (":self-signed"), warnings); + warnings = Fcons (intern (":unknown-ca"), warnings); if (verification & GNUTLS_CERT_SIGNER_NOT_CA) warnings = Fcons (intern (":not-ca"), warnings); @@ -1063,6 +1052,13 @@ The return value is a property list with top-level keys :warnings and CERTIFICATE_NOT_MATCHING) warnings = Fcons (intern (":no-host-match"), warnings); + /* This could get called in the INIT stage, when the certificate is + not yet set. */ + if (XPROCESS (proc)->gnutls_certificate != NULL && + gnutls_x509_crt_check_issuer(XPROCESS (proc)->gnutls_certificate, + XPROCESS (proc)->gnutls_certificate)) + warnings = Fcons (intern (":self-signed"), warnings); + if (!NILP (warnings)) result = list2 (intern (":warnings"), warnings); @@ -1185,7 +1181,7 @@ gnutls_certificate_set_verify_flags. instead. :verify-error is a list of symbols to express verification checks or -`t' to do all checks. Currently it can contain `:trustfiles' and +t to do all checks. Currently it can contain `:trustfiles' and `:hostname' to verify the certificate or the hostname respectively. :min-prime-bits is the minimum accepted number of bits the client will @@ -1516,7 +1512,7 @@ one trustfile (usually a CA bundle). */) || !NILP (Fmember (QCgnutls_bootprop_trustfiles, verify_error))) { emacs_gnutls_deinit (proc); - error ("Certificate validation failed %s, verification code %d", + error ("Certificate validation failed %s, verification code %x", c_hostname, peer_verification); } else @@ -1649,20 +1645,29 @@ DEFUN ("gnutls-available-p", Fgnutls_available_p, Sgnutls_available_p, 0, 0, 0, void syms_of_gnutls (void) { + DEFSYM (Qlibgnutls_version, "libgnutls-version"); + Fset (Qlibgnutls_version, +#ifdef HAVE_GNUTLS + make_number (GNUTLS_VERSION_MAJOR * 10000 + + GNUTLS_VERSION_MINOR * 100 + + GNUTLS_VERSION_PATCH) +#else + make_number (-1) +#endif + ); #ifdef HAVE_GNUTLS gnutls_global_initialized = 0; - DEFSYM (Qgnutls_dll, "gnutls"); DEFSYM (Qgnutls_code, "gnutls-code"); DEFSYM (Qgnutls_anon, "gnutls-anon"); DEFSYM (Qgnutls_x509pki, "gnutls-x509pki"); + + /* The following are for the property list of 'gnutls-boot'. */ DEFSYM (QCgnutls_bootprop_hostname, ":hostname"); DEFSYM (QCgnutls_bootprop_priority, ":priority"); DEFSYM (QCgnutls_bootprop_trustfiles, ":trustfiles"); DEFSYM (QCgnutls_bootprop_keylist, ":keylist"); DEFSYM (QCgnutls_bootprop_crlfiles, ":crlfiles"); - DEFSYM (QCgnutls_bootprop_callbacks, ":callbacks"); - DEFSYM (QCgnutls_bootprop_callbacks_verify, "verify"); DEFSYM (QCgnutls_bootprop_min_prime_bits, ":min-prime-bits"); DEFSYM (QCgnutls_bootprop_loglevel, ":loglevel"); DEFSYM (QCgnutls_bootprop_verify_flags, ":verify-flags");