From 59fd52bfdd7e4a763b5d950ee2213b3bb1e69916 Mon Sep 17 00:00:00 2001 From: Jan Synacek Date: Tue, 11 Sep 2018 13:03:56 +0200 Subject: [PATCH 1/2] New verify-error GnuTLS interface for certificate validation * net/gnutls.el (gnutls-verify-error): New defcustom to control the behavior when a certificate fails validation. Defaults to old behavior: never abort, just warn. (gnutls-negotiate): Use it. * gnutls.c: Replace `:verify_hostname_error' with `:verify_error', now a list of certificate validation checks that will abort a connection with an error. (Fgnutls_boot): Document it and use it. (cherry-picked from commit 31b4827ea9ba8d22deb17c0593f0f555a33e1fa4) jsynacek: gnutls-verify-error defaults to t in RHEL-7. Resolves: #1403643 --- lisp/net/gnutls.el | 67 ++++++++++++++++++++++++++++++++++++++++------------ src/bootstrap-emacs | Bin 25556936 -> 0 bytes src/emacs | Bin 25556936 -> 0 bytes src/fns.c | 22 ++++++++++++++++- src/gnutls.c | 48 +++++++++++++++++++++++-------------- src/temacs | Bin 15992560 -> 0 bytes 6 files changed, 103 insertions(+), 34 deletions(-) delete mode 100755 src/bootstrap-emacs delete mode 100755 src/emacs delete mode 100755 src/temacs diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el index 243c64e..2585f48 100644 --- a/lisp/net/gnutls.el +++ b/lisp/net/gnutls.el @@ -51,6 +51,19 @@ set this variable to \"normal:-dhe-rsa\"." :type '(choice (const nil) string)) +(defcustom gnutls-verify-error t + "If non-nil, this should be a list of checks per hostname regex or t." + :group 'gnutls + :type '(choice + (const t) + (repeat :tag "List of hostname regexps with flags for each" + (list + (choice :tag "Hostname" + (const ".*" :tag "Any hostname") + regexp) + (set (const :trustfiles) + (const :hostname)))))) + (defcustom gnutls-trustfiles '( "/etc/ssl/certs/ca-certificates.crt" ; Debian, Ubuntu, Gentoo and Arch Linux @@ -141,19 +154,25 @@ MIN-PRIME-BITS is the minimum acceptable size of Diffie-Hellman keys \(see `gnutls-min-prime-bits' for more information). Use nil for the default. -When VERIFY-HOSTNAME-ERROR is not nil, an error will be raised -when the hostname does not match the presented certificate's host -name. The exact verification algorithm is a basic implementation -of the matching described in RFC2818 (HTTPS), which takes into -account wildcards, and the DNSName/IPAddress subject alternative -name PKIX extension. See GnuTLS' gnutls_x509_crt_check_hostname -for details. When VERIFY-HOSTNAME-ERROR is nil, only a warning -will be issued. +VERIFY-HOSTNAME-ERROR is a backwards compatibility option for +putting `:hostname' in VERIFY-ERROR. + +When VERIFY-ERROR is t or a list containing `:trustfiles', an +error will be raised when the peer certificate verification fails +as per GnuTLS' gnutls_certificate_verify_peers2. Otherwise, only +warnings will be shown about the verification failure. -When VERIFY-ERROR is not nil, an error will be raised when the -peer certificate verification fails as per GnuTLS' -gnutls_certificate_verify_peers2. Otherwise, only warnings will -be shown about the verification failure. +When VERIFY-ERROR is t or a list containing `:hostname', an error +will be raised when the hostname does not match the presented +certificate's host name. The exact verification algorithm is a +basic implementation of the matching described in +RFC2818 (HTTPS), which takes into account wildcards, and the +DNSName/IPAddress subject alternative name PKIX extension. See +GnuTLS' gnutls_x509_crt_check_hostname for details. Otherwise, +only a warning will be issued. + +Note that the list in `gnutls-verify-error', matched against the +HOSTNAME, is the default VERIFY-ERROR. VERIFY-FLAGS is a numeric OR of verification flags only for `gnutls-x509pki' connections. See GnuTLS' x509.h for details; @@ -186,8 +205,28 @@ defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT." (if gnutls-algorithm-priority (upcase gnutls-algorithm-priority) "NORMAL"))))) + (verify-error (or verify-error + ;; this uses the value of `gnutls-verify-error' + (cond + ;; if t, pass it on + ((eq gnutls-verify-error t) + t) + ;; if a list, look for hostname matches + ((listp gnutls-verify-error) + (mapcan + (lambda (check) + (when (string-match (car check) hostname) + (cdr check))) + gnutls-verify-error)) + ;; else it's nil + (t nil)))) (min-prime-bits (or min-prime-bits gnutls-min-prime-bits)) - (params `(:priority ,priority-string + params ret) + + (when verify-hostname-error + (push :hostname verify-error)) + + (setq params `(:priority ,priority-string :hostname ,hostname :loglevel ,gnutls-log-level :min-prime-bits ,min-prime-bits @@ -196,9 +235,7 @@ defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT." :keylist ,keylist :verify-flags ,verify-flags :verify-error ,verify-error - :verify-hostname-error ,verify-hostname-error :callbacks nil)) - ret) (gnutls-message-maybe (setq ret (gnutls-boot process type params)) diff --git a/src/fns.c b/src/fns.c index fbb3fb5..2a417ff 100644 --- a/src/fns.c +++ b/src/fns.c @@ -2252,7 +2252,7 @@ usage: (nconc &rest LISTS) */) storing the results into elements of VALS, a C vector of Lisp_Objects. LENI is the length of VALS, which should also be the length of SEQ. */ -static void +static EMACS_INT mapcar1 (EMACS_INT leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq) { register Lisp_Object tail; @@ -2326,6 +2326,7 @@ mapcar1 (EMACS_INT leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq) } UNGCPRO; + return leni; } DEFUN ("mapconcat", Fmapconcat, Smapconcat, 3, 3, 0, @@ -2411,6 +2412,24 @@ SEQUENCE may be a list, a vector, a bool-vector, or a string. */) return sequence; } + +DEFUN ("mapcan", Fmapcan, Smapcan, 2, 2, 0, + doc: /* Apply FUNCTION to each element of SEQUENCE, and concatenate +the results by altering them (using `nconc'). +SEQUENCE may be a list, a vector, a bool-vector, or a string. */) + (Lisp_Object function, Lisp_Object sequence) +{ + USE_SAFE_ALLOCA; + EMACS_INT leni = XFASTINT (Flength (sequence)); + if (CHAR_TABLE_P (sequence)) + wrong_type_argument (Qlistp, sequence); + Lisp_Object *args; + SAFE_ALLOCA_LISP (args, leni); + ptrdiff_t nmapped = mapcar1 (leni, args, function, sequence); + Lisp_Object ret = Fnconc (nmapped, args); + SAFE_FREE (); + return ret; +} /* This is how C code calls `yes-or-no-p' and allows the user to redefined it. @@ -4984,6 +5003,7 @@ this variable. */); defsubr (&Snconc); defsubr (&Smapcar); defsubr (&Smapc); + defsubr (&Smapcan); defsubr (&Smapconcat); defsubr (&Syes_or_no_p); defsubr (&Sload_average); diff --git a/src/gnutls.c b/src/gnutls.c index 57d9e17..0c4d10b 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -49,7 +49,7 @@ 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_hostname_error; +static Lisp_Object QCgnutls_bootprop_verify_error; /* Callback keys for `gnutls-boot'. Unused currently. */ static Lisp_Object QCgnutls_bootprop_callbacks_verify; @@ -729,8 +729,12 @@ certificates for `gnutls-x509pki'. :verify-flags is a bitset as per GnuTLS' gnutls_certificate_set_verify_flags. -:verify-hostname-error, if non-nil, makes a hostname mismatch an -error. Otherwise it will be just a warning. +:verify-hostname-error is ignored. Pass :hostname in :verify-error +instead. + +:verify-error is a list of symbols to express verification checks or +`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 accept in Diffie-Hellman key exchange. @@ -774,8 +778,7 @@ one trustfile (usually a CA bundle). */) /* Lisp_Object callbacks; */ Lisp_Object loglevel; Lisp_Object hostname; - /* Lisp_Object verify_error; */ - Lisp_Object verify_hostname_error; + Lisp_Object verify_error; Lisp_Object prime_bits; CHECK_PROCESS (proc); @@ -800,11 +803,14 @@ one trustfile (usually a CA bundle). */) keylist = Fplist_get (proplist, QCgnutls_bootprop_keylist); crlfiles = Fplist_get (proplist, QCgnutls_bootprop_crlfiles); loglevel = Fplist_get (proplist, QCgnutls_bootprop_loglevel); - verify_hostname_error = Fplist_get (proplist, QCgnutls_bootprop_verify_hostname_error); + verify_error = Fplist_get (proplist, QCgnutls_bootprop_verify_error); prime_bits = Fplist_get (proplist, QCgnutls_bootprop_min_prime_bits); + if (!Flistp (verify_error)) + error ("gnutls-boot: invalid :verify_error parameter (not a list)"); + if (!STRINGP (hostname)) - error ("gnutls-boot: invalid :hostname parameter"); + error ("gnutls-boot: invalid :hostname parameter (not a string)"); c_hostname = SSDATA (hostname); state = XPROCESS (proc)->gnutls_state; @@ -1033,14 +1039,17 @@ one trustfile (usually a CA bundle). */) if (peer_verification != 0) { - if (NILP (verify_hostname_error)) - GNUTLS_LOG2 (1, max_log_level, "certificate validation failed:", - c_hostname); - else - { + if (EQ (verify_error, Qt) + || !NILP (Fmember (QCgnutls_bootprop_trustfiles, verify_error))) + { emacs_gnutls_deinit (proc); error ("Certificate validation failed %s, verification code %d", c_hostname, peer_verification); + } + else + { + GNUTLS_LOG2 (1, max_log_level, "certificate validation failed:", + c_hostname); } } @@ -1080,14 +1089,17 @@ one trustfile (usually a CA bundle). */) if (!fn_gnutls_x509_crt_check_hostname (gnutls_verify_cert, c_hostname)) { - if (NILP (verify_hostname_error)) - GNUTLS_LOG2 (1, max_log_level, "x509 certificate does not match:", - c_hostname); - else - { + if (EQ (verify_error, Qt) + || !NILP (Fmember (QCgnutls_bootprop_hostname, verify_error))) + { fn_gnutls_x509_crt_deinit (gnutls_verify_cert); emacs_gnutls_deinit (proc); error ("The x509 certificate does not match \"%s\"", c_hostname); + } + else + { + GNUTLS_LOG2 (1, max_log_level, "x509 certificate does not match:", + c_hostname); } } fn_gnutls_x509_crt_deinit (gnutls_verify_cert); @@ -1144,7 +1156,7 @@ syms_of_gnutls (void) DEFSYM (QCgnutls_bootprop_min_prime_bits, ":min-prime-bits"); DEFSYM (QCgnutls_bootprop_loglevel, ":loglevel"); DEFSYM (QCgnutls_bootprop_verify_flags, ":verify-flags"); - DEFSYM (QCgnutls_bootprop_verify_hostname_error, ":verify-hostname-error"); + DEFSYM (QCgnutls_bootprop_verify_error, ":verify-error"); DEFSYM (Qgnutls_e_interrupted, "gnutls-e-interrupted"); Fput (Qgnutls_e_interrupted, Qgnutls_code,