X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/bc5576723b2ddaa0b4cb6a6ba368fa71bc5a8a0c..c8d4b74cfa26762d34fd1703a07463008b32be16:/lisp/net/gnutls.el diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el index e49af2948e..9cb071b185 100644 --- a/lisp/net/gnutls.el +++ b/lisp/net/gnutls.el @@ -1,6 +1,6 @@ ;;; gnutls.el --- Support SSL/TLS connections through GnuTLS -;; Copyright (C) 2010 Free Software Foundation, Inc. +;; Copyright (C) 2010-2011 Free Software Foundation, Inc. ;; Author: Ted Zlatanov ;; Keywords: comm, tls, ssl, encryption @@ -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: ;; @@ -34,14 +35,31 @@ ;;; Code: +(eval-when-compile (require 'cl)) + (defgroup gnutls nil "Emacs interface to the GnuTLS library." :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\"." + :type '(choice (const nil) + string)) + +;;;###autoload +(defcustom gnutls-min-prime-bits nil + "The minimum number of bits to be used in Diffie-Hellman key exchange. + +This sets the minimum accepted size of the key to be used in a +client-server handshake. If the server sends a prime with fewer than +the specified number of bits the handshake will fail. + +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) @@ -59,46 +77,119 @@ 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 :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)) + +(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." +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)) + (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) "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)