diff options
| author | Lars Magne Ingebrigtsen | 2011-06-26 10:13:07 +0200 |
|---|---|---|
| committer | Lars Magne Ingebrigtsen | 2011-06-26 10:13:07 +0200 |
| commit | 2db18f3ffa5ade74429c6533e4bb22a3ee93cb6d (patch) | |
| tree | 7897f232c3c4fef9f20e27ff11dcf1a0e304b11f | |
| parent | 6302e0d3ceb59aa9c255d9706ce704543369b4bb (diff) | |
| download | emacs-2db18f3ffa5ade74429c6533e4bb22a3ee93cb6d.tar.gz emacs-2db18f3ffa5ade74429c6533e4bb22a3ee93cb6d.zip | |
Use built-in TLS support if `gnutls-available-p' is true.
| -rw-r--r-- | lisp/ChangeLog | 6 | ||||
| -rw-r--r-- | lisp/net/network-stream.el | 17 |
2 files changed, 17 insertions, 6 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 52cb69b7d66..9c67ce8e0e5 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,9 @@ | |||
| 1 | 2011-06-26 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 2 | |||
| 3 | * net/network-stream.el (network-stream-open-starttls): Use | ||
| 4 | built-in TLS support if `gnutls-available-p' is true. | ||
| 5 | (network-stream-open-tls): Ditto. | ||
| 6 | |||
| 1 | 2011-06-26 Leo Liu <sdl.web@gmail.com> | 7 | 2011-06-26 Leo Liu <sdl.web@gmail.com> |
| 2 | 8 | ||
| 3 | * register.el (registerv): New struct. | 9 | * register.el (registerv): New struct. |
diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el index 161d7252d6e..94507f16540 100644 --- a/lisp/net/network-stream.el +++ b/lisp/net/network-stream.el | |||
| @@ -46,7 +46,8 @@ | |||
| 46 | (require 'starttls) | 46 | (require 'starttls) |
| 47 | (require 'auth-source) | 47 | (require 'auth-source) |
| 48 | 48 | ||
| 49 | (declare-function gnutls-negotiate "gnutls" t t) ; defun* | 49 | (autoload 'gnutls-negotiate "gnutls") |
| 50 | (autoload 'open-gnutls-stream "gnutls") | ||
| 50 | 51 | ||
| 51 | ;;;###autoload | 52 | ;;;###autoload |
| 52 | (defun open-network-stream (name buffer host service &rest parameters) | 53 | (defun open-network-stream (name buffer host service &rest parameters) |
| @@ -207,11 +208,13 @@ functionality. | |||
| 207 | (greeting (network-stream-get-response stream start eoc)) | 208 | (greeting (network-stream-get-response stream start eoc)) |
| 208 | (capabilities (network-stream-command stream capability-command eoc)) | 209 | (capabilities (network-stream-command stream capability-command eoc)) |
| 209 | (resulting-type 'plain) | 210 | (resulting-type 'plain) |
| 211 | (builtin-starttls (and (fboundp 'gnutls-available-p) | ||
| 212 | (gnutls-available-p))) | ||
| 210 | starttls-command) | 213 | starttls-command) |
| 211 | 214 | ||
| 212 | ;; If we have built-in STARTTLS support, try to upgrade the | 215 | ;; If we have built-in STARTTLS support, try to upgrade the |
| 213 | ;; connection. | 216 | ;; connection. |
| 214 | (when (and (or (fboundp 'open-gnutls-stream) | 217 | (when (and (or builtin-starttls |
| 215 | (and (or require-tls | 218 | (and (or require-tls |
| 216 | (plist-get parameters :use-starttls-if-possible)) | 219 | (plist-get parameters :use-starttls-if-possible)) |
| 217 | (executable-find "gnutls-cli"))) | 220 | (executable-find "gnutls-cli"))) |
| @@ -221,7 +224,7 @@ functionality. | |||
| 221 | (not (eq (plist-get parameters :type) 'plain))) | 224 | (not (eq (plist-get parameters :type) 'plain))) |
| 222 | ;; If using external STARTTLS, drop this connection and start | 225 | ;; If using external STARTTLS, drop this connection and start |
| 223 | ;; anew with `starttls-open-stream'. | 226 | ;; anew with `starttls-open-stream'. |
| 224 | (unless (fboundp 'open-gnutls-stream) | 227 | (unless builtin-starttls |
| 225 | (delete-process stream) | 228 | (delete-process stream) |
| 226 | (setq start (with-current-buffer buffer (point-max))) | 229 | (setq start (with-current-buffer buffer (point-max))) |
| 227 | (let* ((starttls-use-gnutls t) | 230 | (let* ((starttls-use-gnutls t) |
| @@ -248,7 +251,7 @@ functionality. | |||
| 248 | (when (string-match success-string | 251 | (when (string-match success-string |
| 249 | (network-stream-command stream starttls-command eoc)) | 252 | (network-stream-command stream starttls-command eoc)) |
| 250 | ;; The server said it was OK to begin STARTTLS negotiations. | 253 | ;; The server said it was OK to begin STARTTLS negotiations. |
| 251 | (if (fboundp 'open-gnutls-stream) | 254 | (if builtin-starttls |
| 252 | (let ((cert (network-stream-certificate host service parameters))) | 255 | (let ((cert (network-stream-certificate host service parameters))) |
| 253 | (gnutls-negotiate :process stream :hostname host | 256 | (gnutls-negotiate :process stream :hostname host |
| 254 | :keylist (and cert (list cert)))) | 257 | :keylist (and cert (list cert)))) |
| @@ -296,7 +299,8 @@ functionality. | |||
| 296 | (defun network-stream-open-tls (name buffer host service parameters) | 299 | (defun network-stream-open-tls (name buffer host service parameters) |
| 297 | (with-current-buffer buffer | 300 | (with-current-buffer buffer |
| 298 | (let* ((start (point-max)) | 301 | (let* ((start (point-max)) |
| 299 | (use-builtin-gnutls (fboundp 'open-gnutls-stream)) | 302 | (use-builtin-gnutls (and (fboundp 'gnutls-available-p) |
| 303 | (gnutls-available-p))) | ||
| 300 | (stream | 304 | (stream |
| 301 | (funcall (if use-builtin-gnutls | 305 | (funcall (if use-builtin-gnutls |
| 302 | 'open-gnutls-stream | 306 | 'open-gnutls-stream |
| @@ -307,7 +311,8 @@ functionality. | |||
| 307 | (list nil nil nil 'plain) | 311 | (list nil nil nil 'plain) |
| 308 | ;; If we're using tls.el, we have to delete the output from | 312 | ;; If we're using tls.el, we have to delete the output from |
| 309 | ;; openssl/gnutls-cli. | 313 | ;; openssl/gnutls-cli. |
| 310 | (when (and (null use-builtin-gnutls) eoc) | 314 | (when (and (null use-builtin-gnutls) |
| 315 | eoc) | ||
| 311 | (network-stream-get-response stream start eoc) | 316 | (network-stream-get-response stream start eoc) |
| 312 | (goto-char (point-min)) | 317 | (goto-char (point-min)) |
| 313 | (when (re-search-forward eoc nil t) | 318 | (when (re-search-forward eoc nil t) |