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:
parent
f7c8a12b12
commit
a2cb52cd2e
4 changed files with 82 additions and 55 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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'.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue