Doc fix.

[gnus] / lisp / proto-stream.el

diff --git a/lisp/proto-stream.el b/lisp/proto-stream.el
index 6c90f3a..9117ac9 100644 (file)
--- 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 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: network
@@ -75,10 +75,11 @@ is a string representing the capabilities of the server (if any).
 The PARAMETERS is a keyword list that can have the following
 values:
 
-:type -- either `network', `tls', `shell' or `starttls'.  If
-omitted, the default is `network'.  `network' will be
-opportunistically upgraded to STARTTLS if both the server and
-Emacs supports it.
+:type -- either `network', `network-only, `tls', `shell' or
+`starttls'.  If omitted, the default is `network'.  `network'
+will be opportunistically upgraded to STARTTLS if both the server
+and Emacs supports it.  If you don't want STARTTLS upgrades, use
+`network-only'.
 
 :end-of-command -- a regexp saying what the end of a command is.
 This defaults to \"\\n\".
@@ -100,14 +101,28 @@ command to switch on STARTTLS otherwise."
       (setq type 'network))
      ((eq type 'ssl)
       (setq type 'tls)))
-    (destructuring-bind (stream greeting capabilities)
-       (funcall (intern (format "proto-stream-open-%s" type) obarray)
-                name buffer host service parameters)
-      (list (and stream
-                (memq (process-status stream)
-                      '(open run))
-                stream)
-           greeting capabilities))))
+    (let ((open-result
+          (funcall (intern (format "proto-stream-open-%s" type) obarray)
+                   name buffer host service parameters)))
+      (if (null open-result)
+         (list nil nil nil type)
+       (let ((stream (car open-result)))
+         (list (and stream
+                    (memq (process-status stream)
+                          '(open run))
+                    stream)
+               (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)))
+       (stream (open-network-stream name buffer host service)))
+    (list stream
+         (proto-stream-get-response
+          stream start (proto-stream-eoc parameters))
+         nil
+         'network)))
 
 (defun proto-stream-open-network (name buffer host service parameters)
   (let* ((start (with-current-buffer buffer (point)))
@@ -118,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
@@ -136,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)
@@ -164,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)
@@ -181,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)
@@ -189,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))))
@@ -230,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
@@ -243,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))