diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 21f12a38e0b..7fbd4f898f5 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -169,6 +169,7 @@ How file names, directories and localnames are mangled and managed * Localname deconstruction:: Breaking a localname into its components. * External packages:: Integration with external Lisp packages. * Extension packages:: Adding new methods to @value{tramp}. +* New operations:: Handling further operations in @value{tramp}. @end detailmenu @end menu @@ -5472,6 +5473,13 @@ Suppress reading the remote history file in @code{shell}. Set Disable excessive traces. Set @code{tramp-verbose} to 3 or lower, default being 3. Increase trace levels temporarily when hunting for bugs. + +@item +Use a package with @value{tramp} specific implementation of high-level +operations. For example, the GNU ELPA package @file{tramp-hlo} +implements specialized versions of @code{dir-locals--all-files}, +@code{locate-dominating-file} and @code{dir-locals-find-file} for +@value{tramp}'s @code{tramp-sh} backend (@pxref{New operations}). @end itemize @@ -6457,6 +6465,7 @@ programs. * Localname deconstruction:: Splitting a localname into its component parts. * External packages:: Integrating with external Lisp packages. * Extension packages:: Adding new methods to @value{tramp}. +* New operations:: Handling further operations in @value{tramp}. @end menu @@ -6721,6 +6730,101 @@ The trick is to wrap the function definition of @code{;;;###autoload} cookie. +@node New operations +@section Handling further operations in @value{tramp} + +By default, @value{tramp} handles the basic operations listed in +@ref{Magic File Names, , Magic File Name Operations, elisp}. +Sometimes, it is desired to support more complex operations directly, +mainly for performance reasons. + +An external package package could add an own implementation of an +operation to @value{tramp}, which avoids the performance overhead +caused by using the basic operations which are aware of remote files. +For example, it could implement this by using an own shell script +which collects the information on the remote host for this very +special purpose with one round-trip per-call. + +@defun tramp-add-external-operation operation function backend +This adds an implementation of @var{operation} to @value{tramp}'s +backend @var{backend}. @var{function} is the new implementation. + +Both @var{operation} and @var{function} shall be function symbols. +They must have the same argument list. The first argument is used to +determine, whether @value{tramp} is invoked (check for remote file +name syntax). It must be a string or nil, in the latter case +@code{default-directory} is used for the check. + +@var{backend}, also a symbol, is the feature name of a @value{tramp} +backend (except @code{tramp-ftp}). The new implementation will be +applied only for this backend. Example: + +@lisp +@group +(defun test-operation (file) + (message "Original implementation for %s" file)) +@end group + +@group +(defun handle-test-operation (file) + (message "Handler implementation for %s" file)) +@end group + +@group +(tramp-add-external-operation + #'test-operation #'handle-test-operation 'tramp-sh) +@end group +@end lisp + +Then we have the different use cases: + +@lisp +@group +;; Local file name. +(test-operation "/a/b") +@result{} "Original implementation for /a/b" +@end group + +@group +;; Remote file name, handled by `tramp-sh'. +(test-operation "/ssh::/a/b") +@result{} "Handler implementation for /ssh::/a/b" +@end group + +@group +;; Remote file name, handled by `tramp-gvfs'. +(test-operation "/sftp::/a/b") +@result{} "Original implementation for /sftp::/a/b" +@end group +@end lisp + +@var{function} is implemented like an ordinary @value{tramp} backend +handler, see the examples in @code{tramp--handle-*} and +@code{tramp-handle-*}. It can expect, that the first argument (or +@code{default-directory}, if that is @code{nil}) has remote file name +syntax. It shall use @value{tramp} internal macros and functions like +@code{with-parsed-tramp-file-name} and the different cache functions. + +If the same @var{function} shall be used for different @value{tramp} +backends, @code{tramp-add-external-operation} must be called for every +backend, respectively. +@end defun + +@defun tramp-remove-external-operation operation backend +The handler for @var{operation}, added by +@code{tramp-add-external-operation}, is removed from @var{backend}. +If there are handlers of @var{operation} for other @var{backend}s, +they are kept. Example: + +@lisp +@group +(tramp-remove-external-operation + #'test-operation 'tramp-sh) +@end group +@end lisp +@end defun + + @node Traces and Profiles @chapter How to Customize Traces @vindex tramp-verbose diff --git a/etc/NEWS b/etc/NEWS index 85fad599048..e4fb833c0be 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1612,6 +1612,15 @@ This feature is experimental. --- *** Implementation of filesystem notifications for connection method "smb". ++++ +*** New functions to extend the set of operations with a remote implementation. +The new functions 'tramp-add-external-operation' and +'tramp-remove-external-operation' allow to add an implementation for +other operations but the defined set of magic file name operations. +This can be used by external ELPA packages for performance optimizations +in special cases. For more information, see "(tramp) New operations" in +the Tramp manual. + ** Diff --- @@ -1836,11 +1845,11 @@ restart Emacs. *** Support of 'electric-layout-mode' added. --- -*** DEL now deletes the text in the active region when point is between indentation. -The command 'python-indent-dedent-line-backspace' (by default bound to -'DEL') now deletes the text in the region and deactivates the mark if -Transient Mark mode is enabled, the mark is active, and prefix argument -is 1. +*** 'DEL' now deletes the text in the active region. +When point is between indentation, the command +'python-indent-dedent-line-backspace' (by default bound to 'DEL') now +deletes the text in the region and deactivates the mark if Transient +Mark mode is enabled, the mark is active, and prefix argument is 1. ** Tmm Menubar @@ -2481,10 +2490,10 @@ Use the byte-compiler instead; it provides more and more useful warnings. --- *** New user option 'newsticker-hide-old-feed-header'. It controls whether to automatically hide the header of feeds whose -items are all old or obsolete in the plainview *newsticker* buffer. +items are all old or obsolete in the plainview "*newsticker*" buffer. This is only visually interesting if the content of those feeds are also hidden (see 'newsticker-hide-old-items-in-newsticker-buffer' and -'newsticker-show-descriptions-of-new-items')." +'newsticker-show-descriptions-of-new-items'). --- *** New commands to hide and show headers of old newsticker feeds. @@ -2496,7 +2505,6 @@ or obsolete. ** CPerl mode *** Syntax of Perl up to version 5.42 is supported. - CPerl mode creates imenu entries for ":writer" generated accessors and recognizes the new functions "all" and "any". See https://perldoc.perl.org/5.42.0/perldelta for details. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 2208ce880d7..f3e9556f797 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2380,6 +2380,9 @@ arguments to pass to the OPERATION." signal-hook-function) (apply operation args))) +(defvar tramp-file-name-for-operation-external nil + "List of operations added by external packages.") + ;; We handle here all file primitives. Most of them have the file ;; name as first parameter; nevertheless we check for them explicitly ;; in order to be signaled if a new primitive appears. This @@ -2387,6 +2390,10 @@ arguments to pass to the OPERATION." ;; syntactical means whether a foreign method must be called. It would ;; ease the life if `file-name-handler-alist' would support a decision ;; function as well but regexp only. +;; Operations added by external packages are kept in +;; `tramp-file-name-for-operation-external'. They expect the file +;; name to be checked as first argument or, if there isn't any +;; argument, `default-directory'. (defun tramp-file-name-for-operation (operation &rest args) "Return file name related to OPERATION file primitive. ARGS are the arguments OPERATION has been called with. @@ -2396,40 +2403,40 @@ first argument of `expand-file-name' is absolute and not remote. Must be handled by the callers." (cond ;; FILE resp DIRECTORY. - ((member operation - '(access-file byte-compiler-base-file-name delete-directory - delete-file diff-latest-backup-file directory-file-name - directory-files directory-files-and-attributes dired-compress-file - dired-uncache file-acl file-accessible-directory-p file-attributes - file-directory-p file-executable-p file-exists-p file-local-copy - file-locked-p file-modes file-name-as-directory - file-name-case-insensitive-p file-name-directory - file-name-nondirectory file-name-sans-versions - file-notify-add-watch file-ownership-preserved-p file-readable-p - file-regular-p file-remote-p file-selinux-context file-symlink-p - file-system-info file-truename file-writable-p - find-backup-file-name get-file-buffer - insert-directory insert-file-contents load lock-file make-directory - make-lock-file-name set-file-acl set-file-modes - set-file-selinux-context set-file-times substitute-in-file-name - unhandled-file-name-directory unlock-file vc-registered - ;; Emacs 28- only. - make-directory-internal - ;; Emacs 29+ only. - abbreviate-file-name - ;; Tramp internal magic file name function. - tramp-set-file-uid-gid)) + ((memq operation + '(access-file byte-compiler-base-file-name delete-directory + delete-file diff-latest-backup-file directory-file-name + directory-files directory-files-and-attributes dired-compress-file + dired-uncache file-acl file-accessible-directory-p file-attributes + file-directory-p file-executable-p file-exists-p file-local-copy + file-locked-p file-modes file-name-as-directory + file-name-case-insensitive-p file-name-directory + file-name-nondirectory file-name-sans-versions + file-notify-add-watch file-ownership-preserved-p file-readable-p + file-regular-p file-remote-p file-selinux-context file-symlink-p + file-system-info file-truename file-writable-p + find-backup-file-name get-file-buffer + insert-directory insert-file-contents load lock-file make-directory + make-lock-file-name set-file-acl set-file-modes + set-file-selinux-context set-file-times substitute-in-file-name + unhandled-file-name-directory unlock-file vc-registered + ;; Emacs 28- only. + make-directory-internal + ;; Emacs 29+ only. + abbreviate-file-name + ;; Tramp internal magic file name function. + tramp-set-file-uid-gid)) (if (file-name-absolute-p (nth 0 args)) (nth 0 args) default-directory)) ;; STRING FILE. ((eq operation 'make-symbolic-link) (nth 1 args)) ;; FILE DIRECTORY resp FILE1 FILE2. - ((member operation - '(add-name-to-file copy-directory copy-file - file-equal-p file-in-directory-p - file-name-all-completions file-name-completion - file-newer-than-file-p rename-file)) + ((memq operation + '(add-name-to-file copy-directory copy-file + file-equal-p file-in-directory-p + file-name-all-completions file-name-completion + file-newer-than-file-p rename-file)) (cond ((tramp-tramp-file-p (nth 0 args)) (nth 0 args)) ((file-name-absolute-p (nth 1 args)) (nth 1 args)) @@ -2446,31 +2453,39 @@ Must be handled by the callers." (nth 2 args) default-directory)) ;; BUFFER. - ((member operation - '(make-auto-save-file-name - set-visited-file-modtime verify-visited-file-modtime)) + ((memq operation + '(make-auto-save-file-name + set-visited-file-modtime verify-visited-file-modtime)) (buffer-file-name (if (bufferp (nth 0 args)) (nth 0 args) (current-buffer)))) ;; COMMAND. - ((member operation - '(exec-path make-nearby-temp-file make-process process-file - shell-command start-file-process temporary-file-directory - ;; Emacs 29+ only. - list-system-processes memory-info process-attributes - ;; Emacs 30+ only. - file-group-gid file-user-uid)) + ((memq operation + '(exec-path make-nearby-temp-file make-process process-file + shell-command start-file-process temporary-file-directory + ;; Emacs 29+ only. + list-system-processes memory-info process-attributes + ;; Emacs 30+ only. + file-group-gid file-user-uid)) default-directory) ;; PROC. - ((member operation '(file-notify-rm-watch file-notify-valid-p)) + ((memq operation '(file-notify-rm-watch file-notify-valid-p)) (when (processp (nth 0 args)) (tramp-get-default-directory (process-buffer (nth 0 args))))) ;; VEC. - ((member operation - '(tramp-get-home-directory tramp-get-remote-gid - tramp-get-remote-groups tramp-get-remote-uid)) + ((memq operation + '(tramp-get-home-directory tramp-get-remote-gid + tramp-get-remote-groups tramp-get-remote-uid)) (tramp-make-tramp-file-name (nth 0 args))) + ;; FILE resp DIRECTORY. + ((and (memq operation tramp-file-name-for-operation-external) + (or (stringp (nth 0 args)) (null (nth 0 args)))) + (if (and (stringp (nth 0 args)) (file-name-absolute-p (nth 0 args))) + (nth 0 args) + default-directory)) ;; Unknown file primitive. - (t (error "Unknown file I/O primitive: %s" operation)))) + (t (unless (member 'remote-file-error debug-ignored-errors) + (tramp-error + nil 'remote-file-error "Unknown file I/O primitive: %s" operation))))) (defun tramp-find-foreign-file-name-handler (vec &optional _operation) "Return foreign file name handler if exists." @@ -2494,6 +2509,63 @@ Must be handled by the callers." res (cdr elt)))) res))) +(defun tramp-add-external-operation (operation function backend) + "Add FUNTION to Tramp BACKEND as handler for OPERATION. +OPERATION must not be one of the magic operations listed in Info +node `(elisp) Magic File Names'. FUNCTION must have the same argument +list as OPERATION. BACKEND, a symbol, must be one of the Tramp backend +packages like `tramp-sh' (except `tramp-ftp')." + (require backend) + (when-let* ((fnha + (intern-soft + (concat (symbol-name backend) "-file-name-handler-alist"))) + ((boundp fnha))) + ;; Make BACKEND aware of the new operation. + (add-to-list fnha (cons operation function)) + (unless (memq operation tramp-file-name-for-operation-external) + ;; Make Tramp aware of the new operation. + (add-to-list 'tramp-file-name-for-operation-external operation) + (put #'tramp-file-name-handler + 'operations + (cons operation (get 'tramp-file-name-handler 'operations))) + ;; Add an advice for OPERATION, in order to invoke the handler FUNCTION. + (advice-add + operation :around + `(lambda (orig-fun &rest args) + (if-let* ((handler + (find-file-name-handler + (or (car args) default-directory) #',operation))) + (apply handler #',operation args) + (apply orig-fun args))) + `((name . ,(concat "tramp-advice-" (symbol-name operation)))))))) + +(defun tramp-remove-external-operation (operation backend) + "Remove OPERATION from Tramp BACKEND as handler for OPERATION. +OPERATION must not be one of the magic operations listed in Info +node `(elisp) Magic File Names'. BACKEND, a symbol, must be one of the +Tramp backend packages like `tramp-sh'." + ;; Remove OPERATION from BACKEND. + (when-let* ((fnha + (intern-soft + (concat (symbol-name backend) "-file-name-handler-alist"))) + ((boundp fnha))) + (setf (alist-get operation (symbol-value fnha) nil 'remove) nil)) + ;; Check, whether OPERATION is still used in any backend. + (unless (seq-some + (lambda (item) + (when-let* + ((fnha (intern-soft (concat (symbol-name (cdr item)) "-alist"))) + ((boundp fnha))) + (alist-get operation (symbol-value fnha)))) + tramp-foreign-file-name-handler-alist) + ;; Make Tramp unaware of OPERATION. + (setq tramp-file-name-for-operation-external + (delq operation tramp-file-name-for-operation-external)) + (put #'tramp-file-name-handler + 'operations (delq operation (get 'tramp-file-name-handler 'operations))) + ;; Remove the advice for OPERATION. + (advice-remove operation (concat "tramp-advice-" (symbol-name operation))))) + ;; Main function. ;;;###autoload (defun tramp-file-name-handler (operation &rest args) diff --git a/test/lisp/net/tramp-archive-tests.el b/test/lisp/net/tramp-archive-tests.el index 5846dafa7d8..0ff0f3ddd4d 100644 --- a/test/lisp/net/tramp-archive-tests.el +++ b/test/lisp/net/tramp-archive-tests.el @@ -856,7 +856,7 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." (should (equal uid (with-no-warnings (file-user-uid)))) (should (equal gid (with-no-warnings (file-group-gid))))))) -(ert-deftest tramp-archive-test48-auto-load () +(ert-deftest tramp-archive-test50-auto-load () "Check that `tramp-archive' autoloads properly." :tags '(:expensive-test) (skip-unless tramp-archive-enabled) @@ -898,7 +898,7 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." (format "(setq tramp-archive-enabled %s)" enabled)) (shell-quote-argument (format code file))))))))))) -(ert-deftest tramp-archive-test48-delay-load () +(ert-deftest tramp-archive-test50-delay-load () "Check that `tramp-archive' is loaded lazily, only when needed." :tags '(:expensive-test) (skip-unless tramp-archive-enabled) @@ -937,7 +937,7 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." code tae tramp-archive-test-file-archive (concat tramp-archive-test-archive "foo")))))))))) -(ert-deftest tramp-archive-test49-without-remote-files () +(ert-deftest tramp-archive-test51-without-remote-files () "Check that Tramp can be suppressed." (skip-unless tramp-archive-enabled) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index d0ce17d2497..42426c76498 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -8474,8 +8474,92 @@ process sentinels. They shall not disturb each other." ;; Cleanup. (ignore-errors (delete-file tmp-name)))))) +(defun tramp--test-operation (&optional _file) + "Test operation." + "Test operation") + +(defun tramp--handler-for-test-operation (&optional _file) + "Test operation handler." + "Test operation handler") + +(ert-deftest tramp-test49-external-backend-function () + "Check that Tramp handles external functions for a given backend." + (skip-unless (tramp--test-enabled)) + (skip-unless (not (tramp--test-ange-ftp-p))) + + (let* ((file-name-handler + (tramp-find-foreign-file-name-handler tramp-test-vec)) + (backend + (intern + (string-remove-suffix + "-file-name-handler" (symbol-name file-name-handler))))) + + ;; There is no backend specific code. + (should-not + (string-equal (tramp--test-operation ert-remote-temporary-file-directory) + (tramp--handler-for-test-operation + ert-remote-temporary-file-directory))) + (should-not + (string-equal (tramp--test-operation temporary-file-directory) + (tramp--handler-for-test-operation + temporary-file-directory))) + (let ((default-directory ert-remote-temporary-file-directory)) + (should-not + (string-equal (tramp--test-operation) + (tramp--handler-for-test-operation)))) + (let ((default-directory temporary-file-directory)) + (should-not + (string-equal (tramp--test-operation) + (tramp--handler-for-test-operation)))) + + (should-error + (tramp-add-external-operation + #'tramp--test-operation + #'tramp--handler-for-test-operation 'foo) + :type 'file-missing) + (tramp-add-external-operation + #'tramp--test-operation + #'tramp--handler-for-test-operation backend) + ;; The backend specific function is called. + (should + (string-equal (tramp--test-operation ert-remote-temporary-file-directory) + (tramp--handler-for-test-operation + ert-remote-temporary-file-directory))) + (should-not + (string-equal (tramp--test-operation temporary-file-directory) + (tramp--handler-for-test-operation + temporary-file-directory))) + (let ((default-directory ert-remote-temporary-file-directory)) + (should + (string-equal (tramp--test-operation) + (tramp--handler-for-test-operation)))) + (let ((default-directory temporary-file-directory)) + (should-not + (string-equal (tramp--test-operation) + (tramp--handler-for-test-operation)))) + + (tramp-remove-external-operation + #'tramp--test-operation backend) + ;; There is no backend specific code. + (should-not + (string-equal (tramp--test-operation ert-remote-temporary-file-directory) + (tramp--handler-for-test-operation + ert-remote-temporary-file-directory))) + (should-not + (string-equal (tramp--test-operation temporary-file-directory) + (tramp--handler-for-test-operation + temporary-file-directory))) + (let ((default-directory ert-remote-temporary-file-directory)) + (should-not + (string-equal (tramp--test-operation) + (tramp--handler-for-test-operation)))) + (let ((default-directory temporary-file-directory)) + (should-not + (string-equal (tramp--test-operation) + (tramp--handler-for-test-operation)))))) + ;; This test is inspired by Bug#29163. -(ert-deftest tramp-test49-auto-load () +(ert-deftest tramp-test50-auto-load () "Check that Tramp autoloads properly." ;; If we use another syntax but `default', Tramp is already loaded ;; due to the `tramp-change-syntax' call. @@ -8500,7 +8584,7 @@ process sentinels. They shall not disturb each other." (mapconcat #'shell-quote-argument load-path " -L ") (shell-quote-argument code))))))) -(ert-deftest tramp-test49-delay-load () +(ert-deftest tramp-test50-delay-load () "Check that Tramp is loaded lazily, only when needed." ;; Tramp is neither loaded at Emacs startup, nor when completing a ;; non-Tramp file name like "/foo". Completing a Tramp-alike file @@ -8530,7 +8614,7 @@ process sentinels. They shall not disturb each other." (mapconcat #'shell-quote-argument load-path " -L ") (shell-quote-argument (format code tm))))))))) -(ert-deftest tramp-test49-recursive-load () +(ert-deftest tramp-test50-recursive-load () "Check that Tramp does not fail due to recursive load." (skip-unless (tramp--test-enabled)) @@ -8554,7 +8638,7 @@ process sentinels. They shall not disturb each other." (mapconcat #'shell-quote-argument load-path " -L ") (shell-quote-argument code)))))))) -(ert-deftest tramp-test49-remote-load-path () +(ert-deftest tramp-test50-remote-load-path () "Check that Tramp autoloads its packages with remote `load-path'." ;; `tramp-cleanup-all-connections' is autoloaded from tramp-cmds.el. ;; It shall still work, when a remote file name is in the @@ -8579,7 +8663,7 @@ process sentinels. They shall not disturb each other." (mapconcat #'shell-quote-argument load-path " -L ") (shell-quote-argument code))))))) -(ert-deftest tramp-test50-without-remote-files () +(ert-deftest tramp-test51-without-remote-files () "Check that Tramp can be suppressed." (skip-unless (tramp--test-enabled)) @@ -8594,7 +8678,7 @@ process sentinels. They shall not disturb each other." (setq tramp-mode t) (should (file-remote-p ert-remote-temporary-file-directory))) -(ert-deftest tramp-test51-unload () +(ert-deftest tramp-test52-unload () "Check that Tramp and its subpackages unload completely. Since it unloads Tramp, it shall be the last test to run." :tags '(:expensive-test)