(defvar mail-source-keyword-map
'((file
(:prescript)
+ (:prescript-delay)
(:postscript)
(:path (or (getenv "MAIL")
(concat "/usr/spool/mail/" (user-login-name)))))
(:predicate identity))
(pop
(:prescript)
+ (:prescript-delay)
(:postscript)
(:server (getenv "MAILHOST"))
(:port 110)
(:password)
(:authentication password))
(maildir
- (:path "~/Maildir/new/")))
+ (:path "~/Maildir/new/")
+ (:function))
+ (imap
+ (:server (getenv "MAILHOST"))
+ (:port)
+ (:stream)
+ (:authentication)
+ (:user (or (user-login-name) (getenv "LOGNAME") (getenv "USER")))
+ (:password)
+ (:mailbox "INBOX")
+ (:predicate "UNSEEN UNDELETED")
+ (:fetchflag "\Deleted")
+ (:dontexpunge))
+ (webmail
+ (:subtype hotmail)
+ (:user (or (user-login-name) (getenv "LOGNAME") (getenv "USER")))
+ (:password)
+ (:authentication password)))
"Mapping from keywords to default values.
All keywords that can be used must be listed here."))
'((file mail-source-fetch-file)
(directory mail-source-fetch-directory)
(pop mail-source-fetch-pop)
- (maildir mail-source-fetch-maildir))
+ (maildir mail-source-fetch-maildir)
+ (imap mail-source-fetch-imap)
+ (webmail mail-source-fetch-webmail))
"A mapping from source type to fetcher function.")
(defvar mail-source-password-cache nil)
(funcall function source callback)
(error
(unless (yes-or-no-p
- (format "Mail source error. Continue? "))
+ (format "Mail source error (%s). Continue? " err))
(error "Cannot get new mail."))
0))))))
(when (file-exists-p mail-source-crash-box)
(delete-file mail-source-crash-box))
0)
- (funcall callback mail-source-crash-box info)
- (when (file-exists-p mail-source-crash-box)
- ;; Delete or move the incoming mail out of the way.
- (if mail-source-delete-incoming
- (delete-file mail-source-crash-box)
- (let ((incoming
- (mail-source-make-complex-temp-name
- (expand-file-name
- "Incoming" mail-source-directory))))
- (unless (file-exists-p (file-name-directory incoming))
- (make-directory (file-name-directory incoming) t))
- (rename-file mail-source-crash-box incoming t))))
- 1))
+ (prog1
+ (funcall callback mail-source-crash-box info)
+ (when (file-exists-p mail-source-crash-box)
+ ;; Delete or move the incoming mail out of the way.
+ (if mail-source-delete-incoming
+ (delete-file mail-source-crash-box)
+ (let ((incoming
+ (mail-source-make-complex-temp-name
+ (expand-file-name
+ "Incoming" mail-source-directory))))
+ (unless (file-exists-p (file-name-directory incoming))
+ (make-directory (file-name-directory incoming) t))
+ (rename-file mail-source-crash-box incoming t)))))))
(defun mail-source-movemail (from to)
"Move FROM to TO using movemail."
;; Return whether we moved successfully or not.
to)))
+(defun mail-source-movemail-and-remove (from to)
+ "Move FROM to TO using movemail, then remove FROM if empty."
+ (or (not (mail-source-movemail from to))
+ (not (zerop (nth 7 (file-attributes from))))
+ (delete-file from)))
+
(defvar mail-source-read-passwd nil)
(defun mail-source-read-passwd (prompt &rest args)
"Read a password using PROMPT.
(zerop (call-process shell-file-name nil nil nil
shell-command-switch program)))
+(defun mail-source-run-script (script spec &optional delay)
+ (when script
+ (if (and (symbolp script) (fboundp script))
+ (funcall script)
+ (mail-source-call-script
+ (format-spec script spec))))
+ (when delay
+ (sleep-for delay)))
+
+(defun mail-source-call-script (script)
+ (let ((background nil))
+ (when (string-match "& *$" script)
+ (setq script (substring script 0 (match-beginning 0))
+ background 0))
+ (call-process shell-file-name nil background nil
+ shell-command-switch script)))
+
;;;
;;; Different fetchers
;;;
(defun mail-source-fetch-file (source callback)
"Fetcher for single-file sources."
(mail-source-bind (file source)
- (when prescript
- (if (and (symbolp prescript) (fboundp prescript))
- (funcall prescript)
- (call-process shell-file-name nil nil nil
- shell-command-switch
- (format-spec
- prescript
- (format-spec-make ?t mail-source-crash-box)))))
+ (mail-source-run-script
+ prescript (format-spec-make ?t mail-source-crash-box)
+ prescript-delay)
(let ((mail-source-string (format "file:%s" path)))
(if (mail-source-movemail path mail-source-crash-box)
(prog1
(mail-source-callback callback path)
- (when prescript
- (if (and (symbolp prescript) (fboundp prescript))
- (funcall prescript)
- (call-process shell-file-name nil nil nil
- shell-command-switch
- (format-spec
- postscript
- (format-spec-make ?t mail-source-crash-box))))))
+ (mail-source-run-script
+ postscript (format-spec-make ?t mail-source-crash-box)))
0))))
(defun mail-source-fetch-directory (source callback)
(defun mail-source-fetch-pop (source callback)
"Fetcher for single-file sources."
(mail-source-bind (pop source)
- (when prescript
- (if (and (symbolp prescript)
- (fboundp prescript))
- (funcall prescript)
- (call-process shell-file-name nil 0 nil
- shell-command-switch
- (format-spec
- prescript
- (format-spec-make ?p password ?t mail-source-crash-box
- ?s server ?P port ?u user)))))
+ (mail-source-run-script
+ prescript
+ (format-spec-make ?p password ?t mail-source-crash-box
+ ?s server ?P port ?u user)
+ prescript-delay)
(let ((from (format "%s:%s:%s" server user port))
(mail-source-string (format "pop:%s@%s" user server))
result)
(or password
(cdr (assoc from mail-source-password-cache))
(mail-source-read-passwd
- (format "Password for %s at %s: " user server))))
- (unless (assoc from mail-source-password-cache)
- (push (cons from password) mail-source-password-cache)))
+ (format "Password for %s at %s: " user server)))))
(when server
(setenv "MAILHOST" server))
(setq result
(if (eq authentication 'apop) 'apop 'pass)))
(save-excursion (pop3-movemail mail-source-crash-box))))))
(if result
- (prog1
- (mail-source-callback callback server)
- (when prescript
- (if (and (symbolp postscript)
- (fboundp postscript))
- (funcall prescript)
- (call-process shell-file-name nil 0 nil
- shell-command-switch
- (format-spec
- postscript
- (format-spec-make
- ?p password ?t mail-source-crash-box
- ?s server ?P port ?u user))))))
+ (progn
+ (when (eq authentication 'password)
+ (unless (assoc from mail-source-password-cache)
+ (push (cons from password) mail-source-password-cache)))
+ (prog1
+ (mail-source-callback callback server)
+ (mail-source-run-script
+ postscript
+ (format-spec-make ?p password ?t mail-source-crash-box
+ ?s server ?P port ?u user))))
;; We nix out the password in case the error
;; was because of a wrong password being given.
(setq mail-source-password-cache
(mail-source-string (format "maildir:%s" path)))
(dolist (file (directory-files path t))
(when (and (file-regular-p file)
- (not (rename-file file mail-source-crash-box)))
+ (not (if function
+ (funcall function file mail-source-crash-box)
+ (rename-file file mail-source-crash-box))))
(incf found (mail-source-callback callback file))))
found)))
+(eval-and-compile
+ (autoload 'imap-open "imap")
+ (autoload 'imap-authenticate "imap")
+ (autoload 'imap-mailbox-select "imap")
+ (autoload 'imap-mailbox-unselect "imap")
+ (autoload 'imap-mailbox-close "imap")
+ (autoload 'imap-search "imap")
+ (autoload 'imap-fetch "imap")
+ (autoload 'imap-close "imap")
+ (autoload 'imap-error-text "imap")
+ (autoload 'imap-message-flags-add "imap")
+ (autoload 'imap-list-to-message-set "imap")
+ (autoload 'nnheader-ms-strip-cr "nnheader"))
+
+(defun mail-source-fetch-imap (source callback)
+ "Fetcher for imap sources."
+ (mail-source-bind (imap source)
+ (let ((found 0)
+ (buf (get-buffer-create (generate-new-buffer-name " *imap source*")))
+ (mail-source-string (format "imap:%s:%s" server mailbox))
+ remove)
+ (if (and (imap-open server port stream authentication buf)
+ (imap-authenticate user password buf)
+ (imap-mailbox-select mailbox nil buf))
+ (let (str (coding-system-for-write 'binary))
+ (with-temp-file mail-source-crash-box
+ ;; if predicate is nil, use all uids
+ (dolist (uid (imap-search (or predicate "1:*") buf))
+ (when (setq str (imap-fetch uid "RFC822.PEEK" 'RFC822 nil buf))
+ (push uid remove)
+ (insert "From imap " (current-time-string) "\n")
+ (save-excursion
+ (insert str "\n\n"))
+ (while (re-search-forward "^From " nil t)
+ (replace-match ">From "))
+ (goto-char (point-max))))
+ (nnheader-ms-strip-cr))
+ (incf found (mail-source-callback callback server))
+ (when (and remove fetchflag)
+ (imap-message-flags-add
+ (imap-list-to-message-set remove) fetchflag nil buf))
+ (if dontexpunge
+ (imap-mailbox-unselect buf)
+ (imap-mailbox-close buf))
+ (imap-close buf))
+ (imap-close buf)
+ (error (imap-error-text buf)))
+ (kill-buffer buf)
+ found)))
+
+(eval-and-compile
+ (autoload 'webmail-fetch "webmail"))
+
+(defun mail-source-fetch-webmail (source callback)
+ "Fetch for webmail source."
+ (mail-source-bind (webmail source)
+ (when (eq authentication 'password)
+ (setq password
+ (or password
+ (mail-source-read-passwd
+ (format "Password for %s at %s: " user subtype)))))
+ (webmail-fetch mail-source-crash-box subtype user password)
+ (mail-source-callback callback (symbol-name subtype))))
+
(provide 'mail-source)
;;; mail-source.el ends here
projects / gnus / blobdiff