This patch adds support for Gnus mail retrieval via POP over TLS/SSL, as used by gmail, for example. (Mailutils doesn't support this, only STARTTLS.) 2005-09-19 Dave Love * mail-source.el (mail-sources): Fixes for :type; add stream to it. (mail-source-keyword-map): Add :stream. (mail-source-fetch-pop): Bind pop3-stream-type. * pop3.el (nnheader): Require when compiling. (open-tls-stream, starttls-open-stream): Autoload. (pop3-stream-type): New. (pop3-open-server): Use it. (pop3-apop): Don't use pop-md5. (pop3-md5, pop3-md5-program-args, pop3-md5-program): Deleted. Index: mail-source.el =================================================================== RCS file: /cvsroot/emacs/emacs/lisp/gnus/mail-source.el,v retrieving revision 1.21 diff -u -p -r1.21 mail-source.el --- mail-source.el 6 Aug 2005 19:51:42 -0000 1.21 +++ mail-source.el 8 Oct 2005 13:58:19 -0000 @@ -109,7 +109,7 @@ See Info node `(gnus)Mail Source Specifi (const :format "" :value :port) (choice :tag "Port" :value "pop3" - (number :format "%v") + (integer :format "%v") (string :format "%v"))) (group :inline t (const :format "" :value :user) @@ -125,13 +125,15 @@ See Info node `(gnus)Mail Source Specifi (choice :tag "Prescript" :value nil (string :format "%v") - (function :format "%v"))) + (function :format "%v") + (const :tag "None" nil))) (group :inline t (const :format "" :value :postscript) (choice :tag "Postscript" :value nil (string :format "%v") - (function :format "%v"))) + (function :format "%v") + (const :tag "None" nil))) (group :inline t (const :format "" :value :function) (function :tag "Function")) @@ -144,7 +146,14 @@ See Info node `(gnus)Mail Source Specifi (const apop))) (group :inline t (const :format "" :value :plugged) - (boolean :tag "Plugged")))) + (boolean :tag "Plugged")) + (group :inline t + (const :format "" :value :stream) + (choice :tag "Stream" + :value nil + (const :tag "Clear" nil) + (const starttls) + (const ssl))))) (cons :tag "Maildir (qmail, postfix...)" (const :format "" maildir) (checklist :tag "Options" :greedy t @@ -164,7 +173,7 @@ See Info node `(gnus)Mail Source Specifi (const :format "" :value :port) (choice :tag "Port" :value 143 - number string)) + integer string)) (group :inline t (const :format "" :value :user) (string :tag "User")) @@ -348,7 +357,8 @@ Common keywords should be listed here.") (:program) (:function) (:password) - (:authentication password)) + (:authentication password) + (:stream nil)) (maildir (:path (or (getenv "MAILDIR") "~/Maildir/")) (:subdirs ("cur" "new")) @@ -712,6 +722,7 @@ Pass INFO on to CALLBACK." (defun mail-source-fetch-pop (source callback) "Fetcher for single-file sources." (mail-source-bind (pop source) + ;; fixme: deal with srteam type in format specs (mail-source-run-script prescript (format-spec-make ?p password ?t mail-source-crash-box @@ -745,7 +756,8 @@ Pass INFO on to CALLBACK." (pop3-mailhost server) (pop3-port port) (pop3-authentication-scheme - (if (eq authentication 'apop) 'apop 'pass))) + (if (eq authentication 'apop) 'apop 'pass)) + (pop3-stream-type stream)) (if (or debug-on-quit debug-on-error) (save-excursion (pop3-movemail mail-source-crash-box)) (condition-case err Index: pop3.el =================================================================== RCS file: /cvsroot/emacs/emacs/lisp/gnus/pop3.el,v retrieving revision 1.33 diff -u -p -r1.33 pop3.el --- pop3.el 6 Aug 2005 19:51:42 -0000 1.33 +++ pop3.el 8 Oct 2005 13:58:19 -0000 @@ -36,6 +36,7 @@ ;;; Code: (require 'mail-utils) +(eval-when-compile (require 'nnheader)) (defgroup pop3 nil "Post Office Protocol." @@ -75,10 +76,10 @@ (defcustom pop3-authentication-scheme 'pass "*POP3 authentication scheme. -Defaults to 'pass, for the standard USER/PASS authentication. Other valid -values are 'apop." +Defaults to `pass', for the standard USER/PASS authentication. The other +valid value is 'apop'." :version "22.1" ;; Oort Gnus - :type '(choice (const :tag "USER/PASS" pass) + :type '(choice (const :tag "Normal user/password" pass) (const :tag "APOP" apop)) :group 'pop3) @@ -166,11 +167,9 @@ Shorter values mean quicker response, bu (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 +193,22 @@ Shorter values mean quicker response, bu (pop3-quit process) message-count)) +(autoload 'open-tls-stream "tls") +(autoload 'starttls-open-stream "starttls") + +(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 "22.1" + :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,36 @@ Returns the process associated with the 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) (= port 995))) ; pop3s + (let ((process (open-tls-stream "POP" (current-buffer) + mailhost port))) + (when process + ;; There's a load of info printed that needs deleting. + ;; Fixme: Can this be dealt with sensibly in tls.el? + (when (memq (process-status process) '(open run)) + (pop3-accept-process-output process) + (goto-char (point-max)) + (forward-line -1) + (if (looking-at "\\+OK") + (delete-region (point-min) (point)) +; (pop3-quit process) + (error "POP SSL connexion failed %s" (buffer-string)))) + process))) + ((eq pop3-stream-type 'starttls) + (let ((process (starttls-open-stream "POP" (current-buffer) + mailhost port))) + (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 +356,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") @@ -348,37 +394,6 @@ If NOW, use that time instead." ;; AUTHORIZATION STATE -(eval-when-compile - (if (not (fboundp 'md5)) ;; Emacs 20 - (defalias 'md5 'ignore))) - -(eval-and-compile - (if (and (fboundp 'md5) - ;; There might be an incompatible implementation. - (condition-case nil - (md5 "Check whether the 4th argument is allowed" - nil nil 'binary) - (error nil))) - (defun pop3-md5 (string) - (md5 string nil nil 'binary)) - (defvar pop3-md5-program "md5" - "*Program to encode its input in MD5. -\"openssl\" is a popular alternative; set `pop3-md5-program-args' to -'(\"md5\") if you use it.") - (defvar pop3-md5-program-args nil - "*List of arguments passed to `pop3-md5-program'.") - (defun pop3-md5 (string) - (let ((default-enable-multibyte-characters t) - (coding-system-for-write 'binary)) - (with-temp-buffer - (insert string) - (apply 'call-process-region (point-min) (point-max) - pop3-md5-program t (current-buffer) nil - pop3-md5-program-args) - ;; The meaningful output is the first 32 characters. - ;; Don't return the newline that follows them! - (buffer-substring (point-min) (+ 32 (point-min)))))))) - (defun pop3-user (process user) "Send USER information to POP3 server." (pop3-send-command process (format "USER %s" user)) @@ -400,12 +415,11 @@ If NOW, use that time instead." (setq pass (read-passwd (format "Password for %s: " pop3-maildrop)))) (if pass - (let ((hash (pop3-md5 (concat pop3-timestamp pass)))) + (let ((hash (md5 (concat pop3-timestamp pass)))) (pop3-send-command process (format "APOP %s %s" user hash)) (let ((response (pop3-read-response process t))) (if (not (and response (string-match "+OK" response))) - (pop3-quit process))))) - )) + (pop3-quit process))))))) ;; TRANSACTION STATE @@ -510,6 +524,13 @@ and close the connection." ;; +OK [maildrop locked and ready] ;; -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