bug#8988: 24.0.50; [PATCH] pop3-open-server fails to parse response to CAPA

[Wolfgang Jenkner]

When I evaluate

(progn
  (load "pop3.el")
  (trace-function-background 'open-protocol-stream)
  (let ((pop3-stream-type 'starttls))
    (ignore-errors
      (pop3-open-server "pop.gmx.com" 110))))

buffer *trace-output* contains

======================================================================
1 -> open-protocol-stream: name="POP" buffer=#<buffer  trace of POP session to 
pop.gmx.com> host="pop.gmx.com" service=110 parameters=(:type starttls 
:capability-command "CAPA
" :end-of-command "^\\.?
\\|^\\(-ERR\\|+OK \\).*
" :success "^\\+OK.*
" :return-list t :starttls-function (lambda (capabilities) (and (string-match 
"\\bSTLS\\b" capabilities) "STLS
")))
1 <- open-protocol-stream: (nil :greeting "+OK POP server ready H migmx003
" :capabilities "+OK Capability list follows
" :type plain :error "Server does not support TLS")

However, in the shell

$ telnet pop.gmx.com 110
Trying 212.227.17.187...
Connected to pop.gmx.com.
Escape character is '^]'.
+OK POP server ready H migmx007
CAPA
+OK Capability list follows
TOP
USER
UIDL
STLS
SASL PLAIN
IMPLEMENTATION trinity
.
QUIT
+OK POP server signing off
Connection closed by foreign host.
$ 

So it seems that "+OK Capability list follows" arrived in a separate
chunk and was matched by the second alternative of the regexp specified
for :end-of-command in pop3-open-server before the actual capability
list followed and the regexp's first alternative had a chance to match.
(I haven't tested this theory, though, since it seems valid as
a theoretical possibility anyway :-)

I include ChangeLog entries and patches for lisp/gnus/pop3.el and
lisp/net/network-stream.el (I could also send a bzr bundle, but given
that most of lisp/gnus is merged from the main Gnus repository this
doesn't seem too practical).

Wolfgang

2011-07-03  Wolfgang Jenkner  <wjenkner@inode.at>

        * net/network-stream.el (open-network-stream)
        (network-stream-open-starttls, network-stream-open-tls)
        (network-stream-open-shell): New parameter :end-of-capability,
        like :end-of-command but matches the end of the response to
        a :capability-command query.

2011-07-03  Wolfgang Jenkner  <wjenkner@inode.at>

        * pop3.el (pop3-open-server): Use :end-of-capability.

=== modified file 'lisp/net/network-stream.el'
--- lisp/net/network-stream.el  2011-06-27 00:11:22 +0000
+++ lisp/net/network-stream.el  2011-07-02 23:38:45 +0000
@@ -98,6 +98,10 @@
 
 :end-of-command specifies a regexp matching the end of a command.
 
+:end-of-capability specifies a regexp matching the end of the
+  response to the command specified for :capability-command.
+  It defaults to the regexp specified for :end-of-command.
+
 :success specifies a regexp matching a message indicating a
   successful STARTTLS negotiation.  For instance, the default
   should be \"^3\" for an NNTP connection.
@@ -129,6 +133,10 @@
   asynchronously, if possible."
   (unless (featurep 'make-network-process)
     (error "Emacs was compiled without networking support"))
+  ;; (unless (plist-get parameters :end-of-capability)
+  ;;     (setq parameters (plist-put parameters
+  ;;                             :end-of-capability
+  ;;                             (plist-get parameters :end-of-command))))
   (let ((type (plist-get parameters :type))
        (return-list (plist-get parameters :return-list)))
     (if (and (not return-list)
@@ -203,11 +211,12 @@
         (success-string     (plist-get parameters :success))
         (capability-command (plist-get parameters :capability-command))
         (eoc                (plist-get parameters :end-of-command))
+        (eo-capa            (or (plist-get parameters :end-of-capability) eoc))
         ;; Return (STREAM GREETING CAPABILITIES RESULTING-TYPE)
         (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))
+        (capabilities (network-stream-command stream capability-command 
eo-capa))
         (resulting-type 'plain)
         (builtin-starttls (and (fboundp 'gnutls-available-p)
                                (gnutls-available-p)))
@@ -250,7 +259,7 @@
        ;; Requery capabilities for protocols that require it; i.e.,
        ;; EHLO for SMTP.
        (when (plist-get parameters :always-query-capabilities)
-         (network-stream-command stream capability-command eoc)))
+         (network-stream-command stream capability-command eo-capa)))
       (when (string-match success-string
                          (network-stream-command stream starttls-command eoc))
        ;; The server said it was OK to begin STARTTLS negotiations.
@@ -271,7 +280,7 @@
            (network-stream-get-response stream start eoc)))
        ;; Re-get the capabilities, which may have now changed.
        (setq capabilities
-             (network-stream-command stream capability-command eoc))))
+             (network-stream-command stream capability-command eo-capa))))
 
     ;; If TLS is mandatory, close the connection if it's unencrypted.
     (when (and (or require-tls
@@ -320,7 +329,8 @@
                         'open-gnutls-stream
                       'open-tls-stream)
                     name buffer host service))
-          (eoc (plist-get parameters :end-of-command)))
+          (eoc (plist-get parameters :end-of-command))
+          (eo-capa (or (plist-get parameters :end-of-capability) eoc)))
       (if (null stream)
          (list nil nil nil 'plain)
        ;; If we're using tls.el, we have to delete the output from
@@ -335,13 +345,14 @@
        (let* ((capability-command (plist-get parameters :capability-command)))
          (list stream
                (network-stream-get-response stream start eoc)
-               (network-stream-command stream capability-command eoc)
+               (network-stream-command stream capability-command eo-capa)
                'tls))))))
 
 (defun network-stream-open-shell (name buffer host service parameters)
   (require 'format-spec)
   (let* ((capability-command (plist-get parameters :capability-command))
         (eoc                (plist-get parameters :end-of-command))
+        (eo-capa            (or (plist-get parameters :end-of-capability) eoc))
         (start (with-current-buffer buffer (point)))
         (stream (let ((process-connection-type nil))
                   (start-process name buffer shell-file-name
@@ -353,7 +364,7 @@
                                    ?p service))))))
     (list stream
          (network-stream-get-response stream start eoc)
-         (network-stream-command stream capability-command eoc)
+         (network-stream-command stream capability-command eo-capa)
          'plain)))
 
 (provide 'network-stream)

=== modified file 'lisp/gnus/pop3.el'
--- lisp/gnus/pop3.el   2011-05-30 22:11:52 +0000
+++ lisp/gnus/pop3.el   2011-07-02 23:38:45 +0000
@@ -306,7 +306,12 @@
                    (t
                     (or pop3-stream-type 'network)))
             :capability-command "CAPA\r\n"
-            :end-of-command "^\\.\r?\n\\|^\\(-ERR\\|+OK \\).*\n"
+            :end-of-command "^\\(-ERR\\|+OK \\).*\n"
+            ;; As it happens, the regexp above also matches the first
+            ;; line of the response to CAPA, which might arrive in
+            ;; a separate chunk, with the actual capabilities
+            ;; following later.
+            :end-of-capability "^\\.\r?\n"
             :success "^\\+OK.*\n"
             :return-list t
             :starttls-function