gnutls.el 7.34 KB
Newer Older
1
;;; gnutls.el --- Support SSL/TLS connections through GnuTLS
2

3
;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
Ted Zlatanov's avatar
Ted Zlatanov committed
4 5 6 7

;; Author: Ted Zlatanov <tzz@lifelogs.com>
;; Keywords: comm, tls, ssl, encryption
;; Originally-By: Simon Josefsson (See http://josefsson.org/emacs-security/)
8
;; Thanks-To: Lars Magne Ingebrigtsen <larsi@gnus.org>
Ted Zlatanov's avatar
Ted Zlatanov committed
9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; This package provides language bindings for the GnuTLS library
28 29
;; using the corresponding core functions in gnutls.c.  It should NOT
;; be used directly, only through open-protocol-stream.
Ted Zlatanov's avatar
Ted Zlatanov committed
30 31 32

;; Simple test:
;;
33 34
;; (open-gnutls-stream "tls" "tls-buffer" "yourserver.com" "https")
;; (open-gnutls-stream "tls" "tls-buffer" "imap.gmail.com" "imaps")
Ted Zlatanov's avatar
Ted Zlatanov committed
35 36 37

;;; Code:

38 39
(eval-when-compile (require 'cl))

40 41 42 43 44
(defgroup gnutls nil
  "Emacs interface to the GnuTLS library."
  :prefix "gnutls-"
  :group 'net-utils)

45
(defcustom gnutls-log-level 0
46 47 48 49
  "Logging level to be used by `starttls-negotiate' and GnuTLS."
  :type 'integer
  :group 'gnutls)

50 51 52 53 54 55 56
(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))

57 58
(defun open-gnutls-stream (name buffer host service)
  "Open a SSL/TLS connection for a service to a host.
Ted Zlatanov's avatar
Ted Zlatanov committed
59 60 61 62 63 64 65 66 67 68 69
Returns a subprocess-object to represent the connection.
Input and output work as for subprocesses; `delete-process' closes it.
Args are NAME BUFFER HOST SERVICE.
NAME is name for process.  It is modified if necessary to make it unique.
BUFFER is the buffer (or `buffer-name') to associate with the process.
 Process output goes at end of that buffer, unless you specify
 an output stream or filter function to handle the output.
 BUFFER may be also nil, meaning that this process is not associated
 with any buffer
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
70 71
specifying a port number to connect to.

72 73 74 75 76 77 78 79
Usage example:

  \(with-temp-buffer
    \(open-gnutls-stream \"tls\"
                        \(current-buffer)
                        \"your server goes here\"
                        \"imaps\"))

80 81 82 83
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."
84 85 86
  (gnutls-negotiate :process (open-network-stream name buffer host service)
                    :type 'gnutls-x509pki
                    :hostname host))
87 88 89 90 91 92

(put 'gnutls-error
     'error-conditions
     '(error gnutls-error))
(put 'gnutls-error
     'error-message "GnuTLS error")
Ted Zlatanov's avatar
Ted Zlatanov committed
93

94
(declare-function gnutls-boot "gnutls.c" (proc type proplist))
95
(declare-function gnutls-errorp "gnutls.c" (error))
96

97 98 99 100 101 102
(defun* gnutls-negotiate
    (&rest spec
           &key process type hostname priority-string
           trustfiles crlfiles keylist verify-flags
           verify-error verify-hostname-error
           &allow-other-keys)
103
  "Negotiate a SSL/TLS connection.  Returns proc. Signals gnutls-error.
104 105 106

Note arguments are passed CL style, :type TYPE instead of just TYPE.

107
TYPE is `gnutls-x509pki' (default) or `gnutls-anon'.  Use nil for the default.
108
PROCESS is a process returned by `open-network-stream'.
109
HOSTNAME is the remote hostname.  It must be a valid string.
110 111
PRIORITY-STRING is as per the GnuTLS docs, default is \"NORMAL\".
TRUSTFILES is a list of CA bundles.
112 113
CRLFILES is a list of CRL files.
KEYLIST is an alist of (client key file, client cert file) pairs.
114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144

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."
145
  (let* ((type (or type 'gnutls-x509pki))
146
         (default-trustfile "/etc/ssl/certs/ca-certificates.crt")
147
         (trustfiles (or trustfiles
148 149
                         (when (file-exists-p default-trustfile)
                           (list default-trustfile))))
Ted Zlatanov's avatar
Ted Zlatanov committed
150 151
         (priority-string (or priority-string
                              (cond
152
                               ((eq type 'gnutls-anon)
Ted Zlatanov's avatar
Ted Zlatanov committed
153
                                "NORMAL:+ANON-DH:!ARCFOUR-128")
154
                               ((eq type 'gnutls-x509pki)
155
                                (or gnutls-algorithm-priority "NORMAL")))))
156
         (params `(:priority ,priority-string
157
                             :hostname ,hostname
158 159
                             :loglevel ,gnutls-log-level
                             :trustfiles ,trustfiles
160 161
                             :crlfiles ,crlfiles
                             :keylist ,keylist
162 163 164
                             :verify-flags ,verify-flags
                             :verify-error ,verify-error
                             :verify-hostname-error ,verify-hostname-error
165
                             :callbacks nil))
Ted Zlatanov's avatar
Ted Zlatanov committed
166 167 168
         ret)

    (gnutls-message-maybe
169
     (setq ret (gnutls-boot process type params))
170 171 172 173
     "boot: %s" params)

    (when (gnutls-errorp ret)
      ;; This is a error from the underlying C code.
174
      (signal 'gnutls-error (list process ret)))
Ted Zlatanov's avatar
Ted Zlatanov committed
175

176
    process))
Ted Zlatanov's avatar
Ted Zlatanov committed
177

178 179
(declare-function gnutls-error-string "gnutls.c" (error))

Ted Zlatanov's avatar
Ted Zlatanov committed
180 181 182 183 184 185 186 187 188 189 190 191
(defun gnutls-message-maybe (doit format &rest params)
  "When DOIT, message with the caller name followed by FORMAT on PARAMS."
  ;; (apply 'debug format (or params '(nil)))
  (when (gnutls-errorp doit)
    (message "%s: (err=[%s] %s) %s"
             "gnutls.el"
             doit (gnutls-error-string doit)
             (apply 'format format (or params '(nil))))))

(provide 'gnutls)

;;; gnutls.el ends here