From 7c21dfc771d2a2f44870c80f34001c835690a77d Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Tue, 13 Feb 2018 14:06:56 +0100 Subject: [PATCH] ox-publish: Follow symlink directories * lisp/org-compat.el (directory-files-recursively): Remove compatibility function, no longer needed. * lisp/ox-publish.el (org-publish--expand-file-name): (org-publish-org-to): (org-publish-collect-index): (org-publish--store-crossrefs): (org-publish-resolve-external-link): Preserve symlinks in file name. (org-publish-get-base-files): Follow symlink directories. (org-publish-get-project-from-filename): Preserve symlinks in file name. Do not use `file-in-directory-p', which ignores symlinks. Reported-by: Michel Damiens --- lisp/org-compat.el | 31 -------------------- lisp/ox-publish.el | 54 +++++++++++++++++++++++------------ testing/examples/pub-symlink/link.org | 2 ++ testing/examples/pub/link | 1 + testing/lisp/test-ox-publish.el | 17 +++++++++-- 5 files changed, 54 insertions(+), 51 deletions(-) create mode 100644 testing/examples/pub-symlink/link.org create mode 120000 testing/examples/pub/link diff --git a/lisp/org-compat.el b/lisp/org-compat.el index 1a3cff6a3..1fd408de9 100644 --- a/lisp/org-compat.el +++ b/lisp/org-compat.el @@ -72,37 +72,6 @@ (and (memq system-type '(windows-nt ms-dos)) (= lastc ?\\)))))) -(unless (fboundp 'directory-files-recursively) - (defun directory-files-recursively (dir regexp &optional include-directories) - "Return list of all files under DIR that have file names matching REGEXP. -This function works recursively. Files are returned in \"depth first\" -order, and files from each directory are sorted in alphabetical order. -Each file name appears in the returned list in its absolute form. -Optional argument INCLUDE-DIRECTORIES non-nil means also include in the -output directories whose names match REGEXP." - (let ((result nil) - (files nil) - ;; When DIR is "/", remote file names like "/method:" could - ;; also be offered. We shall suppress them. - (tramp-mode (and tramp-mode (file-remote-p (expand-file-name dir))))) - (dolist (file (sort (file-name-all-completions "" dir) - 'string<)) - (unless (member file '("./" "../")) - (if (directory-name-p file) - (let* ((leaf (substring file 0 (1- (length file)))) - (full-file (expand-file-name leaf dir))) - ;; Don't follow symlinks to other directories. - (unless (file-symlink-p full-file) - (setq result - (nconc result (directory-files-recursively - full-file regexp include-directories)))) - (when (and include-directories - (string-match regexp leaf)) - (setq result (nconc result (list full-file))))) - (when (string-match regexp file) - (push (expand-file-name file dir) files))))) - (nconc result (nreverse files))))) - ;;; Obsolete aliases (remove them after the next major release). diff --git a/lisp/ox-publish.el b/lisp/ox-publish.el index 99e65288b..4a8296056 100644 --- a/lisp/ox-publish.el +++ b/lisp/ox-publish.el @@ -405,11 +405,9 @@ definition." (defun org-publish--expand-file-name (file project) "Return full file name for FILE in PROJECT. When FILE is a relative file name, it is expanded according to -project base directory. Always return the true name of the file, -ignoring symlinks." - (file-truename - (if (file-name-absolute-p file) file - (expand-file-name file (org-publish-property :base-directory project))))) +project base directory." + (if (file-name-absolute-p file) file + (expand-file-name file (org-publish-property :base-directory project)))) (defun org-publish-expand-projects (projects-alist) "Expand projects in PROJECTS-ALIST. @@ -436,10 +434,32 @@ This splices all the components into the list." (match (if (eq extension 'any) "" (format "^[^\\.].*\\.\\(%s\\)$" extension))) (base-files - (cl-remove-if #'file-directory-p - (if (org-publish-property :recursive project) - (directory-files-recursively base-dir match) - (directory-files base-dir t match t))))) + (cond ((not (file-exists-p base-dir)) nil) + ((not (org-publish-property :recursive project)) + (cl-remove-if #'file-directory-p + (directory-files base-dir t match t))) + (t + ;; Find all files recursively. Unlike to + ;; `directory-files-recursively', we follow symlinks + ;; to other directories. + (letrec ((files nil) + (walk-tree + (lambda (dir depth) + (when (> depth 100) + (error "Apparent cycle of symbolic links for %S" + base-dir)) + (dolist (f (file-name-all-completions "" dir)) + (pcase f + ((or "./" "../") nil) + ((pred directory-name-p) + (funcall walk-tree + (expand-file-name f dir) + (1+ depth))) + ((pred (string-match match)) + (push (expand-file-name f dir) files)) + (_ nil))) + files))) + (funcall walk-tree base-dir 0)))))) (org-uniquify (append ;; Files from BASE-DIR. Apply exclusion filter before adding @@ -468,13 +488,13 @@ This splices all the components into the list." "Return a project that FILENAME belongs to. When UP is non-nil, return a meta-project (i.e., with a :components part) publishing FILENAME." - (let* ((filename (file-truename filename)) + (let* ((filename (expand-file-name filename)) (project (cl-some (lambda (p) ;; Ignore meta-projects. (unless (org-publish-property :components p) - (let ((base (file-truename + (let ((base (expand-file-name (org-publish-property :base-directory p)))) (cond ;; Check if FILENAME is explicitly included in one @@ -499,9 +519,7 @@ publishing FILENAME." ;; Check if FILENAME belong to project's base ;; directory, or some of its sub-directories ;; if :recursive in non-nil. - ((org-publish-property :recursive p) - (and (file-in-directory-p filename base) p)) - ((file-equal-p base (file-name-directory filename)) p) + ((member filename (org-publish-get-base-files p)) p) (t nil))))) org-publish-project-alist))) (cond @@ -557,7 +575,7 @@ Return output file name." `(:crossrefs ,(org-publish-cache-get-file-property ;; Normalize file names in cache. - (file-truename filename) :crossrefs nil t) + (expand-file-name filename) :crossrefs nil t) :filter-final-output (org-publish--store-crossrefs org-publish-collect-index @@ -1007,7 +1025,7 @@ PARENT is a reference to the headline, if any, containing the original index keyword. When non-nil, this reference is a cons cell. Its CAR is a symbol among `id', `custom-id' and `name' and its CDR is a string." - (let ((file (file-truename (plist-get info :input-file)))) + (let ((file (expand-file-name (plist-get info :input-file)))) (org-publish-cache-set-file-property file :index (delete-dups @@ -1116,7 +1134,7 @@ a plist. This function is meant to be used as a final output filter. See `org-publish-org-to'." (org-publish-cache-set-file-property - (file-truename (plist-get info :input-file)) + (expand-file-name (plist-get info :input-file)) :crossrefs ;; Update `:crossrefs' so as to remove unused references and search ;; cells. Actually used references are extracted from @@ -1147,7 +1165,7 @@ references with `org-export-get-reference'." search file) "MissingReference") - (let* ((filename (file-truename file)) + (let* ((filename (expand-file-name file)) (crossrefs (org-publish-cache-get-file-property filename :crossrefs nil t)) (cells diff --git a/testing/examples/pub-symlink/link.org b/testing/examples/pub-symlink/link.org new file mode 100644 index 000000000..9fded34da --- /dev/null +++ b/testing/examples/pub-symlink/link.org @@ -0,0 +1,2 @@ +# Time-stamp: <2018-02-13 10:12:03 ngz> +symlink diff --git a/testing/examples/pub/link b/testing/examples/pub/link new file mode 120000 index 000000000..663715b59 --- /dev/null +++ b/testing/examples/pub/link @@ -0,0 +1 @@ +/home/ngz/dev/org-mode/testing/examples/pub-symlink \ No newline at end of file diff --git a/testing/lisp/test-ox-publish.el b/testing/lisp/test-ox-publish.el index 55fa43124..efe64a405 100644 --- a/testing/lisp/test-ox-publish.el +++ b/testing/lisp/test-ox-publish.el @@ -352,7 +352,8 @@ Unless set otherwise in PROPERTIES, `:base-directory' is set to (file (expand-file-name "a.org" base)) (org-publish-project-alist `(("p1" :base-directory "/other/") - ("p2" :base-directory ,base)))) + ("p2" :base-directory ,base) + ("p3" :base-directory ,base)))) (car (org-publish-get-project-from-filename file))))) ;; When :recursive in non-nil, allow files in sub-directories. (should @@ -367,6 +368,19 @@ Unless set otherwise in PROPERTIES, `:base-directory' is set to (org-publish-project-alist `(("p" :base-directory ,base :recursive nil)))) (org-publish-get-project-from-filename file))) + ;; Also, when :recursive is non-nil, follow symlinks to directories. + (should + (let* ((base (expand-file-name "examples/pub/" org-test-dir)) + (file (expand-file-name "link/link.org" base)) + (org-publish-project-alist + `(("p" :base-directory ,base :recursive t)))) + (org-publish-get-project-from-filename file))) + (should-not + (let* ((base (expand-file-name "examples/pub/" org-test-dir)) + (file (expand-file-name "link/link.org" base)) + (org-publish-project-alist + `(("p" :base-directory ,base :recursive nil)))) + (org-publish-get-project-from-filename file))) ;; Check :base-extension. (should (let* ((base (expand-file-name "examples/pub/" org-test-dir)) @@ -401,7 +415,6 @@ Unless set otherwise in PROPERTIES, `:base-directory' is set to (org-publish-project-alist `(("p" :base-directory ,base :recursive t :base-extension any)))) (org-publish-get-base-files (org-publish-get-project-from-filename file)))) - ;; Check :exclude property. (should-not (let* ((base (expand-file-name "examples/pub/" org-test-dir)) -- 2.11.4.GIT