From 15b8681c0c8db555b20d70b2a47cef996ff1cebf Mon Sep 17 00:00:00 2001 Message-ID: <15b8681c0c8db555b20d70b2a47cef996ff1cebf.1735030672.git.yantar92@posteo.net> From: Ihor Radchenko Date: Tue, 24 Dec 2024 09:45:42 +0100 Subject: [PATCH] org-persist: Fix mixing cace data from multiple Emacs processes * lisp/org-persist.el (org-persist--write-elisp-file): When there is a clash with other Emacs process while writing cache data, discard the cache to avoid any problem. (org-persist-write): Return nil when any kind of error occurs when writing. (org-persist--refresh-gc-lock): (org-persist--gc-orphan-p): Bail out when writing fails. Reported-by: Paul Stansell Link: https://orgmode.org/list/YT3PR01MB95943D4DB2E659091A2BDE8DBE2E2@YT3PR01MB9594.CANPRD01.PROD.OUTLOOK.COM --- lisp/org-persist.el | 26 ++++++++++++++------------ 1 file changed, 14 insertions(+), 12 deletions(-) diff --git a/lisp/org-persist.el b/lisp/org-persist.el index 886d227c0a..788714fb15 100644 --- a/lisp/org-persist.el +++ b/lisp/org-persist.el @@ -478,11 +478,12 @@ (defun org-persist--write-elisp-file (file data &optional no-circular pp) (start-time (float-time))) (unless (file-exists-p (file-name-directory file)) (make-directory (file-name-directory file) t)) - ;; Force writing even when the file happens to be opened by - ;; another Emacs process. + ;; Discard cache when there is a clash with other Emacs process. + ;; This way, we make sure that cache is never mixing data & record + ;; from different processes. (cl-letf (((symbol-function #'ask-user-about-lock) - ;; FIXME: Emacs 27 does not yet have `always'. - (lambda (&rest _) t))) + (lambda (&rest _) + (error "Other Emacs process is writing to cache")))) (with-temp-file file (insert ";; -*- mode: lisp-data; -*-\n") (if pp @@ -1120,12 +1121,13 @@ (defun org-persist-write (container &optional associated ignore-return) (seq-find (lambda (v) (run-hook-with-args-until-success 'org-persist-before-write-hook v associated)) (plist-get collection :container))) - (when (or (file-exists-p org-persist-directory) (org-persist--save-index)) - (let ((file (org-file-name-concat org-persist-directory (plist-get collection :persist-file))) - (data (mapcar (lambda (c) (cons c (org-persist-write:generic c collection))) - (plist-get collection :container)))) - (org-persist--write-elisp-file file data) - (or ignore-return (org-persist-read container associated))))))) + (ignore-errors + (when (or (file-exists-p org-persist-directory) (org-persist--save-index)) + (let ((file (org-file-name-concat org-persist-directory (plist-get collection :persist-file))) + (data (mapcar (lambda (c) (cons c (org-persist-write:generic c collection))) + (plist-get collection :container)))) + (org-persist--write-elisp-file file data) + (or ignore-return (org-persist-read container associated)))))))) (defun org-persist-write-all (&optional associated) "Save all the persistent data. @@ -1226,7 +1228,7 @@ (defun org-persist--refresh-gc-lock () (when (< (- (float-time (cdr record)) (float-time (current-time))) org-persist-gc-lock-expiry) (push record new-alist))) - (org-persist--write-elisp-file file new-alist))) + (ignore-errors (org-persist--write-elisp-file file new-alist)))) (defun org-persist--gc-orphan-p () "Return non-nil, when orphan files should be garbage-collected. @@ -1234,7 +1236,7 @@ (defun org-persist--gc-orphan-p () (let* ((file (org-file-name-concat org-persist-directory org-persist-gc-lock-file)) (alist (when (file-exists-p file) (org-persist--read-elisp-file file)))) (setq alist (org-assoc-delete-all before-init-time alist)) - (org-persist--write-elisp-file file alist) + (ignore-errors (org-persist--write-elisp-file file alist)) ;; Only GC orphan files when there are no active sessions. (not alist))) -- 2.47.1