aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/net/tramp-archive.el44
-rw-r--r--lisp/net/tramp-cmds.el3
-rw-r--r--test/lisp/net/tramp-archive-tests.el49
3 files changed, 57 insertions, 39 deletions
diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el
index ac1c4e1448d..5f28756d753 100644
--- a/lisp/net/tramp-archive.el
+++ b/lisp/net/tramp-archive.el
@@ -116,8 +116,9 @@
116;; would load Tramp. So we make a cheaper check. 116;; would load Tramp. So we make a cheaper check.
117;;;###autoload 117;;;###autoload
118(defvar tramp-archive-enabled (featurep 'dbusbind) 118(defvar tramp-archive-enabled (featurep 'dbusbind)
119 "Non-nil when GVFS is available.") 119 "Non-nil when file archive support is available.")
120 120
121;; After loading tramp-gvfs.el, we know it better.
121(setq tramp-archive-enabled tramp-gvfs-enabled) 122(setq tramp-archive-enabled tramp-gvfs-enabled)
122 123
123;; <https://github.com/libarchive/libarchive/wiki/LibarchiveFormats> 124;; <https://github.com/libarchive/libarchive/wiki/LibarchiveFormats>
@@ -175,6 +176,9 @@ It must be supported by libarchive(3).")
175 "\\)" ;; \1 176 "\\)" ;; \1
176 "\\(" "/" ".*" "\\)" "\\'"))) ;; \2 177 "\\(" "/" ".*" "\\)" "\\'"))) ;; \2
177 178
179;; In older Emacsen (prior 27.1), `tramp-archive-autoload-file-name-regexp'
180;; is not autoloaded. So we cannot expect it to be known in
181;; tramp-loaddefs.el. But it exists, when tramp-archive.el is loaded.
178;;;###tramp-autoload 182;;;###tramp-autoload
179(defconst tramp-archive-file-name-regexp 183(defconst tramp-archive-file-name-regexp
180 (ignore-errors (tramp-archive-autoload-file-name-regexp)) 184 (ignore-errors (tramp-archive-autoload-file-name-regexp))
@@ -266,7 +270,7 @@ It must be supported by libarchive(3).")
266 (vc-registered . ignore) 270 (vc-registered . ignore)
267 (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime) 271 (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
268 (write-region . tramp-archive-handle-not-implemented)) 272 (write-region . tramp-archive-handle-not-implemented))
269 "Alist of handler functions for GVFS archive method. 273 "Alist of handler functions for file archive method.
270Operations not mentioned here will be handled by the default Emacs primitives.") 274Operations not mentioned here will be handled by the default Emacs primitives.")
271 275
272(defsubst tramp-archive-file-name-for-operation (operation &rest args) 276(defsubst tramp-archive-file-name-for-operation (operation &rest args)
@@ -288,7 +292,7 @@ pass to the OPERATION."
288 292
289;;;###tramp-autoload 293;;;###tramp-autoload
290(defun tramp-archive-file-name-handler (operation &rest args) 294(defun tramp-archive-file-name-handler (operation &rest args)
291 "Invoke the GVFS archive related OPERATION. 295 "Invoke the file archive related OPERATION.
292First arg specifies the OPERATION, second arg is a list of arguments to 296First arg specifies the OPERATION, second arg is a list of arguments to
293pass to the OPERATION." 297pass to the OPERATION."
294 (let* ((filename (apply 'tramp-archive-file-name-for-operation 298 (let* ((filename (apply 'tramp-archive-file-name-for-operation
@@ -323,8 +327,16 @@ pass to the OPERATION."
323 (put 'tramp-archive-file-name-handler 'safe-magic t)))) 327 (put 'tramp-archive-file-name-handler 'safe-magic t))))
324 328
325;;;###autoload 329;;;###autoload
326(add-hook 'after-init-hook 'tramp-register-archive-file-name-handler) 330(progn
327 331 (add-hook 'after-init-hook 'tramp-register-archive-file-name-handler)
332 (add-hook
333 'tramp-archive-unload-hook
334 (lambda ()
335 (remove-hook
336 'after-init-hook 'tramp-register-archive-file-name-handler))))
337
338;; In older Emacsen (prior 27.1), the autoload above does not exist.
339;; So we call it again; it doesn't hurt.
328(tramp-register-archive-file-name-handler) 340(tramp-register-archive-file-name-handler)
329 341
330;; Mark `operations' the handler is responsible for. 342;; Mark `operations' the handler is responsible for.
@@ -343,12 +355,6 @@ pass to the OPERATION."
343 (remove-hook 355 (remove-hook
344 'url-handler-mode-hook 'tramp-register-file-name-handlers))))) 356 'url-handler-mode-hook 'tramp-register-file-name-handlers)))))
345 357
346;; Debug.
347;(trace-function-background 'tramp-archive-file-name-handler)
348;(trace-function-background 'tramp-gvfs-file-name-handler)
349;(trace-function-background 'tramp-file-name-archive)
350;(trace-function-background 'tramp-archive-dissect-file-name)
351
352 358
353;; File name conversions. 359;; File name conversions.
354 360
@@ -374,6 +380,10 @@ The hash key is the archive name. The value is a cons of the
374used `tramp-file-name' structure for tramp-gvfs, and the file 380used `tramp-file-name' structure for tramp-gvfs, and the file
375name of a local copy, if any.") 381name of a local copy, if any.")
376 382
383(defsubst tramp-archive-gvfs-host (archive)
384 "Return host name of ARCHIVE as used in GVFS for mounting"
385 (url-hexify-string (tramp-gvfs-url-file-name archive)))
386
377(defun tramp-archive-dissect-file-name (name) 387(defun tramp-archive-dissect-file-name (name)
378 "Return a `tramp-file-name' structure. 388 "Return a `tramp-file-name' structure.
379The structure consists of the `tramp-archive-method' method, the 389The structure consists of the `tramp-archive-method' method, the
@@ -397,8 +407,7 @@ name is kept in slot `hop'"
397 (let ((archive 407 (let ((archive
398 (tramp-make-tramp-file-name 408 (tramp-make-tramp-file-name
399 (tramp-archive-dissect-file-name archive) nil 'noarchive))) 409 (tramp-archive-dissect-file-name archive) nil 'noarchive)))
400 (setf (tramp-file-name-host vec) 410 (setf (tramp-file-name-host vec) (tramp-archive-gvfs-host archive)))
401 (url-hexify-string (tramp-gvfs-url-file-name archive))))
402 (puthash archive (list vec) tramp-archive-hash)) 411 (puthash archive (list vec) tramp-archive-hash))
403 412
404 ;; http://... 413 ;; http://...
@@ -411,15 +420,13 @@ name is kept in slot `hop'"
411 (url-type (url-generic-parse-url archive)) 420 (url-type (url-generic-parse-url archive))
412 url-tramp-protocols)) 421 url-tramp-protocols))
413 (archive (url-tramp-convert-url-to-tramp archive))) 422 (archive (url-tramp-convert-url-to-tramp archive)))
414 (setf (tramp-file-name-host vec) 423 (setf (tramp-file-name-host vec) (tramp-archive-gvfs-host archive)))
415 (url-hexify-string (tramp-gvfs-url-file-name archive))))
416 (puthash archive (list vec) tramp-archive-hash)) 424 (puthash archive (list vec) tramp-archive-hash))
417 425
418 ;; GVFS supported schemes. 426 ;; GVFS supported schemes.
419 ((or (tramp-gvfs-file-name-p archive) 427 ((or (tramp-gvfs-file-name-p archive)
420 (not (file-remote-p archive))) 428 (not (file-remote-p archive)))
421 (setf (tramp-file-name-host vec) 429 (setf (tramp-file-name-host vec) (tramp-archive-gvfs-host archive))
422 (url-hexify-string (tramp-gvfs-url-file-name archive)))
423 (puthash archive (list vec) tramp-archive-hash)) 430 (puthash archive (list vec) tramp-archive-hash))
424 431
425 ;; Anything else. Here we call `file-local-copy', which we 432 ;; Anything else. Here we call `file-local-copy', which we
@@ -428,8 +435,7 @@ name is kept in slot `hop'"
428 (inhibit-file-name-handlers 435 (inhibit-file-name-handlers
429 (cons 'jka-compr-handler inhibit-file-name-handlers)) 436 (cons 'jka-compr-handler inhibit-file-name-handlers))
430 (copy (file-local-copy archive))) 437 (copy (file-local-copy archive)))
431 (setf (tramp-file-name-host vec) 438 (setf (tramp-file-name-host vec) (tramp-archive-gvfs-host copy))
432 (url-hexify-string (tramp-gvfs-url-file-name copy)))
433 (puthash archive (cons vec copy) tramp-archive-hash)))) 439 (puthash archive (cons vec copy) tramp-archive-hash))))
434 440
435 ;; So far, `vec' handles just the mount point. Add `localname', 441 ;; So far, `vec' handles just the mount point. Add `localname',
diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el
index ab3768a91f4..cbb9cd37005 100644
--- a/lisp/net/tramp-cmds.el
+++ b/lisp/net/tramp-cmds.el
@@ -144,7 +144,8 @@ This includes password cache, file cache, connection cache, buffers."
144 (clrhash tramp-cache-data) 144 (clrhash tramp-cache-data)
145 145
146 ;; Cleanup local copies of archives. 146 ;; Cleanup local copies of archives.
147 (tramp-archive-cleanup-hash) 147 (when (bound-and-true-p tramp-archive-enabled)
148 (tramp-archive-cleanup-hash))
148 149
149 ;; Remove buffers. 150 ;; Remove buffers.
150 (dolist (name (tramp-list-tramp-buffers)) 151 (dolist (name (tramp-list-tramp-buffers))
diff --git a/test/lisp/net/tramp-archive-tests.el b/test/lisp/net/tramp-archive-tests.el
index e4ae1217002..33916f82dac 100644
--- a/test/lisp/net/tramp-archive-tests.el
+++ b/test/lisp/net/tramp-archive-tests.el
@@ -808,21 +808,29 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
808 ;; Autoloading tramp-archive works since Emacs 27.1. 808 ;; Autoloading tramp-archive works since Emacs 27.1.
809 (skip-unless (tramp-archive--test-emacs27-p)) 809 (skip-unless (tramp-archive--test-emacs27-p))
810 810
811 ;; tramp-archive is neither loaded at Emacs startup, nor when
812 ;; loading a file like "/ssh::" (which loads Tramp).
811 (let ((default-directory (expand-file-name temporary-file-directory)) 813 (let ((default-directory (expand-file-name temporary-file-directory))
812 (code 814 (code
815 "(progn \
816 (message \"tramp-archive loaded: %%s %%s\" \
817 (featurep 'tramp) (featurep 'tramp-archive)) \
818 (file-attributes %S \"/\") \
819 (message \"tramp-archive loaded: %%s %%s\" \
820 (featurep 'tramp) (featurep 'tramp-archive)))"))
821 (dolist (file `("/ssh::foo" ,(concat tramp-archive-test-archive "foo")))
822 (should
823 (string-match
824 (format
825 "tramp-archive loaded: nil nil[[:ascii:]]+tramp-archive loaded: t %s"
826 (tramp-archive-file-name-p file))
827 (shell-command-to-string
813 (format 828 (format
814 "(message \"Tramp loaded: %%s\" (and (file-exists-p %S) t))" 829 "%s -batch -Q -L %s --eval %s"
815 tramp-archive-test-archive))) 830 (shell-quote-argument
816 (should 831 (expand-file-name invocation-name invocation-directory))
817 (string-match 832 (mapconcat 'shell-quote-argument load-path " -L ")
818 "Tramp loaded: t[\n\r]+" 833 (shell-quote-argument (format code file)))))))))
819 (shell-command-to-string
820 (format
821 "%s -batch -Q -L %s --eval %s"
822 (shell-quote-argument
823 (expand-file-name invocation-name invocation-directory))
824 (mapconcat 'shell-quote-argument load-path " -L ")
825 (shell-quote-argument code)))))))
826 834
827(ert-deftest tramp-archive-test42-delay-load () 835(ert-deftest tramp-archive-test42-delay-load ()
828 "Check that `tramp-archive' is loaded lazily, only when needed." 836 "Check that `tramp-archive' is loaded lazily, only when needed."
@@ -836,18 +844,21 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
836 (let ((default-directory (expand-file-name temporary-file-directory)) 844 (let ((default-directory (expand-file-name temporary-file-directory))
837 (code 845 (code
838 "(progn \ 846 "(progn \
839 (setq tramp-archive-enabled %s) \ 847 (setq tramp-archive-enabled %s) \
840 (message \"Tramp loaded: %%s\" (featurep 'tramp-archive)) \ 848 (message \"tramp-archive loaded: %%s\" \
841 (find-file %S \"/\") \ 849 (featurep 'tramp-archive)) \
842 (message \"Tramp loaded: %%s\" (featurep 'tramp-archive)) \ 850 (file-attributes %S \"/\") \
843 (file-attributes %S \"/\") \ 851 (message \"tramp-archive loaded: %%s\" \
844 (message \"Tramp loaded: %%s\" (featurep 'tramp-archive)))")) 852 (featurep 'tramp-archive)) \
853 (file-attributes %S \"/\") \
854 (message \"tramp-archive loaded: %%s\" \
855 (featurep 'tramp-archive)))"))
845 ;; tramp-archive doesn't load when `tramp-archive-enabled' is nil. 856 ;; tramp-archive doesn't load when `tramp-archive-enabled' is nil.
846 (dolist (tae '(t nil)) 857 (dolist (tae '(t nil))
847 (should 858 (should
848 (string-match 859 (string-match
849 (format 860 (format
850 "Tramp loaded: nil[[:ascii:]]+Tramp loaded: nil[[:ascii:]]+Tramp loaded: %s" 861 "tramp-archive loaded: nil[[:ascii:]]+tramp-archive loaded: nil[[:ascii:]]+tramp-archive loaded: %s"
851 tae) 862 tae)
852 (shell-command-to-string 863 (shell-command-to-string
853 (format 864 (format