mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-22 18:35:09 +00:00
Code Issues Releases Activity

Finish implementation of {set-}file-modes FLAG arg in Tramp

Browse Source 
* lisp/net/tramp-adb.el (tramp-adb-handle-file-local-copy): Do not use
'nofollow for temporary files.  Use `tramp-compat-set-file-modes'.
(tramp-adb-handle-write-region): Do not use 'nofollow for
temporary files.
(tramp-adb-handle-set-file-modes): Implement FLAG.

* lisp/net/tramp-compat.el (tramp-compat-file-modes)
(tramp-compat-set-file-modes): New defaliases.

* lisp/net/tramp-gvfs.el (tramp-gvfs-handle-set-file-modes):
Make explicit check (eq flag 'nofollow).

* lisp/net/tramp-sh.el (tramp-sh-handle-set-file-modes): Implement FLAG.
(tramp-do-copy-or-rename-file-directly)
(tramp-sh-handle-file-local-copy, tramp-sh-handle-write-region):
Do not use 'nofollow for temporary files.
(tramp-get-remote-chmod-h): New defun.

* lisp/net/tramp-smb.el (tramp-smb-handle-set-file-modes):
Implement FLAG.

* lisp/net/tramp-sudoedit.el (tramp-sudoedit-handle-set-file-modes):
Implement FLAG.
(tramp-sudoedit-handle-write-region): Use `tramp-compat-set-file-modes'.

* lisp/net/tramp.el (tramp-default-file-modes): Optional argument FLAG.
(tramp-handle-file-modes): Use `file-truename' instead of
`file-chase-links'.  The latter function does not work for remote
file names.
(tramp-handle-write-region): Call `tramp-default-file-modes' with
'nofollow if needed.  Do not use 'nofollow for temporary files.

* test/lisp/net/tramp-tests.el
(tramp--test-ignore-make-symbolic-link-error): Check also for
"Cannot chmod .* with nofollow flag" error.
(tramp-test20-file-modes): Extend test.
(tramp--test-emacs28-p): New defun.
This commit is contained in:
Michael Albinus 2020-02-25 13:25:57 +01:00
parent 22524a6e39
commit 64af3c94a6
8 changed files with 156 additions and 60 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
lisp/net/tramp-adb.el
View File

@ -591,8 +591,9 @@ Emacs dired can't find files."
(ignore-errors (delete-file tmpfile))
(tramp-error
v 'file-error "Cannot make local copy of file `%s'" filename))
(set-file-modes tmpfile (logior (or (file-modes filename) 0) #o0400)
'nofollow))
(set-file-modes
tmpfile
(logior (or (tramp-compat-file-modes filename 'nofollow) 0) #o0400)))
tmpfile)))
(defun tramp-adb-handle-file-writable-p (filename)
@ -637,8 +638,7 @@ But handle the case, if the \"test\" command is not available."
(tmpfile (tramp-compat-make-temp-file filename)))
(when (and append (file-exists-p filename))
(copy-file filename tmpfile 'ok)
(set-file-modes tmpfile (logior (or (file-modes tmpfile) 0) #o0600)
'nofollow))
(set-file-modes tmpfile (logior (or (file-modes tmpfile) 0) #o0600)))
(tramp-run-real-handler
#'write-region (list start end tmpfile append 'no-message lockname))
(with-tramp-progress-reporter
@ -669,8 +669,9 @@ But handle the case, if the \"test\" command is not available."
(defun tramp-adb-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
flag ;; FIXME: Support 'nofollow'.
(with-parsed-tramp-file-name filename nil
(when (and (eq flag 'nofollow) (file-symlink-p filename))
(tramp-error v 'file-error "Cannot chmod %s with %s flag" filename flag))
(tramp-flush-file-properties v localname)
(tramp-adb-send-command-and-check v (format "chmod %o %s" mode localname))))

22
lisp/net/tramp-compat.el
View File

@ -165,7 +165,7 @@ This is a string of ten letters or dashes as in ls -l."
"The error symbol for the `file-missing' error.")
;; `file-local-name', `file-name-quoted-p', `file-name-quote' and
;; `file-name-unquote' are introduced in Emacs 26.
;; `file-name-unquote' are introduced in Emacs 26.1.
(defalias 'tramp-compat-file-local-name
(if (fboundp 'file-local-name)
#'file-local-name
@ -175,7 +175,8 @@ It returns a file name which can be used directly as argument of
`process-file', `start-file-process', or `shell-command'."
(or (file-remote-p name 'localname) name))))
;; `file-name-quoted-p' got a second argument in Emacs 27.1.
;; `file-name-quoted-p', `file-name-quote' and `file-name-unquote' got
;; a second argument in Emacs 27.1.
(defalias 'tramp-compat-file-name-quoted-p
(if (and
(fboundp 'file-name-quoted-p)
@ -217,7 +218,7 @@ NAME is unquoted."
localname (if (= (length localname) 2) "/" (substring localname 2))))
(concat (file-remote-p name) localname)))))
;; `tramp-syntax' has changed its meaning in Emacs 26. We still
;; `tramp-syntax' has changed its meaning in Emacs 26.1. We still
;; support old settings.
(defsubst tramp-compat-tramp-syntax ()
"Return proper value of `tramp-syntax'."
@ -275,6 +276,19 @@ A nil value for either argument stands for the current time."
(lambda (reporter &optional value _suffix)
(progress-reporter-update reporter value))))
;; `file-modes' and `set-file-modes' got argument FLAG in Emacs 28.1.
(defalias 'tramp-compat-file-modes
(if (equal (tramp-compat-funcall 'func-arity #'file-modes) '(1 . 2))
#'file-modes
(lambda (filename &optional _flag)
(file-modes filename))))
(defalias 'tramp-compat-set-file-modes
(if (equal (tramp-compat-funcall 'func-arity #'set-file-modes) '(2 . 3))
#'set-file-modes
(lambda (filename mode &optional _flag)
(set-file-modes filename mode))))
(add-hook 'tramp-unload-hook
(lambda ()
(unload-feature 'tramp-loaddefs 'force)
@ -284,6 +298,8 @@ A nil value for either argument stands for the current time."
;;; TODO:
;;
;; * `func-arity' exists since Emacs 26.1.
;;
;; * Starting with Emacs 27.1, there's no need to escape open
;; parentheses with a backslash in docstrings anymore.

2
lisp/net/tramp-gvfs.el
View File

@ -1567,7 +1567,7 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-properties v localname)
(tramp-gvfs-send-command
v "gvfs-set-attribute" (if flag "-nt" "-t") "uint32"
v "gvfs-set-attribute" (if (eq flag 'nofollow) "-nt" "-t") "uint32"
(tramp-gvfs-url-file-name (tramp-make-tramp-file-name v))
"unix::mode" (number-to-string mode))))

44
lisp/net/tramp-sh.el
View File

@ -1481,13 +1481,17 @@ of."
(defun tramp-sh-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-properties v localname)
flag ;; FIXME: Support 'nofollow'.
;; FIXME: extract the proper text from chmod's stderr.
(tramp-barf-unless-okay
v
(format "chmod %o %s" mode (tramp-shell-quote-argument localname))
"Error while changing file's mode %s" filename)))
(let ((chmod "chmod"))
(when (and (eq flag 'nofollow) (file-symlink-p filename))
(or (setq chmod (tramp-get-remote-chmod-h v))
(tramp-error
v 'file-error "Cannot chmod %s with %s flag" filename flag)))
(tramp-flush-file-properties v localname)
;; FIXME: extract the proper text from chmod's stderr.
(tramp-barf-unless-okay
v
(format "%s %o %s" chmod mode (tramp-shell-quote-argument localname))
"Error while changing file's mode %s" filename))))
(defun tramp-sh-handle-set-file-times (filename &optional time)
"Like `set-file-times' for Tramp files."
@ -2280,7 +2284,7 @@ the uid and gid from FILENAME."
;; We must change the ownership as local user.
;; Since this does not work reliable, we also
;; give read permissions.
(set-file-modes tmpfile #o0777 'nofollow)
(set-file-modes tmpfile #o0777)
(tramp-set-file-uid-gid
tmpfile
(tramp-get-remote-uid v 'integer)
@ -3222,8 +3226,7 @@ STDERR can also be a file name."
(delete-file tmpfile2)))))
;; Set proper permissions.
(set-file-modes tmpfile (tramp-default-file-modes filename)
'nofollow)
(set-file-modes tmpfile (tramp-default-file-modes filename))
;; Set local user ownership.
(tramp-set-file-uid-gid tmpfile))
@ -3272,7 +3275,8 @@ STDERR can also be a file name."
#'write-region
(list start end localname append 'no-message lockname))
(let* ((modes (save-excursion (tramp-default-file-modes filename)))
(let* ((modes (tramp-default-file-modes
filename (and (eq mustbenew 'excl) 'nofollow)))
;; We use this to save the value of
;; `last-coding-system-used' after writing the tmp
;; file. At the end of the function, we set
@ -3322,7 +3326,7 @@ STDERR can also be a file name."
;; handles permissions.
;; Ensure that it is still readable.
(when modes
(set-file-modes tmpfile (logior (or modes 0) #o0400) 'nofollow))
(set-file-modes tmpfile (logior (or modes 0) #o0400)))
;; This is a bit lengthy due to the different methods
;; possible for file transfer. First, we check whether the
@ -5897,6 +5901,22 @@ ID-FORMAT valid values are `string' and `integer'."
vec (concat command " -A n </dev/null"))
command)))))
(defun tramp-get-remote-chmod-h (vec)
"Determine remote `chmod' command which supports nofollow argument."
(with-tramp-connection-property vec "chmod-h"
(tramp-message vec 5 "Finding a suitable `chmod' command with nofollow")
(let ((tmpfile
(make-temp-name
(expand-file-name
tramp-temp-name-prefix (tramp-get-remote-tmpdir vec)))))
(when (tramp-send-command-and-check
vec
(format
"ln -s foo %s && chmod -h %s 0777"
(tramp-file-local-name tmpfile) (tramp-file-local-name tmpfile)))
(delete-file tmpfile)
"chmod -h"))))
(defun tramp-get-env-with-u-option (vec)
"Check, whether the remote `env' command supports the -u option."
(with-tramp-connection-property vec "env-u-option"

3
lisp/net/tramp-smb.el
View File

@ -1466,8 +1466,9 @@ component is used as the target of the symlink."
(defun tramp-smb-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
flag ;; FIXME: Support 'nofollow'.
(with-parsed-tramp-file-name filename nil
(when (and (eq flag 'nofollow) (file-symlink-p filename))
(tramp-error v 'file-error "Cannot chmod %s with %s flag" filename flag))
(when (tramp-smb-get-cifs-capabilities v)
(tramp-flush-file-properties v localname)
(unless (tramp-smb-send-command

21
lisp/net/tramp-sudoedit.el
View File

@ -465,8 +465,9 @@ the result will be a local, non-Tramp, file name."
(defun tramp-sudoedit-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
flag ;; FIXME: Support 'nofollow'.
(with-parsed-tramp-file-name filename nil
(when (and (eq flag 'nofollow) (file-symlink-p filename))
(tramp-error v 'file-error "Cannot chmod %s with %s flag" filename flag))
(tramp-flush-file-properties v localname)
(unless (tramp-sudoedit-send-command
v "chmod" (format "%o" mode)
@ -716,13 +717,14 @@ ID-FORMAT valid values are `string' and `integer'."
(start end filename &optional append visit lockname mustbenew)
"Like `write-region' for Tramp files."
(with-parsed-tramp-file-name filename nil
(let ((uid (or (tramp-compat-file-attribute-user-id
(file-attributes filename 'integer))
(tramp-sudoedit-get-remote-uid v 'integer)))
(gid (or (tramp-compat-file-attribute-group-id
(file-attributes filename 'integer))
(tramp-sudoedit-get-remote-gid v 'integer)))
(modes (tramp-default-file-modes filename)))
(let* ((uid (or (tramp-compat-file-attribute-user-id
(file-attributes filename 'integer))
(tramp-sudoedit-get-remote-uid v 'integer)))
(gid (or (tramp-compat-file-attribute-group-id
(file-attributes filename 'integer))
(tramp-sudoedit-get-remote-gid v 'integer)))
(flag (and (eq mustbenew 'excl) 'nofollow))
(modes (tramp-default-file-modes filename flag)))
(prog1
(tramp-handle-write-region
start end filename append visit lockname mustbenew)
@ -736,8 +738,7 @@ ID-FORMAT valid values are `string' and `integer'."
(file-attributes filename 'integer))
gid))
(tramp-set-file-uid-gid filename uid gid))
(set-file-modes filename modes
(when (eq mustbenew 'excl) 'nofollow))))))
(tramp-compat-set-file-modes filename modes flag)))))
;; Internal functions.

27
lisp/net/tramp.el
View File

@ -2135,11 +2135,13 @@ For definition of that list see `tramp-set-completion-function'."
(defvar tramp-devices 0
"Keeps virtual device numbers.")
(defun tramp-default-file-modes (filename)
(defun tramp-default-file-modes (filename &optional flag)
"Return file modes of FILENAME as integer.
If the file modes of FILENAME cannot be determined, return the
value of `default-file-modes', without execute permissions."
(or (file-modes filename)
If optional FLAG is ‘nofollow’, do not follow FILENAME if it is a
symbolic link. If the file modes of FILENAME cannot be
determined, return the value of `default-file-modes', without
execute permissions."
(or (tramp-compat-file-modes filename flag)
(logand (default-file-modes) #o0666)))
(defun tramp-replace-environment-variables (filename)
@ -3181,11 +3183,11 @@ User is always nil."
(defun tramp-handle-file-modes (filename &optional flag)
"Like `file-modes' for Tramp files."
(when-let ((attrs (file-attributes filename)))
(let ((mode-string (tramp-compat-file-attribute-modes attrs)))
(if (and (not flag) (eq ?l (aref mode-string 0)))
(tramp-handle-file-modes (file-chase-links filename) 'nofollow)
(tramp-mode-string-to-int mode-string)))))
(when-let ((attrs (file-attributes filename))
(mode-string (tramp-compat-file-attribute-modes attrs)))
(if (and (not (eq flag 'nofollow)) (eq ?l (aref mode-string 0)))
(file-modes (file-truename filename))
(tramp-mode-string-to-int mode-string))))
;; Localname manipulation functions that grok Tramp localnames...
(defun tramp-handle-file-name-as-directory (file)
@ -3879,7 +3881,8 @@ of."
(tramp-error v 'file-already-exists filename))
(let ((tmpfile (tramp-compat-make-temp-file filename))
(modes (save-excursion (tramp-default-file-modes filename))))
(modes (tramp-default-file-modes
filename (and (eq mustbenew 'excl) 'nofollow))))
(when (and append (file-exists-p filename))
(copy-file filename tmpfile 'ok))
;; The permissions of the temporary file should be set. If
@ -3887,7 +3890,7 @@ of."
;; renamed to the backup file. This case `save-buffer'
;; handles permissions.
;; Ensure that it is still readable.
(set-file-modes tmpfile (logior (or modes 0) #o0400) 'nofollow)
(set-file-modes tmpfile (logior (or modes 0) #o0400))
;; We say `no-message' here because we don't want the visited file
;; modtime data to be clobbered from the temp file. We call
;; `set-visited-file-modtime' ourselves later on.
@ -4667,7 +4670,7 @@ Return the local name of the temporary file."
(setq result nil)
;; This creates the file by side effect.
(set-file-times result)
(set-file-modes result #o0700 'nofollow)))
(set-file-modes result #o0700)))
;; Return the local part.
(tramp-file-local-name result)))

86
test/lisp/net/tramp-tests.el
View File

@ -3082,14 +3082,18 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
;; Method "smb" supports `make-symbolic-link' only if the remote host
;; has CIFS capabilities. tramp-adb.el, tramp-gvfs.el and
;; tramp-rclone.el do not support symbolic links at all.
;; We check also `set-file-modes' with nofollow flag.
(defmacro tramp--test-ignore-make-symbolic-link-error (&rest body)
"Run BODY, ignoring \"make-symbolic-link not supported\" file error."
(declare (indent defun) (debug (body)))
`(condition-case err
(progn ,@body)
(file-error
(unless (string-equal (error-message-string err)
"make-symbolic-link not supported")
(unless (string-match-p
(concat
"^\\(make-symbolic-link not supported"
"\\|Cannot chmod .* with nofollow flag\\)$")
(error-message-string err))
(signal (car err) (cdr err))))))
(ert-deftest tramp-test18-file-attributes ()
@ -3364,25 +3368,69 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
"ftp" (file-remote-p tramp-test-temporary-file-directory 'method)))))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(let ((tmp-name (tramp--test-make-temp-name nil quoted)))
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted)))
(unwind-protect
(progn
(write-region "foo" nil tmp-name)
(should (file-exists-p tmp-name))
(set-file-modes tmp-name #o777)
(should (= (file-modes tmp-name) #o777))
(should (file-executable-p tmp-name))
(should (file-writable-p tmp-name))
(set-file-modes tmp-name #o444)
(should (= (file-modes tmp-name) #o444))
(should-not (file-executable-p tmp-name))
(write-region "foo" nil tmp-name1)
(should (file-exists-p tmp-name1))
(set-file-modes tmp-name1 #o777)
(should (= (file-modes tmp-name1) #o777))
(should (file-executable-p tmp-name1))
(should (file-writable-p tmp-name1))
(set-file-modes tmp-name1 #o444)
(should (= (file-modes tmp-name1) #o444))
(should-not (file-executable-p tmp-name1))
;; A file is always writable for user "root".
(unless (zerop (tramp-compat-file-attribute-user-id
(file-attributes tmp-name)))
(should-not (file-writable-p tmp-name))))
(file-attributes tmp-name1)))
(should-not (file-writable-p tmp-name1))))
;; Cleanup.
(ignore-errors (delete-file tmp-name))))))
(ignore-errors (delete-file tmp-name1)))
;; Check the NOFOLLOW arg. It exists since Emacs 28.
(when (tramp--test-emacs28-p)
(unwind-protect
(tramp--test-ignore-make-symbolic-link-error
(write-region "foo" nil tmp-name1)
(should (file-exists-p tmp-name1))
(make-symbolic-link tmp-name1 tmp-name2)
(should
(string-equal
(funcall
(if quoted #'tramp-compat-file-name-unquote #'identity)
(file-remote-p tmp-name1 'localname))
(file-symlink-p tmp-name2)))
;; Both report the modes of `tmp-name1'.
(should
(= (file-modes tmp-name1) (file-modes tmp-name2)))
;; `tmp-name1' is a regular file. NOFOLLOW doesn't matter.
(should
(= (file-modes tmp-name1) (file-modes tmp-name1 'nofollow)))
;; `tmp-name2' is a symbolic link. It has different permissions.
(should-not
(= (file-modes tmp-name2) (file-modes tmp-name2 'nofollow)))
(should-not
(= (file-modes tmp-name1 'nofollow)
(file-modes tmp-name2 'nofollow)))
;; Change permissions.
(set-file-modes tmp-name1 #o200)
(set-file-modes tmp-name2 #o200)
(should
(= (file-modes tmp-name1) (file-modes tmp-name2) #o200))
;; Change permissions with NOFOLLOW.
(set-file-modes tmp-name1 #o300 'nofollow)
(set-file-modes tmp-name2 #o300 'nofollow)
(should
(= (file-modes tmp-name1 'nofollow)
(file-modes tmp-name2 'nofollow)))
(should-not (= (file-modes tmp-name1) (file-modes tmp-name2))))
;; Cleanup.
(ignore-errors (delete-file tmp-name1))
(ignore-errors (delete-file tmp-name2)))))))
;; Method "smb" could run into "NT_STATUS_REVISION_MISMATCH" error.
(defmacro tramp--test-ignore-add-name-to-file-error (&rest body)
@ -4358,7 +4406,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(while (accept-process-output proc 0 nil t)))
;; We cannot use `string-equal', because tramp-adb.el
;; echoes also the sent string. And a remote macOS sends
;; a slightly modified string. On MS-Windows,
;; a slightly modified string. On MS Windows,
;; `delete-process' sends an unknown signal.
(should
(string-match
@ -5344,6 +5392,12 @@ Some semantics has been changed for there, w/o new functions or
variables, so we check the Emacs version directly."
(>= emacs-major-version 27))
(defun tramp--test-emacs28-p ()
"Check for Emacs version >= 28.1.
Some semantics has been changed for there, w/o new functions or
variables, so we check the Emacs version directly."
(>= emacs-major-version 28))
(defun tramp--test-adb-p ()
"Check, whether the remote host runs Android.
This requires restrictions of file name syntax."