X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;ds=sidebyside;f=lisp%2Fpop3.el;h=8282f9c50c550172234366ff33cf6d2f9e26f50d;hb=0ddd674342067ef66a296cab65fa509f605aa9d0;hp=29a802698a6328ca533512dc35d0d7ffe44bb936;hpb=20bc985a3232ebba106d335afcfd6b596bb8efba;p=gnus

diff --git a/lisp/pop3.el b/lisp/pop3.el
index 29a802698..8282f9c50 100644
--- a/lisp/pop3.el
+++ b/lisp/pop3.el
@@ -1,7 +1,7 @@
 ;;; pop3.el --- Post Office Protocol (RFC 1460) interface
 
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
-;;        Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
+;;   2004, 2005, 2006 Free Software Foundation, Inc.
 
 ;; Author: Richard L. Pieri <ratinox@peorth.gweep.net>
 ;; Maintainer: FSF
@@ -75,11 +75,11 @@
 
 (defcustom pop3-authentication-scheme 'pass
   "*POP3 authentication scheme.
-Defaults to 'pass, for the standard USER/PASS authentication.  Other valid
-values are 'apop."
-  :version "22.1" ;; Oort Gnus
-  :type '(choice (const :tag "USER/PASS" pass)
+Defaults to `pass', for the standard USER/PASS authentication.  The other
+valid value is 'apop'."
+  :type '(choice (const :tag "Normal user/password" pass)
 		 (const :tag "APOP" apop))
+  :version "22.1" ;; Oort Gnus
   :group 'pop3)
 
 (defcustom pop3-leave-mail-on-server nil
@@ -166,11 +166,9 @@ Shorter values mean quicker response, but are more CPU intensive.")
           (unless pop3-leave-mail-on-server
             (pop3-dele process n))
 	  (setq n (+ 1 n))
-	  (if pop3-debug (sit-for 1) (sit-for 0.1))
-	  )
+	  (if pop3-debug (sit-for 1) (sit-for 0.1))) ; why?
       (pop3-quit process))
-    (kill-buffer crashbuf)
-    )
+    (kill-buffer crashbuf))
   t)
 
 (defun pop3-get-message-count ()
@@ -194,6 +192,23 @@ Shorter values mean quicker response, but are more CPU intensive.")
     (pop3-quit process)
     message-count))
 
+(autoload 'open-tls-stream "tls")
+(autoload 'starttls-open-stream "starttls")
+(autoload 'starttls-negotiate "starttls") ; avoid warning
+
+(defcustom pop3-stream-type nil
+  "*Transport security type for POP3 connexions.
+This may be either nil (plain connexion), `ssl' (use an
+SSL/TSL-secured stream) or `starttls' (use the starttls mechanism
+to turn on TLS security after opening the stream).  However, if
+this is nil, `ssl' is assumed for connexions to port
+995 (pop3s)."
+  :version "23.0" ;; No Gnus
+  :group 'pop3
+  :type '(choice (const :tag "Plain" nil)
+		 (const :tag "SSL/TLS" ssl)
+		 (const starttls)))
+
 (defun pop3-open-server (mailhost port)
   "Open TCP connection to MAILHOST on PORT.
 Returns the process associated with the connection."
@@ -205,7 +220,44 @@ Returns the process associated with the connection."
 					     mailhost)))
       (erase-buffer)
       (setq pop3-read-point (point-min))
-      (setq process (open-network-stream "POP" (current-buffer) mailhost port))
+      (setq process
+	    (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.
+		  (while (when (memq (process-status process) '(open run))
+			   (pop3-accept-process-output process)
+			   (goto-char (point-max))
+			   (forward-line -1)
+			   (if (looking-at "\\+OK")
+			       (progn
+				 (delete-region (point-min) (point))
+				 nil)
+			     (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))
+	      (let ((process (starttls-open-stream "POP" (current-buffer)
+						   mailhost (or port 110))))
+		(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")))
+		process))
+	     (t 
+	      (open-network-stream "POP" (current-buffer) mailhost port))))
       (let ((response (pop3-read-response process t)))
 	(setq pop3-timestamp
 	      (substring response (or (string-match "<" response) 0)
@@ -312,6 +364,8 @@ If NOW, use that time instead."
 	    ;; Date: 08 Jul 1996 23:22:24 -0400
 	    ;; should be
 	    ;; Tue Jul 9 09:04:21 1996
+
+	    ;; Fixme: This should use timezone on the date field contents.
 	    (setq date
 		  (cond ((not date)
 			 "Tue Jan 1 00:00:0 1900")
@@ -480,6 +534,13 @@ and close the connection."
 ;;  -ERR [invalid password]
 ;;  -ERR [unable to lock maildrop]
 
+;; STLS      (RFC 2595)
+;; Arguments: none
+;; Restrictions: Only permitted in AUTHORIZATION state.
+;; Possible responses:
+;;  +OK
+;;  -ERR
+
 ;;; TRANSACTION STATE
 
 ;; STAT