Re: Updating movemail in Emacs

[Sergey Poznyakoff]

Hello,

Attached is a patch that improves the interaction of rmail.el
with movemail from GNU mailutils. The most important features
of this version of movemail are:

* Support for a wide variety of mailbox formats, including imap
  for remote mailboxes. The retrieval of the mail from remote
  servers can be carried over a TLS encrypted channel.
* Support for a wide variety of locking schemes.
* NLS support
* It is backward-compatible with the native Emacs movemail

The attached patch automatically detects which flavor of movemail
is in use: native Emacs or GNU mailutils. Unless the variable
rmail-movemail-program is set, it looks for the movemail program
in a list of directories composed of rmail-movemail-search-path,
exec-path and exec-directory.

If the GNU mailutils movemail is being used, rmail.el allows to
use 'imap://' and 'pop://' URLs in rmail-primary-inbox-list and
properly recognizes them as remote mailboxes. It also starts
movemail with --emacs flag, thereby enabling special emacs-interaction
mode. This is necessary since movemail is fully internationalized,
like the rest of GNU mailutils, and but the current way of discerning
authentication failures by rmail.el is based on matching the program
output against a set of regular expressions. It is hardly feasible
to pack every possible translation of the error message into this 
regexp. To overcome this difficulty, while still providing national
language support, GNU mailutils movemail has a special emacs-interaction
mode. In this mode it first outputs an abbreviated MU-specific error
code, which can easily be used in a regexp, and then the detailed
explanation of the error in current locale.

The patch has been tested with the CVS version of GNU mailutils.

Just as an example, here is the setup I use:

(setq rmail-primary-inbox-list (list "imap://address@hidden"))
(setq rmail-movemail-flags (list "--tls"))
(setq rmail-movemail-search-path (list "~/gnu/mailutils/movemail"))
(setq rmail-movemail-program nil)
(setq rmail-pop-password-required t
      rmail-preserve-inbox t)

ChangeLog entry follows:

2004-11-18  Sergey Poznyakoff  <address@hidden>

        * mail/rmail.el: Updated to work with movemail from GNU Mailutils

        (rmail-pop-password,rmail-pop-password-required)
        (rmail-set-pop-password): Updated docstring
        (rmail-get-pop-password): Take an argument specifying whether it
        is POP or IMAP mailbox we are using.
        (rmail-pop-password-error): Added mailutils-specific error message
        (rmail-movemail-search-path)
        (rmail-movemail-variant-in-use): New variables.
        (rmail-probe,rmail-autodetect,rmail-movemail-variant-p): New
        functions
        (rmail-get-new-mail): Updated for use with GNU mailutils movemail
        
I'll appreciated any feedback.
      
Regards,
Sergey

Index: rmail.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/mail/rmail.el,v
retrieving revision 1.393
diff -p -u -r1.393 rmail.el
--- rmail.el    12 Nov 2004 17:08:57 -0000      1.393
+++ rmail.el    18 Nov 2004 16:43:04 -0000
@@ -98,13 +98,13 @@
   :type '(choice (const nil) string))
 
 (defcustom rmail-pop-password nil
-  "*Password to use when reading mail from a POP server, if required."
+  "*Password to use when reading mail from a POP or IMAP server, if required."
   :type '(choice (string :tag "Password")
                 (const :tag "Not Required" nil))
   :group 'rmail-retrieve)
 
 (defcustom rmail-pop-password-required nil
-  "*Non-nil if a password is required when reading mail using POP."
+  "*Non-nil if a password is required when reading mail using POP or IMAP."
   :type 'boolean
   :group 'rmail-retrieve)
 
@@ -117,8 +117,9 @@ or `-k' to enable Kerberos authenticatio
   :version "20.3")
 
 (defvar rmail-pop-password-error "invalid usercode or password\\|
-unknown user name or bad password"
-  "Regular expression matching incorrect-password POP server error messages.
+unknown user name or bad password\\|Authentication 
failed\\|MU_ERR_AUTH_FAILURE"
+  "Regular expression matching incorrect-password POP or IMAP server error
+messages.
 If you get an incorrect-password error that this expression does not match,
 please report it with \\[report-emacs-bug].")
 
@@ -130,6 +131,65 @@ rather than deleted, after it is retriev
   :type 'boolean
   :group 'rmail-retrieve)
 
+(defcustom rmail-movemail-search-path nil
+    "*List of directories to search for movemail (in addition to `exec-path')."
+    :group 'rmail-retrieve
+    :type '(repeat (directory)))
+
+(defun rmail-probe (prog)
+  (unwind-protect
+      (save-excursion
+       (let ((tbuf (generate-new-buffer " *rmail autodetect*")))
+         (buffer-disable-undo tbuf)
+         (call-process prog nil tbuf nil "--version")
+         (prog1
+             (if (not (buffer-modified-p tbuf))
+                 ;; Should not happen...
+                 nil
+               (set-buffer tbuf)
+               (goto-char (point-min))
+               (cond
+                ((looking-at ".*movemail: invalid option")
+                 'emacs)    ;; Possibly...
+                ((looking-at "movemail (GNU Mailutils .*)")
+                 'mailutils)
+                (t
+                 ;; FIXME:
+                 'emacs)))
+           (kill-buffer tbuf))))))
+  
+(defun rmail-autodetect ()
+  (if rmail-movemail-program
+      (rmail-probe rmail-movemail-program)
+    (catch 'scan
+      (dolist (dir (append rmail-movemail-search-path exec-path
+                          (list exec-directory)))
+       (when (and dir (file-accessible-directory-p dir))
+         (let ((progname (expand-file-name "movemail" dir)))
+           (when (and (not (file-directory-p progname))
+                      (file-executable-p progname))
+             (let ((x (rmail-probe progname)))
+               (when x
+                 (setq rmail-movemail-program progname)
+                 (throw 'scan x))))))))))
+
+(defvar rmail-movemail-variant-in-use nil
+  "The movemail variant currently in use. Known variants are:
+
+  'emacs      Means any implementation, compatible with the native Emacs one.
+              This is the default;
+  'mailutils  Means GNU mailutils implementation, capable of handling full
+mail URLs as the sourse mailbox;")
+
+;;;###autoload
+(defun rmail-movemail-variant-p (&rest variants)
+  "Return t if the current movemail variant is any of VARIANTS.
+Currently known variants are 'emacs and 'mailutils."
+  (when (not rmail-movemail-variant-in-use)
+    ;; Autodetect
+    (setq rmail-movemail-variant-in-use (rmail-autodetect)))
+  (not (null (member rmail-movemail-variant-in-use variants))))
+
 ;;;###autoload
 (defcustom rmail-dont-reply-to-names nil "\
 *A regexp specifying addresses to prune from a reply message.
@@ -1524,10 +1584,12 @@ It returns t if it got any new messages.
             (file-name-nondirectory buffer-file-name)))
   (let (file tofile delete-files movemail popmail got-password password)
     (while files
-      ;; Handle POP mailbox names specially; don't expand as filenames
+      ;; Handle remote mailbox names specially; don't expand as filenames
       ;; in case the userid contains a directory separator.
       (setq file (car files))
-      (setq popmail (string-match "^po:" file))
+      (setq popmail (or (string-match "^po:" file)
+                       (and (rmail-movemail-variant-p 'mailutils)
+                            (string-match "pop://\\|imap://" file))))
       (if popmail
          (setq renamep t)
        (setq file (file-truename
@@ -1562,7 +1624,10 @@ It returns t if it got any new messages.
       (cond (popmail
             (if rmail-pop-password-required
                 (progn (setq got-password (not (rmail-have-password)))
-                       (setq password (rmail-get-pop-password))))
+                       (setq password
+                             (rmail-get-pop-password
+                              (and (rmail-movemail-variant-p 'mailutils)
+                                   (string-match "imap://" file))))))
             (if (memq system-type '(windows-nt cygwin))
                 ;; cannot have "po:" in file name
                 (setq tofile
@@ -1571,7 +1636,7 @@ It returns t if it got any new messages.
                                (file-name-nondirectory (substring file 3)))
                        (file-name-directory
                         (expand-file-name buffer-file-name)))))
-            (message "Getting mail from post office ..."))
+            (message "Getting mail from the remote server ..."))
            ((and (file-exists-p tofile)
                  (/= 0 (nth 7 (file-attributes tofile))))
             (message "Getting mail from %s..." tofile))
@@ -1617,7 +1682,9 @@ It returns t if it got any new messages.
                             (if rmail-preserve-inbox
                                 (list "-p")
                               nil)
-                            rmail-movemail-flags
+                            (if (rmail-movemail-variant-p 'mailutils)
+                                (append (list "--emacs") rmail-movemail-flags)
+                              rmail-movemail-flags)
                             (list file tofile)
                             (if password (list password) nil))))
                       (apply 'call-process args))
@@ -1634,9 +1701,6 @@ It returns t if it got any new messages.
                       (if (looking-at "movemail: ")
                           (delete-region (point-min) (match-end 0)))
                       (beep t)
-                      (message "movemail: %s"
-                               (buffer-substring (point-min)
-                                                 (point-max)))
                       ;; If we just read the password, most likely it is
                       ;; wrong.  Otherwise, see if there is a specific
                       ;; reason to think that the problem is a wrong passwd.
@@ -1644,6 +1708,18 @@ It returns t if it got any new messages.
                               (re-search-forward rmail-pop-password-error
                                                  nil t))
                           (rmail-set-pop-password nil))
+
+                      ;; If using Mailutils, remove initial error code
+                      ;; abbreviation
+                      (when (rmail-movemail-variant-p 'mailutils)
+                        (goto-char (point-min))
+                        (when (looking-at "[A-Z][A-Z0-9_]*:")
+                          (delete-region (point-min) (match-end 0))))
+                      
+                      (message "movemail: %s"
+                               (buffer-substring (point-min)
+                                                 (point-max)))
+                      
                       (sit-for 3)
                       nil))
                 (if errors (kill-buffer errors))))))
@@ -3833,7 +3909,7 @@ TEXT and INDENT are not used."
 
 ;;;###autoload
 (defun rmail-set-pop-password (password)
-  "Set PASSWORD to be used for retrieving mail from a POP server."
+  "Set PASSWORD to be used for retrieving mail from a POP or IMAP server."
   (interactive "sPassword: ")
   (if password
       (setq rmail-encoded-pop-password
@@ -3841,12 +3917,15 @@ TEXT and INDENT are not used."
     (setq rmail-pop-password nil)
     (setq rmail-encoded-pop-password nil)))
 
-(defun rmail-get-pop-password ()
-  "Get the password for retrieving mail from a POP server.  If none
+(defun rmail-get-pop-password (imap)
+  "Get the password for retrieving mail from a POP or IMAP server.  If none
 has been set, then prompt the user for one."
   (if (not rmail-encoded-pop-password)
       (progn (if (not rmail-pop-password)
-                (setq rmail-pop-password (read-passwd "POP password: ")))
+                (setq rmail-pop-password
+                      (read-passwd (if imap
+                                       "IMAP password: "
+                                     "POP password: "))))
             (rmail-set-pop-password rmail-pop-password)
             (setq rmail-pop-password nil)))
   (rmail-encode-string rmail-encoded-pop-password (emacs-pid)))