;;; gnutls.el --- Support SSL/TLS connections through GnuTLS
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2014 Free Software Foundation, Inc.
;; Author: Ted Zlatanov <tzz@lifelogs.com>
;; Keywords: comm, tls, ssl, encryption
;;; Code:
+(require 'cl-lib)
+
(defgroup gnutls nil
"Emacs interface to the GnuTLS library."
+ :version "24.1"
:prefix "gnutls-"
:group 'net-utils)
-(defcustom gnutls-log-level 0
- "Logging level to be used by `starttls-negotiate' and GnuTLS."
- :type 'integer
+(defcustom gnutls-algorithm-priority nil
+ "If non-nil, this should be a TLS priority string.
+For instance, if you want to skip the \"dhe-rsa\" algorithm,
+set this variable to \"normal:-dhe-rsa\"."
+ :group 'gnutls
+ :type '(choice (const nil)
+ string))
+
+(defcustom gnutls-verify-error nil
+ "If non-nil, this should be a list of checks per hostname regex or t."
+ :group 'gnutls
+ :version "24.4"
+ :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
+ "/etc/pki/tls/certs/ca-bundle.crt" ; Fedora and RHEL
+ "/etc/ssl/ca-bundle.pem" ; Suse
+ "/usr/ssl/certs/ca-bundle.crt" ; Cygwin
+ )
+ "List of CA bundle location filenames or a function returning said list.
+The files may be in PEM or DER format, as per the GnuTLS documentation.
+The files may not exist, in which case they will be ignored."
+ :group 'gnutls
+ :type '(choice (function :tag "Function to produce list of bundle filenames")
+ (repeat (file :tag "Bundle filename"))))
+
+;;;###autoload
+(defcustom gnutls-min-prime-bits 256
+ ;; Several mail servers send fewer bits than the GnuTLS default.
+ ;; Currently, 256 appears to be a reasonable choice (Bug#11267).
+ "Minimum number of prime bits accepted by GnuTLS for key exchange.
+During a Diffie-Hellman handshake, if the server sends a prime
+number with fewer than this number of bits, the handshake is
+rejected. \(The smaller the prime number, the less secure the
+key exchange is against man-in-the-middle attacks.)
+
+A value of nil says to use the default GnuTLS value."
+ :type '(choice (const :tag "Use default value" nil)
+ (integer :tag "Number of bits" 512))
:group 'gnutls)
(defun open-gnutls-stream (name buffer host service)
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."
- (gnutls-negotiate (open-network-stream name buffer host service)
- 'gnutls-x509pki
- host))
+ (gnutls-negotiate :process (open-network-stream name buffer host service)
+ :type 'gnutls-x509pki
+ :hostname host))
-(put 'gnutls-error
- 'error-conditions
- '(error gnutls-error))
-(put 'gnutls-error
- 'error-message "GnuTLS error")
+(define-error 'gnutls-error "GnuTLS error")
(declare-function gnutls-boot "gnutls.c" (proc type proplist))
(declare-function gnutls-errorp "gnutls.c" (error))
+(defvar gnutls-log-level) ; gnutls.c
+
+(cl-defun gnutls-negotiate
+ (&rest spec
+ &key process type hostname priority-string
+ trustfiles crlfiles keylist min-prime-bits
+ verify-flags verify-error verify-hostname-error
+ &allow-other-keys)
+ "Negotiate a SSL/TLS connection. Returns proc. Signals gnutls-error.
+
+Note arguments are passed CL style, :type TYPE instead of just TYPE.
-(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'.
+PROCESS 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.
-
-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.
+TRUSTFILES is a list of CA bundles. It defaults to `gnutls-trustfiles'.
+CRLFILES is a list of CRL files.
+KEYLIST is an alist of (client key file, client cert file) pairs.
+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.
+
+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 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;
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
- (when (file-exists-p default-trustfile)
- (list default-trustfile))))
+ (delq nil
+ (mapcar (lambda (f) (and f (file-exists-p f) f))
+ (if (functionp gnutls-trustfiles)
+ (funcall gnutls-trustfiles)
+ gnutls-trustfiles)))))
(priority-string (or priority-string
(cond
((eq type 'gnutls-anon)
"NORMAL:+ANON-DH:!ARCFOUR-128")
((eq type 'gnutls-x509pki)
- "NORMAL"))))
- (params `(:priority ,priority-string
+ (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)
+ (cl-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 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
:trustfiles ,trustfiles
- :keyfiles ,keyfiles
+ :crlfiles ,crlfiles
+ :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 proc type params))
+ (setq ret (gnutls-boot process type params))
"boot: %s" params)
(when (gnutls-errorp ret)
;; This is a error from the underlying C code.
- (signal 'gnutls-error (list proc ret)))
+ (signal 'gnutls-error (list process ret)))
- proc))
+ process))
(declare-function gnutls-error-string "gnutls.c" (error))