mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-06-14 12:31:25 +00:00
Extend integration of external operations in Tramp
* doc/misc/tramp.texi (Extension packages): Use another format char in example. (New operations): Document different argument types. Extend example. * lisp/net/tramp.el: Use consequently `eq', `assq', `memq'. (tramp-file-name-for-operation-external): Extend docstring. (tramp-file-name-for-operation): Make more use of `tramp-file-name-for-operation-external'. (tramp-add-external-operation): New optional argument `arg-type'. * test/lisp/net/tramp-tests.el (tramp--handle-test-operation): Rename from `tramp--handler-for-test-operation'. (tramp--handle-process-id) (tramp--test-operation-file-name-for-operation): New defuns. (tramp-test49-external-backend-function): Extend test.
This commit is contained in:
Michael Albinus
parent
eda9a819ce
commit
00b767089e
3 changed files with 285 additions and 105 deletions
|
|
@ -5556,6 +5556,8 @@ 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}).
|
||||
@c The NonGNU ELPA package @file{tramp-rpc} implements an own
|
||||
@c @value{tramp} backend (@pxref{New operations}).
|
||||
@end itemize
|
||||
|
||||
|
||||
|
|
@ -6743,7 +6745,7 @@ The following parameters expand format specifiers for the
|
|||
The example above could use
|
||||
|
||||
@lisp
|
||||
(tramp-login-program "%1")
|
||||
(tramp-login-program "%b")
|
||||
@end lisp
|
||||
|
||||
And you could set @code{tramp-extra-expand-args} as connection-local value:
|
||||
|
|
@ -6759,7 +6761,7 @@ And you could set @code{tramp-extra-expand-args} as connection-local value:
|
|||
(connection-local-set-profile-variables
|
||||
'foo-tramp-connection-local-default-profile
|
||||
'((tramp-extra-expand-args
|
||||
?1 (foo-tramp-get-login-program (car tramp-current-connection)))))
|
||||
?b (foo-tramp-get-login-program (car tramp-current-connection)))))
|
||||
|
||||
(connection-local-set-profiles
|
||||
'(:application tramp :protocol "foo")
|
||||
|
|
@ -6867,15 +6869,12 @@ 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
|
||||
@defun tramp-add-external-operation operation function backend &optional arg-type
|
||||
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.
|
||||
They must have the same argument list.
|
||||
|
||||
@var{backend}, also a symbol, is the feature name of a @value{tramp}
|
||||
backend (except @code{tramp-ftp}). The new implementation will be
|
||||
|
|
@ -6883,18 +6882,18 @@ applied only for this backend. Example:
|
|||
|
||||
@lisp
|
||||
@group
|
||||
(defun test-operation (file)
|
||||
(defun my-test-operation (file)
|
||||
(message "Original implementation for %s" file))
|
||||
@end group
|
||||
|
||||
@group
|
||||
(defun handle-test-operation (file)
|
||||
(defun my-handle-test-operation (file)
|
||||
(message "Handler implementation for %s" file))
|
||||
@end group
|
||||
|
||||
@group
|
||||
(tramp-add-external-operation
|
||||
#'test-operation #'handle-test-operation 'tramp-sh)
|
||||
#'my-test-operation #'my-handle-test-operation 'tramp-sh)
|
||||
@end group
|
||||
@end lisp
|
||||
|
||||
|
|
@ -6903,19 +6902,19 @@ Then we have the different use cases:
|
|||
@lisp
|
||||
@group
|
||||
;; Local file name.
|
||||
(test-operation "/a/b")
|
||||
(my-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")
|
||||
(my-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")
|
||||
(my-test-operation "/sftp::/a/b")
|
||||
@result{} "Original implementation for /sftp::/a/b"
|
||||
@end group
|
||||
@end lisp
|
||||
|
|
@ -6935,14 +6934,14 @@ could look like:
|
|||
|
||||
@lisp
|
||||
@group
|
||||
(defun handle-test-operation (file)
|
||||
(defun my-handle-test-operation (file)
|
||||
(message "Entry handler implementation for %s" file)
|
||||
(tramp-run-real-handler #'test-operation (list file))
|
||||
(tramp-run-real-handler #'my-test-operation (list file))
|
||||
(message "Exit handler implementation for %s" file))
|
||||
@end group
|
||||
|
||||
@group
|
||||
(test-operation "/ssh::/a/b")
|
||||
(my-test-operation "/ssh::/a/b")
|
||||
@result{} "Entry handler implementation for /ssh::/a/b
|
||||
Original implementation for /ssh::/a/b
|
||||
Exit handler implementation for /ssh::/a/b"
|
||||
|
|
@ -6952,6 +6951,47 @@ could look like:
|
|||
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.
|
||||
|
||||
The optional argument @var{arg-type} specisfies, which argument of
|
||||
@var{operation} shall be used in order to determine, whether the
|
||||
handler @var{function} should be called. It can be
|
||||
|
||||
@itemize @minus
|
||||
@item @code{file}@*
|
||||
The first argument of @var{operation} is the remote file name to be
|
||||
checked. This is the default, if @var{arg-type} is @code{nil}.
|
||||
|
||||
@item @code{default-directory}@*
|
||||
@code{default-directory} is the remote file name to be checked.
|
||||
|
||||
@item @code{process}@*
|
||||
@code{default-directory} of the process buffer of the first argument
|
||||
of @var{operation}, a process, is the remote file name to be checked.
|
||||
@end itemize
|
||||
|
||||
If the first argument of @var{operation} is nil,
|
||||
@code{default-directory} is the remote file name to be checked in case
|
||||
of @var{arg-type} being @code{file} or @code{process}.
|
||||
|
||||
@findex tramp-file-name-for-operation
|
||||
If @var{arg-type} is a function symbol, it will be called with the
|
||||
same arguments as @code{tramp-file-name-for-operation}. It must
|
||||
return a string, which is the remote file name to be checked.
|
||||
|
||||
The example above could be changed like this:
|
||||
|
||||
@lisp
|
||||
@group
|
||||
(defun my-file-name-for-test-operation (operation &rest args)
|
||||
(if (stringp (car args)) (car args) default-directory))
|
||||
@end group
|
||||
|
||||
@group
|
||||
(tramp-add-external-operation
|
||||
#'my-test-operation #'my-handle-test-operation 'tramp-sh
|
||||
#'my-file-name-for-test-operation)
|
||||
@end group
|
||||
@end lisp
|
||||
@end defun
|
||||
|
||||
@defun tramp-remove-external-operation operation backend
|
||||
|
|
@ -6963,7 +7003,7 @@ they are kept. Example:
|
|||
@lisp
|
||||
@group
|
||||
(tramp-remove-external-operation
|
||||
#'test-operation 'tramp-sh)
|
||||
#'my-test-operation 'tramp-sh)
|
||||
@end group
|
||||
@end lisp
|
||||
@end defun
|
||||
|
|
@ -6979,6 +7019,10 @@ An example implementing this mechanism is the GNU ELPA package
|
|||
@code{dir-locals-find-file} for @value{tramp}'s @code{tramp-sh}
|
||||
backend.
|
||||
|
||||
@c Another example is the NonGNU ELPA package @file{tramp-rpc}. It
|
||||
@c provides an own @value{tramp} backend, using a server process on the
|
||||
@c remote host.
|
||||
|
||||
|
||||
@node Traces and Profiles
|
||||
@chapter How to Customize Traces
|
||||
|
|
|
|||
|
|
@ -2424,7 +2424,22 @@ arguments to pass to the OPERATION."
|
|||
(apply operation args)))
|
||||
|
||||
(defvar tramp-file-name-for-operation-external nil
|
||||
"List of operations added by external packages.")
|
||||
"Alist of operations added by external packages.
|
||||
An entry has the form `(OPERATION . ARG-TYPE)'. ARG-TYPE can be the
|
||||
symbol
|
||||
|
||||
- `file': the first argument of OERATION is the remote file name to be
|
||||
checked.
|
||||
- `default-directory': `default-directory' is the remote file name to be
|
||||
checked.
|
||||
- `process': `default-directory' of the process buffer of the first
|
||||
argument of OPERATION is the remote file name to be checked.
|
||||
|
||||
If the first argument of OPERATION is nil, `default-directory' is the
|
||||
remote file name to be checked in case of `file' and `process'.
|
||||
|
||||
If ARG-TYPE is a function symbol, it will be called with the same
|
||||
arguments as `tramp-file-name-for-operation'. It must return a string.")
|
||||
|
||||
;; We handle here all file primitives. Most of them have the file
|
||||
;; name as first parameter; nevertheless we check for them explicitly
|
||||
|
|
@ -2434,9 +2449,7 @@ arguments to pass to the OPERATION."
|
|||
;; 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'.
|
||||
;; `tramp-file-name-for-operation-external'.
|
||||
(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.
|
||||
|
|
@ -2446,30 +2459,32 @@ first argument of `expand-file-name' is absolute and not remote.
|
|||
Must be handled by the callers."
|
||||
(cond
|
||||
;; FILE resp DIRECTORY.
|
||||
((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))
|
||||
((or
|
||||
(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))
|
||||
(eq (alist-get operation tramp-file-name-for-operation-external) 'file))
|
||||
(if (and (stringp (nth 0 args)) (file-name-absolute-p (nth 0 args)))
|
||||
(nth 0 args)
|
||||
default-directory))
|
||||
;; STRING FILE.
|
||||
|
|
@ -2502,31 +2517,45 @@ Must be handled by the callers."
|
|||
(buffer-file-name
|
||||
(if (bufferp (nth 0 args)) (nth 0 args) (current-buffer))))
|
||||
;; COMMAND.
|
||||
((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))
|
||||
((or
|
||||
(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))
|
||||
(eq (alist-get operation tramp-file-name-for-operation-external)
|
||||
'default-directory))
|
||||
default-directory)
|
||||
;; PROC.
|
||||
((memq operation '(file-notify-rm-watch file-notify-valid-p))
|
||||
(when (processp (nth 0 args))
|
||||
(tramp-get-default-directory (process-buffer (nth 0 args)))))
|
||||
;; PROC or BUFFER.
|
||||
((or
|
||||
(memq operation '(file-notify-rm-watch file-notify-valid-p))
|
||||
(eq (alist-get operation tramp-file-name-for-operation-external) 'process))
|
||||
(or (when-let* (((processp (nth 0 args)))
|
||||
(vec (process-get (nth 0 args) 'tramp-vector)))
|
||||
(tramp-make-tramp-file-name vec))
|
||||
(when-let*
|
||||
((buf (cond
|
||||
((processp (nth 0 args)) (process-buffer (nth 0 args)))
|
||||
((bufferp (nth 0 args)) (get-buffer (nth 0 args)))
|
||||
((stringp (nth 0 args))
|
||||
;; Process or buffer name.
|
||||
(or (get-process (nth 0 args)) (get-buffer (nth 0 args)))))))
|
||||
(tramp-get-default-directory buf))
|
||||
""))
|
||||
;; VEC.
|
||||
((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))
|
||||
;; A function.
|
||||
((functionp (alist-get operation tramp-file-name-for-operation-external))
|
||||
(apply
|
||||
(alist-get operation tramp-file-name-for-operation-external)
|
||||
operation args))
|
||||
;; Unknown file primitive.
|
||||
(t (unless (member 'remote-file-error debug-ignored-errors)
|
||||
(t (unless (memq 'remote-file-error debug-ignored-errors)
|
||||
(tramp-error
|
||||
nil 'remote-file-error "Unknown file I/O primitive: %s" operation)))))
|
||||
|
||||
|
|
@ -2544,7 +2573,7 @@ Must be handled by the callers."
|
|||
(funcall (setq func (car elt)) vec)
|
||||
(error
|
||||
(setcar elt #'ignore)
|
||||
(unless (member 'remote-file-error debug-ignored-errors)
|
||||
(unless (memq 'remote-file-error debug-ignored-errors)
|
||||
(tramp-error
|
||||
vec 'remote-file-error
|
||||
"Not a valid Tramp file name function `%s'" func))))
|
||||
|
|
@ -2552,22 +2581,32 @@ Must be handled by the callers."
|
|||
res (cdr elt))))
|
||||
res)))
|
||||
|
||||
(defun tramp-add-external-operation (operation function backend)
|
||||
(defun tramp-add-external-operation
|
||||
(operation function backend &optional arg-type)
|
||||
"Add FUNCTION 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')."
|
||||
packages like `tramp-sh' (except `tramp-ftp'). ARG-TYPE is either
|
||||
`file' (the default), `default-directory', `process' or a function
|
||||
symbol. It describes the type of the OPERATION argument to be checked.
|
||||
See the docstring of `tramp-file-name-for-operation-external' for its
|
||||
meaning."
|
||||
(require backend)
|
||||
(when-let* ((fnha
|
||||
(intern-soft
|
||||
(concat (symbol-name backend) "-file-name-handler-alist")))
|
||||
((boundp fnha)))
|
||||
((boundp fnha))
|
||||
(arg-type (or arg-type 'file)))
|
||||
(unless (or (memq arg-type '(file default-directory process))
|
||||
(functionp arg-type))
|
||||
(tramp-error nil 'remote-file-error "Unknown arg type: %s" arg-type))
|
||||
;; Make BACKEND aware of the new operation.
|
||||
(add-to-list fnha (cons operation function))
|
||||
(unless (memq operation tramp-file-name-for-operation-external)
|
||||
(unless (assq operation tramp-file-name-for-operation-external)
|
||||
;; Make Tramp aware of the new operation.
|
||||
(add-to-list 'tramp-file-name-for-operation-external operation)
|
||||
(add-to-list
|
||||
'tramp-file-name-for-operation-external (cons operation arg-type))
|
||||
(put #'tramp-file-name-handler
|
||||
'operations
|
||||
(cons operation (get 'tramp-file-name-handler 'operations)))
|
||||
|
|
@ -2577,8 +2616,7 @@ packages like `tramp-sh' (except `tramp-ftp')."
|
|||
`(lambda (orig-fun &rest args)
|
||||
(if-let* ((handler
|
||||
(find-file-name-handler
|
||||
(if (and (car args) (file-name-absolute-p (car args)))
|
||||
(car args) default-directory)
|
||||
(apply #'tramp-file-name-for-operation #',operation args)
|
||||
#',operation)))
|
||||
(apply handler #',operation args)
|
||||
(apply orig-fun args)))
|
||||
|
|
@ -2605,7 +2643,7 @@ Tramp backend packages like `tramp-sh'."
|
|||
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))
|
||||
(assq-delete-all 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.
|
||||
|
|
@ -6335,7 +6373,7 @@ Mostly useful to protect BODY from being interrupted by timers."
|
|||
(declare (indent 1) (debug t))
|
||||
`(if (tramp-get-connection-property ,proc "locked")
|
||||
;; Be kind for old versions of Emacs.
|
||||
(if (member 'remote-file-error debug-ignored-errors)
|
||||
(if (memq 'remote-file-error debug-ignored-errors)
|
||||
(throw 'non-essential 'non-essential)
|
||||
;(tramp-backtrace ,proc 'force)
|
||||
(tramp-error
|
||||
|
|
@ -6701,7 +6739,7 @@ If FILENAME is remote, a file name handler is called."
|
|||
ID-FORMAT valid values are `string' and `integer'."
|
||||
;; We use key nil for local connection properties.
|
||||
(with-tramp-connection-property nil (format "uid-%s" id-format)
|
||||
(if (equal id-format 'integer) (user-uid) (user-login-name))))
|
||||
(if (eq id-format 'integer) (user-uid) (user-login-name))))
|
||||
|
||||
(defun tramp-get-local-gid (id-format)
|
||||
"The gid of the local user, in ID-FORMAT.
|
||||
|
|
@ -6709,8 +6747,8 @@ ID-FORMAT valid values are `string' and `integer'."
|
|||
;; We use key nil for local connection properties.
|
||||
(with-tramp-connection-property nil (format "gid-%s" id-format)
|
||||
(cond
|
||||
((equal id-format 'integer) (group-gid))
|
||||
((equal id-format 'string) (group-name (group-gid)))
|
||||
((eq id-format 'integer) (group-gid))
|
||||
((eq id-format 'string) (group-name (group-gid)))
|
||||
((file-attribute-group-id (file-attributes "~/" id-format))))))
|
||||
|
||||
(defun tramp-get-local-locale (&optional vec)
|
||||
|
|
@ -6906,8 +6944,8 @@ ID-FORMAT valid values are `string' and `integer'."
|
|||
(with-tramp-connection-property vec (format "uid-%s" id-format)
|
||||
(tramp-file-name-handler #'tramp-get-remote-uid vec id-format)))
|
||||
;; Ensure there is a valid result.
|
||||
(and (equal id-format 'integer) tramp-unknown-id-integer)
|
||||
(and (equal id-format 'string) tramp-unknown-id-string)))
|
||||
(and (eq id-format 'integer) tramp-unknown-id-integer)
|
||||
(and (eq id-format 'string) tramp-unknown-id-string)))
|
||||
|
||||
(defun tramp-get-remote-gid (vec id-format)
|
||||
"The gid of the remote connection VEC, in ID-FORMAT.
|
||||
|
|
@ -6916,8 +6954,8 @@ ID-FORMAT valid values are `string' and `integer'."
|
|||
(with-tramp-connection-property vec (format "gid-%s" id-format)
|
||||
(tramp-file-name-handler #'tramp-get-remote-gid vec id-format)))
|
||||
;; Ensure there is a valid result.
|
||||
(and (equal id-format 'integer) tramp-unknown-id-integer)
|
||||
(and (equal id-format 'string) tramp-unknown-id-string)))
|
||||
(and (eq id-format 'integer) tramp-unknown-id-integer)
|
||||
(and (eq id-format 'string) tramp-unknown-id-string)))
|
||||
|
||||
(defun tramp-get-remote-groups (vec id-format)
|
||||
"The list of groups of the remote connection VEC, in ID-FORMAT.
|
||||
|
|
@ -7231,9 +7269,9 @@ verbosity of 6."
|
|||
(let ((default-directory temporary-file-directory))
|
||||
(dolist (pid (list-system-processes))
|
||||
(and-let* ((attributes (process-attributes pid))
|
||||
(comm (cdr (assoc 'comm attributes)))
|
||||
(comm (cdr (assq 'comm attributes)))
|
||||
((string-equal
|
||||
(cdr (assoc 'user attributes)) (user-login-name)))
|
||||
(cdr (assq 'user attributes)) (user-login-name)))
|
||||
;; The returned command name could be truncated
|
||||
;; to 15 characters. Therefore, we cannot check
|
||||
;; for `string-equal'.
|
||||
|
|
|
|||
|
|
@ -8859,10 +8859,19 @@ process sentinels. They shall not disturb each other."
|
|||
"Test operation."
|
||||
"Test operation")
|
||||
|
||||
(defun tramp--handler-for-test-operation (&optional _file)
|
||||
(defun tramp--handle-test-operation (&optional _file)
|
||||
"Test operation handler."
|
||||
"Test operation handler")
|
||||
|
||||
(defun tramp--handle-process-id (process)
|
||||
"Handler for `process-id'."
|
||||
;; Return something else.
|
||||
(1+ (tramp-run-real-handler #'process-id (list process))))
|
||||
|
||||
(defun tramp--test-operation-file-name-for-operation (_operation &optional _file)
|
||||
"Helper function for `tramp--test-operation' handler."
|
||||
default-directory)
|
||||
|
||||
(ert-deftest tramp-test49-external-backend-function ()
|
||||
"Check that Tramp handles external functions for a given backend."
|
||||
:tags '(:expensive-test)
|
||||
|
|
@ -8879,78 +8888,167 @@ process sentinels. They shall not disturb each other."
|
|||
;; There is no backend specific code.
|
||||
(should-not
|
||||
(string-equal (tramp--test-operation ert-remote-temporary-file-directory)
|
||||
(tramp--handler-for-test-operation
|
||||
(tramp--handle-test-operation
|
||||
ert-remote-temporary-file-directory)))
|
||||
(should-not
|
||||
(string-equal (tramp--test-operation temporary-file-directory)
|
||||
(tramp--handler-for-test-operation
|
||||
(tramp--handle-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))))
|
||||
(tramp--handle-test-operation))))
|
||||
(let ((default-directory temporary-file-directory))
|
||||
(should-not
|
||||
(string-equal (tramp--test-operation)
|
||||
(tramp--handler-for-test-operation))))
|
||||
(tramp--handle-test-operation))))
|
||||
|
||||
(should-error
|
||||
(tramp-add-external-operation
|
||||
#'tramp--test-operation
|
||||
#'tramp--handler-for-test-operation 'foo)
|
||||
#'tramp--test-operation #'tramp--handle-test-operation 'foo)
|
||||
:type 'file-missing)
|
||||
(should-error
|
||||
(tramp-add-external-operation
|
||||
#'tramp--test-operation #'tramp--handle-test-operation backend 'foo)
|
||||
:type 'remote-file-error)
|
||||
;; This doesn't hurt.
|
||||
(tramp-add-external-operation
|
||||
#'tramp--test-operation
|
||||
#'tramp--handler-for-test-operation backend)
|
||||
#'tramp--test-operation #'tramp--handle-test-operation backend 'file)
|
||||
|
||||
;; The backend specific function is called.
|
||||
(should
|
||||
(string-equal (tramp--test-operation ert-remote-temporary-file-directory)
|
||||
(tramp--handler-for-test-operation
|
||||
(tramp--handle-test-operation
|
||||
ert-remote-temporary-file-directory)))
|
||||
(should-not
|
||||
(string-equal (tramp--test-operation temporary-file-directory)
|
||||
(tramp--handler-for-test-operation
|
||||
(tramp--handle-test-operation
|
||||
temporary-file-directory)))
|
||||
(let ((default-directory ert-remote-temporary-file-directory))
|
||||
(should
|
||||
(string-equal (tramp--test-operation)
|
||||
(tramp--handler-for-test-operation)))
|
||||
(tramp--handle-test-operation)))
|
||||
(should
|
||||
(string-equal (tramp--test-operation "foo")
|
||||
(tramp--handler-for-test-operation "foo"))))
|
||||
(tramp--handle-test-operation "foo"))))
|
||||
(let ((default-directory temporary-file-directory))
|
||||
(should-not
|
||||
(string-equal (tramp--test-operation)
|
||||
(tramp--handler-for-test-operation)))
|
||||
(tramp--handle-test-operation)))
|
||||
(should-not
|
||||
(string-equal (tramp--test-operation "foo")
|
||||
(tramp--handler-for-test-operation "foo"))))
|
||||
(tramp--handle-test-operation "foo"))))
|
||||
|
||||
(tramp-remove-external-operation
|
||||
#'tramp--test-operation backend)
|
||||
(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
|
||||
(tramp--handle-test-operation
|
||||
ert-remote-temporary-file-directory)))
|
||||
(should-not
|
||||
(string-equal (tramp--test-operation temporary-file-directory)
|
||||
(tramp--handler-for-test-operation
|
||||
(tramp--handle-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)))
|
||||
(tramp--handle-test-operation)))
|
||||
(should-not
|
||||
(string-equal (tramp--test-operation "foo")
|
||||
(tramp--handler-for-test-operation "foo"))))
|
||||
(tramp--handle-test-operation "foo"))))
|
||||
(let ((default-directory temporary-file-directory))
|
||||
(should-not
|
||||
(string-equal (tramp--test-operation)
|
||||
(tramp--handler-for-test-operation)))
|
||||
(tramp--handle-test-operation)))
|
||||
(should-not
|
||||
(string-equal (tramp--test-operation "foo")
|
||||
(tramp--handler-for-test-operation "foo"))))))
|
||||
(tramp--handle-test-operation "foo"))))
|
||||
|
||||
;; Test `default-directory' arg type.
|
||||
(tramp-add-external-operation
|
||||
#'tramp--test-operation #'tramp--handle-test-operation
|
||||
backend 'default-directory)
|
||||
|
||||
;; The backend specific function is called.
|
||||
(let ((default-directory ert-remote-temporary-file-directory))
|
||||
(should
|
||||
(string-equal (tramp--test-operation "foo")
|
||||
(tramp--handle-test-operation "foo"))))
|
||||
(let ((default-directory temporary-file-directory))
|
||||
(should-not
|
||||
(string-equal (tramp--test-operation "foo")
|
||||
(tramp--handle-test-operation "foo"))))
|
||||
|
||||
(tramp-remove-external-operation #'tramp--test-operation backend)
|
||||
;; There is no backend specific code.
|
||||
(let ((default-directory ert-remote-temporary-file-directory))
|
||||
(should-not
|
||||
(string-equal (tramp--test-operation)
|
||||
(tramp--handle-test-operation)))
|
||||
(should-not
|
||||
(string-equal (tramp--test-operation "foo")
|
||||
(tramp--handle-test-operation "foo"))))
|
||||
(let ((default-directory temporary-file-directory))
|
||||
(should-not
|
||||
(string-equal (tramp--test-operation)
|
||||
(tramp--handle-test-operation)))
|
||||
(should-not
|
||||
(string-equal (tramp--test-operation "foo")
|
||||
(tramp--handle-test-operation "foo"))))
|
||||
|
||||
;; Test `process' arg type.
|
||||
(when (and (tramp--test-supports-processes-p) (not (tramp--test-smb-p)))
|
||||
(let ((default-directory ert-remote-temporary-file-directory)
|
||||
proc command id)
|
||||
(unwind-protect
|
||||
(with-temp-buffer
|
||||
(setq command '("cat")
|
||||
proc
|
||||
(make-process
|
||||
:name "test" :buffer (current-buffer) :command command
|
||||
:file-handler t))
|
||||
(should (processp proc))
|
||||
(should (eq (process-status proc) 'run))
|
||||
(should (natnump (setq id (process-id proc))))
|
||||
(tramp-add-external-operation
|
||||
#'process-id #'tramp--handle-process-id backend 'process)
|
||||
(should (= (process-id proc) (1+ id))))
|
||||
|
||||
;; Cleanup.
|
||||
(tramp-remove-external-operation #'process-id backend)
|
||||
(ignore-errors (delete-process proc)))))
|
||||
|
||||
;; Test function arg type.
|
||||
(tramp-add-external-operation
|
||||
#'tramp--test-operation #'tramp--handle-test-operation
|
||||
backend #'tramp--test-operation-file-name-for-operation)
|
||||
|
||||
;; The backend specific function is called.
|
||||
(let ((default-directory ert-remote-temporary-file-directory))
|
||||
(should
|
||||
(string-equal (tramp--test-operation "foo")
|
||||
(tramp--handle-test-operation "foo"))))
|
||||
(let ((default-directory temporary-file-directory))
|
||||
(should-not
|
||||
(string-equal (tramp--test-operation "foo")
|
||||
(tramp--handle-test-operation "foo"))))
|
||||
|
||||
(tramp-remove-external-operation #'tramp--test-operation backend)
|
||||
;; There is no backend specific code.
|
||||
(let ((default-directory ert-remote-temporary-file-directory))
|
||||
(should-not
|
||||
(string-equal (tramp--test-operation)
|
||||
(tramp--handle-test-operation)))
|
||||
(should-not
|
||||
(string-equal (tramp--test-operation "foo")
|
||||
(tramp--handle-test-operation "foo"))))
|
||||
(let ((default-directory temporary-file-directory))
|
||||
(should-not
|
||||
(string-equal (tramp--test-operation)
|
||||
(tramp--handle-test-operation)))
|
||||
(should-not
|
||||
(string-equal (tramp--test-operation "foo")
|
||||
(tramp--handle-test-operation "foo"))))))
|
||||
|
||||
;; This test is inspired by Bug#29163.
|
||||
(ert-deftest tramp-test50-auto-load ()
|
||||
|
|
|
|||
Loading…
Reference in a new issue