;;; gnutls.el --- Support SSL/TLS connections through GnuTLS
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
;; Author: Ted Zlatanov <tzz@lifelogs.com>
;; Keywords: comm, tls, ssl, encryption
;;; 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:
;;
;;; Code:
+(eval-when-compile (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-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)
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 :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")
(declare-function gnutls-boot "gnutls.c" (proc type proplist))
+(declare-function gnutls-errorp "gnutls.c" (error))
+
+(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 &optional priority-string
- trustfiles keyfiles)
- "Negotiate a SSL/TLS connection.
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."
+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.
+
+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))
(trustfiles (or trustfiles
- '("/etc/ssl/certs/ca-certificates.crt")))
+ (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"))))
+ (if gnutls-algorithm-priority
+ (upcase gnutls-algorithm-priority)
+ "NORMAL")))))
+ (min-prime-bits (or min-prime-bits gnutls-min-prime-bits))
(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))
- "boot: %s")
+ (setq ret (gnutls-boot process type params))
+ "boot: %s" params)
- proc))
+ (when (gnutls-errorp ret)
+ ;; This is a error from the underlying C code.
+ (signal 'gnutls-error (list process ret)))
+
+ process))
-(declare-function gnutls-errorp "gnutls.c" (error))
(declare-function gnutls-error-string "gnutls.c" (error))
(defun gnutls-message-maybe (doit format &rest params)