comparison lisp/mail/rmail.el @ 90072:cb67264d6096

Revision: [e-mail]--gnu-2005/emacs--unicode--0--patch-2 Merge from emacs--cvs-trunk--0 Patches applied: * [e-mail]--gnu-2004/gnus--rel--5.10--patch-83 - [e-mail]--gnu-2004/gnus--rel--5.10--patch-84 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-3 - [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-4 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-5 Merge from gnus--rel--5.10 * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-6 - [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-11 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-12 Remove "-face" suffix from lazy-highlight face name * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-13 - [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-16 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-17 Merge from gnus--rel--5.10 * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-18 - [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-21 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-22 <no summary provided> * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-23 - [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-39 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-40 Fix regressions from latest reftex update * [e-mail]--gnu-2005/gnus--rel--5.10--base-0 tag of [e-mail]--gnu-2004/gnus--rel--5.10--patch-82 * [e-mail]--gnu-2005/gnus--rel--5.10--patch-1 Merge from emacs--cvs-trunk--0 * [e-mail]--gnu-2005/gnus--rel--5.10--patch-2 Merge from [e-mail]--gnu-2004 * [e-mail]--gnu-2005/gnus--rel--5.10--patch-3 Merge from emacs--cvs-trunk--0

90071:f6b4d0ebf147

;;; rmail.el --- main code of "RMAIL" mail reader for Emacs

;; Copyright (C) 1985,86,87,88,93,94,95,96,97,98,2000, 01, 2004
;;		Free Software Foundation, Inc.

;; Maintainer: FSF
;; Keywords: mail

(defgroup rmail-edit nil
  "Rmail editing."
  :prefix "rmail-edit-"
  :group 'rmail)


(defcustom rmail-movemail-program nil
  "If non-nil, name of program for fetching new mail."
  :group 'rmail-retrieve
  :type '(choice (const nil) string))

(defcustom rmail-pop-password nil
  "*Password to use when reading mail from a POP 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."
  :type 'boolean
  :group 'rmail-retrieve)

(defcustom rmail-movemail-flags nil
  "*List of flags to pass to movemail.
Most commonly used to specify `-g' to enable GSS-API authentication
or `-k' to enable Kerberos authentication."
  :type '(repeat string)
  :group 'rmail-retrieve
  :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.
If you get an incorrect-password error that this expression does not match,
please report it with \\[report-emacs-bug].")

(defvar rmail-encoded-pop-password nil)

(defcustom rmail-preserve-inbox nil
  "*Non-nil if incoming mail should be left in the user's inbox,
rather than deleted, after it is retrieved."
  :type 'boolean
  :group 'rmail-retrieve)

;;;###autoload
(defcustom rmail-dont-reply-to-names nil "\
*A regexp specifying addresses to prune from a reply message.
A value of nil means exclude your own email address as an address

		(setq found t))))
	  found)
      ;; Don't leave the buffer screwed up if we get a disk-full error.
      (or found (rmail-show-message)))))

(defun rmail-insert-inbox-text (files renamep)
  ;; Detect a locked file now, so that we avoid moving mail
  ;; out of the real inbox file.  (That could scare people.)
  (or (memq (file-locked-p buffer-file-name) '(nil t))
      (error "RMAIL file %s is locked"
	     (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
      ;; in case the userid contains a directory separator.
      (setq file (car files))
      (setq popmail (string-match "^po:" file))
      (if popmail
	  (setq renamep t)
	(setq file (file-truename
		    (substitute-in-file-name (expand-file-name file)))))
      (setq tofile (expand-file-name
		    ;; Generate name to move to from inbox name,
		    ;; in case of multiple inboxes that need moving.
		    (concat ".newmail-" (file-name-nondirectory file))
		    ;; Use the directory of this rmail file
		    ;; because it's a nuisance to use the homedir
		    ;; if that is on a full disk and this rmail
		    ;; file isn't.
		    (file-name-directory

	    ;; and the actual inbox is /usr/spool/mail/foo/foo.
	    (if (file-directory-p file)
		(setq file (expand-file-name (user-login-name)
					     file)))))
      (cond (popmail
	     (if rmail-pop-password-required
		 (progn (setq got-password (not (rmail-have-password)))
			(setq password (rmail-get-pop-password))))
	     (if (memq system-type '(windows-nt cygwin))
		 ;; cannot have "po:" in file name
		 (setq tofile
		       (expand-file-name
			(concat ".newmail-pop-"
				(file-name-nondirectory (substring file 3)))
			(file-name-directory
			 (expand-file-name buffer-file-name)))))
	     (message "Getting mail from post office ..."))
	    ((and (file-exists-p tofile)
		  (/= 0 (nth 7 (file-attributes tofile))))
	     (message "Getting mail from %s..." tofile))
	    ((and (file-exists-p file)
		  (/= 0 (nth 7 (file-attributes file))))

	     (if (not rmail-preserve-inbox)
		 (condition-case ()
		     (write-region (point) (point) file)
		   (file-error nil))))
	    (t
	     (let ((errors nil))
	       (unwind-protect
		   (save-excursion
		     (setq errors (generate-new-buffer " *rmail loss*"))
		     (buffer-disable-undo errors)
		     (let ((args
			    (append
			     (list (or rmail-movemail-program
				       (expand-file-name "movemail"
							 exec-directory))
				   nil errors nil)
			     (if rmail-preserve-inbox
				 (list "-p")
			       nil)
			     rmail-movemail-flags
			     (list file tofile)
			     (if password (list password) nil))))
		       (apply 'call-process args))
		     (if (not (buffer-modified-p errors))
			 ;; No output => movemail won
			 nil
		       (set-buffer errors)
		       (subst-char-in-region (point-min) (point-max)
					     ?\n ?\  )
		       (goto-char (point-max))
		       (skip-chars-backward " \t")
		       (delete-region (point) (point-max))
		       (goto-char (point-min))
		       (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.
		       (if (or got-password
			       (re-search-forward rmail-pop-password-error
						  nil t))
			   (rmail-set-pop-password nil))
		       (sit-for 3)
		       nil))
		 (if errors (kill-buffer errors))))))
      ;; At this point, TOFILE contains the name to read:
      ;; Either the alternate name (if we renamed)
      ;; or the actual inbox (if not renaming).
      (if (file-exists-p tofile)
	  (let ((coding-system-for-read 'no-conversion)

; The password is encoded to prevent it from being easily accessible
; to "prying eyes."  Obviously, this encoding isn't "real security,"
; nor is it meant to be.

;;;###autoload
(defun rmail-set-pop-password (password)
  "Set PASSWORD to be used for retrieving mail from a POP server."
  (interactive "sPassword: ")
  (if password
      (setq rmail-encoded-pop-password
	    (rmail-encode-string password (emacs-pid)))
    (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
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: ")))
	     (rmail-set-pop-password rmail-pop-password)
	     (setq rmail-pop-password nil)))
  (rmail-encode-string rmail-encoded-pop-password (emacs-pid)))

(defun rmail-have-password ()
  (or rmail-pop-password rmail-encoded-pop-password))

(defun rmail-encode-string (string mask)
 "Encode STRING with integer MASK, by taking the exclusive OR of the
lowest byte in the mask with the first character of string, the
second-lowest-byte with the second character of the string, etc.,

90072:cb67264d6096

;;; rmail.el --- main code of "RMAIL" mail reader for Emacs

;; Copyright (C) 1985,86,87,88,93,94,95,96,97,98,2000,01,2004,2005
;;		Free Software Foundation, Inc.

;; Maintainer: FSF
;; Keywords: mail

(defgroup rmail-edit nil
  "Rmail editing."
  :prefix "rmail-edit-"
  :group 'rmail)

(defgroup rmail-obsolete nil
  "Rmail obsolete customization variables."
  :group 'rmail)

(defcustom rmail-movemail-program nil
  "If non-nil, name of program for fetching new mail."
  :group 'rmail-retrieve
  :type '(choice (const nil) string))

(defcustom rmail-pop-password nil
  "*Password to use when reading mail from POP server. Please, use rmail-remote-password instead."
  :type '(choice (string :tag "Password")
		 (const :tag "Not Required" nil))
  :group 'rmail-obsolete)

(defcustom rmail-pop-password-required nil
  "*Non-nil if a password is required when reading mail from a POP server. Please, use rmail-remote-password-required instead."
  :type 'boolean
  :group 'rmail-obsolete)

(defcustom rmail-remote-password nil
  "*Password to use when reading mail from a remote server. This setting is ignored for mailboxes whose URL already contains a password."
  :type '(choice (string :tag "Password")
		 (const :tag "Not Required" nil))
  :set-after '(rmail-pop-password)
  :set #'(lambda (symbol value)
	   (set-default symbol 
			(if (and (not value)
                                 (boundp 'rmail-pop-password)
				 rmail-pop-password)
			    rmail-pop-password
			  value))
	   (setq rmail-pop-password nil))
  :group 'rmail-retrieve
  :version "21.3.50.1")

(defcustom rmail-remote-password-required nil
  "*Non-nil if a password is required when reading mail from a remote server."
  :type 'boolean
  :set-after '(rmail-pop-password-required)
  :set #'(lambda (symbol value)
	   (set-default symbol 
			(if (and (not value)
                                 (boundp 'rmail-pop-password-required)
				 rmail-pop-password-required)
			    rmail-pop-password-required
			  value))
	   (setq rmail-pop-password-required nil))
  :group 'rmail-retrieve
  :version "21.3.50.1")

(defcustom rmail-movemail-flags nil
  "*List of flags to pass to movemail.
Most commonly used to specify `-g' to enable GSS-API authentication
or `-k' to enable Kerberos authentication."
  :type '(repeat string)
  :group 'rmail-retrieve
  :version "20.3")

(defvar rmail-remote-password-error "invalid usercode or password\\|
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].")

(defvar rmail-encoded-remote-password nil)

(defcustom rmail-preserve-inbox nil
  "*Non-nil if incoming mail should be left in the user's inbox,
rather than deleted, after it is retrieved."
  :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)
  "Determine what flavor of movemail PROG is by executing it with --version
command line option and analyzing its output."
  (with-temp-buffer
    (let ((tbuf (current-buffer)))
      (buffer-disable-undo tbuf)
      (call-process prog nil tbuf nil "--version")
      (if (not (buffer-modified-p tbuf))
	  ;; Should not happen...
	  nil
	(goto-char (point-min))
	(cond
	 ((looking-at ".*movemail: invalid option")
	  'emacs)    ;; Possibly...
	 ((looking-at "movemail (GNU Mailutils .*)")
	  'mailutils)
	 (t
	  ;; FIXME:
	  'emacs))))))

(defun rmail-autodetect ()
  "Determine and return the flavor of `movemail' program in use. If
rmail-movemail-program is set, use it. Otherwise, look for `movemail'
in the path constructed by appending rmail-movemail-search-path,
exec-path and exec-directory."
  (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 source 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.
A value of nil means exclude your own email address as an address

		(setq found t))))
	  found)
      ;; Don't leave the buffer screwed up if we get a disk-full error.
      (or found (rmail-show-message)))))

(defun rmail-parse-url (file)
  "Parse the supplied URL. Return (list MAILBOX-NAME REMOTE PASSWORD GOT-PASSWORD)
WHERE MAILBOX-NAME is the name of the mailbox suitable as argument to the
actual version of `movemail', REMOTE is non-nil if MAILBOX-NAME refers to
a remote mailbox, PASSWORD is the password if it should be
supplied as a separate argument to `movemail' or nil otherwise, GOT-PASSWORD
is non-nil if the user has supplied the password interactively.
"
  (if (string-match "^\\([^:]+\\)://\\(\\([^:@]+\\)\\(:\\([^@]+\\)\\)?@\\)?.*" file)
      (let (got-password supplied-password 
	    (proto (match-string 1 file))
	    (user  (match-string 3 file))
	    (pass  (match-string 5 file))
	    (host  (substring file (or (match-end 2)
				       (+ 3 (match-end 1))))))
	(if (not pass)
	    (when rmail-remote-password-required
	      (setq got-password (not (rmail-have-password)))
	      (setq supplied-password (rmail-get-remote-password
				       (string-equal proto "imap")))))
			      
	(if (rmail-movemail-variant-p 'emacs)
	    (if (string-equal proto "pop")
		(list (concat "po:" user ":" host)
		      t
		      (or pass supplied-password)
		      got-password)
	      (error "Emacs movemail does not support %s protocol" proto))
	  (list file
		(or (string-equal proto "pop") (string-equal proto "imap"))
		supplied-password
		got-password)))
    (list file nil nil nil)))

(defun rmail-insert-inbox-text (files renamep)
  ;; Detect a locked file now, so that we avoid moving mail
  ;; out of the real inbox file.  (That could scare people.)
  (or (memq (file-locked-p buffer-file-name) '(nil t))
      (error "RMAIL file %s is locked"
	     (file-name-nondirectory buffer-file-name)))
  (let (file tofile delete-files movemail popmail got-password password)
    (while files
      ;; Handle remote mailbox names specially; don't expand as filenames
      ;; in case the userid contains a directory separator.
      (setq file (car files))
      (let ((url-data (rmail-parse-url file)))
	(setq file (nth 0 url-data))
	(setq popmail (nth 1 url-data))
	(setq password (nth 2 url-data))
	(setq got-password (nth 3 url-data)))

      (if popmail
	  (setq renamep t)
	(setq file (file-truename
		    (substitute-in-file-name (expand-file-name file)))))
      (setq tofile (expand-file-name
		    ;; Generate name to move to from inbox name,
		    ;; in case of multiple inboxes that need moving.
		    (concat ".newmail-"
			    (file-name-nondirectory 
			     (if (memq system-type '(windows-nt cygwin))
				 ;; cannot have "po:" in file name
				 (substring file 3)
			       file)))
		    ;; Use the directory of this rmail file
		    ;; because it's a nuisance to use the homedir
		    ;; if that is on a full disk and this rmail
		    ;; file isn't.
		    (file-name-directory

	    ;; and the actual inbox is /usr/spool/mail/foo/foo.
	    (if (file-directory-p file)
		(setq file (expand-file-name (user-login-name)
					     file)))))
      (cond (popmail
	     (message "Getting mail from the remote server ..."))
	    ((and (file-exists-p tofile)
		  (/= 0 (nth 7 (file-attributes tofile))))
	     (message "Getting mail from %s..." tofile))
	    ((and (file-exists-p file)
		  (/= 0 (nth 7 (file-attributes file))))

	     (if (not rmail-preserve-inbox)
		 (condition-case ()
		     (write-region (point) (point) file)
		   (file-error nil))))
	    (t
	     (with-temp-buffer
	       (let ((errors (current-buffer)))
		 (buffer-disable-undo errors)
		 (let ((args
			(append
			 (list (or rmail-movemail-program
				   (expand-file-name "movemail"
						     exec-directory))
			       nil errors nil)
			 (if rmail-preserve-inbox
			     (list "-p")
			   nil)
			 (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))
		 (if (not (buffer-modified-p errors))
		     ;; No output => movemail won
		     nil
		   (set-buffer errors)
		   (subst-char-in-region (point-min) (point-max)
					 ?\n ?\  )
		   (goto-char (point-max))
		   (skip-chars-backward " \t")
		   (delete-region (point) (point-max))
		   (goto-char (point-min))
		   (if (looking-at "movemail: ")
		       (delete-region (point-min) (match-end 0)))
		   (beep t)
		   ;; 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.
		   (if (or got-password
			   (re-search-forward rmail-remote-password-error
					      nil t))
		       (rmail-set-remote-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)))))
	       
      ;; At this point, TOFILE contains the name to read:
      ;; Either the alternate name (if we renamed)
      ;; or the actual inbox (if not renaming).
      (if (file-exists-p tofile)
	  (let ((coding-system-for-read 'no-conversion)

; The password is encoded to prevent it from being easily accessible
; to "prying eyes."  Obviously, this encoding isn't "real security,"
; nor is it meant to be.

;;;###autoload
(defun rmail-set-remote-password (password)
  "Set PASSWORD to be used for retrieving mail from a POP or IMAP server."
  (interactive "sPassword: ")
  (if password
      (setq rmail-encoded-remote-password
	    (rmail-encode-string password (emacs-pid)))
    (setq rmail-remote-password nil)
    (setq rmail-encoded-remote-password nil)))

(defun rmail-get-remote-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."
  (when (not rmail-encoded-remote-password)
    (if (not rmail-remote-password)
	(setq rmail-remote-password
	      (read-passwd (if imap
			       "IMAP password: "
			     "POP password: "))))
    (rmail-set-remote-password rmail-remote-password)
    (setq rmail-remote-password nil))
  (rmail-encode-string rmail-encoded-remote-password (emacs-pid)))

(defun rmail-have-password ()
  (or rmail-remote-password rmail-encoded-remote-password))

(defun rmail-encode-string (string mask)
 "Encode STRING with integer MASK, by taking the exclusive OR of the
lowest byte in the mask with the first character of string, the
second-lowest-byte with the second character of the string, etc.,