From fe83afc300716a9a6fe5f8f76883a37468aa92aa Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Thu, 21 Mar 2024 12:04:53 +0300 Subject: [PATCH] org-persist: Do not demand write access to existing directories * lisp/org-persist.el (org-persist--check-write-access): New function checking write access to creating a directory and all the necessary parents. The function is a refactoring of duplicated code that previously checked one parent beyond what needs to be created. (org-persist-write:index): Use the new function. Create `org-persist-directory' together with all its parents. Gracefully handle failure. * lisp/org-persist.el: Use the new function when adding hooks to `kill-emacs-hook'. Reported-by: Al Oomens Link: https://list.orgmode.org/MW4PR19MB6888F37194BA260AE5631770C4332@MW4PR19MB6888.namprd19.prod.outlook.com --- lisp/org-persist.el | 52 +++++++++++++++++++++++---------------------- 1 file changed, 27 insertions(+), 25 deletions(-) diff --git a/lisp/org-persist.el b/lisp/org-persist.el index 9acf35bd4..2c7510f16 100644 --- a/lisp/org-persist.el +++ b/lisp/org-persist.el @@ -689,22 +689,31 @@ COLLECTION is the plist holding data collection." path))) (format "%s-%s.%s" persist-file (md5 path) ext))))) +(defun org-persist--check-write-access (path) + "Check write access to all missing directories in PATH. +Show message and return nil if there is no write access. +Otherwise, return t." + (let* ((dir (directory-file-name (file-name-as-directory path))) + (prev dir)) + (while (and (not (file-exists-p dir)) + (setq prev dir) + (not (equal dir (setq dir (directory-file-name + (file-name-directory dir))))))) + (if (file-writable-p prev) t ; return t + (message "org-persist: Missing write access rights to: %S" prev) + ;; return nil + nil))) + (defun org-persist-write:index (container _) "Write index CONTAINER." (org-persist--get-collection container) (unless (file-exists-p org-persist-directory) - (make-directory org-persist-directory)) - (unless (file-exists-p org-persist-directory) - (warn "Failed to create org-persist storage in %s." - org-persist-directory) - (let ((dir (directory-file-name - (file-name-as-directory org-persist-directory)))) - (while (and (not (file-exists-p dir)) - (not (equal dir (setq dir (directory-file-name - (file-name-directory dir))))))) - (unless (file-writable-p dir) - (message "Missing write access rights to org-persist-directory: %S" - org-persist-directory)))) + (condition-case nil + (make-directory org-persist-directory 'parent) + (t + (warn "Failed to create org-persist storage in %s." + org-persist-directory) + (org-persist--check-write-access org-persist-directory)))) (when (file-exists-p org-persist-directory) (org-persist--write-elisp-file (org-file-name-concat org-persist-directory org-persist-index-file) @@ -1010,19 +1019,12 @@ such scenario." (make-temp-file "org-persist-" 'dir))) ;; Automatically write the data, but only when we have write access. -(let ((dir (directory-file-name - (file-name-as-directory org-persist-directory)))) - (while (and (not (file-exists-p dir)) - (not (equal dir (setq dir (directory-file-name - (file-name-directory dir))))))) - (if (not (file-writable-p dir)) - (message "Missing write access rights to org-persist-directory: %S" - org-persist-directory) - (add-hook 'kill-emacs-hook #'org-persist-clear-storage-maybe) ; Run last. - (add-hook 'kill-emacs-hook #'org-persist-write-all) - ;; `org-persist-gc' should run before `org-persist-write-all'. - ;; So we are adding the hook after `org-persist-write-all'. - (add-hook 'kill-emacs-hook #'org-persist-gc))) +(when (org-persist--check-write-access org-persist-directory) + (add-hook 'kill-emacs-hook #'org-persist-clear-storage-maybe) ; Run last. + (add-hook 'kill-emacs-hook #'org-persist-write-all) + ;; `org-persist-gc' should run before `org-persist-write-all'. + ;; So we are adding the hook after `org-persist-write-all'. + (add-hook 'kill-emacs-hook #'org-persist-gc)) (add-hook 'after-init-hook #'org-persist-load-all)