[Emacs-diffs] /srv/bzr/emacs/trunk r103811: Merge open-protocol-stream into open-network-stream.

[Chong Yidong]

------------------------------------------------------------
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)