diff options
| author | Simon Josefsson | 2004-10-12 09:55:08 +0000 |
|---|---|---|
| committer | Simon Josefsson | 2004-10-12 09:55:08 +0000 |
| commit | 5bbb0eb9eaf5304206dbbe39c0b35f756cd77482 (patch) | |
| tree | 70a9a0c68d8f637e03b6c6d8c335b94f413f1dbd | |
| parent | 18965008d19ace53d4adea3eec5ea1168a7e3942 (diff) | |
| download | emacs-5bbb0eb9eaf5304206dbbe39c0b35f756cd77482.tar.gz emacs-5bbb0eb9eaf5304206dbbe39c0b35f756cd77482.zip | |
url-vars.el (url-gateway-method): Add new method `tls'.
url-news.el (url-snews): Use nntp-open-tls-stream if
url-gateway-method is tls.
url-ldap.el (url-ldap-certificate-formatter): Use
tls-certificate-information if ssl.el is not available.
url-https.el (url-https-create-secure-wrapper): Use tls if ssl
is not available.
url-gw.el (url-open-stream): Support tls url-gateway-method.
(url-open-stream): Likewise.
| -rw-r--r-- | lisp/url/url-gw.el | 6 | ||||
| -rw-r--r-- | lisp/url/url-https.el | 14 | ||||
| -rw-r--r-- | lisp/url/url-ldap.el | 4 | ||||
| -rw-r--r-- | lisp/url/url-news.el | 6 | ||||
| -rw-r--r-- | lisp/url/url-vars.el | 8 |
5 files changed, 24 insertions, 14 deletions
diff --git a/lisp/url/url-gw.el b/lisp/url/url-gw.el index 538d607d327..608827d7cee 100644 --- a/lisp/url/url-gw.el +++ b/lisp/url/url-gw.el | |||
| @@ -3,7 +3,7 @@ | |||
| 3 | ;; Keywords: comm, data, processes | 3 | ;; Keywords: comm, data, processes |
| 4 | 4 | ||
| 5 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 5 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 6 | ;;; Copyright (c) 1997, 1998 Free Software Foundation, Inc. | 6 | ;;; Copyright (c) 1997, 1998, 2004 Free Software Foundation, Inc. |
| 7 | ;;; | 7 | ;;; |
| 8 | ;;; This file is part of GNU Emacs. | 8 | ;;; This file is part of GNU Emacs. |
| 9 | ;;; | 9 | ;;; |
| @@ -29,6 +29,7 @@ | |||
| 29 | 29 | ||
| 30 | (autoload 'socks-open-network-stream "socks") | 30 | (autoload 'socks-open-network-stream "socks") |
| 31 | (autoload 'open-ssl-stream "ssl") | 31 | (autoload 'open-ssl-stream "ssl") |
| 32 | (autoload 'open-tls-stream "tls") | ||
| 32 | 33 | ||
| 33 | (defgroup url-gateway nil | 34 | (defgroup url-gateway nil |
| 34 | "URL gateway variables" | 35 | "URL gateway variables" |
| @@ -212,6 +213,7 @@ Args per `open-network-stream'. | |||
| 212 | Will not make a connexion if `url-gateway-unplugged' is non-nil." | 213 | Will not make a connexion if `url-gateway-unplugged' is non-nil." |
| 213 | (unless url-gateway-unplugged | 214 | (unless url-gateway-unplugged |
| 214 | (let ((gw-method (if (and url-gateway-local-host-regexp | 215 | (let ((gw-method (if (and url-gateway-local-host-regexp |
| 216 | (not (eq 'tls url-gateway-method)) | ||
| 215 | (not (eq 'ssl url-gateway-method)) | 217 | (not (eq 'ssl url-gateway-method)) |
| 216 | (string-match | 218 | (string-match |
| 217 | url-gateway-local-host-regexp | 219 | url-gateway-local-host-regexp |
| @@ -242,6 +244,8 @@ Will not make a connexion if `url-gateway-unplugged' is non-nil." | |||
| 242 | (let ((coding-system-for-read 'binary) | 244 | (let ((coding-system-for-read 'binary) |
| 243 | (coding-system-for-write 'binary)) | 245 | (coding-system-for-write 'binary)) |
| 244 | (setq conn (case gw-method | 246 | (setq conn (case gw-method |
| 247 | (tls | ||
| 248 | (open-tls-stream name buffer host service)) | ||
| 245 | (ssl | 249 | (ssl |
| 246 | (open-ssl-stream name buffer host service)) | 250 | (open-ssl-stream name buffer host service)) |
| 247 | ((native) | 251 | ((native) |
diff --git a/lisp/url/url-https.el b/lisp/url/url-https.el index 11b2593ea80..9631aeb18e4 100644 --- a/lisp/url/url-https.el +++ b/lisp/url/url-https.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; url-https.el --- HTTP over SSL routines | 1 | ;;; url-https.el --- HTTP over SSL/TLS routines |
| 2 | 2 | ||
| 3 | ;; Copyright (c) 1999, 2004 Free Software Foundation, Inc. | 3 | ;; Copyright (c) 1999, 2004 Free Software Foundation, Inc. |
| 4 | 4 | ||
| @@ -30,6 +30,7 @@ | |||
| 30 | (require 'url-parse) | 30 | (require 'url-parse) |
| 31 | (require 'url-cookie) | 31 | (require 'url-cookie) |
| 32 | (require 'url-http) | 32 | (require 'url-http) |
| 33 | (require 'tls) | ||
| 33 | 34 | ||
| 34 | (defconst url-https-default-port 443 "Default HTTPS port.") | 35 | (defconst url-https-default-port 443 "Default HTTPS port.") |
| 35 | (defconst url-https-asynchronous-p t "HTTPS retrievals are asynchronous.") | 36 | (defconst url-https-asynchronous-p t "HTTPS retrievals are asynchronous.") |
| @@ -38,12 +39,11 @@ | |||
| 38 | (defmacro url-https-create-secure-wrapper (method args) | 39 | (defmacro url-https-create-secure-wrapper (method args) |
| 39 | `(defun ,(intern (format (if method "url-https-%s" "url-https") method)) ,args | 40 | `(defun ,(intern (format (if method "url-https-%s" "url-https") method)) ,args |
| 40 | ,(format "HTTPS wrapper around `%s' call." (or method "url-http")) | 41 | ,(format "HTTPS wrapper around `%s' call." (or method "url-http")) |
| 41 | (condition-case () | 42 | (let ((url-gateway-method (condition-case () |
| 42 | (require 'ssl) | 43 | (require 'ssl) |
| 43 | (error | 44 | (error 'tls)))) |
| 44 | (error "HTTPS support could not find `ssl' library"))) | 45 | (,(intern (format (if method "url-http-%s" "url-http") method)) |
| 45 | (let ((url-gateway-method 'ssl)) | 46 | ,@(remove '&rest (remove '&optional args)))))) |
| 46 | ( ,(intern (format (if method "url-http-%s" "url-http") method)) ,@(remove '&rest (remove '&optional args)))))) | ||
| 47 | 47 | ||
| 48 | (url-https-create-secure-wrapper nil (url callback cbargs)) | 48 | (url-https-create-secure-wrapper nil (url callback cbargs)) |
| 49 | (url-https-create-secure-wrapper file-exists-p (url)) | 49 | (url-https-create-secure-wrapper file-exists-p (url)) |
diff --git a/lisp/url/url-ldap.el b/lisp/url/url-ldap.el index 27cbb8ad1e3..24a3ade4922 100644 --- a/lisp/url/url-ldap.el +++ b/lisp/url/url-ldap.el | |||
| @@ -28,6 +28,7 @@ | |||
| 28 | (require 'url-parse) | 28 | (require 'url-parse) |
| 29 | (require 'url-util) | 29 | (require 'url-util) |
| 30 | (require 'ldap) | 30 | (require 'ldap) |
| 31 | (autoload 'tls-certificate-information "tls") | ||
| 31 | 32 | ||
| 32 | ;; This has been implemented from RFC2255 'The LDAP URL Format' (Dec 1997) | 33 | ;; This has been implemented from RFC2255 'The LDAP URL Format' (Dec 1997) |
| 33 | ;; | 34 | ;; |
| @@ -96,7 +97,8 @@ | |||
| 96 | (require 'ssl) | 97 | (require 'ssl) |
| 97 | (error nil)) | 98 | (error nil)) |
| 98 | (let ((vals (if (fboundp 'ssl-certificate-information) | 99 | (let ((vals (if (fboundp 'ssl-certificate-information) |
| 99 | (ssl-certificate-information data)))) | 100 | (ssl-certificate-information data) |
| 101 | (tls-certificate-information data)))) | ||
| 100 | (if (not vals) | 102 | (if (not vals) |
| 101 | "<b>Unable to parse certificate</b>" | 103 | "<b>Unable to parse certificate</b>" |
| 102 | (concat "<table border=0>\n" | 104 | (concat "<table border=0>\n" |
diff --git a/lisp/url/url-news.el b/lisp/url/url-news.el index a426f09b1ca..59364c9ccd0 100644 --- a/lisp/url/url-news.el +++ b/lisp/url/url-news.el | |||
| @@ -2,7 +2,7 @@ | |||
| 2 | ;; Keywords: comm, data, processes | 2 | ;; Keywords: comm, data, processes |
| 3 | 3 | ||
| 4 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 4 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 5 | ;;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc. | 5 | ;;; Copyright (c) 1996 - 1999, 2004 Free Software Foundation, Inc. |
| 6 | ;;; | 6 | ;;; |
| 7 | ;;; This file is part of GNU Emacs. | 7 | ;;; This file is part of GNU Emacs. |
| 8 | ;;; | 8 | ;;; |
| @@ -125,7 +125,9 @@ | |||
| 125 | 125 | ||
| 126 | ;;;###autoload | 126 | ;;;###autoload |
| 127 | (defun url-snews (url) | 127 | (defun url-snews (url) |
| 128 | (let ((nntp-open-connection-function 'nntp-open-ssl-stream)) | 128 | (let ((nntp-open-connection-function (if (eq 'tls url-gateway-method) |
| 129 | nntp-open-tls-stream | ||
| 130 | nntp-open-ssl-stream))) | ||
| 129 | (url-news url))) | 131 | (url-news url))) |
| 130 | 132 | ||
| 131 | (provide 'url-news) | 133 | (provide 'url-news) |
diff --git a/lisp/url/url-vars.el b/lisp/url/url-vars.el index 4328c34b6fa..a33d8ba43e3 100644 --- a/lisp/url/url-vars.el +++ b/lisp/url/url-vars.el | |||
| @@ -2,7 +2,7 @@ | |||
| 2 | ;; Keywords: comm, data, processes, hypermedia | 2 | ;; Keywords: comm, data, processes, hypermedia |
| 3 | 3 | ||
| 4 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 4 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 5 | ;;; Copyright (c) 1996,1997,1998,1999,2001 Free Software Foundation, Inc. | 5 | ;;; Copyright (c) 1996,1997,1998,1999,2001,2004 Free Software Foundation, Inc. |
| 6 | ;;; | 6 | ;;; |
| 7 | ;;; This file is part of GNU Emacs. | 7 | ;;; This file is part of GNU Emacs. |
| 8 | ;;; | 8 | ;;; |
| @@ -368,12 +368,14 @@ Currently supported methods: | |||
| 368 | `telnet': Run telnet in a subprocess to connect; | 368 | `telnet': Run telnet in a subprocess to connect; |
| 369 | `rlogin': Rlogin to another machine to connect; | 369 | `rlogin': Rlogin to another machine to connect; |
| 370 | `socks': Connect through a socks server; | 370 | `socks': Connect through a socks server; |
| 371 | `ssl': Connect with SSL; | 371 | `tls': Connect with TLS; |
| 372 | `ssl': Connect with SSL (deprecated, use `tls' instead); | ||
| 372 | `native': Connect directy." | 373 | `native': Connect directy." |
| 373 | :type '(radio (const :tag "Telnet to gateway host" :value telnet) | 374 | :type '(radio (const :tag "Telnet to gateway host" :value telnet) |
| 374 | (const :tag "Rlogin to gateway host" :value rlogin) | 375 | (const :tag "Rlogin to gateway host" :value rlogin) |
| 375 | (const :tag "Use SOCKS proxy" :value socks) | 376 | (const :tag "Use SOCKS proxy" :value socks) |
| 376 | (const :tag "Use SSL for all connections" :value ssl) | 377 | (const :tag "Use SSL/TLS for all connections" :value tls) |
| 378 | (const :tag "Use SSL for all connections (obsolete)" :value ssl) | ||
| 377 | (const :tag "Direct connection" :value native)) | 379 | (const :tag "Direct connection" :value native)) |
| 378 | :group 'url-hairy) | 380 | :group 'url-hairy) |
| 379 | 381 | ||