cgit.sxemacs.org Git - gnus/blob - lisp/nnmaildir.el

   1 ;;; nnmaildir.el --- maildir backend for Gnus
   2
   3 ;; This file is in the public domain.
   4
   5 ;; Author: Paul Jarc <prj@po.cwru.edu>
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software: you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation, either version 3 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 ;;; Commentary:
  23
  24 ;; Maildir format is documented at <URL:http://cr.yp.to/proto/maildir.html>
  25 ;; and in the maildir(5) man page from qmail (available at
  26 ;; <URL:http://www.qmail.org/man/man5/maildir.html>).  nnmaildir also stores
  27 ;; extra information in the .nnmaildir/ directory within a maildir.
  28 ;;
  29 ;; Some goals of nnmaildir:
  30 ;; * Everything Just Works, and correctly.  E.g., NOV data is automatically
  31 ;;   regenerated when stale; no need for manually running
  32 ;;   *-generate-nov-databases.
  33 ;; * Perfect reliability: [C-g] will never corrupt its data in memory, and
  34 ;;   SIGKILL will never corrupt its data in the filesystem.
  35 ;; * Allow concurrent operation as much as possible.  If files change out
  36 ;;   from under us, adapt to the changes or degrade gracefully.
  37 ;; * We use the filesystem as a database, so that, e.g., it's easy to
  38 ;;   manipulate marks from outside Gnus.
  39 ;; * All information about a group is stored in the maildir, for easy backup,
  40 ;;   copying, restoring, etc.
  41 ;;
  42 ;; Todo:
  43 ;; * When moving an article for expiry, copy all the marks except 'expire
  44 ;;   from the original article.
  45 ;; * Add a hook for when moving messages from new/ to cur/, to support
  46 ;;   nnmail's duplicate detection.
  47 ;; * Improve generated Xrefs, so crossposts are detectable.
  48 ;; * Improve code readability.
  49
  50 ;;; Code:
  51
  52 ;; eval this before editing
  53 [(progn
  54    (put 'nnmaildir--with-nntp-buffer 'lisp-indent-function 0)
  55    (put 'nnmaildir--with-work-buffer 'lisp-indent-function 0)
  56    (put 'nnmaildir--with-nov-buffer  'lisp-indent-function 0)
  57    (put 'nnmaildir--with-move-buffer 'lisp-indent-function 0)
  58    (put 'nnmaildir--condcase         'lisp-indent-function 2)
  59    )
  60 ]
  61
  62 ;; For Emacs < 22.2.
  63 (eval-and-compile
  64   (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
  65
  66 (eval-and-compile
  67   (require 'nnheader)
  68   (require 'gnus)
  69   (require 'gnus-util)
  70   (require 'gnus-range)
  71   (require 'gnus-start)
  72   (require 'gnus-int)
  73   (require 'message))
  74 (eval-when-compile
  75   (require 'cl)
  76   (require 'nnmail))
  77
  78 (defconst nnmaildir-version "Gnus")
  79
  80 (defvar nnmaildir-article-file-name nil
  81   "*The filename of the most recently requested article.  This variable is set
  82 by nnmaildir-request-article.")
  83
  84 ;; The filename of the article being moved/copied:
  85 (defvar nnmaildir--file nil)
  86
  87 ;; Variables to generate filenames of messages being delivered:
  88 (defvar   nnmaildir--delivery-time "")
  89 (defconst nnmaildir--delivery-pid (concat "P" (number-to-string (emacs-pid))))
  90 (defvar   nnmaildir--delivery-count nil)
  91
  92 ;; An obarry containing symbols whose names are server names and whose values
  93 ;; are servers:
  94 (defvar nnmaildir--servers (make-vector 3 0))
  95 ;; The current server:
  96 (defvar nnmaildir--cur-server nil)
  97
  98 ;; A copy of nnmail-extra-headers
  99 (defvar nnmaildir--extra nil)
 100
 101 ;; A NOV structure looks like this (must be prin1-able, so no defstruct):
 102 ["subject\tfrom\tdate"
 103  "references\tchars\lines"
 104  "To: you\tIn-Reply-To: <your.mess@ge>"
 105  (12345 67890)     ;; modtime of the corresponding article file
 106  (to in-reply-to)] ;; contemporary value of nnmail-extra-headers
 107 (defconst nnmaildir--novlen 5)
 108 (defmacro nnmaildir--nov-new (beg mid end mtime extra)
 109   `(vector ,beg ,mid ,end ,mtime ,extra))
 110 (defmacro nnmaildir--nov-get-beg   (nov) `(aref ,nov 0))
 111 (defmacro nnmaildir--nov-get-mid   (nov) `(aref ,nov 1))
 112 (defmacro nnmaildir--nov-get-end   (nov) `(aref ,nov 2))
 113 (defmacro nnmaildir--nov-get-mtime (nov) `(aref ,nov 3))
 114 (defmacro nnmaildir--nov-get-extra (nov) `(aref ,nov 4))
 115 (defmacro nnmaildir--nov-set-beg   (nov value) `(aset ,nov 0 ,value))
 116 (defmacro nnmaildir--nov-set-mid   (nov value) `(aset ,nov 1 ,value))
 117 (defmacro nnmaildir--nov-set-end   (nov value) `(aset ,nov 2 ,value))
 118 (defmacro nnmaildir--nov-set-mtime (nov value) `(aset ,nov 3 ,value))
 119 (defmacro nnmaildir--nov-set-extra (nov value) `(aset ,nov 4 ,value))
 120
 121 (defstruct nnmaildir--art
 122   (prefix nil :type string)  ;; "time.pid.host"
 123   (suffix nil :type string)  ;; ":2,flags"
 124   (num    nil :type natnum)  ;; article number
 125   (msgid  nil :type string)  ;; "<mess.age@id>"
 126   (nov    nil :type vector)) ;; cached nov structure, or nil
 127
 128 (defstruct nnmaildir--grp
 129   (name  nil :type string)  ;; "group.name"
 130   (new   nil :type list)    ;; new/ modtime
 131   (cur   nil :type list)    ;; cur/ modtime
 132   (min   1   :type natnum)  ;; minimum article number
 133   (count 0   :type natnum)  ;; count of articles
 134   (nlist nil :type list)    ;; list of articles, ordered descending by number
 135   (flist nil :type vector)  ;; obarray mapping filename prefix->article
 136   (mlist nil :type vector)  ;; obarray mapping message-id->article
 137   (cache nil :type vector)  ;; nov cache
 138   (index nil :type natnum)  ;; index of next cache entry to replace
 139   (mmth  nil :type vector)) ;; obarray mapping mark name->dir modtime
 140                                         ; ("Mark Mod Time Hash")
 141
 142 (defstruct nnmaildir--srv
 143   (address       nil :type string)         ;; server address string
 144   (method        nil :type list)           ;; (nnmaildir "address" ...)
 145   (prefix        nil :type string)         ;; "nnmaildir+address:"
 146   (dir           nil :type string)         ;; "/expanded/path/to/server/dir/"
 147   (ls            nil :type function)       ;; directory-files function
 148   (groups        nil :type vector)         ;; obarray mapping group name->group
 149   (curgrp        nil :type nnmaildir--grp) ;; current group, or nil
 150   (error         nil :type string)         ;; last error message, or nil
 151   (mtime         nil :type list)           ;; modtime of dir
 152   (gnm           nil)                      ;; flag: split from mail-sources?
 153   (target-prefix nil :type string))        ;; symlink target prefix
 154
 155 (defun nnmaildir--expired-article (group article)
 156   (setf (nnmaildir--art-nov article) nil)
 157   (let ((flist  (nnmaildir--grp-flist group))
 158         (mlist  (nnmaildir--grp-mlist group))
 159         (min    (nnmaildir--grp-min   group))
 160         (count  (1- (nnmaildir--grp-count group)))
 161         (prefix (nnmaildir--art-prefix article))
 162         (msgid  (nnmaildir--art-msgid  article))
 163         (new-nlist nil)
 164         (nlist-pre '(nil . nil))
 165         nlist-post num)
 166     (unless (zerop count)
 167       (setq nlist-post (nnmaildir--grp-nlist group)
 168             num (nnmaildir--art-num article))
 169       (if (eq num (caar nlist-post))
 170           (setq new-nlist (cdr nlist-post))
 171         (setq new-nlist nlist-post
 172               nlist-pre nlist-post
 173               nlist-post (cdr nlist-post))
 174 &nbs