Fix rmail handling of movemail protocols (bug#18278)
* lisp/mail/rmail.el (rmail-remote-proto-p): New function. (rmail-parse-url): Return protocol in second list element. Only use passwords with remote mailboxes. (rmail-insert-inbox-text): Handle non-simple local mailboxes (maildir, MH, etc.).
This commit is contained in:
parent
79b1669c24
commit
48536f67e0
1 changed files with 38 additions and 27 deletions
|
@ -1884,14 +1884,19 @@ not be a new one). It returns non-nil if it got any new messages."
|
|||
(setq result (> new-messages 0))
|
||||
result))))
|
||||
|
||||
(defun rmail-remote-proto-p (proto)
|
||||
"Return non-nil if string PROTO refers to a remote mailbox protocol."
|
||||
(string-match-p "^\\(imap\\|pop\\)s?$" proto))
|
||||
|
||||
(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.
|
||||
"
|
||||
"Parse a mailbox URL string FILE.
|
||||
Return (MAILBOX-NAME PROTO PASSWORD GOT-PASSWORD), where MAILBOX-NAME is
|
||||
the name of the mailbox suitable as argument to the actual version of
|
||||
`movemail', PROTO is the movemail protocol (use `rmail-remote-proto-p'
|
||||
to see if it refers to a remote mailbox), PASSWORD is the password if it
|
||||
should be supplied as a separate argument to `movemail' or nil otherwise,
|
||||
and GOT-PASSWORD is non-nil if the user has supplied the password
|
||||
interactively."
|
||||
(cond
|
||||
((string-match "^\\([^:]+\\)://\\(\\([^:@]+\\)\\(:\\([^@]+\\)\\)?@\\)?.*" file)
|
||||
(let (got-password supplied-password
|
||||
|
@ -1901,24 +1906,26 @@ is non-nil if the user has supplied the password interactively.
|
|||
(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"))))
|
||||
;; The password is embedded. Strip it out since movemail
|
||||
;; does not really like it, in spite of the movemail spec.
|
||||
(setq file (concat proto "://" user "@" host)))
|
||||
(if (rmail-remote-proto-p proto)
|
||||
(if (not pass)
|
||||
(when rmail-remote-password-required
|
||||
(setq got-password (not (rmail-have-password)))
|
||||
(setq supplied-password (rmail-get-remote-password
|
||||
(string-match "^imaps?" proto))))
|
||||
;; FIXME
|
||||
;; The password is embedded. Strip it out since movemail
|
||||
;; does not really like it, in spite of the movemail spec.
|
||||
(setq file (concat proto "://" user "@" host))))
|
||||
|
||||
(if (rmail-movemail-variant-p 'emacs)
|
||||
(if (string-equal proto "pop")
|
||||
(list (concat "po:" user ":" host)
|
||||
t
|
||||
proto
|
||||
(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"))
|
||||
proto
|
||||
(or supplied-password pass)
|
||||
got-password))))
|
||||
|
||||
|
@ -1981,18 +1988,18 @@ Value is the size of the newly read mail after conversion."
|
|||
size))
|
||||
|
||||
(defun rmail-insert-inbox-text (files renamep)
|
||||
(let (file tofile delete-files popmail got-password password)
|
||||
(let (file tofile delete-files proto 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 proto (nth 1 url-data))
|
||||
(setq password (nth 2 url-data))
|
||||
(setq got-password (nth 3 url-data)))
|
||||
|
||||
(if popmail
|
||||
(if proto
|
||||
(setq renamep t)
|
||||
(setq file (file-truename
|
||||
(substitute-in-file-name (expand-file-name file)))))
|
||||
|
@ -2013,14 +2020,17 @@ Value is the size of the newly read mail after conversion."
|
|||
(expand-file-name buffer-file-name))))
|
||||
;; Always use movemail to rename the file,
|
||||
;; since there can be mailboxes in various directories.
|
||||
(when (not popmail)
|
||||
(when (not proto)
|
||||
;; On some systems, /usr/spool/mail/foo is a 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 ..."))
|
||||
(cond (proto
|
||||
(message "Getting mail from %s..."
|
||||
(if (rmail-remote-proto-p proto)
|
||||
"the remote server"
|
||||
proto)))
|
||||
((and (file-exists-p tofile)
|
||||
(/= 0 (nth 7 (file-attributes tofile))))
|
||||
(message "Getting mail from %s..." tofile))
|
||||
|
@ -2031,7 +2041,7 @@ Value is the size of the newly read mail after conversion."
|
|||
;; rename or copy the file FILE to TOFILE if and as appropriate.
|
||||
(cond ((not renamep)
|
||||
(setq tofile file))
|
||||
((or (file-exists-p tofile) (and (not popmail)
|
||||
((or (file-exists-p tofile) (and (not proto)
|
||||
(not (file-exists-p file))))
|
||||
nil)
|
||||
(t
|
||||
|
@ -2066,9 +2076,10 @@ Value is the size of the newly read mail after conversion."
|
|||
;; 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))
|
||||
(if (and (rmail-remote-proto-p proto)
|
||||
(or got-password
|
||||
(re-search-forward rmail-remote-password-error
|
||||
nil t)))
|
||||
(rmail-set-remote-password nil))
|
||||
|
||||
;; If using Mailutils, remove initial error code
|
||||
|
|
Loading…
Add table
Reference in a new issue