X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fmail-source.el;h=d442627d6b27a281fa27440abf901fff65252fa0;hb=2debbbace9a07b7dae6ba293271c2604eda053fc;hp=19fdf51f30f08f4dc2854acd338e9dd1f417a81b;hpb=dc08afde1cf334835e72b830131d34cf285bc67f;p=gnus diff --git a/lisp/mail-source.el b/lisp/mail-source.el index 19fdf51f3..d442627d6 100644 --- a/lisp/mail-source.el +++ b/lisp/mail-source.el @@ -1,5 +1,7 @@ ;;; mail-source.el --- functions for fetching mail -;; Copyright (C) 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc. + +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news, mail @@ -18,8 +20,8 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -32,8 +34,7 @@ (eval-and-compile (autoload 'pop3-movemail "pop3") (autoload 'pop3-get-message-count "pop3") - (autoload 'nnheader-cancel-timer "nnheader") - (autoload 'nnheader-run-at-time "nnheader")) + (autoload 'nnheader-cancel-timer "nnheader")) (require 'format-spec) (require 'mm-util) (require 'message) ;; for `message-directory' @@ -107,7 +108,7 @@ See Info node `(gnus)Mail Source Specifiers'." (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) @@ -123,13 +124,15 @@ See Info node `(gnus)Mail Source Specifiers'." (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")) @@ -142,7 +145,14 @@ See Info node `(gnus)Mail Source Specifiers'." (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 :tag "SSL/TLS" ssl))))) (cons :tag "Maildir (qmail, postfix...)" (const :format "" maildir) (checklist :tag "Options" :greedy t @@ -162,7 +172,7 @@ See Info node `(gnus)Mail Source Specifiers'." (const :format "" :value :port) (choice :tag "Port" :value 143 - number string)) + integer string)) (group :inline t (const :format "" :value :user) (string :tag "User")) @@ -234,7 +244,10 @@ See Info node `(gnus)Mail Source Specifiers'." (defcustom mail-source-ignore-errors nil "*Ignore errors when querying mail sources. If nil, the user will be prompted when an error occurs. If non-nil, -the error will be ignored.") +the error will be ignored." + :version "22.1" + :group 'mail-source + :type 'boolean) (defcustom mail-source-primary-source nil "*Primary source for incoming mail. @@ -253,7 +266,7 @@ If non-nil, this maildrop will be checked periodically for new mail." :type 'file) (defcustom mail-source-directory message-directory - "Directory where files (if any) will be stored." + "Directory where incoming mail source files (if any) will be stored." :group 'mail-source :type 'directory) @@ -262,7 +275,7 @@ If non-nil, this maildrop will be checked periodically for new mail." :group 'mail-source :type 'integer) -(defcustom mail-source-delete-incoming t +(defcustom mail-source-delete-incoming nil "*If non-nil, delete incoming files after handling. If t, delete immediately, if nil, never delete. If a positive number, delete files older than number of days." @@ -280,6 +293,7 @@ files older than number of days." "*If non-nil, ask for for confirmation before deleting old incoming files. This variable only applies when `mail-source-delete-incoming' is a positive number." + :version "22.1" :group 'mail-source :type 'boolean) @@ -300,6 +314,7 @@ number." (defcustom mail-source-movemail-program nil "If non-nil, name of program for fetching new mail." + :version "22.1" :group 'mail-source :type '(choice (const nil) string)) @@ -341,10 +356,11 @@ Common keywords should be listed here.") (:program) (:function) (:password) - (:authentication password)) + (:authentication password) + (:stream nil)) (maildir (:path (or (getenv "MAILDIR") "~/Maildir/")) - (:subdirs ("new" "cur")) + (:subdirs ("cur" "new")) (:function)) (imap (:server (getenv "MAILHOST")) @@ -357,6 +373,9 @@ Common keywords should be listed here.") (:mailbox "INBOX") (:predicate "UNSEEN UNDELETED") (:fetchflag "\\Deleted") + (:prescript) + (:prescript-delay) + (:postscript) (:dontexpunge)) (webmail (:subtype hotmail) @@ -490,7 +509,8 @@ Return the number of files that were found." (when (file-exists-p mail-source-crash-box) (message "Processing mail from %s..." mail-source-crash-box) (setq found (mail-source-callback - callback mail-source-crash-box))) + callback mail-source-crash-box)) + (mail-source-delete-crash-box)) (+ found (if (or debug-on-quit debug-on-error) (funcall function source callback) @@ -503,7 +523,7 @@ Return the number of files that were found." (format "Mail source %s error (%s). Continue? " (if (memq ':password source) (let ((s (copy-sequence source))) - (setcar (cdr (memq ':password s)) + (setcar (cdr (memq ':password s)) "********") s) source) @@ -540,33 +560,33 @@ If CONFIRM is non-nil, ask for confirmation before removing a file." (delete-file ffile)))))) (defun mail-source-callback (callback info) - "Call CALLBACK on the mail file, and then remove the mail file. -Pass INFO on to CALLBACK." + "Call CALLBACK on the mail file. Pass INFO on to CALLBACK." (if (or (not (file-exists-p mail-source-crash-box)) (zerop (nth 7 (file-attributes mail-source-crash-box)))) (progn (when (file-exists-p mail-source-crash-box) (delete-file mail-source-crash-box)) 0) - (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 (eq mail-source-delete-incoming t) - (delete-file mail-source-crash-box) - (let ((incoming - (mm-make-temp-file - (expand-file-name - mail-source-incoming-file-prefix - 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) - ;; remove old incoming files? - (when (natnump mail-source-delete-incoming) - (mail-source-delete-old-incoming - mail-source-delete-incoming - mail-source-delete-old-incoming-confirm)))))))) + (funcall callback mail-source-crash-box info))) + +(defun mail-source-delete-crash-box () + (when (file-exists-p mail-source-crash-box) + ;; Delete or move the incoming mail out of the way. + (if (eq mail-source-delete-incoming t) + (delete-file mail-source-crash-box) + (let ((incoming + (mm-make-temp-file + (expand-file-name + mail-source-incoming-file-prefix + 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) + ;; remove old incoming files? + (when (natnump mail-source-delete-incoming) + (mail-source-delete-old-incoming + mail-source-delete-incoming + mail-source-delete-old-incoming-confirm)))))) (defun mail-source-movemail (from to) "Move FROM to TO using movemail." @@ -645,8 +665,8 @@ Pass INFO on to CALLBACK." (delete-file from))) (defun mail-source-fetch-with-program (program) - (zerop (call-process shell-file-name nil nil nil - shell-command-switch program))) + (eq 0 (call-process shell-file-name nil nil nil + shell-command-switch program))) (defun mail-source-run-script (script spec &optional delay) (when script @@ -680,7 +700,8 @@ Pass INFO on to CALLBACK." (prog1 (mail-source-callback callback path) (mail-source-run-script - postscript (format-spec-make ?t mail-source-crash-box))) + postscript (format-spec-make ?t mail-source-crash-box)) + (mail-source-delete-crash-box)) 0)))) (defun mail-source-fetch-directory (source callback) @@ -695,13 +716,15 @@ Pass INFO on to CALLBACK." (when (and (file-regular-p file) (funcall predicate file) (mail-source-movemail file mail-source-crash-box)) - (incf found (mail-source-callback callback file)))) - (mail-source-run-script postscript (format-spec-make ?t path)) + (incf found (mail-source-callback callback file)) + (mail-source-run-script postscript (format-spec-make ?t path)) + (mail-source-delete-crash-box))) found))) (defun mail-source-fetch-pop (source callback) "Fetcher for single-file sources." (mail-source-bind (pop source) + ;; fixme: deal with stream type in format specs (mail-source-run-script prescript (format-spec-make ?p password ?t mail-source-crash-box @@ -730,12 +753,14 @@ Pass INFO on to CALLBACK." (funcall function mail-source-crash-box)) ;; The default is to use pop3.el. (t + (require 'pop3) (let ((pop3-password password) (pop3-maildrop user) (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 @@ -760,7 +785,8 @@ Pass INFO on to CALLBACK." (mail-source-run-script postscript (format-spec-make ?p password ?t mail-source-crash-box - ?s server ?P port ?u user)))) + ?s server ?P port ?u user)) + (mail-source-delete-crash-box))) ;; We nix out the password in case the error ;; was because of a wrong password being given. (setq mail-source-password-cache @@ -791,6 +817,7 @@ Pass INFO on to CALLBACK." (function) ;; The default is to use pop3.el. (t + (require 'pop3) (let ((pop3-password password) (pop3-maildrop user) (pop3-mailhost server) @@ -822,12 +849,13 @@ Pass INFO on to CALLBACK." "Open and close a POP connection shortly. POP server should be defined in `mail-source-primary-source' (which is preferred) or `mail-sources'. You may use it for the POP-before-SMTP -authentication. To do that, you need to set the option -`message-send-mail-function' to `message-smtpmail-send-it' and put the -following line in .gnus file: +authentication. To do that, you need to set the +`message-send-mail-function' variable as `message-smtpmail-send-it' +and put the following line in your ~/.gnus.el file: \(add-hook 'message-send-mail-hook 'mail-source-touch-pop) -" + +See the Gnus manual for details." (let ((sources (if mail-source-primary-source (list mail-source-primary-source) mail-sources))) @@ -852,7 +880,7 @@ following line in .gnus file: (eval-when-compile (if (featurep 'xemacs) - (require 'itimer) + (require 'timer-funcs) (require 'timer))) (defun mail-source-start-idle-timer () @@ -897,7 +925,7 @@ This only works when `display-time' is enabled." (setq display-time-mail-function #'mail-source-new-mail-p) ;; Set up the main timer. (setq mail-source-report-new-mail-timer - (nnheader-run-at-time + (run-at-time (* 60 mail-source-report-new-mail-interval) (* 60 mail-source-report-new-mail-interval) #'mail-source-start-idle-timer)) @@ -942,7 +970,8 @@ This only works when `display-time' is enabled." ;; MMDF mail format (insert "\001\001\001\001\n")) (delete-file file))))) - (incf found (mail-source-callback callback file)))))) + (incf found (mail-source-callback callback file)) + (mail-source-delete-crash-box))))) found))) (eval-and-compile @@ -966,6 +995,10 @@ This only works when `display-time' is enabled." (defun mail-source-fetch-imap (source callback) "Fetcher for imap sources." (mail-source-bind (imap source) + (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)) (found 0) (buf (generate-new-buffer " *imap source*")) @@ -985,8 +1018,8 @@ This only works when `display-time' is enabled." (mm-disable-multibyte) ;; remember password (with-current-buffer buf - (when (or imap-password - (assoc from mail-source-password-cache)) + (when (and imap-password + (not (assoc from mail-source-password-cache))) (push (cons from imap-password) mail-source-password-cache))) ;; if predicate is nil, use all uids (dolist (uid (imap-search (or predicate "1:*") buf)) @@ -999,11 +1032,13 @@ This only works when `display-time' is enabled." (insert "From imap " (current-time-string) "\n") (save-excursion (insert str "\n\n")) - (while (re-search-forward "^From " nil t) + (while (let ((case-fold-search nil)) + (re-search-forward "^From " nil t)) (replace-match ">From ")) (goto-char (point-max)))) (nnheader-ms-strip-cr)) (incf found (mail-source-callback callback server)) + (mail-source-delete-crash-box) (when (and remove fetchflag) (setq remove (nreverse remove)) (imap-message-flags-add @@ -1021,6 +1056,10 @@ This only works when `display-time' is enabled." mail-source-password-cache)) (error "IMAP error: %s" (imap-error-text buf))) (kill-buffer buf) + (mail-source-run-script + postscript + (format-spec-make ?p password ?t mail-source-crash-box + ?s server ?P port ?u user)) found))) (eval-and-compile @@ -1045,8 +1084,10 @@ This only works when `display-time' is enabled." (push (cons (format "webmail:%s:%s" subtype user) password) mail-source-password-cache))) (webmail-fetch mail-source-crash-box subtype user password) - (mail-source-callback callback (symbol-name subtype))))) + (mail-source-callback callback (symbol-name subtype)) + (mail-source-delete-crash-box)))) (provide 'mail-source) +;;; arch-tag: 72948025-1d17-4d6c-bb12-ef1aa2c490fd ;;; mail-source.el ends here