[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
emacs-28 f5b8f62 2/2: Fix some Tramp problems
|
From: |
Michael Albinus |
|
Subject: |
emacs-28 f5b8f62 2/2: Fix some Tramp problems |
|
Date: |
Mon, 18 Oct 2021 13:54:26 -0400 (EDT) |
branch: emacs-28
commit f5b8f626e3d7233a935e67ffc5ffee0de9069ae5
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>
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 6d8bed1..362a258 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 115d005..ebe57a8 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 6984dd8..6f3b324 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 516d46d..845f31d 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 318b4e4..372e0a2 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 da15401..8c7fc48 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