Switch on STARTTLS on NNTP servers that support it.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index ae3c30c..d13d097 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,6 +1,10 @@
 2010-11-27  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
+       * nntp.el (nntp-open-connection): Switch on STARTTLS on supported
+       servers.
+
        * proto-stream.el (open-proto-stream): Use network, not stream.
+       (open-proto-stream): Add a way to specify what the end of a command is.
 
        * nntp.el (nntp-open-connection): Use proto-streams for the relevant
        connections types.

diff --git a/lisp/nntp.el b/lisp/nntp.el
index f201d35..6dd01b0 100644 (file)
--- a/lisp/nntp.el
+++ b/lisp/nntp.el
@@ -1272,7 +1272,14 @@ password contained in '~/.nntp-authinfo'."
                    (car (open-proto-stream
                          "nntpd" pbuffer nntp-address nntp-port-number
                          :type (cadr
-                                (assoc nntp-open-connection-function map))))
+                                (assoc nntp-open-connection-function map))
+                         :end-of-command "^\\([2345]\\|[.]\\).*\n"
+                         :capability-command "CAPABILITIES\r\n"
+                         :starttls-function
+                         (lambda (capabilities)
+                           (if (not (string-match "STARTTLS" capabilities))
+                               nil
+                             "STARTTLS"))))
                  (funcall nntp-open-connection-function pbuffer)))
            (error nil)
            (quit

diff --git a/lisp/proto-stream.el b/lisp/proto-stream.el
index b1f2818..5ec6b54 100644 (file)
--- a/lisp/proto-stream.el
+++ b/lisp/proto-stream.el
@@ -72,6 +72,9 @@ values:
 :type -- either `network', `tls', `shell' or `starttls'.  If
 omitted, the default is `network'.
 
+:end-of-command -- a regexp saying what the end of a command is.
+This defaults to \"\\n\".
+
 :capability-command -- a string representing the command used to
 query server for capabilities.  For instance, for IMAP this is
 \"1 CAPABILITY\\r\\n\".
@@ -99,11 +102,13 @@ command to switch on STARTTLS otherwise."
   (let* ((start (with-current-buffer buffer (point)))
         (stream (open-network-stream name buffer host service))
         (capability-command (cadr (memq :capability-command parameters)))
-        (greeting (proto-stream-get-response stream start)))
+        (greeting (proto-stream-get-response
+                   stream start (proto-stream-eoc parameters))))
     (if (not capability-command)
        (list stream greeting nil)
       (let* ((capabilities
-             (proto-stream-capabilities stream capability-command))
+             (proto-stream-capabilities stream capability-command
+                                        (proto-stream-eoc parameters)))
             (starttls-command
              (funcall (cadr (memq :starttls-function parameters))
                       capabilities)))
@@ -121,21 +126,22 @@ command to switch on STARTTLS otherwise."
         ((fboundp 'open-gnutls-stream)
          (setq start (with-current-buffer buffer (point-max)))
          (process-send-string stream starttls-command)
-         (proto-stream-get-response stream start)
+         (proto-stream-get-response stream start (proto-stream-eoc parameters))
          (gnutls-negotiate stream nil)
          ;; Re-get the capabilities, since they may have changed
          ;; after switching to TLS.
          (setq start (with-current-buffer buffer (point-max)))
          (process-send-string stream capability-command)
-         (list stream greeting (proto-stream-get-response stream start)))
+         (list stream greeting (proto-stream-get-response
+                                stream start (proto-stream-eoc parameters))))
         (t
          (delete-process stream)
          (proto-stream-open-starttls name buffer host service parameters)))))))
 
-(defun proto-stream-capabilities (stream command)
+(defun proto-stream-capabilities (stream command end-of-command)
   (let ((start (with-current-buffer (process-buffer stream) (point-max))))
     (process-send-string stream command)
-    (proto-stream-get-response stream start)))
+    (proto-stream-get-response stream start end-of-command)))
 
 (defun proto-stream-open-starttls (name buffer host service parameters)
   (proto-stream-capability-open
@@ -143,13 +149,13 @@ command to switch on STARTTLS otherwise."
    (starttls-open-stream name buffer host service)
    parameters))
 
-(defun proto-stream-get-response (stream start)
+(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 (search-forward "\n" nil t)))
+                 (not (re-search-forward end-of-command nil t)))
        (accept-process-output stream 0 50)
        (goto-char start))
       (if (= start (point))
@@ -182,10 +188,17 @@ command to switch on STARTTLS otherwise."
 
 (defun proto-stream-capability-open (start stream parameters)
   (let ((capability-command (cadr (memq :capability-command parameters)))
-       (greeting (proto-stream-get-response stream start)))
+       (greeting (proto-stream-get-response
+                  stream start (proto-stream-eoc parameters))))
     (list stream greeting
          (and capability-command
-              (proto-stream-capabilities stream capability-command)))))
+              (proto-stream-capabilities
+               stream capability-command
+               (proto-stream-eoc parameters))))))
+
+(defun proto-stream-eoc (parameters)
+  (or (cadr (memq :end-of-command parameters))
+      "\n"))
 
 (provide 'proto-stream)