procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fix some Tramp problems

Browse source 
* lisp/net/tramp-adb.el (tramp-adb-file-name-handler-alist):
Use `tramp-adb-handle-file-executable-p' and
`tramp-adb-handle-file-readable-p'.
(tramp-adb-handle-file-executable-p)
(tramp-adb-handle-file-readable-p): New defuns.
(tramp-adb-handle-file-writable-p): Simplify.
(tramp-adb-handle-make-process): Handle :filter being t.
(tramp-adb-find-test-command): Remove.

* lisp/net/tramp-sh.el (tramp-sh-handle-file-readable-p):
* lisp/net/tramp-sudoedit.el (tramp-sudoedit-handle-file-readable-p):
* lisp/net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist):
Use `tramp-handle-file-readable-p'.
(tramp-gvfs-handle-file-executable-p): Do not check whether file
exists, this is done in `tramp-check-cached-permissions'.
(tramp-gvfs-handle-file-readable-p): Remove.

* lisp/net/tramp.el (tramp-error): Move binding of `inhibit-message' ...
(tramp-signal-hook-function): ... here.
(tramp-handle-access-file): Rewrite.
(tramp-handle-file-readable-p): New defun.
(tramp-handle-make-process): Setting :filter to t works since
Emacs 29.1 only.

* test/lisp/net/tramp-tests.el (tramp-test17-insert-directory)
(tramp-test18-file-attributes): Extend tests.
This commit is contained in:
Michael Albinus 2021-10-18 19:54:13 +02:00
parent fc988a7113
commit f5b8f626e3
6 changed files with 98 additions and 78 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

65
lisp/net/tramp-adb.el
View file

@ -128,8 +128,7 @@ It is used for TCP/IP devices."
(file-attributes . tramp-adb-handle-file-attributes)
(file-directory-p . tramp-handle-file-directory-p)
(file-equal-p . tramp-handle-file-equal-p)
;; FIXME: This is too sloppy.
(file-executable-p . tramp-handle-file-exists-p)
(file-executable-p . tramp-adb-handle-file-executable-p)
(file-exists-p . tramp-handle-file-exists-p)
(file-in-directory-p . tramp-handle-file-in-directory-p)
(file-local-copy . tramp-adb-handle-file-local-copy)
@ -147,7 +146,7 @@ It is used for TCP/IP devices."
(file-notify-rm-watch . tramp-handle-file-notify-rm-watch)
(file-notify-valid-p . tramp-handle-file-notify-valid-p)
(file-ownership-preserved-p . ignore)
(file-readable-p . tramp-handle-file-exists-p)
(file-readable-p . tramp-adb-handle-file-readable-p)
(file-regular-p . tramp-handle-file-regular-p)
(file-remote-p . tramp-handle-file-remote-p)
(file-selinux-context . tramp-handle-file-selinux-context)
@ -515,28 +514,31 @@ Emacs dired can't find files."
(set-file-modes tmpfile (logior (or (file-modes filename) 0) #o0400)))
tmpfile)))
(defun tramp-adb-handle-file-executable-p (filename)
"Like `file-executable-p' for Tramp files."
(with-parsed-tramp-file-name filename nil
(with-tramp-file-property v localname "file-executable-p"
(tramp-adb-send-command-and-check
v (format "test -x %s" (tramp-shell-quote-argument localname))))))
(defun tramp-adb-handle-file-readable-p (filename)
"Like `file-readable-p' for Tramp files."
(with-parsed-tramp-file-name filename nil
(with-tramp-file-property v localname "file-readable-p"
(or (tramp-handle-file-readable-p filename)
(tramp-adb-send-command-and-check
v (format "test -r %s" (tramp-shell-quote-argument localname)))))))
(defun tramp-adb-handle-file-writable-p (filename)
"Like `file-writable-p' for Tramp files.
But handle the case, if the \"test\" command is not available."
"Like `file-writable-p' for Tramp files."
(with-parsed-tramp-file-name filename nil
(with-tramp-file-property v localname "file-writable-p"
(if (tramp-adb-find-test-command v)
(if (file-exists-p filename)
(tramp-adb-send-command-and-check
v (format "test -w %s" (tramp-shell-quote-argument localname)))
(and
(file-directory-p (file-name-directory filename))
(file-writable-p (file-name-directory filename))))
;; Missing "test" command on Android < 4.
(let ((rw-path "/data/data"))
(tramp-message
v 5
"Not implemented yet (assuming \"/data/data\" is writable): %s"
localname)
(and (>= (length localname) (length rw-path))
(string= (substring localname 0 (length rw-path))
rw-path)))))))
(if (file-exists-p filename)
(tramp-adb-send-command-and-check
v (format "test -w %s" (tramp-shell-quote-argument localname)))
(and
(file-directory-p (file-name-directory filename))
(file-writable-p (file-name-directory filename)))))))
(defun tramp-adb-handle-write-region
(start end filename &optional append visit lockname mustbenew)
@ -1043,12 +1045,13 @@ implementation will be used."
(rename-file remote-tmpstderr stderr))))
;; Read initial output. Remove the first
;; line, which is the command echo.
(while
(progn
(goto-char (point-min))
(not (re-search-forward "[\n]" nil t)))
(tramp-accept-process-output p 0))
(delete-region (point-min) (point))
(unless (eq filter t)
(while
(progn
(goto-char (point-min))
(not (re-search-forward "[\n]" nil t)))
(tramp-accept-process-output p 0))
(delete-region (point-min) (point)))
;; Provide error buffer. This shows only
;; initial error messages; messages arriving
;; later on will be inserted when the
@ -1141,12 +1144,6 @@ error and non-nil on success."
(let ((inhibit-read-only t)) (delete-region (point-min) (point-max)))
(zerop (apply #'tramp-call-process vec tramp-adb-program nil t nil args))))
(defun tramp-adb-find-test-command (vec)
"Check whether the ash has a builtin \"test\" command.
This happens for Android >= 4.0."
(with-tramp-connection-property vec "test"
(tramp-adb-send-command-and-check vec "type test")))
;; Connection functions
(defun tramp-adb-send-command (vec command &optional neveropen nooutput)

30
lisp/net/tramp-gvfs.el
View file

@ -788,7 +788,7 @@ It has been changed in GVFS 1.14.")
(file-notify-rm-watch . tramp-handle-file-notify-rm-watch)
(file-notify-valid-p . tramp-handle-file-notify-valid-p)
(file-ownership-preserved-p . ignore)
(file-readable-p . tramp-gvfs-handle-file-readable-p)
(file-readable-p . tramp-handle-file-readable-p)
(file-regular-p . tramp-handle-file-regular-p)
(file-remote-p . tramp-handle-file-remote-p)
(file-selinux-context . tramp-handle-file-selinux-context)
@ -1396,8 +1396,7 @@ If FILE-SYSTEM is non-nil, return file system attributes."
"Like `file-executable-p' for Tramp files."
(with-parsed-tramp-file-name filename nil
(with-tramp-file-property v localname "file-executable-p"
(and (file-exists-p filename)
(tramp-check-cached-permissions v ?x)))))
(tramp-check-cached-permissions v ?x))))
(defun tramp-gvfs-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files."
@ -1519,31 +1518,6 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(when string (tramp-message proc 10 "Rest string:\n%s" string))
(process-put proc 'rest-string string)))
(defun tramp-gvfs-handle-file-readable-p (filename)
"Like `file-readable-p' for Tramp files."
(with-parsed-tramp-file-name filename nil
(with-tramp-file-property v localname "file-readable-p"
(and (file-exists-p filename)
(or (tramp-check-cached-permissions v ?r)
;; `tramp-check-cached-permissions' doesn't handle
;; symbolic links.
(and (stringp (file-symlink-p filename))
(file-readable-p
(concat
(file-remote-p filename) (file-symlink-p filename))))
;; If the user is different from what we guess to be
;; the user, we don't know. Let's check, whether
;; access is restricted explicitly.
(and (/= (tramp-get-remote-uid v 'integer)
(tramp-compat-file-attribute-user-id
(file-attributes filename 'integer)))
(not
(string-equal
"FALSE"
(cdr (assoc
"access::can-read"
(tramp-gvfs-get-file-attributes filename)))))))))))
(defun tramp-gvfs-handle-file-system-info (filename)
"Like `file-system-info' for Tramp files."
(setq filename (directory-file-name (expand-file-name filename)))

4
lisp/net/tramp-sh.el
View file

@ -1580,9 +1580,7 @@ ID-FORMAT valid values are `string' and `integer'."
"Like `file-readable-p' for Tramp files."
(with-parsed-tramp-file-name filename nil
(with-tramp-file-property v localname "file-readable-p"
;; Examine `file-attributes' cache to see if request can be
;; satisfied without remote operation.
(or (tramp-check-cached-permissions v ?r)
(or (tramp-handle-file-readable-p filename)
(tramp-run-test "-r" filename)))))
;; Functions implemented using the basic functions above.

5
lisp/net/tramp-sudoedit.el
View file

@ -464,8 +464,9 @@ the result will be a local, non-Tramp, file name."
"Like `file-readable-p' for Tramp files."
(with-parsed-tramp-file-name filename nil
(with-tramp-file-property v localname "file-readable-p"
(tramp-sudoedit-send-command
v "test" "-r" (tramp-compat-file-name-unquote localname)))))
(or (tramp-handle-file-readable-p filename)
(tramp-sudoedit-send-command
v "test" "-r" (tramp-compat-file-name-unquote localname))))))
(defun tramp-sudoedit-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."

44
lisp/net/tramp.el
View file

@ -2087,8 +2087,7 @@ VEC-OR-PROC identifies the connection to use, SIGNAL is the
signal identifier to be raised, remaining arguments passed to
`tramp-message'. Finally, signal SIGNAL is raised with
FMT-STRING and ARGUMENTS."
(let ((inhibit-message t)
signal-hook-function)
(let (signal-hook-function)
(tramp-backtrace vec-or-proc)
(unless arguments
;; FMT-STRING could be just a file name, as in
@ -2198,9 +2197,10 @@ the resulting error message."
;; `custom-initialize-*' functions provoke `void-variable' errors.
;; We don't want to see them in the backtrace.
(unless (eq error-symbol 'void-variable)
(tramp-error
(car tramp-current-connection) error-symbol
(mapconcat (lambda (x) (format "%s" x)) data " "))))
(let ((inhibit-message t))
(tramp-error
(car tramp-current-connection) error-symbol
(mapconcat (lambda (x) (format "%s" x)) data " ")))))
(put #'tramp-signal-hook-function 'tramp-suppress-trace t)
@ -3275,10 +3275,18 @@ User is always nil."
(defun tramp-handle-access-file (filename string)
"Like `access-file' for Tramp files."
(unless (file-readable-p (file-truename filename))
(tramp-compat-file-missing
(tramp-dissect-file-name filename)
(format "%s: %s" string filename))))
(setq filename (file-truename filename))
(with-parsed-tramp-file-name filename v
(if (file-exists-p filename)
(unless
(funcall
(if (file-directory-p filename)
#'file-accessible-directory-p #'file-readable-p)
filename)
(tramp-error
v 'file-error (format "%s: Permission denied, %s" string filename)))
(tramp-compat-file-missing
v (format "%s: No such file or directory, %s" string filename)))))
(defun tramp-handle-add-name-to-file
(filename newname &optional ok-if-already-exists)
@ -3568,6 +3576,17 @@ User is always nil."
(tramp-compat-file-attribute-modification-time
(file-attributes file1))))))
(defun tramp-handle-file-readable-p (filename)
"Like `file-readable-p' for Tramp files."
(with-parsed-tramp-file-name filename nil
(with-tramp-file-property v localname "file-readable-p"
(or (tramp-check-cached-permissions v ?r)
;; `tramp-check-cached-permissions' doesn't handle symbolic
;; links.
(when-let ((symlink (file-symlink-p filename)))
(and (stringp symlink)
(file-readable-p (concat (file-remote-p filename) symlink))))))))
(defun tramp-handle-file-regular-p (filename)
"Like `file-regular-p' for Tramp files."
(and (file-exists-p filename)
@ -4220,7 +4239,12 @@ substitution. SPEC-LIST is a list of char/value pairs used for
:name name :buffer buffer
:command (append `(,login-program) login-args command)
:coding coding :noquery noquery :connection-type connection-type
:filter filter :sentinel sentinel :stderr stderr))
:sentinel sentinel :stderr stderr))
;; Set filter. Prior Emacs 29.1, it doesn't work reliable
;; to provide it as `make-process' argument when filter is
;; t. See Bug#51177.
(when filter
(set-process-filter p filter))
(tramp-message v 6 "%s" (string-join (process-command p) " "))
p))))))

28
test/lisp/net/tramp-tests.el
View file

@ -3159,7 +3159,20 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
(regexp-opt (directory-files tmp-name1))
(length (directory-files tmp-name1)))))))
;; Check error case.
;; Check error cases.
(when (and (tramp--test-supports-file-modes-p)
;; With "sshfs", directories with zero file
;; modes are still "accessible".
(not (tramp--test-sshfs-p))
;; A directory is always accessible for user "root".
(not (zerop (tramp-compat-file-attribute-user-id
(file-attributes tmp-name1)))))
(set-file-modes tmp-name1 0)
(with-temp-buffer
(should-error
(insert-directory tmp-name1 nil)
:type 'file-error))
(set-file-modes tmp-name1 #o777))
(delete-directory tmp-name1 'recursive)
(with-temp-buffer
(should-error
@ -3372,9 +3385,22 @@ This tests also `access-file', `file-readable-p',
(tramp-get-remote-gid tramp-test-vec 'integer)))
(delete-file tmp-name1))
(when (and (tramp--test-supports-file-modes-p)
;; A file is always accessible for user "root".
(not (zerop (tramp-compat-file-attribute-user-id
(file-attributes
tramp-test-temporary-file-directory)))))
(write-region "foo" nil tmp-name1)
(set-file-modes tmp-name1 0)
(should-error
(access-file tmp-name1 "error")
:type 'file-error)
(set-file-modes tmp-name1 #o777)
(delete-file tmp-name1))
(should-error
(access-file tmp-name1 "error")
:type tramp-file-missing)
;; `file-ownership-preserved-p' should return t for
;; non-existing files.
(when test-file-ownership-preserved-p