;;; nnmaildir.el --- maildir backend for Gnus
-;; Copyright (c) 2001 Free Software Foundation, Inc.
-;; Copyright (c) 2000, 2001 Paul Jarc <prj@po.cwru.edu>
+;; Public domain.
;; Author: Paul Jarc <prj@po.cwru.edu>
;; 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:
-;; Maildir format is documented in the maildir(5) man page from qmail
-;; and at <URL:http://cr.yp.to/proto/maildir.html>. nnmaildir also
-;; stores extra information in the .nnmaildir/ directory within a
-;; maildir.
+;; Maildir format is documented at <URL:http://cr.yp.to/proto/maildir.html>
+;; and in the maildir(5) man page from qmail (available at
+;; <URL:http://www.qmail.org/man/man5/maildir.html>). nnmaildir also stores
+;; extra information in the .nnmaildir/ directory within a maildir.
;;
;; Some goals of nnmaildir:
-;; * Everything Just Works, and correctly. E.g., stale NOV data is
-;; ignored when articles have been edited; no need for
-;; -generate-nov-databases.
-;; * Perfect reliability: [C-g] will never corrupt its data in memory,
-;; and SIGKILL will never corrupt its data in the filesystem.
-;; * We make it easy to manipulate marks, etc., from outside Gnus.
-;; * All information about a group is stored in the maildir, for easy
-;; backup and restoring.
-;; * We use the filesystem as a database.
+;; * Everything Just Works, and correctly. E.g., NOV data is automatically
+;; regenerated when stale; no need for manually running
+;; *-generate-nov-databases.
+;; * Perfect reliability: [C-g] will never corrupt its data in memory, and
+;; SIGKILL will never corrupt its data in the filesystem.
+;; * Allow concurrent operation as much as possible. If files change out
+;; from under us, adapt to the changes or degrade gracefully.
+;; * We use the filesystem as a database, so that, e.g., it's easy to
+;; manipulate marks from outside Gnus.
+;; * All information about a group is stored in the maildir, for easy backup,
+;; copying, restoring, etc.
;;
;; Todo:
-;; * Ignore old NOV data when gnus-extra-headers has changed.
-;; * Don't force article renumbering, so nnmaildir can be used with
-;; the cache and agent. Alternatively, completely rewrite the Gnus
-;; backend interface, which would have other advantages.
-;;
-;; See also <URL:http://multivac.cwru.edu./nnmaildir/> until that
-;; information is added to the Gnus manual.
+;; * When moving an article for expiry, copy all the marks except 'expire
+;; from the original article.
+;; * Add a hook for when moving messages from new/ to cur/, to support
+;; nnmail's duplicate detection.
+;; * Improve generated Xrefs, so crossposts are detectable.
+;; * Improve code readability.
;;; Code:
+;; eval this before editing
+[(progn
+ (put 'nnmaildir--with-nntp-buffer 'lisp-indent-function 0)
+ (put 'nnmaildir--with-work-buffer 'lisp-indent-function 0)
+ (put 'nnmaildir--with-nov-buffer 'lisp-indent-function 0)
+ (put 'nnmaildir--with-move-buffer 'lisp-indent-function 0)
+ (put 'nnmaildir--condcase 'lisp-indent-function 2)
+ )
+]
+
(eval-and-compile
(require 'nnheader)
(require 'gnus)
;; Variables to generate filenames of messages being delivered:
(defvar nnmaildir--delivery-time "")
-(defconst nnmaildir--delivery-pid (number-to-string (emacs-pid)))
-(defvar nnmaildir--delivery-ct nil)
+(defconst nnmaildir--delivery-pid (concat "P" (number-to-string (emacs-pid))))
+(defvar nnmaildir--delivery-count nil)
;; An obarry containing symbols whose names are server names and whose values
;; are servers:
(defvar nnmaildir--servers (make-vector 3 0))
-;; A server which has not necessarily been added to nnmaildir--servers, or nil:
-(defvar nnmaildir--tmp-server nil)
;; The current server:
(defvar nnmaildir--cur-server nil)
-;; A server is a vector:
-["server-name"
- select-method
- "/expanded/path/to/directory/containing/symlinks/to/maildirs/"
- directory-files-function
- group-name-transformation-function
- ;; An obarray containing symbols whose names are group names and whose values
- ;; are groups:
- group-hash
- ;; A group which has not necessarily been added to the group hash, or nil:
- tmp-group
- current-group ;; or nil
- "Last error message, or nil"
- directory-modtime
- get-new-mail-p ;; Should we split mail from mail-sources?
- "new/group/creation/directory"]
-
-;; A group is a vector:
-["group.name"
- "prefixed:group.name"
- ;; Modification times of the "new", and "cur" directories:
- new-modtime
- cur-modtime
- ;; A vector containing lists of articles:
- [;; A list of articles, with article numbers in descending order, ending with
- ;; article 1:
- article-list
- ;; An obarray containing symbols whose names are filename prefixes and whose
- ;; values are articles:
- file-hash
- ;; Same as above, but keyed on Message-ID:
- msgid-hash
- ;; An article which has not necessarily been added to the file and msgid
- ;; hashes, or nil:
- tmp-article]
- ;; A vector containing nil, or articles with NOV data:
- nov-cache
- ;; The index of the next nov-cache entry to be replaced:
- nov-cache-index
- ;; An obarray containing symbols whose names are mark names and whose values
- ;; are modtimes of mark directories:
- mark-modtime-hash]
-
-;; An article is a vector:
-["file.name.prefix"
- ":2,suffix" ;; or 'expire if expired
- number
- "msgid"
- ;; A NOV data vector, or nil:
- ["subject\tfrom\tdate"
- "references\tchars\lines"
- "extra"
- article-file-modtime]]
-
-(defmacro nnmaildir--srv-new () '(make-vector 11 nil))
-(defmacro nnmaildir--srv-get-name (server) `(aref ,server 0))
-(defmacro nnmaildir--srv-get-method (server) `(aref ,server 1))
-(defmacro nnmaildir--srv-get-dir (server) `(aref ,server 2))
-(defmacro nnmaildir--srv-get-ls (server) `(aref ,server 3))
-(defmacro nnmaildir--srv-get-groups (server) `(aref ,server 4))
-(defmacro nnmaildir--srv-get-tmpgrp (server) `(aref ,server 5))
-(defmacro nnmaildir--srv-get-curgrp (server) `(aref ,server 6))
-(defmacro nnmaildir--srv-get-error (server) `(aref ,server 7))
-(defmacro nnmaildir--srv-get-mtime (server) `(aref ,server 8))
-(defmacro nnmaildir--srv-get-gnm (server) `(aref ,server 9))
-(defmacro nnmaildir--srv-get-create-dir (server) `(aref ,server 10))
-(defmacro nnmaildir--srv-set-name (server val) `(aset ,server 0 ,val))
-(defmacro nnmaildir--srv-set-method (server val) `(aset ,server 1 ,val))
-(defmacro nnmaildir--srv-set-dir (server val) `(aset ,server 2 ,val))
-(defmacro nnmaildir--srv-set-ls (server val) `(aset ,server 3 ,val))
-(defmacro nnmaildir--srv-set-groups (server val) `(aset ,server 4 ,val))
-(defmacro nnmaildir--srv-set-tmpgrp (server val) `(aset ,server 5 ,val))
-(defmacro nnmaildir--srv-set-curgrp (server val) `(aset ,server 6 ,val))
-(defmacro nnmaildir--srv-set-error (server val) `(aset ,server 7 ,val))
-(defmacro nnmaildir--srv-set-mtime (server val) `(aset ,server 8 ,val))
-(defmacro nnmaildir--srv-set-gnm (server val) `(aset ,server 9 ,val))
-(defmacro nnmaildir--srv-set-create-dir (server val) `(aset ,server 10 ,val))
-
-(defmacro nnmaildir--grp-new () '(make-vector 8 nil))
-(defmacro nnmaildir--grp-get-name (group) `(aref ,group 0))
-(defmacro nnmaildir--grp-get-pname (group) `(aref ,group 1))
-(defmacro nnmaildir--grp-get-new (group) `(aref ,group 2))
-(defmacro nnmaildir--grp-get-cur (group) `(aref ,group 3))
-(defmacro nnmaildir--grp-get-lists (group) `(aref ,group 4))
-(defmacro nnmaildir--grp-get-cache (group) `(aref ,group 5))
-(defmacro nnmaildir--grp-get-index (group) `(aref ,group 6))
-(defmacro nnmaildir--grp-get-mmth (group) `(aref ,group 7))
-(defmacro nnmaildir--grp-set-name (group val) `(aset ,group 0 ,val))
-(defmacro nnmaildir--grp-set-pname (group val) `(aset ,group 1 ,val))
-(defmacro nnmaildir--grp-set-new (group val) `(aset ,group 2 ,val))
-(defmacro nnmaildir--grp-set-cur (group val) `(aset ,group 3 ,val))
-(defmacro nnmaildir--grp-set-lists (group val) `(aset ,group 4 ,val))
-(defmacro nnmaildir--grp-set-cache (group val) `(aset ,group 5 ,val))
-(defmacro nnmaildir--grp-set-index (group val) `(aset ,group 6 ,val))
-(defmacro nnmaildir--grp-set-mmth (group val) `(aset ,group 7 ,val))
-
-(defmacro nnmaildir--lists-new () '(make-vector 4 nil))
-(defmacro nnmaildir--lists-get-nlist (lists) `(aref ,lists 0))
-(defmacro nnmaildir--lists-get-flist (lists) `(aref ,lists 1))
-(defmacro nnmaildir--lists-get-mlist (lists) `(aref ,lists 2))
-(defmacro nnmaildir--lists-get-tmpart (lists) `(aref ,lists 3))
-(defmacro nnmaildir--lists-set-nlist (lists val) `(aset ,lists 0 ,val))
-(defmacro nnmaildir--lists-set-flist (lists val) `(aset ,lists 1 ,val))
-(defmacro nnmaildir--lists-set-mlist (lists val) `(aset ,lists 2 ,val))
-(defmacro nnmaildir--lists-set-tmpart (lists val) `(aset ,lists 3 ,val))
-
-(defmacro nnmaildir--nlist-last-num (list)
- `(if ,list (nnmaildir--art-get-num (car ,list)) 0))
-(defmacro nnmaildir--nlist-art (list num)
- `(and ,list
- (>= (nnmaildir--art-get-num (car ,list)) ,num)
- (nth (- (nnmaildir--art-get-num (car ,list)) ,num) ,list)))
+;; A copy of nnmail-extra-headers
+(defvar nnmaildir--extra nil)
+
+;; A NOV structure looks like this (must be prin1-able, so no defstruct):
+["subject\tfrom\tdate"
+ "references\tchars\lines"
+ "To: you\tIn-Reply-To: <your.mess@ge>"
+ (12345 67890) ;; modtime of the corresponding article file
+ (to in-reply-to)] ;; contemporary value of nnmail-extra-headers
+(defconst nnmaildir--novlen 5)
+(defmacro nnmaildir--nov-new (beg mid end mtime extra)
+ `(vector ,beg ,mid ,end ,mtime ,extra))
+(defmacro nnmaildir--nov-get-beg (nov) `(aref ,nov 0))
+(defmacro nnmaildir--nov-get-mid (nov) `(aref ,nov 1))
+(defmacro nnmaildir--nov-get-end (nov) `(aref ,nov 2))
+(defmacro nnmaildir--nov-get-mtime (nov) `(aref ,nov 3))
+(defmacro nnmaildir--nov-get-extra (nov) `(aref ,nov 4))
+(defmacro nnmaildir--nov-set-beg (nov value) `(aset ,nov 0 ,value))
+(defmacro nnmaildir--nov-set-mid (nov value) `(aset ,nov 1 ,value))
+(defmacro nnmaildir--nov-set-end (nov value) `(aset ,nov 2 ,value))
+(defmacro nnmaildir--nov-set-mtime (nov value) `(aset ,nov 3 ,value))
+(defmacro nnmaildir--nov-set-extra (nov value) `(aset ,nov 4 ,value))
+
+(defstruct nnmaildir--art
+ (prefix nil :type string) ;; "time.pid.host"
+ (suffix nil :type string) ;; ":2,flags"
+ (num nil :type natnum) ;; article number
+ (msgid nil :type string) ;; "<mess.age@id>"
+ (nov nil :type vector)) ;; cached nov structure, or nil
+
+(defstruct nnmaildir--grp
+ (name nil :type string) ;; "group.name"
+ (new nil :type list) ;; new/ modtime
+ (cur nil :type list) ;; cur/ modtime
+ (min 1 :type natnum) ;; minimum article number
+ (count 0 :type natnum) ;; count of articles
+ (nlist nil :type list) ;; list of articles, ordered descending by number
+ (flist nil :type vector) ;; obarray mapping filename prefix->article
+ (mlist nil :type vector) ;; obarray mapping message-id->article
+ (cache nil :type vector) ;; nov cache
+ (index nil :type natnum) ;; index of next cache entry to replace
+ (mmth nil :type vector)) ;; obarray mapping mark name->dir modtime
+ ; ("Mark Mod Time Hash")
+
+(defstruct nnmaildir--srv
+ (address nil :type string) ;; server address string
+ (method nil :type list) ;; (nnmaildir "address" ...)
+ (prefix nil :type string) ;; "nnmaildir+address:"
+ (dir nil :type string) ;; "/expanded/path/to/server/dir/"
+ (ls nil :type function) ;; directory-files function
+ (groups nil :type vector) ;; obarray mapping group name->group
+ (curgrp nil :type nnmaildir--grp) ;; current group, or nil
+ (error nil :type string) ;; last error message, or nil
+ (mtime nil :type list) ;; modtime of dir
+ (gnm nil) ;; flag: split from mail-sources?
+ (target-prefix nil :type string)) ;; symlink target prefix
+
+(defun nnmaildir--expired-article (group article)
+ (setf (nnmaildir--art-nov article) nil)
+ (let ((flist (nnmaildir--grp-flist group))
+ (mlist (nnmaildir--grp-mlist group))
+ (min (nnmaildir--grp-min group))
+ (count (1- (nnmaildir--grp-count group)))
+ (prefix (nnmaildir--art-prefix article))
+ (msgid (nnmaildir--art-msgid article))
+ (new-nlist nil)
+ (nlist-pre '(nil . nil))
+ nlist-post num)
+ (unless (zerop count)
+ (setq nlist-post (nnmaildir--grp-nlist group)
+ num (nnmaildir--art-num article))
+ (if (eq num (caar nlist-post))
+ (setq new-nlist (cdr nlist-post))
+ (setq new-nlist nlist-post
+ nlist-pre nlist-post
+ nlist-post (cdr nlist-post))
+ (while (/= num (caar nlist-post))
+ (setq nlist-pre nlist-post
+ nlist-post (cdr nlist-post)))
+ (setq nlist-post (cdr nlist-post))
+ (if (eq num min)
+ (setq min (caar nlist-pre)))))
+ (let ((inhibit-quit t))
+ (setf (nnmaildir--grp-min group) min)
+ (setf (nnmaildir--grp-count group) count)
+ (setf (nnmaildir--grp-nlist group) new-nlist)
+ (setcdr nlist-pre nlist-post)
+ (unintern prefix flist)
+ (unintern msgid mlist))))
+
+(defun nnmaildir--nlist-art (group num)
+ (let ((entry (assq num (nnmaildir--grp-nlist group))))
+ (if entry
+ (cdr entry))))
(defmacro nnmaildir--flist-art (list file)
`(symbol-value (intern-soft ,file ,list)))
(defmacro nnmaildir--mlist-art (list msgid)
`(symbol-value (intern-soft ,msgid ,list)))
-(defmacro nnmaildir--art-new () '(make-vector 5 nil))
-(defmacro nnmaildir--art-get-prefix (article) `(aref ,article 0))
-(defmacro nnmaildir--art-get-suffix (article) `(aref ,article 1))
-(defmacro nnmaildir--art-get-num (article) `(aref ,article 2))
-(defmacro nnmaildir--art-get-msgid (article) `(aref ,article 3))
-(defmacro nnmaildir--art-get-nov (article) `(aref ,article 4))
-(defmacro nnmaildir--art-set-prefix (article val) `(aset ,article 0 ,val))
-(defmacro nnmaildir--art-set-suffix (article val) `(aset ,article 1 ,val))
-(defmacro nnmaildir--art-set-num (article val) `(aset ,article 2 ,val))
-(defmacro nnmaildir--art-set-msgid (article val) `(aset ,article 3 ,val))
-(defmacro nnmaildir--art-set-nov (article val) `(aset ,article 4 ,val))
-
-(defmacro nnmaildir--nov-new () '(make-vector 4 nil))
-(defmacro nnmaildir--nov-get-beg (nov) `(aref ,nov 0))
-(defmacro nnmaildir--nov-get-mid (nov) `(aref ,nov 1))
-(defmacro nnmaildir--nov-get-end (nov) `(aref ,nov 2))
-(defmacro nnmaildir--nov-get-mtime (nov) `(aref ,nov 3))
-(defmacro nnmaildir--nov-set-beg (nov val) `(aset ,nov 0 ,val))
-(defmacro nnmaildir--nov-set-mid (nov val) `(aset ,nov 1 ,val))
-(defmacro nnmaildir--nov-set-end (nov val) `(aset ,nov 2 ,val))
-(defmacro nnmaildir--nov-set-mtime (nov val) `(aset ,nov 3 ,val))
-
-(defmacro nnmaildir--srv-grp-dir (srv-dir gname)
- `(file-name-as-directory (concat ,srv-dir ,gname)))
-
-(defun nnmaildir--param (prefixed-group-name param)
- (setq param
- (gnus-group-find-parameter prefixed-group-name param 'allow-list)
- param (if (vectorp param) (aref param 0) param))
+(defun nnmaildir--pgname (server gname)
+ (let ((prefix (nnmaildir--srv-prefix server)))
+ (if prefix (concat prefix gname)
+ (setq gname (gnus-group-prefixed-name gname
+ (nnmaildir--srv-method server)))
+ (setf (nnmaildir--srv-prefix server) (gnus-group-real-prefix gname))
+ gname)))
+
+(defun nnmaildir--param (pgname param)
+ (setq param (gnus-group-find-parameter pgname param 'allow-list))
+ (if (vectorp param) (setq param (aref param 0)))
(eval param))
-(defmacro nnmaildir--unlink (file)
- `(if (file-attributes ,file) (delete-file ,file)))
-
-(defmacro nnmaildir--tmp (dir) `(file-name-as-directory (concat ,dir "tmp")))
-(defmacro nnmaildir--new (dir) `(file-name-as-directory (concat ,dir "new")))
-(defmacro nnmaildir--cur (dir) `(file-name-as-directory (concat ,dir "cur")))
-(defmacro nnmaildir--nndir (dir)
- `(file-name-as-directory (concat ,dir ".nnmaildir")))
-
-(defun nnmaildir--lists-fix (lists)
- (let ((tmp (nnmaildir--lists-get-tmpart lists)))
- (when tmp
- (set (intern (nnmaildir--art-get-prefix tmp)
- (nnmaildir--lists-get-flist lists))
- tmp)
- (set (intern (nnmaildir--art-get-msgid tmp)
- (nnmaildir--lists-get-mlist lists))
- tmp)
- (nnmaildir--lists-set-tmpart lists nil))))
-
+(defmacro nnmaildir--with-nntp-buffer (&rest body)
+ `(save-excursion
+ (set-buffer nntp-server-buffer)
+ ,@body))
+(defmacro nnmaildir--with-work-buffer (&rest body)
+ `(save-excursion
+ (set-buffer (get-buffer-create " *nnmaildir work*"))
+ ,@body))
+(defmacro nnmaildir--with-nov-buffer (&rest body)
+ `(save-excursion
+ (set-buffer (get-buffer-create " *nnmaildir nov*"))
+ ,@body))
+(defmacro nnmaildir--with-move-buffer (&rest body)
+ `(save-excursion
+ (set-buffer (get-buffer-create " *nnmaildir move*"))
+ ,@body))
+
+(defmacro nnmaildir--subdir (dir subdir)
+ `(file-name-as-directory (concat ,dir ,subdir)))
+(defmacro nnmaildir--srvgrp-dir (srv-dir gname)
+ `(nnmaildir--subdir ,srv-dir ,gname))
+(defmacro nnmaildir--tmp (dir) `(nnmaildir--subdir ,dir "tmp"))
+(defmacro nnmaildir--new (dir) `(nnmaildir--subdir ,dir "new"))
+(defmacro nnmaildir--cur (dir) `(nnmaildir--subdir ,dir "cur"))
+(defmacro nnmaildir--nndir (dir) `(nnmaildir--subdir ,dir ".nnmaildir"))
+(defmacro nnmaildir--nov-dir (dir) `(nnmaildir--subdir ,dir "nov"))
+(defmacro nnmaildir--marks-dir (dir) `(nnmaildir--subdir ,dir "marks"))
+(defmacro nnmaildir--num-dir (dir) `(nnmaildir--subdir ,dir "num"))
+
+(defmacro nnmaildir--unlink (file-arg)
+ `(let ((file ,file-arg))
+ (if (file-attributes file) (delete-file file))))
+(defun nnmaildir--mkdir (dir)
+ (or (file-exists-p (file-name-as-directory dir))
+ (make-directory-internal (directory-file-name dir))))
+(defun nnmaildir--mkfile (file)
+ (write-region "" nil file nil 'no-message))
+(defun nnmaildir--delete-dir-files (dir ls)
+ (when (file-attributes dir)
+ (mapcar 'delete-file (funcall ls dir 'full "\\`[^.]" 'nosort))
+ (delete-directory dir)))
+
+(defun nnmaildir--group-maxnum (server group)
+ (catch 'return
+ (if (zerop (nnmaildir--grp-count group)) (throw 'return 0))
+ (let ((dir (nnmaildir--srvgrp-dir (nnmaildir--srv-dir server)
+ (nnmaildir--grp-name group)))
+ (number-opened 1)
+ attr ino-opened nlink number-linked)
+ (setq dir (nnmaildir--nndir dir)
+ dir (nnmaildir--num-dir dir))
+ (while t
+ (setq attr (file-attributes
+ (concat dir (number-to-string number-opened))))
+ (or attr (throw 'return (1- number-opened)))
+ (setq ino-opened (nth 10 attr)
+ nlink (nth 1 attr)
+ number-linked (+ number-opened nlink))
+ (if (or (< nlink 1) (< number-linked nlink))
+ (signal 'error '("Arithmetic overflow")))
+ (setq attr (file-attributes
+ (concat dir (number-to-string number-linked))))
+ (or attr (throw 'return (1- number-linked)))
+ (if (/= ino-opened (nth 10 attr))
+ (setq number-opened number-linked))))))
+
+;; Make the given server, if non-nil, be the current server. Then make the
+;; given group, if non-nil, be the current group of the current server. Then
+;; return the group object for the current group.
(defun nnmaildir--prepare (server group)
(let (x groups)
(catch 'return
- (setq x nnmaildir--tmp-server)
- (when x
- (set (intern (nnmaildir--srv-get-name x) nnmaildir--servers) x)
- (setq nnmaildir--tmp-server nil))
(if (null server)
- (or (setq server nnmaildir--cur-server)
- (throw 'return nil))
- (or (setq server (intern-soft server nnmaildir--servers))
- (throw 'return nil))
- (setq server (symbol-value server)
- nnmaildir--cur-server server))
- (setq groups (nnmaildir--srv-get-groups server))
- (if groups nil (throw 'return nil))
- (if (nnmaildir--srv-get-method server) nil
- (setq x (concat "nnmaildir:" (nnmaildir--srv-get-name server))
- x (gnus-server-to-method x))
- (if x nil (throw 'return nil))
- (nnmaildir--srv-set-method server x))
- (setq x (nnmaildir--srv-get-tmpgrp server))
- (when x
- (set (intern (nnmaildir--grp-get-name x) groups) x)
- (nnmaildir--srv-set-tmpgrp server nil))
+ (unless (setq server nnmaildir--cur-server)
+ (throw 'return nil))
+ (unless (setq server (intern-soft server nnmaildir--servers))
+ (throw 'return nil))
+ (setq server (symbol-value server)
+ nnmaildir--cur-server server))
+ (unless (setq groups (nnmaildir--srv-groups server))
+ (throw 'return nil))
+ (unless (nnmaildir--srv-method server)
+ (setq x (concat "nnmaildir:" (nnmaildir--srv-address server))
+ x (gnus-server-to-method x))
+ (unless x (throw 'return nil))
+ (setf (nnmaildir--srv-method server) x))
(if (null group)
- (or (setq group (nnmaildir--srv-get-curgrp server))
- (throw 'return nil))
- (setq group (intern-soft group groups))
- (if group nil (throw 'return nil))
- (setq group (symbol-value group)))
- (nnmaildir--lists-fix (nnmaildir--grp-get-lists group))
+ (unless (setq group (nnmaildir--srv-curgrp server))
+ (throw 'return nil))
+ (unless (setq group (intern-soft group groups))
+ (throw 'return nil))
+ (setq group (symbol-value group)))
group)))
-(defun nnmaildir--update-nov (srv-dir group article)
+(defun nnmaildir--tab-to-space (string)
+ (let ((pos 0))
+ (while (string-match "\t" string pos)
+ (aset string (match-beginning 0) ? )
+ (setq pos (match-end 0))))
+ string)
+
+(defmacro nnmaildir--condcase (errsym body &rest handler)
+ `(condition-case ,errsym
+ (let ((system-messages-locale "C")) ,body)
+ (error . ,handler)))
+
+(defun nnmaildir--emlink-p (err)
+ (and (eq (car err) 'file-error)
+ (string= (downcase (caddr err)) "too many links")))
+
+(defun nnmaildir--enoent-p (err)
+ (and (eq (car err) 'file-error)
+ (string= (downcase (caddr err)) "no such file or directory")))
+
+(defun nnmaildir--eexist-p (err)
+ (eq (car err) 'file-already-exists))
+
+(defun nnmaildir--new-number (nndir)
+ "Allocate a new article number by atomically creating a file under NNDIR."
+ (let ((numdir (nnmaildir--num-dir nndir))
+ (make-new-file t)
+ (number-open 1)
+ number-link previous-number-link path-open path-link ino-open)
+ (nnmaildir--mkdir numdir)
+ (catch 'return
+ (while t
+ (setq path-open (concat numdir (number-to-string number-open)))
+ (if (not make-new-file)
+ (setq previous-number-link number-link)
+ (nnmaildir--mkfile path-open)
+ ;; If Emacs had O_CREAT|O_EXCL, we could return number-open here.
+ (setq make-new-file nil
+ previous-number-link 0))
+ (let* ((attr (file-attributes path-open))
+ (nlink (nth 1 attr)))
+ (setq ino-open (nth 10 attr)
+ number-link (+ number-open nlink))
+ (if (or (< nlink 1) (< number-link nlink))
+ (signal 'error '("Arithmetic overflow"))))
+ (if (= number-link previous-number-link)
+ ;; We've already tried this number, in the previous loop iteration,
+ ;; and failed.
+ (signal 'error `("Corrupt internal nnmaildir data" ,path-open)))
+ (setq path-link (concat numdir (number-to-string number-link)))
+ (nnmaildir--condcase err
+ (progn
+ (add-name-to-file path-open path-link)
+ (throw 'return number-link))
+ (cond
+ ((nnmaildir--emlink-p err)
+ (setq make-new-file t
+ number-open number-link))
+ ((nnmaildir--eexist-p err)
+ (let ((attr (file-attributes path-link)))
+ (if (/= (nth 10 attr) ino-open)
+ (setq number-open number-link
+ number-link 0))))
+ (t (signal (car err) (cdr err)))))))))
+
+(defun nnmaildir--update-nov (server group article)
(let ((nnheader-file-coding-system 'binary)
- dir gname pgname msgdir prefix suffix file attr mtime novdir novfile
- nov msgid nov-beg nov-mid nov-end field pos extra val deactivate-mark)
+ (srv-dir (nnmaildir--srv-dir server))
+ (storage-version 1) ;; [version article-number msgid [...nov...]]
+ dir gname pgname msgdir prefix suffix file attr mtime novdir novfile
+ nov msgid nov-beg nov-mid nov-end field val old-extra num numdir
+ deactivate-mark)
(catch 'return
- (setq suffix (nnmaildir--art-get-suffix article))
- (if (stringp suffix) nil
- (nnmaildir--art-set-nov article nil)
- (throw 'return nil))
- (setq gname (nnmaildir--grp-get-name group)
- pgname (nnmaildir--grp-get-pname group)
- dir (nnmaildir--srv-grp-dir srv-dir gname)
- msgdir (if (nnmaildir--param pgname 'read-only)
- (nnmaildir--new dir) (nnmaildir--cur dir))
- prefix (nnmaildir--art-get-prefix article)
- file (concat msgdir prefix suffix)
- attr (file-attributes file))
- (if attr nil
- (nnmaildir--art-set-suffix article 'expire)
- (nnmaildir--art-set-nov article nil)
- (throw 'return nil))
+ (setq gname (nnmaildir--grp-name group)
+ pgname (nnmaildir--pgname server gname)
+ dir (nnmaildir--srvgrp-dir srv-dir gname)
+ msgdir (if (nnmaildir--param pgname 'read-only)
+ (nnmaildir--new dir) (nnmaildir--cur dir))
+ prefix (nnmaildir--art-prefix article)
+ suffix (nnmaildir--art-suffix article)
+ file (concat msgdir prefix suffix)
+ attr (file-attributes file))
+ (unless attr
+ (nnmaildir--expired-article group article)
+ (throw 'return nil))
(setq mtime (nth 5 attr)
- attr (nth 7 attr)
- nov (nnmaildir--art-get-nov article)
- novdir (concat (nnmaildir--nndir dir) "nov")
- novdir (file-name-as-directory novdir)
- novfile (concat novdir prefix))
- (save-excursion
- (set-buffer (get-buffer-create " *nnmaildir nov*"))
- (when (file-exists-p novfile)
- (and nov
- (equal mtime (nnmaildir--nov-get-mtime nov))
- (throw 'return nov))
- (erase-buffer)
- (nnheader-insert-file-contents novfile)
- (setq nov (read (current-buffer)))
- (nnmaildir--art-set-msgid article (car nov))
- (setq nov (cadr nov))
- (and (equal mtime (nnmaildir--nov-get-mtime nov))
- (throw 'return nov)))
- (erase-buffer)
- (nnheader-insert-file-contents file)
- (insert "\n")
- (goto-char (point-min))
- (save-restriction
- (if (search-forward "\n\n" nil 'noerror)
- (progn
- (setq nov-mid (count-lines (point) (point-max)))
- (narrow-to-region (point-min) (1- (point))))
- (setq nov-mid 0))
- (goto-char (point-min))
- (delete-char 1)
- (nnheader-fold-continuation-lines)
- (setq nov (nnheader-parse-head 'naked)
- field (or (mail-header-lines nov) 0)))
- (if (or (zerop field) (nnmaildir--param pgname 'distrust-Lines:)) nil
- (setq nov-mid field))
- (setq nov-mid (number-to-string nov-mid)
- nov-mid (concat (number-to-string attr) "\t" nov-mid)
- field (or (mail-header-references nov) "")
- pos 0)
- (save-match-data
- (while (string-match "\t" field pos)
- (aset field (match-beginning 0) ? )
- (setq pos (match-end 0)))
- (setq nov-mid (concat field "\t" nov-mid)
- extra (mail-header-extra nov)
- nov-end "")
- (while extra
- (setq field (car extra) extra (cdr extra)
- val (cdr field) field (symbol-name (car field))
- pos 0)
- (while (string-match "\t" field pos)
- (aset field (match-beginning 0) ? )
- (setq pos (match-end 0)))
- (setq pos 0)
- (while (string-match "\t" val pos)
- (aset val (match-beginning 0) ? )
- (setq pos (match-end 0)))
- (setq nov-end (concat nov-end "\t" field ": " val)))
- (setq nov-end (if (zerop (length nov-end)) "" (substring nov-end 1))
- field (or (mail-header-subject nov) "")
- pos 0)
- (while (string-match "\t" field pos)
- (aset field (match-beginning 0) ? )
- (setq pos (match-end 0)))
- (setq nov-beg field
- field (or (mail-header-from nov) "")
- pos 0)
- (while (string-match "\t" field pos)
- (aset field (match-beginning 0) ? )
- (setq pos (match-end 0)))
- (setq nov-beg (concat nov-beg "\t" field)
- field (or (mail-header-date nov) "")
- pos 0)
- (while (string-match "\t" field pos)
- (aset field (match-beginning 0) ? )
- (setq pos (match-end 0)))
- (setq nov-beg (concat nov-beg "\t" field)
- field (mail-header-id nov)
- pos 0)
- (while (string-match "\t" field pos)
- (aset field (match-beginning 0) ? )
- (setq pos (match-end 0)))
- (setq msgid field))
- (if (or (null msgid) (nnheader-fake-message-id-p msgid))
- (setq msgid (concat "<" prefix "@nnmaildir>")))
- (erase-buffer)
- (setq nov (nnmaildir--nov-new))
- (nnmaildir--nov-set-beg nov nov-beg)
- (nnmaildir--nov-set-mid nov nov-mid)
- (nnmaildir--nov-set-end nov nov-end)
- (nnmaildir--nov-set-mtime nov mtime)
- (prin1 (list msgid nov) (current-buffer))
- (setq file (concat novdir ":"))
- (nnmaildir--unlink file)
- (write-region (point-min) (point-max) file nil 'no-message))
+ attr (nth 7 attr)
+ nov (nnmaildir--art-nov article)
+ dir (nnmaildir--nndir dir)
+ novdir (nnmaildir--nov-dir dir)
+ novfile (concat novdir prefix))
+ (unless (equal nnmaildir--extra nnmail-extra-headers)
+ (setq nnmaildir--extra (copy-sequence nnmail-extra-headers)))
+ (nnmaildir--with-nov-buffer
+ ;; First we'll check for already-parsed NOV data.
+ (cond ((not (file-exists-p novfile))
+ ;; The NOV file doesn't exist; we have to parse the message.
+ (setq nov nil))
+ ((not nov)
+ ;; The file exists, but the data isn't in memory; read the file.
+ (erase-buffer)
+ (nnheader-insert-file-contents novfile)
+
projects / gnus / blobdiff