[Emacs-diffs] master a2cb52c: Prevent loading tramp-archive when it cannot be used

[Michael Albinus]

branch: master
commit a2cb52cd2e7c497df51d751b91b331f59f9637e7
Author: Michael Albinus <address@hidden>
Commit: Michael Albinus <address@hidden>

    Prevent loading tramp-archive when it cannot be used
    
    * lisp/files.el (locate-dominating-file): Check, that FILE is
    a directory when traversing the tree.
    
    * lisp/net/tramp-archive.el (tramp-archive-enabled): New defvar.
    (tramp-archive-file-name-regexp): Protect against errors.
    (tramp-archive-file-name-handler)
    (tramp-register-archive-file-name-handler): Use it.
    (all) Call `tramp-register-archive-file-name-handler'.
    
    * lisp/net/tramp.el (tramp-register-file-name-handlers):
    Use `tramp-archive-enabled'.
    
    * test/lisp/net/tramp-archive-tests.el (all):
    Use `tramp-archive-enabled' instead of `tramp-gvfs-enabled'.
    (tramp-archive--test-emacs27-p): New defun.
    (tramp-archive-test42-auto-load): Skip for older Emacsen.
    (tramp-archive-test42-delay-load): Skip for older Emacsen.
    Test also behavior when `tramp-archive-enabled' is nil.
---
 lisp/files.el                        |   3 +-
 lisp/net/tramp-archive.el            |  23 +++++---
 lisp/net/tramp.el                    |   9 ++--
 test/lisp/net/tramp-archive-tests.el | 102 ++++++++++++++++++++---------------
 4 files changed, 82 insertions(+), 55 deletions(-)

diff --git a/lisp/files.el b/lisp/files.el
index e884a3a..414eb3f 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -963,7 +963,8 @@ the function needs to examine, starting with FILE."
                     (null file)
                     (string-match locate-dominating-stop-dir-regexp file)))
       (setq try (if (stringp name)
-                    (file-exists-p (expand-file-name name file))
+                    (and (file-directory-p file)
+                         (file-exists-p (expand-file-name name file)))
                   (funcall name file)))
       (cond (try (setq root file))
             ((equal file (setq file (file-name-directory
diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el
index 23191f1..ac1c4e1 100644
--- a/lisp/net/tramp-archive.el
+++ b/lisp/net/tramp-archive.el
@@ -112,6 +112,14 @@
 (defvar url-handler-regexp)
 (defvar url-tramp-protocols)
 
+;; We cannot check `tramp-gvfs-enabled' in loaddefs.el, because this
+;; would load Tramp. So we make a cheaper check.
+;;;###autoload
+(defvar tramp-archive-enabled (featurep 'dbusbind)
+  "Non-nil when GVFS is available.")
+
+(setq tramp-archive-enabled tramp-gvfs-enabled)
+
 ;; <https://github.com/libarchive/libarchive/wiki/LibarchiveFormats>
 ;;;###autoload
 (defconst tramp-archive-suffixes
@@ -169,7 +177,7 @@ It must be supported by libarchive(3).")
 
 ;;;###tramp-autoload
 (defconst tramp-archive-file-name-regexp
-  (tramp-archive-autoload-file-name-regexp)
+  (ignore-errors (tramp-archive-autoload-file-name-regexp))
   "Regular expression matching archive file names.")
 
 ;;;###tramp-autoload
@@ -291,7 +299,7 @@ pass to the OPERATION."
             (tramp-archive-run-real-handler 'file-directory-p (list archive)))
        (tramp-archive-run-real-handler operation args)
       ;; Now run the handler.
-      (unless tramp-gvfs-enabled
+      (unless tramp-archive-enabled
        (tramp-compat-user-error nil "Package `tramp-archive' not supported"))
       (let ((tramp-methods (cons `(,tramp-archive-method) tramp-methods))
            (tramp-gvfs-methods tramp-archive-all-gvfs-methods)
@@ -308,14 +316,17 @@ pass to the OPERATION."
 ;;;###autoload
 (progn (defun tramp-register-archive-file-name-handler ()
   "Add archive file name handler to `file-name-handler-alist'."
-  (add-to-list 'file-name-handler-alist
-              (cons (tramp-archive-autoload-file-name-regexp)
-                    'tramp-autoload-file-name-handler))
-  (put 'tramp-archive-file-name-handler 'safe-magic t)))
+  (when tramp-archive-enabled
+    (add-to-list 'file-name-handler-alist
+                (cons (tramp-archive-autoload-file-name-regexp)
+                      'tramp-autoload-file-name-handler))
+    (put 'tramp-archive-file-name-handler 'safe-magic t))))
 
 ;;;###autoload
 (add-hook 'after-init-hook 'tramp-register-archive-file-name-handler)
 
+(tramp-register-archive-file-name-handler)
+
 ;; Mark `operations' the handler is responsible for.
 (put 'tramp-archive-file-name-handler 'operations
      (mapcar 'car tramp-archive-file-name-handler-alist))
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 5a2e358..09abd48 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -2401,10 +2401,11 @@ remote file names."
   (put 'tramp-completion-file-name-handler 'operations
        (mapcar 'car tramp-completion-file-name-handler-alist))
 
-  (add-to-list 'file-name-handler-alist
-              (cons tramp-archive-file-name-regexp
-                    'tramp-archive-file-name-handler))
-  (put 'tramp-archive-file-name-handler 'safe-magic t)
+  (when (bound-and-true-p tramp-archive-enabled)
+    (add-to-list 'file-name-handler-alist
+                (cons tramp-archive-file-name-regexp
+                      'tramp-archive-file-name-handler))
+    (put 'tramp-archive-file-name-handler 'safe-magic t))
 
   ;; If jka-compr or epa-file are already loaded, move them to the
   ;; front of `file-name-handler-alist'.
diff --git a/test/lisp/net/tramp-archive-tests.el 
b/test/lisp/net/tramp-archive-tests.el
index bebdf10..e4ae121 100644
--- a/test/lisp/net/tramp-archive-tests.el
+++ b/test/lisp/net/tramp-archive-tests.el
@@ -86,12 +86,18 @@ Some semantics has been changed for there, w/o new 
functions or
 variables, so we check the Emacs version directly."
   (>= emacs-major-version 26))
 
+(defun tramp-archive--test-emacs27-p ()
+  "Check for Emacs version >= 27.1.
+Some semantics has been changed for there, w/o new functions or
+variables, so we check the Emacs version directly."
+  (>= emacs-major-version 27))
+
 (ert-deftest tramp-archive-test00-availability ()
-  "Test availability of Tramp functions."
-  :expected-result (if tramp-gvfs-enabled :passed :failed)
+  "Test availability of archive file name functions."
+  :expected-result (if tramp-archive-enabled :passed :failed)
   (should
    (and
-    tramp-gvfs-enabled
+    tramp-archive-enabled
     (file-exists-p tramp-archive-test-file-archive)
     (tramp-archive-file-name-p tramp-archive-test-archive))))
 
@@ -147,7 +153,7 @@ variables, so we check the Emacs version directly."
 
 (ert-deftest tramp-archive-test02-file-name-dissect ()
   "Check archive file name components."
-  (skip-unless tramp-gvfs-enabled)
+  (skip-unless tramp-archive-enabled)
 
   (with-parsed-tramp-archive-file-name tramp-archive-test-archive nil
     (should (string-equal method tramp-archive-method))
@@ -266,7 +272,7 @@ They shall still be supported"
   "Check `directory-file-name'.
 This checks also `file-name-as-directory', `file-name-directory',
 `file-name-nondirectory' and `unhandled-file-name-directory'."
-  (skip-unless tramp-gvfs-enabled)
+  (skip-unless tramp-archive-enabled)
 
   (should
    (string-equal
@@ -305,7 +311,7 @@ This checks also `file-name-as-directory', 
`file-name-directory',
 
 (ert-deftest tramp-archive-test07-file-exists-p ()
   "Check `file-exist-p', `write-region' and `delete-file'."
-  (skip-unless tramp-gvfs-enabled)
+  (skip-unless tramp-archive-enabled)
 
   (unwind-protect
       (let ((default-directory tramp-archive-test-archive))
@@ -327,7 +333,7 @@ This checks also `file-name-as-directory', 
`file-name-directory',
 
 (ert-deftest tramp-archive-test08-file-local-copy ()
   "Check `file-local-copy'."
-  (skip-unless tramp-gvfs-enabled)
+  (skip-unless tramp-archive-enabled)
 
   (let (tmp-name)
     (unwind-protect
@@ -353,7 +359,7 @@ This checks also `file-name-as-directory', 
`file-name-directory',
 
 (ert-deftest tramp-archive-test09-insert-file-contents ()
   "Check `insert-file-contents'."
-  (skip-unless tramp-gvfs-enabled)
+  (skip-unless tramp-archive-enabled)
 
   (let ((tmp-name (expand-file-name "bar/bar" tramp-archive-test-archive)))
     (unwind-protect
@@ -379,7 +385,7 @@ This checks also `file-name-as-directory', 
`file-name-directory',
 
 (ert-deftest tramp-archive-test11-copy-file ()
   "Check `copy-file'."
-  (skip-unless tramp-gvfs-enabled)
+  (skip-unless tramp-archive-enabled)
 
   ;; Copy simple file.
   (let ((tmp-name1 (expand-file-name "bar/bar" tramp-archive-test-archive))
@@ -444,7 +450,7 @@ This checks also `file-name-as-directory', 
`file-name-directory',
 
 (ert-deftest tramp-archive-test15-copy-directory ()
   "Check `copy-directory'."
-  (skip-unless tramp-gvfs-enabled)
+  (skip-unless tramp-archive-enabled)
 
   (let* ((tmp-name1 (expand-file-name "bar" tramp-archive-test-archive))
         (tmp-name2 (tramp-archive--test-make-temp-name))
@@ -498,7 +504,7 @@ This checks also `file-name-as-directory', 
`file-name-directory',
 
 (ert-deftest tramp-archive-test16-directory-files ()
   "Check `directory-files'."
-  (skip-unless tramp-gvfs-enabled)
+  (skip-unless tramp-archive-enabled)
 
   (let ((tmp-name tramp-archive-test-archive)
        (files '("." ".." "bar"  "baz.tar" "foo.hrd" "foo.lnk" "foo.txt")))
@@ -521,7 +527,7 @@ This checks also `file-name-as-directory', 
`file-name-directory',
 
 (ert-deftest tramp-archive-test17-insert-directory ()
   "Check `insert-directory'."
-  (skip-unless tramp-gvfs-enabled)
+  (skip-unless tramp-archive-enabled)
 
   (let (;; We test for the summary line.  Keyword "total" could be localized.
        (process-environment
@@ -563,7 +569,7 @@ This checks also `file-name-as-directory', 
`file-name-directory',
 (ert-deftest tramp-archive-test18-file-attributes ()
   "Check `file-attributes'.
 This tests also `file-readable-p' and `file-regular-p'."
-  (skip-unless tramp-gvfs-enabled)
+  (skip-unless tramp-archive-enabled)
 
   (let ((tmp-name1 (expand-file-name "foo.txt" tramp-archive-test-archive))
        (tmp-name2 (expand-file-name "foo.lnk" tramp-archive-test-archive))
@@ -613,7 +619,7 @@ This tests also `file-readable-p' and `file-regular-p'."
 
 (ert-deftest tramp-archive-test19-directory-files-and-attributes ()
   "Check `directory-files-and-attributes'."
-  (skip-unless tramp-gvfs-enabled)
+  (skip-unless tramp-archive-enabled)
 
   (let ((tmp-name (expand-file-name "bar" tramp-archive-test-archive))
        attr)
@@ -638,7 +644,7 @@ This tests also `file-readable-p' and `file-regular-p'."
 (ert-deftest tramp-archive-test20-file-modes ()
   "Check `file-modes'.
 This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
-  (skip-unless tramp-gvfs-enabled)
+  (skip-unless tramp-archive-enabled)
 
   (let ((tmp-name1 (expand-file-name "foo.txt" tramp-archive-test-archive))
        (tmp-name2 (expand-file-name "bar" tramp-archive-test-archive)))
@@ -667,7 +673,7 @@ This tests also `file-executable-p', `file-writable-p' and 
`set-file-modes'."
 
 (ert-deftest tramp-archive-test21-file-links ()
   "Check `file-symlink-p' and `file-truename'"
-  (skip-unless tramp-gvfs-enabled)
+  (skip-unless tramp-archive-enabled)
 
   ;; We must use `file-truename' for the file archive, because it
   ;; could be located on a symlinked directory.  This would let the
@@ -705,7 +711,7 @@ This tests also `file-executable-p', `file-writable-p' and 
`set-file-modes'."
 
 (ert-deftest tramp-archive-test26-file-name-completion ()
   "Check `file-name-completion' and `file-name-all-completions'."
-  (skip-unless tramp-gvfs-enabled)
+  (skip-unless tramp-archive-enabled)
 
   (let ((tmp-name tramp-archive-test-archive))
     (unwind-protect
@@ -744,7 +750,7 @@ This tests also `file-executable-p', `file-writable-p' and 
`set-file-modes'."
 ;; The functions were introduced in Emacs 26.1.
 (ert-deftest tramp-archive-test37-make-nearby-temp-file ()
   "Check `make-nearby-temp-file' and `temporary-file-directory'."
-  (skip-unless tramp-gvfs-enabled)
+  (skip-unless tramp-archive-enabled)
   ;; Since Emacs 26.1.
   (skip-unless
    (and (fboundp 'make-nearby-temp-file) (fboundp 'temporary-file-directory)))
@@ -781,7 +787,7 @@ This tests also `file-executable-p', `file-writable-p' and 
`set-file-modes'."
 
 (ert-deftest tramp-archive-test40-file-system-info ()
   "Check that `file-system-info' returns proper values."
-  (skip-unless tramp-gvfs-enabled)
+  (skip-unless tramp-archive-enabled)
   ;; Since Emacs 27.1.
   (skip-unless (fboundp 'file-system-info))
 
@@ -798,7 +804,9 @@ This tests also `file-executable-p', `file-writable-p' and 
`set-file-modes'."
 
 (ert-deftest tramp-archive-test42-auto-load ()
   "Check that `tramp-archive' autoloads properly."
-  (skip-unless tramp-gvfs-enabled)
+  (skip-unless tramp-archive-enabled)
+  ;; Autoloading tramp-archive works since Emacs 27.1.
+  (skip-unless (tramp-archive--test-emacs27-p))
 
   (let ((default-directory (expand-file-name temporary-file-directory))
        (code
@@ -818,38 +826,44 @@ This tests also `file-executable-p', `file-writable-p' 
and `set-file-modes'."
 
 (ert-deftest tramp-archive-test42-delay-load ()
   "Check that `tramp-archive' is loaded lazily, only when needed."
-  (skip-unless tramp-gvfs-enabled)
+  (skip-unless tramp-archive-enabled)
+  ;; Autoloading tramp-archive works since Emacs 27.1.
+  (skip-unless (tramp-archive--test-emacs27-p))
 
-  ;; Tramp is neither loaded at Emacs startup, nor when completing a
-  ;; non archive file name like "/foo".  Completing an archive file
-  ;; name like "/foo.tar/" autoloads Tramp, when `tramp-mode' is t.
+  ;; tramp-archive is neither loaded at Emacs startup, nor when
+  ;; loading a file like "/foo.tar".  It is loaded only when
+  ;; `tramp-archive-enabled' is t.
   (let ((default-directory (expand-file-name temporary-file-directory))
        (code
+        "(progn \
+          (setq tramp-archive-enabled %s) \
+         (message \"Tramp loaded: %%s\" (featurep 'tramp-archive)) \
+         (find-file %S \"/\") \
+         (message \"Tramp loaded: %%s\" (featurep 'tramp-archive)) \
+         (file-attributes %S \"/\") \
+         (message \"Tramp loaded: %%s\" (featurep 'tramp-archive)))"))
+    ;; tramp-archive doesn't load when `tramp-archive-enabled' is nil.
+    (dolist (tae '(t nil))
+      (should
+       (string-match
+       (format
+    "Tramp loaded: nil[[:ascii:]]+Tramp loaded: nil[[:ascii:]]+Tramp loaded: 
%s"
+        tae)
+        (shell-command-to-string
          (format
-         "(progn \
-           (message \"Tramp loaded: %%s\" (featurep 'tramp-archive)) \
-           (file-name-all-completions %S \"/\") \
-           (message \"Tramp loaded: %%s\" (featurep 'tramp-archive)) \
-           (file-name-all-completions %S \"/\") \
-           (message \"Tramp loaded: %%s\" (featurep 'tramp-archive)))"
-         tramp-archive-test-file-archive
-         tramp-archive-test-archive)))
-    ;; Tramp doesn't load when `tramp-mode' is nil.
-    (should
-     (string-match
-      "Tramp loaded: nil[\n\r]+Tramp loaded: nil[\n\r]+Tramp loaded: t[\n\r]+"
-      (shell-command-to-string
-       (format
-       "%s -batch -Q -L %s --eval %s"
-       (shell-quote-argument
-        (expand-file-name invocation-name invocation-directory))
-       (mapconcat 'shell-quote-argument load-path " -L ")
-       (shell-quote-argument code)))))))
+         "%s -batch -Q -L %s --eval %s"
+         (shell-quote-argument
+          (expand-file-name invocation-name invocation-directory))
+         (mapconcat 'shell-quote-argument load-path " -L ")
+         (shell-quote-argument
+           (format
+            code tae tramp-archive-test-file-archive
+            (concat tramp-archive-test-archive "foo"))))))))))
 
 (ert-deftest tramp-archive-test99-libarchive-tests ()
   "Run tests of libarchive test files."
   :tags '(:expensive-test)
-  (skip-unless tramp-gvfs-enabled)
+  (skip-unless tramp-archive-enabled)
   ;; We do not want to run unless chosen explicitly.  This test makes
   ;; sense only in my local environment.  Michael Albinus.
   (skip-unless