;;; nnmail.el --- mail support functions for the Gnus mail backends
-;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001
+;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news, mail
(eval-when-compile (require 'cl))
(require 'nnheader)
-(require 'timezone)
(require 'message)
(require 'custom)
(require 'gnus-util)
+(require 'mail-source)
+(require 'mm-util)
(eval-and-compile
(autoload 'gnus-error "gnus-util")
can also be `immediate' and `never'."
:group 'nnmail-expire
:type '(choice (const immediate)
- (integer :tag "days")
+ (number :tag "days")
(const never)))
(defcustom nnmail-expiry-wait-function nil
:type '(choice (const :tag "nnmail-expiry-wait" nil)
(function :format "%v" nnmail-)))
+(defcustom nnmail-expiry-target 'delete
+ "*Variable that says where expired messages should end up.
+The default value is `delete' (which says to delete the messages),
+but it can also be a string or a function. If it is a string, expired
+messages end up in that group. If it is a function, the function is
+called in a buffer narrowed to the message in question. The function
+receives one argument, the name of the group the message comes from.
+The return value should be `delete' or a group name (a string)."
+ :version "21.1"
+ :group 'nnmail-expire
+ :type '(choice (const delete)
+ (function :format "%v" nnmail-)
+ string))
+
(defcustom nnmail-cache-accepted-message-ids nil
- "If non-nil, put Message-IDs of Gcc'd articles into the duplicate cache."
+ "If non-nil, put Message-IDs of Gcc'd articles into the duplicate cache.
+If non-nil, also update the cache when copy or move articles."
:group 'nnmail
:type 'boolean)
-(defcustom nnmail-spool-file
- (or (getenv "MAIL")
- (concat "/usr/spool/mail/" (user-login-name)))
+(defcustom nnmail-spool-file '((file))
"*Where the mail backends will look for incoming mail.
-This variable is \"/usr/spool/mail/$user\" by default.
-If this variable is nil, no mail backends will read incoming mail.
-If this variable is a list, all files mentioned in this list will be
-used as incoming mailboxes.
-If this variable is a directory (i. e., it's name ends with a \"/\"),
-treat all files in that directory as incoming spool files."
- :group 'nnmail-files
- :type '(choice (file :tag "File")
- (repeat :tag "Files" file)))
-
-(defcustom nnmail-crash-box "~/.gnus-crash-box"
- "File where Gnus will store mail while processing it."
+This variable is a list of mail source specifiers.
+This variable is obsolete; `mail-sources' should be used instead."
:group 'nnmail-files
- :type 'file)
+ :type 'sexp)
-(defcustom nnmail-use-procmail nil
- "*If non-nil, the mail backends will look in `nnmail-procmail-directory' for spool files.
-The file(s) in `nnmail-spool-file' will also be read."
+(defcustom nnmail-resplit-incoming nil
+ "*If non-nil, re-split incoming procmail sorted mail."
:group 'nnmail-procmail
:type 'boolean)
-(defcustom nnmail-procmail-directory "~/incoming/"
- "*When using procmail (and the like), incoming mail is put in this directory.
-The Gnus mail backends will read the mail from this directory."
- :group 'nnmail-procmail
- :type 'directory)
-
-(defcustom nnmail-procmail-suffix "\\.spool"
- "*Suffix of files created by procmail (and the like).
-This variable might be a suffix-regexp to match the suffixes of
-several files - eg. \".spool[0-9]*\"."
- :group 'nnmail-procmail
- :type 'regexp)
-
-(defcustom nnmail-resplit-incoming nil
- "*If non-nil, re-split incoming procmail sorted mail."
+(defcustom nnmail-scan-directory-mail-source-once nil
+ "*If non-nil, scan all incoming procmail sorted mails once.
+It scans low-level sorted spools even when not required."
+ :version "21.1"
:group 'nnmail-procmail
:type 'boolean)
(function-item copy-file)
(function :tag "Other")))
-(defcustom nnmail-movemail-program "movemail"
- "*A command to be executed to move mail from the inbox.
-The default is \"movemail\".
-
-This can also be a function. In that case, the function will be
-called with two parameters -- the name of the INBOX file, and the file
-to be moved to."
- :group 'nnmail-files
- :group 'nnmail-retrieve
- :type 'string)
-
-(defcustom nnmail-pop-password-required nil
- "*Non-nil if a password is required when reading mail using POP."
- :group 'nnmail-retrieve
- :type 'boolean)
-
(defcustom nnmail-read-incoming-hook
(if (eq system-type 'windows-nt)
'(nnheader-ms-strip-cr)
nil)
"*Hook that will be run after the incoming mail has been transferred.
-The incoming mail is moved from `nnmail-spool-file' (which normally is
+The incoming mail is moved from the specified spool file (which normally is
something like \"/usr/spool/mail/$user\") to the user's home
directory. This hook is called after the incoming mail box has been
emptied, and can be used to call any mail box programs you have
Eg.
\(add-hook 'nnmail-read-incoming-hook
- (lambda ()
- (start-process \"mailsend\" nil
- \"/local/bin/mailsend\" \"read\" \"mbox\")))
+ (lambda ()
+ (call-process \"/local/bin/mailsend\" nil nil nil
+ \"read\" nnmail-spool-file)))
If you have xwatch running, this will alert it that mail has been
read.
:group 'nnmail-prepare
:type 'hook)
-;; Suggested by Erik Selberg <speed@cs.washington.edu>.
(defcustom nnmail-prepare-incoming-hook nil
"Hook called before treating incoming mail.
The hook is run in a buffer with all the new, incoming mail."
:group 'nnmail-split
:type 'hook)
-;; Suggested by Mejia Pablo J <pjm9806@usl.edu>.
-(defcustom nnmail-tmp-directory nil
- "*If non-nil, use this directory for temporary storage.
-Used when reading incoming mail."
- :group 'nnmail-files
- :group 'nnmail-retrieve
- :type '(choice (const :tag "default" nil)
- (directory :format "%v")))
-
(defcustom nnmail-large-newsgroup 50
"*The number of the articles which indicates a large newsgroup.
If the number of the articles is greater than the value, verbose
GROUP: Mail will be stored in GROUP (a string).
-\(FIELD VALUE SPLIT): If the message field FIELD (a regexp) contains
- VALUE (a regexp), store the messages as specified by SPLIT.
+\(FIELD VALUE [- RESTRICT [- RESTRICT [...]]] SPLIT): If the message
+ field FIELD (a regexp) contains VALUE (a regexp), store the messages
+ as specified by SPLIT. If RESTRICT (a regexp) matches some string
+ after FIELD and before the end of the matched VALUE, return NIL,
+ otherwise process SPLIT. Multiple RESTRICTs add up, further
+ restricting the possibility of processing SPLIT.
\(| SPLIT...): Process each SPLIT expression until one of them matches.
A SPLIT expression is said to match if it will cause the mail
the buffer containing the message headers. The return value FUNCTION
should be a split, which is then recursively processed.
+\(! FUNCTION SPLIT): Call FUNCTION with the result of SPLIT. The
+ return value FUNCTION should be a split, which is then recursively
+ processed.
+
FIELD must match a complete field name. VALUE must match a complete
word according to the `nnmail-split-fancy-syntax-table' syntax table.
You can use \".*\" in the regexps to match partial field names or words.
;; Other mailing lists...
(any \"procmail@informatik\\\\.rwth-aachen\\\\.de\" \"procmail.list\")
(any \"SmartList@informatik\\\\.rwth-aachen\\\\.de\" \"SmartList.list\")
+ ;; Both lists below have the same suffix, so prevent
+ ;; cross-posting to mkpkg.list of messages posted only to
+ ;; the bugs- list, but allow cross-posting when the
+ ;; message was really cross-posted.
+ (any \"bugs-mypackage@somewhere\" \"mypkg.bugs\")
+ (any \"mypackage@somewhere\" - \"bugs-mypackage\" \"mypkg.list\")
+ ;;
;; People...
(any \"larsi@ifi\\\\.uio\\\\.no\" \"people.Lars Magne Ingebrigtsen\"))
;; Unmatched mail goes to the catch all group.
:group 'nnmail-split
:type '(repeat (cons :format "%v" symbol regexp)))
-(defcustom nnmail-delete-incoming nil
- "*If non-nil, the mail backends will delete incoming files after
-splitting."
- :group 'nnmail-retrieve
- :type 'boolean)
-
(defcustom nnmail-message-id-cache-length 1000
"*The approximate number of Message-IDs nnmail will keep in its cache.
If this variable is nil, no checking on duplicate messages will be
(defcustom nnmail-treat-duplicates 'warn
"*If non-nil, nnmail keep a cache of Message-IDs to discover mail duplicates.
-Three values are legal: nil, which means that nnmail is not to keep a
+Three values are valid: nil, which means that nnmail is not to keep a
Message-ID cache; `warn', which means that nnmail should insert extra
headers to warn the user about the duplication (this is the default);
and `delete', which means that nnmail will delete duplicated mails.
(const warn)
(const delete)))
+(defcustom nnmail-extra-headers nil
+ "*Extra headers to parse."
+ :version "21.1"
+ :group 'nnmail
+ :type '(repeat symbol))
+
+(defcustom nnmail-split-header-length-limit 512
+ "Header lines longer than this limit are excluded from the split function."
+ :version "21.1"
+ :group 'nnmail
+ :type 'integer)
+
;;; Internal variables.
(defvar nnmail-split-history nil
"List of group/article elements that say where the previous split put messages.")
-(defvar nnmail-current-spool nil)
-
-(defvar nnmail-pop-password nil
- "*Password to use when reading mail from a POP server, if required.")
-
(defvar nnmail-split-fancy-syntax-table nil
"Syntax table used by `nnmail-split-fancy'.")
(unless (syntax-table-p nnmail-split-fancy-syntax-table)
(defvar nnmail-prepare-save-mail-hook nil
"Hook called before saving mail.")
-(defvar nnmail-moved-inboxes nil
- "List of inboxes that have been moved.")
-
-(defvar nnmail-internal-password nil)
-
(defvar nnmail-split-tracing nil)
(defvar nnmail-split-trace nil)
(defvar nnmail-file-coding-system 'raw-text
"Coding system used in nnmail.")
+(defvar nnmail-incoming-coding-system
+ mm-text-coding-system
+ "Coding system used in reading inbox")
+
+(defvar nnmail-pathname-coding-system 'iso-8859-1
+ "*Coding system for pathname.")
+
(defun nnmail-find-file (file)
"Insert FILE in server buffer safely."
(set-buffer nntp-server-buffer)
- (erase-buffer)
+ (delete-region (point-min) (point-max))
(let ((format-alist nil)
(after-insert-file-functions nil))
(condition-case ()
(let ((coding-system-for-read nnmail-file-coding-system)
- (pathname-coding-system 'binary))
+ (auto-mode-alist (mm-auto-mode-alist))
+ (file-name-coding-system nnmail-pathname-coding-system))
(insert-file-contents file)
t)
(file-error nil))))
-(defvar nnmail-pathname-coding-system
- 'iso-8859-1
- "*Coding system for pathname.")
-
(defun nnmail-group-pathname (group dir &optional file)
"Make pathname for GROUP."
(concat
(let ((dir (file-name-as-directory (expand-file-name dir))))
+ (setq group (nnheader-replace-duplicate-chars-in-string
+ (nnheader-replace-chars-in-string group ?/ ?_)
+ ?. ?_))
(setq group (nnheader-translate-file-chars group))
;; If this directory exists, we use it directly.
- (if (or nnmail-use-long-file-names
- (file-directory-p (concat dir group)))
- (concat dir group "/")
- ;; If not, we translate dots into slashes.
- (concat dir
- (nnheader-encode-coding-string
- (nnheader-replace-chars-in-string group ?. ?/)
- nnmail-pathname-coding-system)
- "/")))
+ (file-name-as-directory
+ (if (or nnmail-use-long-file-names
+ (file-directory-p (concat dir group)))
+ (expand-file-name group dir)
+ ;; If not, we translate dots into slashes.
+ (expand-file-name
+ (mm-encode-coding-string
+ (nnheader-replace-chars-in-string group ?. ?/)
+ nnmail-pathname-coding-system)
+ dir))))
(or file "")))
-(defun nnmail-date-to-time (date)
- "Convert DATE into time."
- (condition-case ()
- (let* ((d1 (timezone-parse-date date))
- (t1 (timezone-parse-time (aref d1 3))))
- (apply 'encode-time
- (mapcar (lambda (el)
- (and el (string-to-number el)))
- (list
- (aref t1 2) (aref t1 1) (aref t1 0)
- (aref d1 2) (aref d1 1) (aref d1 0)
- (number-to-string
- (* 60 (timezone-zone-to-minute (aref d1 4))))))))
- ;; If we get an error, then we just return a 0 time.
- (error (list 0 0))))
-
-(defun nnmail-time-less (t1 t2)
- "Say whether time T1 is less than time T2."
- (or (< (car t1) (car t2))
- (and (= (car t1) (car t2))
- (< (nth 1 t1) (nth 1 t2)))))
-
-(defun nnmail-days-to-time (days)
- "Convert DAYS into time."
- (let* ((seconds (* 1.0 days 60 60 24))
- (rest (expt 2 16))
- (ms (condition-case nil (floor (/ seconds rest))
- (range-error (expt 2 16)))))
- (list ms (condition-case nil (round (- seconds (* ms rest)))
- (range-error (expt 2 16))))))
-
-(defun nnmail-time-since (time)
- "Return the time since TIME, which is either an internal time or a date."
- (when (stringp time)
- ;; Convert date strings to internal time.
- (setq time (nnmail-date-to-time time)))
- (let* ((current (current-time))
- (rest (when (< (nth 1 current) (nth 1 time))
- (expt 2 16))))
- (list (- (+ (car current) (if rest -1 0)) (car time))
- (- (+ (or rest 0) (nth 1 current)) (nth 1 time)))))
-
-;; Function rewritten from rmail.el.
-(defun nnmail-move-inbox (inbox)
- "Move INBOX to `nnmail-crash-box'."
- (if (not (file-writable-p nnmail-crash-box))
- (gnus-error 1 "Can't write to crash box %s. Not moving mail"
- nnmail-crash-box)
- ;; If the crash box exists and is empty, we delete it.
- (when (and (file-exists-p nnmail-crash-box)
- (zerop (nnheader-file-size (file-truename nnmail-crash-box))))
- (delete-file nnmail-crash-box))
- (let ((tofile (file-truename (expand-file-name nnmail-crash-box)))
- (popmail (string-match "^po:" inbox))
- movemail errors result)
- (unless popmail
- (setq inbox (file-truename (expand-file-name inbox)))
- (setq movemail t)
- ;; On some systems, /usr/spool/mail/foo is a directory
- ;; and the actual inbox is /usr/spool/mail/foo/foo.
- (when (file-directory-p inbox)
- (setq inbox (expand-file-name (user-login-name) inbox))))
- (if (member inbox nnmail-moved-inboxes)
- ;; We don't try to move an already moved inbox.
- nil
- (if popmail
- (progn
- (when (and nnmail-pop-password
- (not nnmail-internal-password))
- (setq nnmail-internal-password nnmail-pop-password))
- (when (and nnmail-pop-password-required
- (not nnmail-internal-password))
- (setq nnmail-internal-password
- (nnmail-read-passwd
- (format "Password for %s: "
- (substring inbox (+ popmail 3))))))
- (nnheader-message 5 "Getting mail from the post office..."))
- (when (or (and (file-exists-p tofile)
- (/= 0 (nnheader-file-size tofile)))
- (and (file-exists-p inbox)
- (/= 0 (nnheader-file-size inbox))))
- (nnheader-message 5 "Getting mail from %s..." inbox)))
- ;; Set TOFILE if have not already done so, and
- ;; rename or copy the file INBOX to TOFILE if and as appropriate.
- (cond
- ((file-exists-p tofile)
- ;; The crash box exists already.
- t)
- ((and (not popmail)
- (not (file-exists-p inbox)))
- ;; There is no inbox.
- (setq tofile nil))
- (t
- ;; If getting from mail spool directory, use movemail to move
- ;; rather than just renaming, so as to interlock with the
- ;; mailer.
- (unwind-protect
- (save-excursion
- (setq errors (generate-new-buffer " *nnmail loss*"))
- (buffer-disable-undo errors)
- (if (nnheader-functionp nnmail-movemail-program)
- (condition-case err
- (progn
- (funcall nnmail-movemail-program inbox tofile)
- (setq result 0))
- (error
- (save-excursion
- (set-buffer errors)
- (insert (prin1-to-string err))
- (setq result 255))))
- (let ((default-directory "/"))
- (setq result
- (apply
- 'call-process
- (append
- (list
- (expand-file-name
- nnmail-movemail-program exec-directory)
- nil errors nil inbox tofile)
- (when nnmail-internal-password
- (list nnmail-internal-password)))))))
- (push inbox nnmail-moved-inboxes)
- (if (and (not (buffer-modified-p errors))
- (zerop result))
- ;; No output => movemail won
- (progn
- (unless popmail
- (when (file-exists-p tofile)
- (set-file-modes tofile nnmail-default-file-modes))))
- (set-buffer errors)
- ;; There may be a warning about older revisions. We
- ;; ignore those.
- (goto-char (point-min))
- (if (search-forward "older revision" nil t)
- (progn
- (unless popmail
- (when (file-exists-p tofile)
- (set-file-modes
- tofile nnmail-default-file-modes))))
- ;; Probably a real error.
- ;; We nix out the password in case the error
- ;; was because of a wrong password being given.
- (setq nnmail-internal-password nil)
- (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))
- (when (looking-at "movemail: ")
- (delete-region (point-min) (match-end 0)))
- (unless (yes-or-no-p
- (format "movemail: %s (%d return). Continue? "
- (buffer-string) result))
- (error "%s" (buffer-string)))
- (setq tofile nil)))))))
- (nnheader-message 5 "Getting mail from %s...done" inbox)
- (and errors
- (buffer-name errors)
- (kill-buffer errors))
- tofile))))
-
(defun nnmail-get-active ()
"Returns an assoc of group names and active ranges.
nn*-request-list should have been called before calling this function."
- (let (group-assoc)
- ;; Go through all groups from the active list.
- (save-excursion
- (set-buffer nntp-server-buffer)
- (goto-char (point-min))
- (while (re-search-forward
- "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)" nil t)
- ;; We create an alist with `(GROUP (LOW . HIGH))' elements.
- (push (list (match-string 1)
- (cons (string-to-int (match-string 3))
- (string-to-int (match-string 2))))
- group-assoc)))
+ ;; Go through all groups from the active list.
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (nnmail-parse-active)))
+
+(defun nnmail-parse-active ()
+ "Parse the active file in the current buffer and return an alist."
+ (goto-char (point-min))
+ (unless (re-search-forward "[\\\"]" nil t)
+ (goto-char (point-max))
+ (while (re-search-backward "[][';?()#]" nil t)
+ (insert ?\\)))
+ (goto-char (point-min))
+ (let ((buffer (current-buffer))
+ group-assoc group max min)
+ (while (not (eobp))
+ (condition-case err
+ (progn
+ (narrow-to-region (point) (gnus-point-at-eol))
+ (setq group (read buffer))
+ (unless (stringp group)
+ (setq group (symbol-name group)))
+ (if (and (numberp (setq max (read nntp-server-buffer)))
+ (numberp (setq min (read nntp-server-buffer))))
+ (push (list group (cons min max))
+ group-assoc)))
+ (error nil))
+ (widen)
+ (forward-line 1))
group-assoc))
-(defvar nnmail-active-file-coding-system 'binary
+(defvar nnmail-active-file-coding-system 'raw-text
"*Coding system for active file.")
(defun nnmail-save-active (group-assoc file-name)
(erase-buffer)
(let (group)
(while (setq group (pop alist))
- (insert (format "%s %d %d y\n" (car group) (cdadr group)
- (caadr group))))))
+ (insert (format "%S %d %d y\n" (intern (car group)) (cdadr group)
+ (caadr group))))
+ (goto-char (point-max))
+ (while (search-backward "\\." nil t)
+ (delete-char 1))))
-(defun nnmail-get-split-group (file group)
+(defun nnmail-get-split-group (file source)
"Find out whether this FILE is to be split into GROUP only.
-If GROUP is non-nil and we are using procmail, return the group name
-only when the file is the correct procmail file. When GROUP is nil,
-return nil if FILE is a spool file or the procmail group for which it
-is a spool. If not using procmail, return GROUP."
- (if (or (eq nnmail-spool-file 'procmail)
- nnmail-use-procmail)
- (if (string-match (concat "^" (regexp-quote
- (expand-file-name
- (file-name-as-directory
- nnmail-procmail-directory)))
- "\\([^/]*\\)"
- nnmail-procmail-suffix "$")
- (expand-file-name file))
- (let ((procmail-group (substring (expand-file-name file)
- (match-beginning 1)
- (match-end 1))))
- (if group
- (if (string-equal group procmail-group)
- group
- nil)
- procmail-group))
- nil)
- group))
+If SOURCE is a directory spec, try to return the group name component."
+ (if (eq (car source) 'directory)
+ (let ((file (file-name-nondirectory file)))
+ (mail-source-bind (directory source)
+ (if (string-match (concat (regexp-quote suffix) "$") file)
+ (substring file 0 (match-beginning 0))
+ nil)))
+ nil))
(defun nnmail-process-babyl-mail-format (func artnum-func)
(let ((case-fold-search t)
+ (count 0)
start message-id content-length do-search end)
(while (not (eobp))
(goto-char (point-min))
(narrow-to-region start (point))
(goto-char (point-min))
(nnmail-check-duplication message-id func artnum-func)
+ (incf count)
(setq end (point-max))))
- (goto-char end))))
+ (goto-char end))
+ count))
(defsubst nnmail-search-unix-mail-delim ()
"Put point at the beginning of the next Unix mbox message."
(when (and (or (bobp)
(save-excursion
(forward-line -1)
- (= (following-char) ?\n)))
+ (eq (char-after) ?\n)))
(save-excursion
(forward-line 1)
(while (looking-at ">From \\|From ")
(when (and (or (bobp)
(save-excursion
(forward-line -1)
- (= (following-char) ?\n)))
+ (eq (char-after) ?\n)))
(save-excursion
(forward-line 1)
(while (looking-at ">From \\|From ")
(defun nnmail-process-unix-mail-format (func artnum-func)
(let ((case-fold-search t)
+ (count 0)
start message-id content-length end skip head-end)
(goto-char (point-min))
(if (not (and (re-search-forward "^From " nil t)
(goto-char (match-beginning 0))))
;; Possibly wrong format?
- (progn
- (pop-to-buffer (nnheader-find-file-noselect nnmail-current-spool))
- (error "Error, unknown mail format! (Possibly corrupted.)"))
+ (error "Error, unknown mail format! (Possibly corrupted.)")
;; Carry on until the bitter end.
(while (not (eobp))
(setq start (point)
(save-restriction
(narrow-to-region start (point))
(goto-char (point-min))
+ (incf count)
(nnmail-check-duplication message-id func artnum-func)
(setq end (point-max))))
- (goto-char end)))))
+ (goto-char end)))
+ count))
(defun nnmail-process-mmdf-mail-format (func artnum-func)
(let ((delim "^\^A\^A\^A\^A$")
(case-fold-search t)
+ (count 0)
start message-id end)
(goto-char (point-min))
(if (not (and (re-search-forward delim nil t)
(forward-line 1)))
;; Possibly wrong format?
- (progn
- (pop-to-buffer (nnheader-find-file-noselect nnmail-current-spool))
- (error "Error, unknown mail format! (Possibly corrupted.)"))
+ (error "Error, unknown mail format! (Possibly corrupted.)")
;; Carry on until the bitter end.
(while (not (eobp))
(setq start (point))
(save-restriction
(narrow-to-region start (point))
(goto-char (point-min))
+ (incf count)
(nnmail-check-duplication message-id func artnum-func)
(setq end (point-max))))
(goto-char end)
- (forward-line 2)))))
+ (forward-line 2)))
+ count))
+
+(defun nnmail-process-maildir-mail-format (func artnum-func)
+ ;; In a maildir, every file contains exactly
projects / gnus / blobdiff