1 ;;; nnml.el --- mail spool access for Gnus
2 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001
3 ;; Free Software Foundation, Inc.
5 ;; Author: Simon Josefsson <simon@josefsson.org> (adding MARKS)
6 ;; Lars Magne Ingebrigtsen <larsi@gnus.org>
7 ;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
8 ;; Keywords: news, mail
10 ;; This file is part of GNU Emacs.
12 ;; GNU Emacs is free software; you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation; either version 2, or (at your option)
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25 ;; Boston, MA 02111-1307, USA.
29 ;; Based on nnspool.el by Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>.
30 ;; For an overview of what the interface functions do, please see the
39 (eval-when-compile (require 'cl))
42 (autoload 'gnus-article-unpropagatable-p "gnus-sum"))
46 (defvoo nnml-directory message-directory
47 "Spool directory for the nnml mail backend.")
49 (defvoo nnml-active-file
50 (expand-file-name "active" nnml-directory)
53 (defvoo nnml-newsgroups-file
54 (expand-file-name "newsgroups" nnml-directory)
55 "Mail newsgroups description file.")
57 (defvoo nnml-get-new-mail t
58 "If non-nil, nnml will check the incoming mail file and split the mail.")
60 (defvoo nnml-nov-is-evil nil
61 "If non-nil, Gnus will never generate and use nov databases for mail spools.
62 Using nov databases will speed up header fetching considerably.
63 This variable shouldn't be flipped much. If you have, for some reason,
64 set this to t, and want to set it to nil again, you should always run
65 the `nnml-generate-nov-databases' command. The function will go
66 through all nnml directories and generate nov databases for them
67 all. This may very well take some time.")
69 (defvoo nnml-marks-is-evil nil
70 "If non-nil, Gnus will never generate and use marks file for mail spools.
71 Using marks files makes it possible to backup and restore mail groups
72 separately from `.newsrc.eld'. If you have, for some reason, set this
73 to t, and want to set it to nil again, you should always remove the
74 corresponding marks file (usually named `.marks' in the nnml group
75 directory, but see `nnml-marks-file-name') for the group. Then the
76 marks file will be regenerated properly by Gnus.")
78 (defvoo nnml-prepare-save-mail-hook nil
79 "Hook run narrowed to an article before saving.")
81 (defvoo nnml-inhibit-expiry nil
82 "If non-nil, inhibit expiry.")
84 (defvoo nnml-use-compressed-files nil
85 "If non-nil, allow using compressed message files.")
89 (defconst nnml-version "nnml 1.0"
92 (defvoo nnml-nov-file-name ".overview")
93 (defvoo nnml-marks-file-name ".marks")
95 (defvoo nnml-current-directory nil)
96 (defvoo nnml-current-group nil)
97 (defvoo nnml-status-string "")
98 (defvoo nnml-nov-buffer-alist nil)
99 (defvoo nnml-group-alist nil)
100 (defvoo nnml-active-timestamp nil)
101 (defvoo nnml-article-file-alist nil)
103 (defvoo nnml-generate-active-function 'nnml-generate-active-info)
105 (defvar nnml-nov-buffer-file-name nil)
107 (defvoo nnml-file-coding-system nnmail-file-coding-system)
109 (defvoo nnml-marks nil)
111 (defvar nnml-marks-modtime (gnus-make-hashtable))
114 ;;; Interface functions.
116 (nnoo-define-basics nnml)
118 (deffoo nnml-retrieve-headers (sequence &optional group server fetch-old)
119 (when (nnml-possibly-change-directory group server)
121 (set-buffer nntp-server-buffer)
124 (number (length sequence))
126 (file-name-coding-system nnmail-pathname-coding-system)
128 (if (stringp (car sequence))
130 (if (nnml-retrieve-headers-with-nov sequence fetch-old)
133 (setq article (car sequence))
134 (setq file (nnml-article-to-file article))
137 (not (file-directory-p file)))
138 (insert (format "221 %d Article retrieved.\n" article))
140 (nnheader-insert-head file)
142 (if (re-search-forward "\n\r?\n" nil t)
144 (goto-char (point-max))
147 (delete-region (point) (point-max)))
148 (setq sequence (cdr sequence))
149 (setq count (1+ count))
150 (and (numberp nnmail-large-newsgroup)
151 (> number nnmail-large-newsgroup)
153 (nnheader-message 6 "nnml: Receiving headers... %d%%"
154 (/ (* count 100) number))))
156 (and (numberp nnmail-large-newsgroup)
157 (> number nnmail-large-newsgroup)
158 (nnheader-message 6 "nnml: Receiving headers...done"))
160 (nnheader-fold-continuation-lines)
163 (deffoo nnml-open-server (server &optional defs)
164 (nnoo-change-server 'nnml server defs)
165 (when (not (file-exists-p nnml-directory))
166 (ignore-errors (make-directory nnml-directory t)))
168 ((not (file-exists-p nnml-directory))
170 (nnheader-report 'nnml "Couldn't create directory: %s" nnml-directory))
171 ((not (file-directory-p (file-truename nnml-directory)))
173 (nnheader-report 'nnml "Not a directory: %s" nnml-directory))
175 (nnheader-report 'nnml "Opened server %s using directory %s"
176 server nnml-directory)
179 (deffoo nnml-request-regenerate (server)
180 (nnml-possibly-change-directory nil server)
181 (nnml-generate-nov-databases server)
184 (deffoo nnml-request-article (id &optional group server buffer)
185 (nnml-possibly-change-directory group server)
186 (let* ((nntp-server-buffer (or buffer nntp-server-buffer))
187 (file-name-coding-system nnmail-pathname-coding-system)
188 path gpath group-num)
190 (when (and (setq group-num (nnml-find-group-number id))
192 (assq (cdr group-num)
193 (nnheader-article-to-file-alist
195 (nnmail-group-pathname
198 (setq path (concat gpath (int-to-string (cdr group-num)))))
199 (setq path (nnml-article-to-file id)))
202 (nnheader-report 'nnml "No such article: %s" id))
203 ((not (file-exists-p path))
204 (nnheader-report 'nnml "No such file: %s" path))
205 ((file-directory-p path)
206 (nnheader-report 'nnml "File is a directory: %s" path))
207 ((not (save-excursion (let ((nnmail-file-coding-system
208 nnml-file-coding-system))
209 (nnmail-find-file path))))
210 (nnheader-report 'nnml "Couldn't read file: %s" path))
212 (nnheader-report 'nnml "Article %s retrieved" id)
213 ;; We return the article number.
214 (cons (if group-num (car group-num) group)
215 (string-to-int (file-name-nondirectory path)))))))
217 (deffoo nnml-request-group (group &optional server dont-check)
218 (let ((file-name-coding-system nnmail-pathname-coding-system))
220 ((not (nnml-possibly-change-directory group server))
221 (nnheader-report 'nnml "Invalid group (no such directory)"))
222 ((not (file-exists-p nnml-current-directory))
223 (nnheader-report 'nnml "Directory %s does not exist"
224 nnml-current-directory))
225 ((not (file-directory-p nnml-current-directory))
226 (nnheader-report 'nnml "%s is not a directory" nnml-current-directory))
228 (nnheader-report 'nnml "Group %s selected" group)
231 (nnheader-re-read-dir nnml-current-directory)
232 (nnmail-activate 'nnml)
233 (let ((active (nth 1 (assoc group nnml-group-alist))))
235 (nnheader-report 'nnml "No such group: %s" group)
236 (nnheader-report 'nnml "Selected group %s" group)
237 (nnheader-insert "211 %d %d %d %s\n"
238 (max (1+ (- (cdr active) (car active))) 0)
239 (car active) (cdr active) group)))))))
241 (deffoo nnml-request-scan (&optional group server)
242 (setq nnml-article-file-alist nil)
243 (nnml-possibly-change-directory group server)
244 (nnmail-get-new-mail 'nnml 'nnml-save-nov nnml-directory group))
246 (deffoo nnml-close-group (group &optional server)
247 (setq nnml-article-file-alist nil)
250 (deffoo nnml-request-create-group (group &optional server args)
251 (nnml-possibly-change-directory nil server)
252 (nnmail-activate 'nnml)
254 ((assoc group nnml-group-alist)
256 ((and (file-exists-p (nnmail-group-pathname group nnml-directory))
257 (not (file-directory-p (nnmail-group-pathname group nnml-directory))))
258 (nnheader-report 'nnml "%s is a file"
259 (nnmail-group-pathname group nnml-directory)))
262 (push (list group (setq active (cons 1 0)))
264 (nnml-possibly-create-directory group)
265 (nnml-possibly-change-directory group server)
266 (let ((articles (nnml-directory-articles nnml-current-directory)))
268 (setcar active (apply 'min articles))
269 (setcdr active (apply 'max articles))))
270 (nnmail-save-active nnml-group-alist nnml-active-file)
273 (deffoo nnml-request-list (&optional server)
275 (let ((nnmail-file-coding-system nnmail-active-file-coding-system)
276 (file-name-coding-system nnmail-pathname-coding-system))
277 (nnmail-find-file nnml-active-file))
278 (setq nnml-group-alist (nnmail-get-active))
281 (deffoo nnml-request-newgroups (date &optional server)
282 (nnml-request-list server))
284 (deffoo nnml-request-list-newsgroups (&optional server)
286 (nnmail-find-file nnml-newsgroups-file)))
288 (deffoo nnml-request-expire-articles (articles group &optional server force)
289 (nnml-possibly-change-directory group server)
290 (let ((active-articles
291 (nnml-directory-articles nnml-current-directory))
293 article rest mod-time number)
294 (nnmail-activate 'nnml)
296 (setq active-articles (sort active-articles '<))
297 ;; Articles not listed in active-articles are already gone,
298 ;; so don't try to expire them.
299 (setq articles (gnus-sorted-intersection articles active-articles))
301 (while (and articles is-old)
302 (if (and (setq article (nnml-article-to-file
303 (setq number (pop articles))))
304 (setq mod-time (nth 5 (file-attributes article)))
305 (nnml-deletable-article-p group number)
306 (setq is-old (nnmail-expired-article-p group mod-time force
307 nnml-inhibit-expiry)))
309 ;; Allow a special target group.
310 (unless (eq nnmail-expiry-target 'delete)
312 (nnml-request-article number group server (current-buffer))
313 (let (nnml-current-directory
315 nnml-article-file-alist)
316 (nnmail-expiry-target-group nnmail-expiry-target group)))
317 ;; Maybe directory is changed during nnmail-expiry-target-group.
318 (nnml-possibly-change-directory group server))
319 (nnheader-message 5 "Deleting article %s in %s"
322 (funcall nnmail-delete-file-function article)
325 (setq active-articles (delq number active-articles))
326 (nnml-nov-delete-article group number))
328 (let ((active (nth 1 (assoc group nnml-group-alist))))
330 (setcar active (or (and active-articles
331 (apply 'min active-articles))
333 (nnmail-save-active nnml-group-alist nnml-active-file))
335 (nconc rest articles)))
337 (deffoo nnml-request-move-article
338 (article group server accept-form &optional last)
339 (let ((buf (get-buffer-create " *nnml move*"))
341 (nnml-possibly-change-directory group server)
342 (nnml-update-file-alist)
344 (nnml-deletable-article-p group article)
345 (nnml-request-article article group server)
346 (let (nnml-current-directory
348 nnml-article-file-alist)
351 (insert-buffer-substring nntp-server-buffer)
352 (setq result (eval accept-form))
353 (kill-buffer (current-buffer))
356 (nnml-possibly-change-directory group server)
358 (funcall nnmail-delete-file-function
359 (nnml-article-to-file article))
361 (nnml-nov-delete-article group article)
364 (nnmail-save-active nnml-group-alist nnml-active-file))))
367 (deffoo nnml-request-accept-article (group &optional server last)
368 (nnml-possibly-change-directory group server)
369 (nnmail-check-syntax)
371 (when nnmail-cache-accepted-message-ids
372 (nnmail-cache-insert (nnmail-fetch-field "message-id") group))
375 (nnmail-activate 'nnml)
376 (setq result (car (nnml-save-mail
377 (list (cons group (nnml-active-number group))))))
379 (nnmail-save-active nnml-group-alist nnml-active-file)
380 (and last (nnml-save-nov))))
382 (nnmail-activate 'nnml)
383 (if (and (not (setq result (nnmail-article-group 'nnml-active-number)))
384 (yes-or-no-p "Moved to `junk' group; delete article? "))
386 (setq result (car (nnml-save-mail result))))
388 (nnmail-save-active nnml-group-alist nnml-active-file)
389 (when nnmail-cache-accepted-message-ids
390 (nnmail-cache-close))
394 (deffoo nnml-request-post (&optional server)
395 (nnmail-do-request-post 'nnml-request-accept-article server))
397 (deffoo nnml-request-replace-article (article group buffer)
398 (nnml-possibly-change-directory group)
401 (nnml-possibly-create-directory group)
402 (let ((chars (nnmail-insert-lines))
403 (art (concat (int-to-string article) "\t"))
407 (point-min) (point-max)
408 (or (nnml-article-to-file article)
409 (expand-file-name (int-to-string article)
410 nnml-current-directory))
411 nil (if (nnheader-be-verbose 5) nil 'nomesg))
413 (setq headers (nnml-parse-head chars article))
414 ;; Replace the NOV line in the NOV file.
416 (set-buffer (nnml-open-nov group))
417 (goto-char (point-min))
418 (if (or (looking-at art)
419 (search-forward (concat "\n" art) nil t))
420 ;; Delete the old NOV line.
421 (delete-region (progn (beginning-of-line) (point))
422 (progn (forward-line 1) (point)))
423 ;; The line isn't here, so we have to find out where
424 ;; we should insert it. (This situation should never
425 ;; occur, but one likes to make sure...)
426 (while (and (looking-at "[0-9]+\t")
429 (match-beginning 0) (match-end 0)))
431 (zerop (forward-line 1)))))
433 (nnheader-insert-nov headers)
437 (deffoo nnml-request-delete-group (group &optional force server)
438 (nnml-possibly-change-directory group server)