mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-27 10:54:40 +00:00
Code Issues Releases Activity

url-vars.el (url-gateway-method): Add new method `tls'.

Browse Source 
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.
This commit is contained in:
Simon Josefsson 2004-10-12 09:55:08 +00:00
parent 18965008d1
commit 5bbb0eb9ea
5 changed files with 24 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
lisp/url/url-gw.el
View File

@ -3,7 +3,7 @@
;; Keywords: comm, data, processes
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Copyright (c) 1997, 1998 Free Software Foundation, Inc.
;;; Copyright (c) 1997, 1998, 2004 Free Software Foundation, Inc.
;;;
;;; This file is part of GNU Emacs.
;;;
@ -29,6 +29,7 @@
(autoload 'socks-open-network-stream "socks")
(autoload 'open-ssl-stream "ssl")
(autoload 'open-tls-stream "tls")
(defgroup url-gateway nil
"URL gateway variables"
@ -212,6 +213,7 @@ Args per `open-network-stream'.
Will not make a connexion if `url-gateway-unplugged' is non-nil."
(unless url-gateway-unplugged
(let ((gw-method (if (and url-gateway-local-host-regexp
(not (eq 'tls url-gateway-method))
(not (eq 'ssl url-gateway-method))
(string-match
url-gateway-local-host-regexp
@ -242,6 +244,8 @@ Will not make a connexion if `url-gateway-unplugged' is non-nil."
(let ((coding-system-for-read 'binary)
(coding-system-for-write 'binary))
(setq conn (case gw-method
(tls
(open-tls-stream name buffer host service))
(ssl
(open-ssl-stream name buffer host service))
((native)

14
lisp/url/url-https.el
View File

@ -1,4 +1,4 @@
;;; url-https.el --- HTTP over SSL routines
;;; url-https.el --- HTTP over SSL/TLS routines
;; Copyright (c) 1999, 2004 Free Software Foundation, Inc.
@ -30,6 +30,7 @@
(require 'url-parse)
(require 'url-cookie)
(require 'url-http)
(require 'tls)
(defconst url-https-default-port 443 "Default HTTPS port.")
(defconst url-https-asynchronous-p t "HTTPS retrievals are asynchronous.")
@ -38,12 +39,11 @@
(defmacro url-https-create-secure-wrapper (method args)
`(defun ,(intern (format (if method "url-https-%s" "url-https") method)) ,args
,(format "HTTPS wrapper around `%s' call." (or method "url-http"))
(condition-case ()
(require 'ssl)
(error
(error "HTTPS support could not find `ssl' library")))
(let ((url-gateway-method 'ssl))
( ,(intern (format (if method "url-http-%s" "url-http") method)) ,@(remove '&rest (remove '&optional args))))))
(let ((url-gateway-method (condition-case ()
(require 'ssl)
(error 'tls))))
(,(intern (format (if method "url-http-%s" "url-http") method))
,@(remove '&rest (remove '&optional args))))))
(url-https-create-secure-wrapper nil (url callback cbargs))
(url-https-create-secure-wrapper file-exists-p (url))

4
lisp/url/url-ldap.el
View File

@ -28,6 +28,7 @@
(require 'url-parse)
(require 'url-util)
(require 'ldap)
(autoload 'tls-certificate-information "tls")
;; This has been implemented from RFC2255 'The LDAP URL Format' (Dec 1997)
;;
@ -96,7 +97,8 @@
(require 'ssl)
(error nil))
(let ((vals (if (fboundp 'ssl-certificate-information)
(ssl-certificate-information data))))
(ssl-certificate-information data)
(tls-certificate-information data))))
(if (not vals)
"<b>Unable to parse certificate</b>"
(concat "<table border=0>\n"

6
lisp/url/url-news.el
View File

@ -2,7 +2,7 @@
;; Keywords: comm, data, processes
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc.
;;; Copyright (c) 1996 - 1999, 2004 Free Software Foundation, Inc.
;;;
;;; This file is part of GNU Emacs.
;;;
@ -125,7 +125,9 @@
;;;###autoload
(defun url-snews (url)
(let ((nntp-open-connection-function 'nntp-open-ssl-stream))
(let ((nntp-open-connection-function (if (eq 'tls url-gateway-method)
nntp-open-tls-stream
nntp-open-ssl-stream)))
(url-news url)))
(provide 'url-news)

8
lisp/url/url-vars.el
View File

@ -2,7 +2,7 @@
;; Keywords: comm, data, processes, hypermedia
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Copyright (c) 1996,1997,1998,1999,2001 Free Software Foundation, Inc.
;;; Copyright (c) 1996,1997,1998,1999,2001,2004 Free Software Foundation, Inc.
;;;
;;; This file is part of GNU Emacs.
;;;
@ -368,12 +368,14 @@ Currently supported methods:
`telnet': Run telnet in a subprocess to connect;
`rlogin': Rlogin to another machine to connect;
`socks': Connect through a socks server;
`ssl': Connect with SSL;
`tls': Connect with TLS;
`ssl': Connect with SSL (deprecated, use `tls' instead);
`native': Connect directy."
:type '(radio (const :tag "Telnet to gateway host" :value telnet)
(const :tag "Rlogin to gateway host" :value rlogin)
(const :tag "Use SOCKS proxy" :value socks)
(const :tag "Use SSL for all connections" :value ssl)
(const :tag "Use SSL/TLS for all connections" :value tls)
(const :tag "Use SSL for all connections (obsolete)" :value ssl)
(const :tag "Direct connection" :value native))
:group 'url-hairy)