[gnus git] branch master updated: n0-17-2-g9c09bfb =1= * pop3.el (pop3-open-server): Upgrade opportunistically to STARTTLS.

       via  9c09bfb629f99c5909c70982a17607060a419022 (commit)
      from  8dcd80548b0bd7bd16ca08c33d4fa068aa7baf98 (commit)


- Log -----------------------------------------------------------------
commit 9c09bfb629f99c5909c70982a17607060a419022
Author: Lars Magne Ingebrigtsen <[email protected]>
Date:   Sun May 1 23:54:39 2011 +0200

    * pop3.el (pop3-open-server): Upgrade opportunistically to STARTTLS.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index b212a29..fa5ae85 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,7 @@
+2011-05-01  Lars Magne Ingebrigtsen  <[email protected]>
+
+	* pop3.el (pop3-open-server): Upgrade opportunistically to STARTTLS.
+
 2011-05-01  Lars Magne Ingebrigtsen  <[email protected]>
 
 	* gnus.el: No Gnus v0.17 is released.
diff --git a/lisp/pop3.el b/lisp/pop3.el
index 08cd7cd..2266510 100644
--- a/lisp/pop3.el
+++ b/lisp/pop3.el
@@ -33,6 +33,13 @@
 ;;; Code:
 
 (eval-when-compile (require 'cl))
+
+(eval-and-compile
+  ;; In Emacs 24, `open-protocol-stream' is an autoloaded alias for
+  ;; `make-network-stream'.
+  (unless (fboundp 'open-protocol-stream)
+    (require 'proto-stream)))
+
 (require 'mail-utils)
 (defvar parse-time-months)
 
@@ -286,64 +293,37 @@ this is nil, `ssl' is assumed for connexions to port
 Returns the process associated with the connection."
   (let ((coding-system-for-read 'binary)
 	(coding-system-for-write 'binary)
-	process)
+	result)
     (with-current-buffer
         (get-buffer-create (concat " trace of POP session to "
                                    mailhost))
       (erase-buffer)
       (setq pop3-read-point (point-min))
-      (setq process
-	    (cond
+      (setq result
+	    (open-protocol-stream
+	     "POP" (current-buffer) mailhost port
+	     :type (cond
 	     ((or (eq pop3-stream-type 'ssl)
-		  (and (not pop3-stream-type) (member port '(995 "pop3s"))))
-	      ;; gnutls-cli, openssl don't accept service names
-	      (if (or (equal port "pop3s")
-		      (null port))
-		  (setq port 995))
-	      (let ((process (open-tls-stream "POP" (current-buffer)
-					      mailhost port)))
-		(when process
-		  ;; There's a load of info printed that needs deleting.
-		  (let ((again 't))
-		    ;; repeat until
-		    ;; - either we received the +OK line
-		    ;; - or accept-process-output timed out without getting
-		    ;;   anything
-		    (while (and again
-				(setq again (memq (process-status process)
-						  '(open run))))
-		      (setq again (pop3-accept-process-output process))
-		      (goto-char (point-max))
-		      (forward-line -1)
-		      (cond ((looking-at "\\+OK")
-			     (setq again nil)
-			     (delete-region (point-min) (point)))
-			    ((not again)
-			     (pop3-quit process)
-			     (error "POP SSL connexion failed")))))
-		  process)))
-	     ((eq pop3-stream-type 'starttls)
-	      ;; gnutls-cli, openssl don't accept service names
-	      (if (equal port "pop3")
-		  (setq port 110))
-	      ;; Delay STLS until server greeting is read (Bug#7438).
-	      (starttls-open-stream "POP" (current-buffer)
-				    mailhost (or port 110)))
+			 (and (not pop3-stream-type)
+			      (member port '(995 "pop3s"))))
+		     :tls)
 	     (t
-	      (open-network-stream "POP" (current-buffer) mailhost port))))
-      (let ((response (pop3-read-response process t)))
+		     (or pop3-stream-type 'network)))
+	     :capability-command "CAPA\r\n"
+	     :end-of-command "^\\.\r?\n\\|^\\+[A-Z]+ .*\n"
+	     :success "^\\+OK.*\n"
+	     :return-list t
+	     :starttls-function
+	     (lambda (capabilities)
+	       (and (string-match "STLS" capabilities)
+		    "STLS\r\n"))))
+      (when result
+	(let ((response (plist-get (cdr result) :greeting)))
 	(setq pop3-timestamp
 	      (substring response (or (string-match "<" response) 0)
 			 (+ 1 (or (string-match ">" response) -1)))))
-      (when (eq pop3-stream-type 'starttls)
-	(pop3-send-command process "STLS")
-	(let ((response (pop3-read-response process t)))
-	  (if (and response (string-match "+OK" response))
-	      (starttls-negotiate process)
-	    (pop3-quit process)
-	    (error "POP server doesn't support starttls"))))
-      (pop3-set-process-query-on-exit-flag process nil)
-      process)))
+	(pop3-set-process-query-on-exit-flag (car result) nil)
+	(car result)))))
 
 ;; Support functions
 

-----------------------------------------------------------------------
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we listed those
revisions in full, above.

Summary of changes:
 lisp/ChangeLog |    4 ++
 lisp/pop3.el   |   86 +++++++++++++++++++++----------------------------------
 2 files changed, 37 insertions(+), 53 deletions(-)

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "Gnus Project".

The branch, master has been updated


hooks/post-receive
-- 
Gnus Project