[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] /srv/bzr/emacs/trunk r103811: Merge open-protocol-stream i
From: |
Chong Yidong |
Subject: |
[Emacs-diffs] /srv/bzr/emacs/trunk r103811: Merge open-protocol-stream into open-network-stream. |
Date: |
Sat, 02 Apr 2011 19:41:03 -0400 |
User-agent: |
Bazaar (2.0.3) |
------------------------------------------------------------
revno: 103811
committer: Chong Yidong <address@hidden>
branch nick: trunk
timestamp: Sat 2011-04-02 19:41:03 -0400
message:
Merge open-protocol-stream into open-network-stream.
* lisp/subr.el (open-network-stream): Move to net/network-stream.el.
* lisp/gnus/proto-stream.el: Move to net/network-stream.el.
* lisp/net/network-stream.el: Move from gnus/proto-stream.el.
Change prefix to network-stream throughout.
(open-protocol-stream): Merge into open-network-stream, leaving
open-protocol-stream as an alias. Handle nil BUFFER args.
* lisp/gnus/nnimap.el (nnimap-open-connection-1): Pass explicit
:end-of-command
parameter to open-protocol-stream.
* lisp/emacs-lisp/package.el (package--with-work-buffer): Recognize
https URLs.
* lisp/url/url-gw.el (url-open-stream): Use new open-network-stream
functionality to perform encryption.
renamed:
lisp/gnus/proto-stream.el => lisp/net/network-stream.el
modified:
etc/NEWS
lisp/ChangeLog
lisp/emacs-lisp/package.el
lisp/gnus/ChangeLog
lisp/gnus/nnimap.el
lisp/gnus/nntp.el
lisp/subr.el
lisp/url/url-gw.el
lisp/net/network-stream.el
=== modified file 'etc/NEWS'
--- a/etc/NEWS 2011-04-01 17:19:52 +0000
+++ b/etc/NEWS 2011-04-02 23:41:03 +0000
@@ -773,6 +773,12 @@
* Lisp changes in Emacs 24.1
+** `open-network-stream' can now be used to open an encrypted stream.
+It now accepts an optional `:type' parameter for initiating a TLS
+connection, directly or via STARTTLS. To do STARTTLS, additional
+parameters (`:end-of-command', `:success', `:capabilities-command')
+must also be supplied.
+
** Code can now use lexical scoping by default instead of dynamic scoping.
The `lexical-binding' variable lets code use lexical scoping for local
variables. It is typically set via file-local variables, in which case it
=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog 2011-04-02 20:36:47 +0000
+++ b/lisp/ChangeLog 2011-04-02 23:41:03 +0000
@@ -1,3 +1,15 @@
+2011-04-02 Chong Yidong <address@hidden>
+
+ * emacs-lisp/package.el (package--with-work-buffer): Recognize
+ https URLs.
+
+ * net/network-stream.el: Move from gnus/proto-stream.el. Change
+ prefix to network-stream throughout.
+ (open-protocol-stream): Merge into open-network-stream, leaving
+ open-protocol-stream as an alias. Handle nil BUFFER args.
+
+ * subr.el (open-network-stream): Move to net/network-stream.el.
+
2011-04-02 Glenn Morris <address@hidden>
* find-dired.el (find-exec-terminator): New option.
@@ -210,14 +222,14 @@
* textmodes/css.el:
* startup.el:
* uniquify.el:
- * minibuffer.el:
- * newcomment.el:
- * reveal.el:
- * server.el:
- * mpc.el:
- * emacs-lisp/smie.el:
- * doc-view.el:
- * dired.el:
+ * minibuffer.el:
+ * newcomment.el:
+ * reveal.el:
+ * server.el:
+ * mpc.el:
+ * emacs-lisp/smie.el:
+ * doc-view.el:
+ * dired.el:
* abbrev.el: Use lexical binding.
2011-04-01 Eli Zaretskii <address@hidden>
=== modified file 'lisp/emacs-lisp/package.el'
--- a/lisp/emacs-lisp/package.el 2011-03-19 18:27:55 +0000
+++ b/lisp/emacs-lisp/package.el 2011-04-02 23:41:03 +0000
@@ -652,7 +652,7 @@
This macro retrieves FILE from LOCATION into a temporary buffer,
and evaluates BODY while that buffer is current. This work
buffer is killed afterwards. Return the last value in BODY."
- `(let* ((http (string-match "\\`http:" ,location))
+ `(let* ((http (string-match "\\`https?:" ,location))
(buffer
(if http
(url-retrieve-synchronously (concat ,location ,file))
=== modified file 'lisp/gnus/ChangeLog'
--- a/lisp/gnus/ChangeLog 2011-04-01 14:24:22 +0000
+++ b/lisp/gnus/ChangeLog 2011-04-02 23:41:03 +0000
@@ -1,3 +1,10 @@
+2011-04-02 Chong Yidong <address@hidden>
+
+ * proto-stream.el: Move to Emacs core, at net/network-stream.el.
+
+ * nnimap.el (nnimap-open-connection-1): Pass explicit :end-of-command
+ parameter to open-protocol-stream.
+
2011-04-01 Julien Danjou <address@hidden>
* mm-view.el (mm-display-inline-fontify): Do not fontify with
=== modified file 'lisp/gnus/nnimap.el'
--- a/lisp/gnus/nnimap.el 2011-03-30 14:59:42 +0000
+++ b/lisp/gnus/nnimap.el 2011-04-02 23:41:03 +0000
@@ -31,7 +31,11 @@
(unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
(eval-and-compile
- (require 'nnheader))
+ (require 'nnheader)
+ ;; In Emacs 24, `open-protocol-stream' is an autoloaded alias for
+ ;; `make-network-stream'.
+ (unless (fboundp 'open-protocol-stream)
+ (require 'proto-stream)))
(eval-when-compile
(require 'cl))
@@ -45,7 +49,6 @@
(require 'tls)
(require 'parse-time)
(require 'nnmail)
-(require 'proto-stream)
(autoload 'auth-source-forget+ "auth-source")
(autoload 'auth-source-search "auth-source")
@@ -365,6 +368,7 @@
:return-list t
:shell-command nnimap-shell-program
:capability-command "1 CAPABILITY\r\n"
+ :end-of-command "\r\n"
:success " OK "
:starttls-function
(lambda (capabilities)
=== modified file 'lisp/gnus/nntp.el'
--- a/lisp/gnus/nntp.el 2011-03-30 02:21:28 +0000
+++ b/lisp/gnus/nntp.el 2011-04-02 23:41:03 +0000
@@ -27,13 +27,16 @@
;; For Emacs <22.2 and XEmacs.
(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
+ (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))
+ ;; In Emacs 24, `open-protocol-stream' is an autoloaded alias for
+ ;; `make-network-stream'.
+ (unless (fboundp 'open-protocol-stream)
+ (require 'proto-stream)))
(require 'nnheader)
(require 'nnoo)
(require 'gnus-util)
(require 'gnus)
-(require 'proto-stream)
(require 'gnus-group) ;; gnus-group-name-charset
(nnoo-declare nntp)
=== renamed file 'lisp/gnus/proto-stream.el' => 'lisp/net/network-stream.el'
--- a/lisp/gnus/proto-stream.el 2011-03-30 02:21:28 +0000
+++ b/lisp/net/network-stream.el 2011-04-02 23:41:03 +0000
@@ -1,4 +1,4 @@
-;;; proto-stream.el --- negotiating TLS, STARTTLS and other connections
+;;; network-stream.el --- open network processes, possibly with encryption
;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
@@ -22,20 +22,14 @@
;;; Commentary:
-;; This library is meant to provide the glue between modules that want
-;; to establish a network connection to a server for protocols such as
-;; IMAP, NNTP, SMTP and POP3.
-
-;; The main problem is that there's more than a couple of interfaces
-;; towards doing this. You have normal, plain connections, which are
-;; no trouble at all, but you also have TLS/SSL connections, and you
-;; have STARTTLS. Negotiating this for each protocol can be rather
-;; tedious, so this library provides a single entry point, and hides
-;; much of the ugliness.
+;; This library provides the function `open-network-stream', which provides a
+;; higher-level interface for opening TCP network processes than the built-in
+;; function `make-network-process'. In addition to plain connections, it
+;; supports TLS/SSL and STARTTLS connections.
;; Usage example:
-;; (open-protocol-stream
+;; (open-network-stream
;; "*nnimap*" buffer address port
;; :type 'network
;; :capability-command "1 CAPABILITY\r\n"
@@ -55,14 +49,24 @@
(proc type &optional priority-string trustfiles keyfiles))
;;;###autoload
-(defun open-protocol-stream (name buffer host service &rest parameters)
- "Open a network stream to HOST, possibly with encryption.
+(defun open-network-stream (name buffer host service &rest parameters)
+ "Open a TCP connection to HOST, optionally with encryption.
Normally, return a network process object; with a non-nil
:return-list parameter, return a list instead (see below).
-
-The first four parameters, NAME, BUFFER, HOST, and SERVICE, have
-the same meanings as in `open-network-stream'. The remaining
-PARAMETERS should be a sequence of keywords and values:
+Input and output work as for subprocesses; `delete-process'
+closes it.
+
+NAME is the name for the process. It is modified if necessary to
+ make it unique.
+BUFFER is a buffer or buffer name to associate with the process.
+ Process output goes at end of that buffer. BUFFER may be nil,
+ meaning that the process is not associated with any buffer.
+HOST is the name or IP address of the host to connect to.
+SERVICE is the name of the service desired, or an integer specifying
+ a port number to connect to.
+
+The remaining PARAMETERS should be a sequence of keywords and
+values:
:type specifies the connection type, one of the following:
nil or `network'
@@ -92,7 +96,6 @@
or `tls' (TLS-encrypted).
:end-of-command specifies a regexp matching the end of a command.
- If non-nil, it defaults to \"\\n\".
:success specifies a regexp matching a message indicating a
successful STARTTLS negotiation. For instance, the default
@@ -106,6 +109,8 @@
This function should take one parameter, the response to the
capability command, and should return the command to switch on
STARTTLS if the server supports STARTTLS, and nil otherwise."
+ (unless (featurep 'make-network-process)
+ (error "Emacs was compiled without networking support"))
(let ((type (plist-get parameters :type))
(return-list (plist-get parameters :return-list)))
(if (and (not return-list)
@@ -113,21 +118,24 @@
(and (memq type '(nil network))
(not (and (plist-get parameters :success)
(plist-get parameters :capability-command))))))
- ;; The simplest case is equivalent to `open-network-stream'.
- (open-network-stream name buffer host service)
- ;; For everything else, refer to proto-stream-open-*.
- (unless (plist-get parameters :end-of-command)
- (setq parameters (append '(:end-of-command "\r\n") parameters)))
- (let* ((connection-function
- (cond
- ((eq type 'plain) 'proto-stream-open-plain)
- ((memq type '(nil network starttls))
- 'proto-stream-open-starttls)
- ((memq type '(tls ssl)) 'proto-stream-open-tls)
- ((eq type 'shell) 'proto-stream-open-shell)
- (t (error "Invalid connection type %s" type))))
- (result (funcall connection-function
- name buffer host service parameters)))
+ ;; The simplest case: wrapper around `make-network-process'.
+ (make-network-process :name name :buffer buffer
+ :host host :service service)
+ (let ((work-buffer (or buffer
+ (generate-new-buffer " *stream buffer*")))
+ (fun (cond ((eq type 'plain) 'network-stream-open-plain)
+ ((memq type '(nil network starttls))
+ 'network-stream-open-starttls)
+ ((memq type '(tls ssl)) 'network-stream-open-tls)
+ ((eq type 'shell) 'network-stream-open-shell)
+ (t (error "Invalid connection type %s" type))))
+ result)
+ (unwind-protect
+ (setq result (funcall fun name work-buffer host service parameters))
+ (unless buffer
+ (and (processp (car result))
+ (set-process-buffer (car result) nil))
+ (kill-buffer work-buffer)))
(if return-list
(list (car result)
:greeting (nth 1 result)
@@ -135,16 +143,20 @@
:type (nth 3 result))
(car result))))))
-(defun proto-stream-open-plain (name buffer host service parameters)
+;;;###autoload
+(defalias 'open-protocol-stream 'open-network-stream)
+
+(defun network-stream-open-plain (name buffer host service parameters)
(let ((start (with-current-buffer buffer (point)))
- (stream (open-network-stream name buffer host service)))
+ (stream (make-network-process :name name :buffer buffer
+ :host host :service service)))
(list stream
- (proto-stream-get-response stream start
+ (network-stream-get-response stream start
(plist-get parameters :end-of-command))
nil
'plain)))
-(defun proto-stream-open-starttls (name buffer host service parameters)
+(defun network-stream-open-starttls (name buffer host service parameters)
(let* ((start (with-current-buffer buffer (point)))
(require-tls (eq (plist-get parameters :type) 'starttls))
(starttls-function (plist-get parameters :starttls-function))
@@ -152,11 +164,10 @@
(capability-command (plist-get parameters :capability-command))
(eoc (plist-get parameters :end-of-command))
;; Return (STREAM GREETING CAPABILITIES RESULTING-TYPE)
- (stream (open-network-stream name buffer host service))
- (greeting (proto-stream-get-response stream start eoc))
- (capabilities (when capability-command
- (proto-stream-command stream
- capability-command eoc)))
+ (stream (make-network-process :name name :buffer buffer
+ :host host :service service))
+ (greeting (network-stream-get-response stream start eoc))
+ (capabilities (network-stream-command stream capability-command eoc))
(resulting-type 'plain)
starttls-command)
@@ -179,9 +190,9 @@
;; care about the identity of the peer.
(cons "--insecure" starttls-extra-arguments))))
(setq stream (starttls-open-stream name buffer host service)))
- (proto-stream-get-response stream start eoc))
+ (network-stream-get-response stream start eoc))
(when (string-match success-string
- (proto-stream-command stream starttls-command eoc))
+ (network-stream-command stream starttls-command eoc))
;; The server said it was OK to begin STARTTLS negotiations.
(if (fboundp 'open-gnutls-stream)
(gnutls-negotiate stream nil)
@@ -192,11 +203,13 @@
;; We didn't successfully negotiate STARTTLS; if TLS
;; isn't demanded, reopen an unencrypted connection.
(unless require-tls
- (setq stream (open-network-stream name buffer host service))
- (proto-stream-get-response stream start eoc)))
+ (setq stream
+ (make-network-process :name name :buffer buffer
+ :host host :service service))
+ (network-stream-get-response stream start eoc)))
;; Re-get the capabilities, which may have now changed.
(setq capabilities
- (proto-stream-command stream capability-command eoc))))
+ (network-stream-command stream capability-command eoc))))
;; If TLS is mandatory, close the connection if it's unencrypted.
(and require-tls
@@ -205,70 +218,69 @@
;; Return value:
(list stream greeting capabilities resulting-type)))
-(defun proto-stream-command (stream command eoc)
- (let ((start (with-current-buffer (process-buffer stream) (point-max))))
- (process-send-string stream command)
- (proto-stream-get-response stream start eoc)))
-
-(defun proto-stream-get-response (stream start end-of-command)
- (with-current-buffer (process-buffer stream)
- (save-excursion
- (goto-char start)
- (while (and (memq (process-status stream)
- '(open run))
- (not (re-search-forward end-of-command nil t)))
- (accept-process-output stream 0 50)
- (goto-char start))
- (if (= start (point))
- ;; The process died; return nil.
- nil
- ;; Return the data we got back.
- (buffer-substring start (point))))))
-
-(defun proto-stream-open-tls (name buffer host service parameters)
+(defun network-stream-command (stream command eoc)
+ (when command
+ (let ((start (with-current-buffer (process-buffer stream) (point-max))))
+ (process-send-string stream command)
+ (network-stream-get-response stream start eoc))))
+
+(defun network-stream-get-response (stream start end-of-command)
+ (when end-of-command
+ (with-current-buffer (process-buffer stream)
+ (save-excursion
+ (goto-char start)
+ (while (and (memq (process-status stream) '(open run))
+ (not (re-search-forward end-of-command nil t)))
+ (accept-process-output stream 0 50)
+ (goto-char start))
+ ;; Return the data we got back, or nil if the process died.
+ (unless (= start (point))
+ (buffer-substring start (point)))))))
+
+(defun network-stream-open-tls (name buffer host service parameters)
(with-current-buffer buffer
- (let ((start (point-max))
- (stream
- (funcall (if (fboundp 'open-gnutls-stream)
- 'open-gnutls-stream
- 'open-tls-stream)
- name buffer host service))
- (eoc (plist-get parameters :end-of-command)))
+ (let* ((start (point-max))
+ (use-builtin-gnutls (fboundp 'open-gnutls-stream))
+ (stream
+ (funcall (if use-builtin-gnutls
+ 'open-gnutls-stream
+ 'open-tls-stream)
+ name buffer host service))
+ (eoc (plist-get parameters :end-of-command)))
(if (null stream)
(list nil nil nil 'plain)
;; If we're using tls.el, we have to delete the output from
;; openssl/gnutls-cli.
- (unless (fboundp 'open-gnutls-stream)
- (proto-stream-get-response stream start eoc)
+ (when (and (null use-builtin-gnutls) eoc)
+ (network-stream-get-response stream start eoc)
(goto-char (point-min))
(when (re-search-forward eoc nil t)
(goto-char (match-beginning 0))
(delete-region (point-min) (line-beginning-position))))
- (proto-stream-capability-open start stream parameters 'tls)))))
+ (let* ((capability-command (plist-get parameters :capability-command)))
+ (list stream
+ (network-stream-get-response stream start eoc)
+ (network-stream-command stream capability-command eoc)
+ 'tls))))))
-(defun proto-stream-open-shell (name buffer host service parameters)
+(defun network-stream-open-shell (name buffer host service parameters)
(require 'format-spec)
- (proto-stream-capability-open
- (with-current-buffer buffer (point))
- (let ((process-connection-type nil))
- (start-process name buffer shell-file-name
- shell-command-switch
- (format-spec
- (plist-get parameters :shell-command)
- (format-spec-make
- ?s host
- ?p service))))
- parameters 'plain))
-
-(defun proto-stream-capability-open (start stream parameters stream-type)
(let* ((capability-command (plist-get parameters :capability-command))
(eoc (plist-get parameters :end-of-command))
- (greeting (proto-stream-get-response stream start eoc)))
- (list stream greeting
- (and capability-command
- (proto-stream-command stream capability-command eoc))
- stream-type)))
-
-(provide 'proto-stream)
-
-;;; proto-stream.el ends here
+ (start (with-current-buffer buffer (point)))
+ (stream (let ((process-connection-type nil))
+ (start-process name buffer shell-file-name
+ shell-command-switch
+ (format-spec
+ (plist-get parameters :shell-command)
+ (format-spec-make
+ ?s host
+ ?p service))))))
+ (list stream
+ (network-stream-get-response stream start eoc)
+ (network-stream-command stream capability-command eoc)
+ 'plain)))
+
+(provide 'network-stream)
+
+;;; network-stream.el ends here
=== modified file 'lisp/subr.el'
--- a/lisp/subr.el 2011-03-31 04:24:03 +0000
+++ b/lisp/subr.el 2011-04-02 23:41:03 +0000
@@ -1792,28 +1792,6 @@
(forward-line 1))
(nreverse lines)))))
-;; open-network-stream is a wrapper around make-network-process.
-
-(when (featurep 'make-network-process)
- (defun open-network-stream (name buffer host service)
- "Open a TCP connection for a service to a host.
-Returns a subprocess-object to represent the connection.
-Input and output work as for subprocesses; `delete-process' closes it.
-
-NAME is the name for the process. It is modified if necessary to make
- it unique.
-BUFFER is the buffer (or buffer name) to associate with the
- process. Process output goes at end of that buffer. BUFFER may
- be nil, meaning that this process is not associated with any buffer.
-HOST is the name or IP address of the host to connect to.
-SERVICE is the name of the service desired, or an integer specifying
- a port number to connect to.
-
-This is a wrapper around `make-network-process', and only offers a
-subset of its functionality."
- (make-network-process :name name :buffer buffer
- :host host :service service)))
-
;; compatibility
(make-obsolete
=== modified file 'lisp/url/url-gw.el'
--- a/lisp/url/url-gw.el 2011-01-26 08:36:39 +0000
+++ b/lisp/url/url-gw.el 2011-04-02 23:41:03 +0000
@@ -28,8 +28,6 @@
;; Fixme: support SSH explicitly or via a url-gateway-rlogin-program?
(autoload 'socks-open-network-stream "socks")
-(autoload 'open-ssl-stream "ssl")
-(autoload 'open-tls-stream "tls")
(defgroup url-gateway nil
"URL gateway variables."
@@ -219,13 +217,6 @@
host))
'native
url-gateway-method))
-;;; ;; This hack is for OS/2 Emacs so that it will not do bogus CRLF
-;;; ;; conversions while trying to be 'helpful'
-;;; (tcp-binary-process-output-services (if (stringp service)
-;;; (list service)
-;;; (list service
-;;; (int-to-string service))))
-
;; An attempt to deal with denied connections, and attempt
;; to reconnect
(cur-retries 0)
@@ -243,19 +234,15 @@
(let ((coding-system-for-read 'binary)
(coding-system-for-write 'binary))
(setq conn (case gw-method
- (tls
- (funcall (if (fboundp 'open-gnutls-stream)
- 'open-gnutls-stream
- 'open-tls-stream)
- name buffer host service))
- (ssl
- (open-ssl-stream name buffer host service))
- ((native)
- ;; Use non-blocking socket if we can.
- (make-network-process :name name :buffer buffer
- :host host :service service
- :nowait
- (featurep 'make-network-process
'(:nowait t))))
+ ((tls ssl native)
+ (if (eq gw-method 'native)
+ (setq gw-method 'plain))
+ (open-network-stream
+ name buffer host service
+ :type gw-method
+ ;; Use non-blocking socket if we can.
+ :nowait (featurep 'make-network-process
+ '(:nowait t))))
(socks
(socks-open-network-stream name buffer host service))
(telnet
@@ -264,13 +251,7 @@
(url-open-rlogin name buffer host service))
(otherwise
(error "Bad setting of url-gateway-method: %s"
- url-gateway-method)))))
- ;; Ignoring errors here seems wrong. E.g. it'll throw away the
- ;; error signaled two lines above. It was also found inconvenient
- ;; during debugging.
- ;; (error
- ;; (setq conn nil))
- )
+ url-gateway-method))))))
conn)))
(provide 'url-gw)
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] /srv/bzr/emacs/trunk r103811: Merge open-protocol-stream into open-network-stream.,
Chong Yidong <=