X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fnnmaildir.el;h=2a8f8850a9ff50be17b2dcb3f070170cd66d9751;hb=f27470d2732440c068c86d5043b5ffaebc5be7f1;hp=5391192446703c62dcea3cad61a2aba8e479a220;hpb=a0424edc209c3ddb4e8abcfbdabd5897ac1cc5b2;p=gnus diff --git a/lisp/nnmaildir.el b/lisp/nnmaildir.el index 539119244..2a8f8850a 100644 --- a/lisp/nnmaildir.el +++ b/lisp/nnmaildir.el @@ -17,8 +17,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: @@ -41,6 +41,8 @@ ;; copying, restoring, etc. ;; ;; Todo: +;; * 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. @@ -54,6 +56,7 @@ (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) ) ] @@ -229,7 +232,6 @@ by nnmaildir-request-article.") (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--num-file (dir) `(concat ,dir ":")) (defmacro nnmaildir--unlink (file-arg) `(let ((file ,file-arg)) @@ -237,20 +239,36 @@ by nnmaildir-request-article.") (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) - (if (zerop (nnmaildir--grp-count group)) 0 - (let ((x (nnmaildir--srvgrp-dir (nnmaildir--srv-dir server) - (nnmaildir--grp-name group)))) - (setq x (nnmaildir--nndir x) - x (nnmaildir--num-dir x) - x (nnmaildir--num-file x) - x (file-attributes x)) - (if x (1- (nth 1 x)) 0)))) + (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 @@ -287,6 +305,64 @@ by nnmaildir-request-article.") (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) (srv-dir (nnmaildir--srv-dir server)) @@ -398,30 +474,7 @@ by nnmaildir-request-article.") nnmaildir--extra) num (nnmaildir--art-num article)) (unless num - ;; Allocate a new article number. - (erase-buffer) - (setq numdir (nnmaildir--num-dir dir) - file (nnmaildir--num-file numdir) - num -1) - (nnmaildir--mkdir numdir) - (write-region "" nil file nil 'no-message) - (while file - ;; Get the number of links to file. - (setq attr (nth 1 (file-attributes file))) - (if (= attr num) - ;; We've already tried this number, in the previous loop - ;; iteration, and failed. - (signal 'error `("Corrupt internal nnmaildir data" ,numdir))) - ;; If attr is 123, try to link file to "123". This atomically - ;; increases the link count and creates the "123" link, failing - ;; if that link was already created by another Gnus, just after - ;; we stat()ed file. - (condition-case nil - (progn - (add-name-to-file file (concat numdir (format "%x" attr))) - (setq file nil)) ;; Stop looping. - (file-already-exists nil)) - (setq num attr)) + (setq num (nnmaildir--new-number dir)) (setf (nnmaildir--art-num article) num)) ;; Store this new NOV data in a file (erase-buffer) @@ -682,8 +735,7 @@ by nnmaildir-request-article.") group (make-nnmaildir--grp :name gname :index 0)) (nnmaildir--mkdir nndir) (nnmaildir--mkdir (nnmaildir--nov-dir nndir)) - (nnmaildir--mkdir (nnmaildir--marks-dir nndir)) - (write-region "" nil (concat nndir "markfile") nil 'no-message)) + (nnmaildir--mkdir (nnmaildir--marks-dir nndir))) (setq read-only (nnmaildir--param pgname 'read-only) ls (or (nnmaildir--param pgname 'directory-files) srv-ls)) (unless read-only @@ -978,7 +1030,7 @@ by nnmaildir-request-article.") (throw 'return nil)) (when (save-match-data (string-match "[\0/\t]" gname)) (setf (nnmaildir--srv-error nnmaildir--cur-server) - (concat "Illegal characters (null, tab, or /) in group name: " + (concat "Invalid characters (null, tab, or /) in group name: " gname)) (throw 'return nil)) (setq groups (nnmaildir--srv-groups nnmaildir--cur-server)) @@ -1023,7 +1075,7 @@ by nnmaildir-request-article.") (throw 'return nil)) (when (save-match-data (string-match "[\0/\t]" new-name)) (setf (nnmaildir--srv-error nnmaildir--cur-server) - (concat "Illegal characters (null, tab, or /) in group name: " + (concat "Invalid characters (null, tab, or /) in group name: " new-name)) (throw 'return nil)) (if (string-equal gname new-name) (throw 'return t)) @@ -1253,7 +1305,7 @@ by nnmaildir-request-article.") t))) (defun nnmaildir-request-move-article (article gname server accept-form - &optional last) + &optional last move-is-internal) (let ((group (nnmaildir--prepare server gname)) pgname suffix result nnmaildir--file deactivate-mark) (catch 'return @@ -1338,13 +1390,12 @@ by nnmaildir-request-article.") nnmaildir--cur-server) "24-hour timer expired") (throw 'return nil)))) - (condition-case nil - (add-name-to-file nnmaildir--file tmpfile) + (condition-case nil (add-name-to-file nnmaildir--file tmpfile) (error (write-region (point-min) (point-max) tmpfile nil 'no-message nil 'excl) (unix-sync))) ;; no fsync :( - (cancel-timer 24h) + (nnheader-cancel-timer 24h) (condition-case err (add-name-to-file tmpfile curfile) (error @@ -1469,7 +1520,12 @@ by nnmaildir-request-article.") (not (string-equal target pgname))) ;; Move it. (erase-buffer) (nnheader-insert-file-contents nnmaildir--file) - (gnus-request-accept-article target nil nil 'no-encode)) + (let ((group-art (gnus-request-accept-article + target nil nil 'no-encode))) + (when (consp group-art) + ;; Maybe also copy: dormant forward reply save tick + ;; (gnus-add-mark? gnus-request-set-mark?) + (gnus-group-mark-article-read target (cdr group-art))))) (if (equal target pgname) ;; Leave it here. (setq didnt (cons (nnmaildir--art-num article) didnt)) @@ -1483,8 +1539,8 @@ by nnmaildir-request-article.") (coding-system-for-write nnheader-file-coding-system) (buffer-file-coding-system nil) (file-coding-system-alist nil) - del-mark del-action add-action set-action marksdir markfile nlist - ranges begin end article all-marks todo-marks did-marks mdir mfile + del-mark del-action add-action set-action marksdir nlist + ranges begin end article all-marks todo-marks mdir mfile pgname ls permarkfile deactivate-mark) (setq del-mark (lambda (mark) @@ -1499,17 +1555,19 @@ by nnmaildir-request-article.") (setq mdir (nnmaildir--subdir marksdir (symbol-name mark)) permarkfile (concat mdir ":") mfile (concat mdir (nnmaildir--art-prefix article))) - (unless (memq mark did-marks) - (setq did-marks (cons mark did-marks)) - (nnmaildir--mkdir mdir) - (unless (file-attributes permarkfile) - (condition-case nil - (add-name-to-file markfile permarkfile) - (file-error - ;; AFS can't make hard links in separate directories - (write-region "" nil permarkfile nil 'no-message))))) - (unless (file-exists-p mfile) - (add-name-to-file permarkfile mfile))) + (nnmaildir--condcase err (add-name-to-file permarkfile mfile) + (cond + ((nnmaildir--eexist-p err)) + ((nnmaildir--enoent-p err) + (nnmaildir--mkdir mdir) + (nnmaildir--mkfile permarkfile) + (add-name-to-file permarkfile mfile)) + ((nnmaildir--emlink-p err) + (let ((permarkfilenew (concat permarkfile "{new}"))) + (nnmaildir--mkfile permarkfilenew) + (rename-file permarkfilenew permarkfile 'replace) + (add-name-to-file permarkfile mfile))) + (t (signal (car err) (cdr err)))))) todo-marks)) set-action (lambda (article) (funcall add-action) @@ -1529,7 +1587,6 @@ by nnmaildir-request-article.") marksdir (nnmaildir--srv-dir nnmaildir--cur-server) marksdir (nnmaildir--srvgrp-dir marksdir gname) marksdir (nnmaildir--nndir marksdir) - markfile (concat marksdir "markfile") marksdir (nnmaildir--marks-dir marksdir) gname (nnmaildir--grp-name group) pgname (nnmaildir--pgname nnmaildir--cur-server gname) @@ -1623,4 +1680,5 @@ by nnmaildir-request-article.") ;; fill-column: 77 ;; End: +;;; arch-tag: 0c4e44cd-dfde-4040-888e-5597ec771849 ;;; nnmaildir.el ends here