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)