diff options
| -rw-r--r-- | lisp/net/tramp-archive.el | 44 | ||||
| -rw-r--r-- | lisp/net/tramp-cmds.el | 3 | ||||
| -rw-r--r-- | test/lisp/net/tramp-archive-tests.el | 49 |
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. |
| 270 | Operations not mentioned here will be handled by the default Emacs primitives.") | 274 | Operations 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. |
| 292 | First arg specifies the OPERATION, second arg is a list of arguments to | 296 | First arg specifies the OPERATION, second arg is a list of arguments to |
| 293 | pass to the OPERATION." | 297 | pass 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 | |||
| 374 | used `tramp-file-name' structure for tramp-gvfs, and the file | 380 | used `tramp-file-name' structure for tramp-gvfs, and the file |
| 375 | name of a local copy, if any.") | 381 | name 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. |
| 379 | The structure consists of the `tramp-archive-method' method, the | 389 | The 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 |