mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-24 06:20:43 -08:00
Code Issues Projects Releases Wiki Activity

Use built-in TLS support if `gnutls-available-p' is true.

Browse source
This commit is contained in:
Lars Magne Ingebrigtsen 2011-06-26 10:13:07 +02:00
parent 6302e0d3ce
commit 2db18f3ffa
2 changed files with 17 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

6
lisp/ChangeLog
View file

@ -1,3 +1,9 @@
2011-06-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
* net/network-stream.el (network-stream-open-starttls): Use
built-in TLS support if `gnutls-available-p' is true.
(network-stream-open-tls): Ditto.
2011-06-26 Leo Liu <sdl.web@gmail.com> 2011-06-26 Leo Liu <sdl.web@gmail.com>
* register.el (registerv): New struct. * register.el (registerv): New struct.

17
lisp/net/network-stream.el
View file

@ -46,7 +46,8 @@
(require 'starttls) (require 'starttls)
(require 'auth-source) (require 'auth-source)
(declare-function gnutls-negotiate "gnutls" t t) ; defun* (autoload 'gnutls-negotiate "gnutls")
(autoload 'open-gnutls-stream "gnutls")
;;;###autoload ;;;###autoload
(defun open-network-stream (name buffer host service &rest parameters) (defun open-network-stream (name buffer host service &rest parameters)
@ -207,11 +208,13 @@ functionality.
(greeting (network-stream-get-response stream start eoc)) (greeting (network-stream-get-response stream start eoc))
(capabilities (network-stream-command stream capability-command eoc)) (capabilities (network-stream-command stream capability-command eoc))
(resulting-type 'plain) (resulting-type 'plain)
(builtin-starttls (and (fboundp 'gnutls-available-p)
(gnutls-available-p)))
starttls-command) starttls-command)
;; If we have built-in STARTTLS support, try to upgrade the ;; If we have built-in STARTTLS support, try to upgrade the
;; connection. ;; connection.
(when (and (or (fboundp 'open-gnutls-stream) (when (and (or builtin-starttls
(and (or require-tls (and (or require-tls
(plist-get parameters :use-starttls-if-possible)) (plist-get parameters :use-starttls-if-possible))
(executable-find "gnutls-cli"))) (executable-find "gnutls-cli")))
@ -221,7 +224,7 @@ functionality.
(not (eq (plist-get parameters :type) 'plain))) (not (eq (plist-get parameters :type) 'plain)))
;; If using external STARTTLS, drop this connection and start ;; If using external STARTTLS, drop this connection and start
;; anew with `starttls-open-stream'. ;; anew with `starttls-open-stream'.
(unless (fboundp 'open-gnutls-stream) (unless builtin-starttls
(delete-process stream) (delete-process stream)
(setq start (with-current-buffer buffer (point-max))) (setq start (with-current-buffer buffer (point-max)))
(let* ((starttls-use-gnutls t) (let* ((starttls-use-gnutls t)
@ -248,7 +251,7 @@ functionality.
(when (string-match success-string (when (string-match success-string
(network-stream-command stream starttls-command eoc)) (network-stream-command stream starttls-command eoc))
;; The server said it was OK to begin STARTTLS negotiations. ;; The server said it was OK to begin STARTTLS negotiations.
(if (fboundp 'open-gnutls-stream) (if builtin-starttls
(let ((cert (network-stream-certificate host service parameters))) (let ((cert (network-stream-certificate host service parameters)))
(gnutls-negotiate :process stream :hostname host (gnutls-negotiate :process stream :hostname host
:keylist (and cert (list cert)))) :keylist (and cert (list cert))))
@ -296,7 +299,8 @@ functionality.
(defun network-stream-open-tls (name buffer host service parameters) (defun network-stream-open-tls (name buffer host service parameters)
(with-current-buffer buffer (with-current-buffer buffer
(let* ((start (point-max)) (let* ((start (point-max))
(use-builtin-gnutls (fboundp 'open-gnutls-stream)) (use-builtin-gnutls (and (fboundp 'gnutls-available-p)
(gnutls-available-p)))
(stream (stream
(funcall (if use-builtin-gnutls (funcall (if use-builtin-gnutls
'open-gnutls-stream 'open-gnutls-stream
@ -307,7 +311,8 @@ functionality.
(list nil nil nil 'plain) (list nil nil nil 'plain)
;; If we're using tls.el, we have to delete the output from ;; If we're using tls.el, we have to delete the output from
;; openssl/gnutls-cli. ;; openssl/gnutls-cli.
(when (and (null use-builtin-gnutls) eoc) (when (and (null use-builtin-gnutls)
eoc)
(network-stream-get-response stream start eoc) (network-stream-get-response stream start eoc)
(goto-char (point-min)) (goto-char (point-min))
(when (re-search-forward eoc nil t) (when (re-search-forward eoc nil t)