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.

9 files changed, 166 insertions, 163 deletions

diff --git a/etc/NEWS b/etc/NEWS
index 521741100f1..a1b0896a643 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -773,6 +773,12 @@ sc.el, x-menu.el, rnews.el, rnewspost.el
 
 * 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
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 9a5b1fd6cc4..04353b9137c 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,15 @@
+2011-04-02  Chong Yidong  <cyd@stupidchicken.com>
+
+        * 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  <rgm@gnu.org>
 
         * 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  <eliz@gnu.org>
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 5dc2938fe08..6aecc3615f3 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -652,7 +652,7 @@ FILE is the name of a file relative to that base location.
 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))
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 37faf83fd12..44c29256b7c 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,10 @@
+2011-04-02  Chong Yidong  <cyd@stupidchicken.com>
+
+        * 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  <julien@danjou.info>
 
         * mm-view.el (mm-display-inline-fontify): Do not fontify with
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index fa09c7ff165..afdea185dd3 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -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 @@ textual parts.")
                :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)
diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el
index fa765e17463..3285da513e8 100644
--- a/lisp/gnus/nntp.el
+++ b/lisp/gnus/nntp.el
@@ -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)
diff --git a/lisp/gnus/proto-stream.el b/lisp/net/network-stream.el
index 45cc974e7a9..070cd2641db 100644
--- a/lisp/gnus/proto-stream.el
+++ b/lisp/net/network-stream.el
@@ -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).
+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 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:
+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 @@ PARAMETERS should be a sequence of keywords and 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
@@ -106,6 +109,8 @@ PARAMETERS should be a sequence of keywords and 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)
@@ -113,21 +118,24 @@ PARAMETERS should be a sequence of keywords and values:
                  (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 @@ PARAMETERS should be a sequence of keywords and values:
                   :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 @@ PARAMETERS should be a sequence of keywords and values:
          (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 @@ PARAMETERS should be a sequence of keywords and values:
                   ;; 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 @@ PARAMETERS should be a sequence of keywords and values:
           ;; 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 @@ PARAMETERS should be a sequence of keywords and values:
     ;; 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)))
+         (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 'proto-stream)
+(provide 'network-stream)
 
-;;; proto-stream.el ends here
+;;; network-stream.el ends here
diff --git a/lisp/subr.el b/lisp/subr.el
index e6e0c62e0b4..387d538b69d 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1792,28 +1792,6 @@ Signal an error if the program returns with a non-zero exit status."
           (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
diff --git a/lisp/url/url-gw.el b/lisp/url/url-gw.el
index 2ba23583528..7d80f2f6725 100644
--- a/lisp/url/url-gw.el
+++ b/lisp/url/url-gw.el
@@ -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 @@ Might do a non-blocking connection; use `process-status' to check."
                                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 @@ Might do a non-blocking connection; use `process-status' to check."
           (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 @@ Might do a non-blocking connection; use `process-status' to check."
                           (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)