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

[Wolfgang Jenkner <wjenkner@inode.at>]

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