From f5b8f626e3d7233a935e67ffc5ffee0de9069ae5 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 18 Oct 2021 19:54:13 +0200 Subject: [PATCH] Fix some Tramp problems * 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. --- lisp/net/tramp-adb.el | 65 +++++++++++++++++------------------- lisp/net/tramp-gvfs.el | 30 ++--------------- lisp/net/tramp-sh.el | 4 +-- lisp/net/tramp-sudoedit.el | 5 +-- lisp/net/tramp.el | 44 ++++++++++++++++++------ test/lisp/net/tramp-tests.el | 28 +++++++++++++++- 6 files changed, 98 insertions(+), 78 deletions(-) diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 6d8bed1d7862..362a258f43d6 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -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) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 115d005c0ca6..ebe57a8bcece 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -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))) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 6984dd8b4297..6f3b3245225e 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -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. diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index 516d46da37d5..845f31d09b17 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -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." diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 318b4e454dad..372e0a2cb738 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -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)))))) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index da15401be056..8c7fc48848ba 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -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