diff options
| author | Ted Zlatanov | 2011-05-03 20:44:58 -0500 |
|---|---|---|
| committer | Ted Zlatanov | 2011-05-03 20:44:58 -0500 |
| commit | 48e79d6a80c1ef67fae3f8fd45d753be5cb58ea4 (patch) | |
| tree | b5a2879697c54e52eed58e24fdac7e31b15766ad | |
| parent | ef80fc093a3b13ee9c1575c54b7831bc9cf2ef8b (diff) | |
| download | emacs-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/ChangeLog | 10 | ||||
| -rw-r--r-- | lisp/net/gnutls.el | 34 | ||||
| -rw-r--r-- | lisp/net/network-stream.el | 6 |
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 @@ | |||
| 1 | 2011-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 | |||
| 1 | 2011-05-04 Stefan Monnier <monnier@iro.umontreal.ca> | 11 | 2011-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 | |||
| 72 | documentation for the specific parameters you can use to open a | 74 | documentation for the specific parameters you can use to open a |
| 73 | GnuTLS connection, including specifying the credential type, | 75 | GnuTLS connection, including specifying the credential type, |
| 74 | trust and key files, and priority string." | 76 | trust 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 | |||
| 98 | Note arguments are passed CL style, :type TYPE instead of just TYPE. | ||
| 99 | |||
| 92 | TYPE is `gnutls-x509pki' (default) or `gnutls-anon'. Use nil for the default. | 100 | TYPE is `gnutls-x509pki' (default) or `gnutls-anon'. Use nil for the default. |
| 93 | PROC is a process returned by `open-network-stream'. | 101 | PROCESS is a process returned by `open-network-stream'. |
| 94 | HOSTNAME is the remote hostname. It must be a valid string. | 102 | HOSTNAME is the remote hostname. It must be a valid string. |
| 95 | PRIORITY-STRING is as per the GnuTLS docs, default is \"NORMAL\". | 103 | PRIORITY-STRING is as per the GnuTLS docs, default is \"NORMAL\". |
| 96 | TRUSTFILES is a list of CA bundles. | 104 | TRUSTFILES is a list of CA bundles. |
| 97 | KEYFILES is a list of client keys. | 105 | CRLFILES is a list of CRL files. |
| 106 | KEYLIST is an alist of (client key file, client cert file) pairs. | ||
| 98 | 107 | ||
| 99 | When VERIFY-HOSTNAME-ERROR is not nil, an error will be raised | 108 | When VERIFY-HOSTNAME-ERROR is not nil, an error will be raised |
| 100 | when the hostname does not match the presented certificate's host | 109 | when 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)) |