From 8b492194a904d115258ae59eb522c986860c4c18 Mon Sep 17 00:00:00 2001 From: Ted Zlatanov Date: Sun, 24 Apr 2011 20:31:45 -0500 Subject: [PATCH] Bug fixes and certificate and hostname verification for the Emacs GnuTLS support. * lisp/net/gnutls.el (gnutls-negotiate): Add hostname, verify-flags, verify-error, and verify-hostname-error parameters. Check whether default trustfile exists before going to use it. Add missing argument to gnutls-message-maybe call. Return return value. Reported by Claudio Bley . (open-gnutls-stream): Add usage example. * lisp/net/network-stream.el (network-stream-open-starttls): Give host parameter to `gnutls-negotiate'. (gnutls-negotiate): Adjust `gnutls-negotiate' declaration. --- lisp/ChangeLog | 13 +++++++ lisp/net/gnutls.el | 77 +++++++++++++++++++++++++++++++++----- lisp/net/network-stream.el | 5 ++- 3 files changed, 84 insertions(+), 11 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 0a63e6d5dec..c4e28b61586 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,16 @@ +2011-04-24 Teodor Zlatanov + + * net/gnutls.el (gnutls-negotiate): Add hostname, verify-flags, + verify-error, and verify-hostname-error parameters. Check whether + default trustfile exists before going to use it. Add missing + argument to gnutls-message-maybe call. Return return value. + Reported by Claudio Bley . + (open-gnutls-stream): Add usage example. + + * net/network-stream.el (network-stream-open-starttls): Give host + parameter to `gnutls-negotiate'. + (gnutls-negotiate): Adjust `gnutls-negotiate' declaration. + 2011-04-24 Daniel Colascione * progmodes/cc-engine.el (c-forward-decl-or-cast-1): Use diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el index 0929c31b6c4..46c20e6b344 100644 --- a/lisp/net/gnutls.el +++ b/lisp/net/gnutls.el @@ -25,7 +25,8 @@ ;;; Commentary: ;; This package provides language bindings for the GnuTLS library -;; using the corresponding core functions in gnutls.c. +;; using the corresponding core functions in gnutls.c. It should NOT +;; be used directly, only through open-protocol-stream. ;; Simple test: ;; @@ -59,26 +60,76 @@ Third arg is name of the host to connect to, or its IP address. Fourth arg SERVICE is name of the service desired, or an integer specifying a port number to connect to. +Usage example: + + \(with-temp-buffer + \(open-gnutls-stream \"tls\" + \(current-buffer) + \"your server goes here\" + \"imaps\")) + This is a very simple wrapper around `gnutls-negotiate'. See its documentation for the specific parameters you can use to open a GnuTLS connection, including specifying the credential type, trust and key files, and priority string." - (let ((proc (open-network-stream name buffer host service))) - (gnutls-negotiate proc 'gnutls-x509pki))) + (gnutls-negotiate (open-network-stream name buffer host service) + 'gnutls-x509pki + host)) + +(put 'gnutls-error + 'error-conditions + '(error gnutls-error)) +(put 'gnutls-error + 'error-message "GnuTLS error") (declare-function gnutls-boot "gnutls.c" (proc type proplist)) -(defun gnutls-negotiate (proc type &optional priority-string - trustfiles keyfiles) - "Negotiate a SSL/TLS connection. +(defun gnutls-negotiate (proc type hostname &optional priority-string + trustfiles keyfiles verify-flags + verify-error verify-hostname-error) + "Negotiate a SSL/TLS connection. Returns proc. Signals gnutls-error. TYPE is `gnutls-x509pki' (default) or `gnutls-anon'. Use nil for the default. PROC is a process returned by `open-network-stream'. +HOSTNAME is the remote hostname. It must be a valid string. PRIORITY-STRING is as per the GnuTLS docs, default is \"NORMAL\". TRUSTFILES is a list of CA bundles. -KEYFILES is a list of client keys." +KEYFILES is a list of client keys. + +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. + +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. + +VERIFY-FLAGS is a numeric OR of verification flags only for +`gnutls-x509pki' connections. See GnuTLS' x509.h for details; +here's a recent version of the list. + + GNUTLS_VERIFY_DISABLE_CA_SIGN = 1, + GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT = 2, + GNUTLS_VERIFY_DO_NOT_ALLOW_SAME = 4, + GNUTLS_VERIFY_ALLOW_ANY_X509_V1_CA_CRT = 8, + GNUTLS_VERIFY_ALLOW_SIGN_RSA_MD2 = 16, + GNUTLS_VERIFY_ALLOW_SIGN_RSA_MD5 = 32, + GNUTLS_VERIFY_DISABLE_TIME_CHECKS = 64, + GNUTLS_VERIFY_DISABLE_TRUSTED_TIME_CHECKS = 128, + GNUTLS_VERIFY_DO_NOT_ALLOW_X509_V1_CA_CRT = 256 + +It must be omitted, a number, or nil; if omitted or nil it +defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT." (let* ((type (or type 'gnutls-x509pki)) + (default-trustfile "/etc/ssl/certs/ca-certificates.crt") (trustfiles (or trustfiles - '("/etc/ssl/certs/ca-certificates.crt"))) + (when (file-exists-p default-trustfile) + (list default-trustfile)))) (priority-string (or priority-string (cond ((eq type 'gnutls-anon) @@ -86,15 +137,23 @@ KEYFILES is a list of client keys." ((eq type 'gnutls-x509pki) "NORMAL")))) (params `(:priority ,priority-string + :hostname ,hostname :loglevel ,gnutls-log-level :trustfiles ,trustfiles :keyfiles ,keyfiles + :verify-flags ,verify-flags + :verify-error ,verify-error + :verify-hostname-error ,verify-hostname-error :callbacks nil)) ret) (gnutls-message-maybe (setq ret (gnutls-boot proc type params)) - "boot: %s") + "boot: %s" params) + + (when (gnutls-errorp ret) + ;; This is a error from the underlying C code. + (signal 'gnutls-error (list proc ret))) proc)) diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el index 67bb7eae68e..09519e14870 100644 --- a/lisp/net/network-stream.el +++ b/lisp/net/network-stream.el @@ -46,7 +46,8 @@ (require 'starttls) (declare-function gnutls-negotiate "gnutls" - (proc type &optional priority-string trustfiles keyfiles)) + (proc type host &optional priority-string trustfiles keyfiles + verify-flags verify-error verify-hostname-error)) ;;;###autoload (defun open-network-stream (name buffer host service &rest parameters) @@ -197,7 +198,7 @@ values: (network-stream-command stream starttls-command eoc)) ;; The server said it was OK to begin STARTTLS negotiations. (if (fboundp 'open-gnutls-stream) - (gnutls-negotiate stream nil) + (gnutls-negotiate stream nil host) (unless (starttls-negotiate stream) (delete-process stream))) (if (memq (process-status stream) '(open run)) -- 2.39.2