1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-30 20:32:00 -08:00

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.
This commit is contained in:
Michael Albinus 2018-02-03 18:49:56 +01:00
parent f7c8a12b12
commit a2cb52cd2e
4 changed files with 82 additions and 55 deletions

View file

@ -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

View file

@ -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))

View file

@ -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'.

View file

@ -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