aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorTed Zlatanov2011-05-03 20:44:58 -0500
committerTed Zlatanov2011-05-03 20:44:58 -0500
commit48e79d6a80c1ef67fae3f8fd45d753be5cb58ea4 (patch)
treeb5a2879697c54e52eed58e24fdac7e31b15766ad
parentef80fc093a3b13ee9c1575c54b7831bc9cf2ef8b (diff)
downloademacs-48e79d6a80c1ef67fae3f8fd45d753be5cb58ea4.tar.gz
emacs-48e79d6a80c1ef67fae3f8fd45d753be5cb58ea4.zip
Use CL-style keyword arguments for `gnutls-negotiate' and allow :keylist and :crlfiles arguments.
* lisp/net/gnutls.el (gnutls-negotiate): Use CL-style keyword arguments instead of positional arguments. Allow :keylist and :crlfiles arguments. (open-gnutls-stream): Call it. * lisp/net/network-stream.el (network-stream-open-starttls): Adjust to call `gnutls-negotiate' with :process and :hostname arguments.
-rw-r--r--lisp/ChangeLog10
-rw-r--r--lisp/net/gnutls.el34
-rw-r--r--lisp/net/network-stream.el6
3 files changed, 34 insertions, 16 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 65a2ba029dd..21c2acf72a6 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,13 @@
12011-05-04 Teodor Zlatanov <tzz@lifelogs.com>
2
3 * net/gnutls.el (gnutls-negotiate): Use CL-style keyword arguments
4 instead of positional arguments. Allow :keylist and :crlfiles
5 arguments.
6 (open-gnutls-stream): Call it.
7
8 * net/network-stream.el (network-stream-open-starttls): Adjust to
9 call `gnutls-negotiate' with :process and :hostname arguments.
10
12011-05-04 Stefan Monnier <monnier@iro.umontreal.ca> 112011-05-04 Stefan Monnier <monnier@iro.umontreal.ca>
2 12
3 * minibuffer.el (completion--message): New function. 13 * minibuffer.el (completion--message): New function.
diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el
index 8b662795665..67d7b2d20d3 100644
--- a/lisp/net/gnutls.el
+++ b/lisp/net/gnutls.el
@@ -35,6 +35,8 @@
35 35
36;;; Code: 36;;; Code:
37 37
38(eval-when-compile (require 'cl))
39
38(defgroup gnutls nil 40(defgroup gnutls nil
39 "Emacs interface to the GnuTLS library." 41 "Emacs interface to the GnuTLS library."
40 :prefix "gnutls-" 42 :prefix "gnutls-"
@@ -72,9 +74,9 @@ This is a very simple wrapper around `gnutls-negotiate'. See its
72documentation for the specific parameters you can use to open a 74documentation for the specific parameters you can use to open a
73GnuTLS connection, including specifying the credential type, 75GnuTLS connection, including specifying the credential type,
74trust and key files, and priority string." 76trust and key files, and priority string."
75 (gnutls-negotiate (open-network-stream name buffer host service) 77 (gnutls-negotiate :process (open-network-stream name buffer host service)
76 'gnutls-x509pki 78 :type 'gnutls-x509pki
77 host)) 79 :hostname host))
78 80
79(put 'gnutls-error 81(put 'gnutls-error
80 'error-conditions 82 'error-conditions
@@ -85,16 +87,23 @@ trust and key files, and priority string."
85(declare-function gnutls-boot "gnutls.c" (proc type proplist)) 87(declare-function gnutls-boot "gnutls.c" (proc type proplist))
86(declare-function gnutls-errorp "gnutls.c" (error)) 88(declare-function gnutls-errorp "gnutls.c" (error))
87 89
88(defun gnutls-negotiate (proc type hostname &optional priority-string 90(defun* gnutls-negotiate
89 trustfiles keyfiles verify-flags 91 (&rest spec
90 verify-error verify-hostname-error) 92 &key process type hostname priority-string
93 trustfiles crlfiles keylist verify-flags
94 verify-error verify-hostname-error
95 &allow-other-keys)
91 "Negotiate a SSL/TLS connection. Returns proc. Signals gnutls-error. 96 "Negotiate a SSL/TLS connection. Returns proc. Signals gnutls-error.
97
98Note arguments are passed CL style, :type TYPE instead of just TYPE.
99
92TYPE is `gnutls-x509pki' (default) or `gnutls-anon'. Use nil for the default. 100TYPE is `gnutls-x509pki' (default) or `gnutls-anon'. Use nil for the default.
93PROC is a process returned by `open-network-stream'. 101PROCESS is a process returned by `open-network-stream'.
94HOSTNAME is the remote hostname. It must be a valid string. 102HOSTNAME is the remote hostname. It must be a valid string.
95PRIORITY-STRING is as per the GnuTLS docs, default is \"NORMAL\". 103PRIORITY-STRING is as per the GnuTLS docs, default is \"NORMAL\".
96TRUSTFILES is a list of CA bundles. 104TRUSTFILES is a list of CA bundles.
97KEYFILES is a list of client keys. 105CRLFILES is a list of CRL files.
106KEYLIST is an alist of (client key file, client cert file) pairs.
98 107
99When VERIFY-HOSTNAME-ERROR is not nil, an error will be raised 108When VERIFY-HOSTNAME-ERROR is not nil, an error will be raised
100when the hostname does not match the presented certificate's host 109when the hostname does not match the presented certificate's host
@@ -141,7 +150,8 @@ defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
141 :hostname ,hostname 150 :hostname ,hostname
142 :loglevel ,gnutls-log-level 151 :loglevel ,gnutls-log-level
143 :trustfiles ,trustfiles 152 :trustfiles ,trustfiles
144 :keyfiles ,keyfiles 153 :crlfiles ,crlfiles
154 :keylist ,keylist
145 :verify-flags ,verify-flags 155 :verify-flags ,verify-flags
146 :verify-error ,verify-error 156 :verify-error ,verify-error
147 :verify-hostname-error ,verify-hostname-error 157 :verify-hostname-error ,verify-hostname-error
@@ -149,14 +159,14 @@ defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
149 ret) 159 ret)
150 160
151 (gnutls-message-maybe 161 (gnutls-message-maybe
152 (setq ret (gnutls-boot proc type params)) 162 (setq ret (gnutls-boot process type params))
153 "boot: %s" params) 163 "boot: %s" params)
154 164
155 (when (gnutls-errorp ret) 165 (when (gnutls-errorp ret)
156 ;; This is a error from the underlying C code. 166 ;; This is a error from the underlying C code.
157 (signal 'gnutls-error (list proc ret))) 167 (signal 'gnutls-error (list process ret)))
158 168
159 proc)) 169 process))
160 170
161(declare-function gnutls-error-string "gnutls.c" (error)) 171(declare-function gnutls-error-string "gnutls.c" (error))
162 172
diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el
index 2071f790656..f3cfd7d058f 100644
--- a/lisp/net/network-stream.el
+++ b/lisp/net/network-stream.el
@@ -45,9 +45,7 @@
45(require 'tls) 45(require 'tls)
46(require 'starttls) 46(require 'starttls)
47 47
48(declare-function gnutls-negotiate "gnutls" 48(declare-function gnutls-negotiate "gnutls" (&rest spec))
49 (proc type host &optional priority-string trustfiles keyfiles
50 verify-flags verify-error verify-hostname-error))
51 49
52;;;###autoload 50;;;###autoload
53(defun open-network-stream (name buffer host service &rest parameters) 51(defun open-network-stream (name buffer host service &rest parameters)
@@ -203,7 +201,7 @@ asynchronously, if possible."
203 (network-stream-command stream starttls-command eoc)) 201 (network-stream-command stream starttls-command eoc))
204 ;; The server said it was OK to begin STARTTLS negotiations. 202 ;; The server said it was OK to begin STARTTLS negotiations.
205 (if (fboundp 'open-gnutls-stream) 203 (if (fboundp 'open-gnutls-stream)
206 (gnutls-negotiate stream nil host) 204 (gnutls-negotiate :process stream :hostname host)
207 (unless (starttls-negotiate stream) 205 (unless (starttls-negotiate stream)
208 (delete-process stream))) 206 (delete-process stream)))
209 (if (memq (process-status stream) '(open run)) 207 (if (memq (process-status stream) '(open run))