[gnus git] branch master updated: n0-15-31-g60fcfe9 =1= Fix previous commits.
Katsumi Yamaoka <[email protected]>
| Newsgroups | gmane.emacs.gnus.cvs |
|---|---|
| Message-ID | <[email protected]> |
via 60fcfe91c518207e97eb109555e9fc682210e8c6 (commit)
from 85f5a3d86caf063b2c153acb1bdb6125abf3ca9e (commit)
- Log -----------------------------------------------------------------
commit 60fcfe91c518207e97eb109555e9fc682210e8c6
Author: Katsumi Yamaoka <[email protected]>
Date: Sun Apr 3 11:37:59 2011 +0000
Fix previous commits.
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 7ac0efd..7fd853e 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,7 +1,5 @@
2011-04-02 Chong Yidong <[email protected]>
- * proto-stream.el: Rename it to network-stream.el.
-
* nnimap.el (nnimap-open-connection-1): Pass explicit :end-of-command
parameter to open-protocol-stream.
diff --git a/lisp/nnimap.el b/lisp/nnimap.el
index 44caaed..afdea18 100644
--- a/lisp/nnimap.el
+++ b/lisp/nnimap.el
@@ -32,7 +32,10 @@
(eval-and-compile
(require 'nnheader)
- (require 'network-stream))
+ ;; 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))
diff --git a/lisp/nntp.el b/lisp/nntp.el
index 0689143..3285da5 100644
--- a/lisp/nntp.el
+++ b/lisp/nntp.el
@@ -28,7 +28,10 @@
;; For Emacs <22.2 and XEmacs.
(eval-and-compile
(unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))
- (require 'network-stream))
+ ;; 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)
diff --git a/lisp/network-stream.el b/lisp/proto-stream.el
similarity index 57%
rename from lisp/network-stream.el
rename to lisp/proto-stream.el
index 070cd26..45cc974 100644
--- a/lisp/network-stream.el
+++ b/lisp/proto-stream.el
@@ -1,4 +1,4 @@
-;;; network-stream.el --- open network processes, possibly with encryption
+;;; proto-stream.el --- negotiating TLS, STARTTLS and other connections
;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
@@ -22,14 +22,20 @@
;;; Commentary:
-;; 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.
+;; 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.
;; Usage example:
-;; (open-network-stream
+;; (open-protocol-stream
;; "*nnimap*" buffer address port
;; :type 'network
;; :capability-command "1 CAPABILITY\r\n"
@@ -49,24 +55,14 @@
(proc type &optional priority-string trustfiles keyfiles))
;;;###autoload
-(defun open-network-stream (name buffer host service &rest parameters)
- "Open a TCP connection to HOST, optionally with encryption.
+(defun open-protocol-stream (name buffer host service &rest parameters)
+ "Open a network stream to HOST, possibly with encryption.
Normally, return a network process object; with a non-nil
:return-list parameter, return a list instead (see below).
-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:
+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:
:type specifies the connection type, one of the following:
nil or `network'
@@ -96,6 +92,7 @@ values:
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
@@ -109,8 +106,6 @@ values:
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)
@@ -118,24 +113,21 @@ values:
(and (memq type '(nil network))
(not (and (plist-get parameters :success)
(plist-get parameters :capability-command))))))
- ;; 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)
+ ;; 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))
- 'network-stream-open-starttls)
- ((memq type '(tls ssl)) 'network-stream-open-tls)
- ((eq type 'shell) 'network-stream-open-shell)
+ '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)
- (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)))
+ (result (funcall connection-function
+ name buffer host service parameters)))
(if return-list
(list (car result)
:greeting (nth 1 result)
@@ -143,20 +135,16 @@ values:
:type (nth 3 result))
(car result))))))
-;;;###autoload
-(defalias 'open-protocol-stream 'open-network-stream)
-
-(defun network-stream-open-plain (name buffer host service parameters)
+(defun proto-stream-open-plain (name buffer host service parameters)
(let ((start (with-current-buffer buffer (point)))
- (stream (make-network-process :name name :buffer buffer
- :host host :service service)))
+ (stream (open-network-stream name buffer host service)))
(list stream
- (network-stream-get-response stream start
+ (proto-stream-get-response stream start
(plist-get parameters :end-of-command))
nil
'plain)))
-(defun network-stream-open-starttls (name buffer host service parameters)
+(defun proto-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))
@@ -164,10 +152,11 @@ values:
(capability-command (plist-get parameters :capability-command))
(eoc (plist-get parameters :end-of-command))
;; Return (STREAM GREETING CAPABILITIES RESULTING-TYPE)
- (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))
+ (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)))
(resulting-type 'plain)
starttls-command)
@@ -190,9 +179,9 @@ values:
;; care about the identity of the peer.
(cons "--insecure" starttls-extra-arguments))))
(setq stream (starttls-open-stream name buffer host service)))
- (network-stream-get-response stream start eoc))
+ (proto-stream-get-response stream start eoc))
(when (string-match success-string
- (network-stream-command stream starttls-command eoc))
+ (proto-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)
@@ -203,13 +192,11 @@ values:
;; We didn't successfully negotiate STARTTLS; if TLS
;; isn't demanded, reopen an unencrypted connection.
(unless require-tls
- (setq stream
- (make-network-process :name name :buffer buffer
- :host host :service service))
- (network-stream-get-response stream start eoc)))
+ (setq stream (open-network-stream name buffer host service))
+ (proto-stream-get-response stream start eoc)))
;; Re-get the capabilities, which may have now changed.
(setq capabilities
- (network-stream-command stream capability-command eoc))))
+ (proto-stream-command stream capability-command eoc))))
;; If TLS is mandatory, close the connection if it's unencrypted.
(and require-tls
@@ -218,31 +205,31 @@ values:
;; Return value:
(list stream greeting capabilities resulting-type)))
-(defun network-stream-command (stream command eoc)
- (when command
+(defun proto-stream-command (stream command eoc)
(let ((start (with-current-buffer (process-buffer stream) (point-max))))
(process-send-string stream command)
- (network-stream-get-response stream start eoc))))
+ (proto-stream-get-response stream start eoc)))
-(defun network-stream-get-response (stream start end-of-command)
- (when end-of-command
+(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))
+ (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)))))))
+ (if (= start (point))
+ ;; The process died; return nil.
+ nil
+ ;; Return the data we got back.
+ (buffer-substring start (point))))))
-(defun network-stream-open-tls (name buffer host service parameters)
+(defun proto-stream-open-tls (name buffer host service parameters)
(with-current-buffer buffer
- (let* ((start (point-max))
- (use-builtin-gnutls (fboundp 'open-gnutls-stream))
+ (let ((start (point-max))
(stream
- (funcall (if use-builtin-gnutls
+ (funcall (if (fboundp 'open-gnutls-stream)
'open-gnutls-stream
'open-tls-stream)
name buffer host service))
@@ -251,36 +238,37 @@ values:
(list nil nil nil 'plain)
;; If we're using tls.el, we have to delete the output from
;; openssl/gnutls-cli.
- (when (and (null use-builtin-gnutls) eoc)
- (network-stream-get-response stream start eoc)
+ (unless (fboundp 'open-gnutls-stream)
+ (proto-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))))
- (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))))))
+ (proto-stream-capability-open start stream parameters 'tls)))))
-(defun network-stream-open-shell (name buffer host service parameters)
+(defun proto-stream-open-shell (name buffer host service parameters)
(require 'format-spec)
- (let* ((capability-command (plist-get parameters :capability-command))
- (eoc (plist-get parameters :end-of-command))
- (start (with-current-buffer buffer (point)))
- (stream (let ((process-connection-type nil))
+ (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))))))
- (list stream
- (network-stream-get-response stream start eoc)
- (network-stream-command stream capability-command eoc)
- 'plain)))
+ ?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 'network-stream)
+(provide 'proto-stream)
-;;; network-stream.el ends here
+;;; proto-stream.el ends here
-----------------------------------------------------------------------
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we listed those
revisions in full, above.
Summary of changes:
lisp/ChangeLog | 2 -
lisp/nnimap.el | 5 +-
lisp/nntp.el | 5 +-
lisp/{network-stream.el => proto-stream.el} | 210 +++++++++++++--------------
4 files changed, 107 insertions(+), 115 deletions(-)
rename lisp/{network-stream.el => proto-stream.el} (57%)
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "Gnus Project".
The branch, master has been updated
hooks/post-receive
--
Gnus Project