X-Git-Url: https://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fproto-stream.el;h=9117ac9f4e37f6333a4cd29b5e6df78df2da1083;hp=546461a67b38054649ccfdd38b172cd89bc2c89f;hb=38514cc0cc2016d69948f2cf103cc9742421278c;hpb=68bab3816a03f315ca498b3174a4803e09f63c55

diff --git a/lisp/proto-stream.el b/lisp/proto-stream.el
index 546461a67..9117ac9f4 100644
--- a/lisp/proto-stream.el
+++ b/lisp/proto-stream.el
@@ -1,6 +1,6 @@
 ;;; proto-stream.el --- negotiating TLS, STARTTLS and other connections
 
-;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: network
@@ -105,13 +105,15 @@ command to switch on STARTTLS otherwise."
 	   (funcall (intern (format "proto-stream-open-%s" type) obarray)
 		    name buffer host service parameters)))
       (if (null open-result)
-	  (list nil nil nil)
-	(destructuring-bind (stream greeting capabilities) open-result
+	  (list nil nil nil type)
+	(let ((stream (car open-result)))
 	  (list (and stream
 		     (memq (process-status stream)
 			   '(open run))
 		     stream)
-		greeting capabilities))))))
+		(nth 1 open-result)
+		(nth 2 open-result)
+		(nth 3 open-result)))))))
 
 (defun proto-stream-open-network-only (name buffer host service parameters)
   (let ((start (with-current-buffer buffer (point)))
@@ -119,7 +121,8 @@ command to switch on STARTTLS otherwise."
     (list stream
 	  (proto-stream-get-response
 	   stream start (proto-stream-eoc parameters))
-	  nil)))
+	  nil
+	  'network)))
 
 (defun proto-stream-open-network (name buffer host service parameters)
   (let* ((start (with-current-buffer buffer (point)))
@@ -130,7 +133,7 @@ command to switch on STARTTLS otherwise."
 	 (greeting (proto-stream-get-response stream start eoc))
 	 success)
     (if (not capability-command)
-	(list stream greeting nil)
+	(list stream greeting nil 'network)
       (let* ((capabilities
 	      (proto-stream-command stream capability-command eoc))
 	     (starttls-command
@@ -148,7 +151,7 @@ command to switch on STARTTLS otherwise."
 		(delete-process stream)
 		nil)
 	    ;; Otherwise, just return this plain network connection.
-	    (list stream greeting capabilities)))
+	    (list stream greeting capabilities 'network)))
 	 ;; We have some kind of STARTTLS support, so we try to
 	 ;; upgrade the connection opportunistically.
 	 ((or (fboundp 'open-gnutls-stream)
@@ -176,7 +179,7 @@ command to switch on STARTTLS otherwise."
 		    (progn
 		      (delete-process stream)
 		      nil)
-		  (list stream greeting capabilities)))
+		  (list stream greeting capabilities 'network)))
 	    ;; The server said it was OK to start doing STARTTLS negotiations.
 	    (if (fboundp 'open-gnutls-stream)
 		(gnutls-negotiate stream nil)
@@ -193,7 +196,7 @@ command to switch on STARTTLS otherwise."
 	    ;; Re-get the capabilities, since they may have changed
 	    ;; after switching to TLS.
 	    (list stream greeting
-		  (proto-stream-command stream capability-command eoc))))
+		  (proto-stream-command stream capability-command eoc) 'tls)))
 	 ;; We don't have STARTTLS support available, but the caller
 	 ;; requested a STARTTLS connection, so we give up.
 	 ((eq (cadr (memq :type parameters)) 'starttls)
@@ -201,7 +204,7 @@ command to switch on STARTTLS otherwise."
 	  nil)
 	 ;; Fall back on using a plain network stream.
 	 (t
-	  (list stream greeting capabilities)))))))
+	  (list stream greeting capabilities 'network)))))))
 
 (defun proto-stream-command (stream command eoc)
   (let ((start (with-current-buffer (process-buffer stream) (point-max))))
@@ -242,7 +245,7 @@ command to switch on STARTTLS otherwise."
 	  (when (re-search-forward (proto-stream-eoc parameters) nil t)
 	    (goto-char (match-beginning 0))
 	    (delete-region (point-min) (line-beginning-position))))
-	(proto-stream-capability-open start stream parameters)))))
+	(proto-stream-capability-open start stream parameters 'tls)))))
 
 (defun proto-stream-open-shell (name buffer host service parameters)
   (proto-stream-capability-open
@@ -255,16 +258,17 @@ command to switch on STARTTLS otherwise."
 		     (format-spec-make
 		      ?s host
 		      ?p service))))
-   parameters))
+   parameters 'network))
 
-(defun proto-stream-capability-open (start stream parameters)
+(defun proto-stream-capability-open (start stream parameters stream-type)
   (let ((capability-command (cadr (memq :capability-command parameters)))
 	(greeting (proto-stream-get-response
 		   stream start (proto-stream-eoc parameters))))
     (list stream greeting
 	  (and capability-command
 	       (proto-stream-command
-		stream capability-command (proto-stream-eoc parameters))))))
+		stream capability-command (proto-stream-eoc parameters)))
+	  stream-type)))
 
 (defun proto-stream-eoc (parameters)
   (or (cadr (memq :end-of-command parameters))