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

Fix Bug#29579

Browse source 
* lisp/files.el (file-name-non-special):
Inhibit `file-name-handler-alist' only for some operations.
Add missing operations.  (Bug#29579)

* lisp/net/tramp-compat.el (tramp-compat-file-name-quote):
Do not quote if it is quoted already.

* lisp/net/tramp-smb.el (tramp-smb-handle-insert-directory):
Use `copy-tree' but `copy-sequence'.

* lisp/net/tramp.el (tramp-handle-file-truename): Handle several
trailing slashes correctly.

* test/lisp/net/tramp-tests.el (tramp-test11-copy-file)
(tramp-test12-rename-file, tramp-test24-file-acl)
(tramp-test25-file-selinux, tramp--test-check-files):
Handle also quoted file names.
(tramp-test21-file-links): Fix file name quoting test.
(tramp-test24-file-acl): Be more robust for "smb" method.
(tramp-test35-make-auto-save-file-name): Enable hidden test cases.
This commit is contained in:
Michael Albinus 2017-12-06 20:49:30 +01:00
parent cb3d979b74
commit a1bbc49015
6 changed files with 97 additions and 86 deletions
Download patch file Download diff file Expand all files Collapse all files

111
lisp/files.el
View file

@ -6975,60 +6975,67 @@ only these files will be asked to be saved."
;; We depend on being the last handler on the list, ;; We depend on being the last handler on the list,
;; so that anything else which does need handling ;; so that anything else which does need handling
;; has been handled already. ;; has been handled already.
;; So it is safe for us to inhibit *all* magic file name handlers. ;; So it is safe for us to inhibit *all* magic file name handlers for
;; operations, which return a file name. See Bug#29579.
(defun file-name-non-special (operation &rest arguments) (defun file-name-non-special (operation &rest arguments)
(let ((file-name-handler-alist nil) (let* ((op-returns-file-name-list
(default-directory '(expand-file-name file-name-directory file-name-as-directory
;; Some operations respect file name handlers in directory-file-name file-name-sans-versions
;; `default-directory'. Because core function like find-backup-file-name file-remote-p))
;; `call-process' don't care about file name handlers in (file-name-handler-alist
;; `default-directory', we here have to resolve the (and
;; directory into a local one. For `process-file', (not (memq operation op-returns-file-name-list))
;; `start-file-process', and `shell-command', this fixes file-name-handler-alist))
;; Bug#25949. (default-directory
(if (memq operation '(insert-directory process-file start-file-process ;; Some operations respect file name handlers in
shell-command)) ;; `default-directory'. Because core function like
(directory-file-name ;; `call-process' don't care about file name handlers in
(expand-file-name ;; `default-directory', we here have to resolve the
(unhandled-file-name-directory default-directory))) ;; directory into a local one. For `process-file',
default-directory)) ;; `start-file-process', and `shell-command', this fixes
;; Get a list of the indices of the args which are file names. ;; Bug#25949.
(file-arg-indices (if (memq operation
(cdr (or (assq operation '(insert-directory process-file start-file-process
;; The first six are special because they shell-command))
;; return a file name. We want to include the /: (directory-file-name
;; in the return value. (expand-file-name
;; So just avoid stripping it in the first place. (unhandled-file-name-directory default-directory)))
'((expand-file-name . nil) default-directory))
(file-name-directory . nil) ;; Get a list of the indices of the args which are file names.
(file-name-as-directory . nil) (file-arg-indices
(directory-file-name . nil) (cdr (or (assq operation
(file-name-sans-versions . nil) ;; The first seven are special because they
(find-backup-file-name . nil) ;; return a file name. We want to include the /:
;; `identity' means just return the first arg ;; in the return value.
;; not stripped of its quoting. ;; So just avoid stripping it in the first place.
(substitute-in-file-name identity) (append
;; `add' means add "/:" to the result. (mapcar 'list op-returns-file-name-list)
(file-truename add 0) '(;; `identity' means just return the first arg
(insert-file-contents insert-file-contents 0) ;; not stripped of its quoting.
;; `unquote-then-quote' means set buffer-file-name (substitute-in-file-name identity)
;; temporarily to unquoted filename. ;; `add' means add "/:" to the result.
(verify-visited-file-modtime unquote-then-quote) (file-truename add 0)
;; List the arguments which are filenames. (insert-file-contents insert-file-contents 0)
(file-name-completion 1) ;; `unquote-then-quote' means set buffer-file-name
(file-name-all-completions 1) ;; temporarily to unquoted filename.
(write-region 2 5) (verify-visited-file-modtime unquote-then-quote)
(rename-file 0 1) ;; List the arguments which are filenames.
(copy-file 0 1) (file-name-completion 1)
(make-symbolic-link 0 1) (file-name-all-completions 1)
(add-name-to-file 0 1))) (write-region 2 5)
;; For all other operations, treat the first argument only (rename-file 0 1)
;; as the file name. (copy-file 0 1)
'(nil 0)))) (copy-directory 0 1)
method (file-in-directory-p 0 1)
;; Copy ARGUMENTS so we can replace elements in it. (make-symbolic-link 0 1)
(arguments (copy-sequence arguments))) (add-name-to-file 0 1))))
;; For all other operations, treat the first argument only
;; as the file name.
'(nil 0))))
method
;; Copy ARGUMENTS so we can replace elements in it.
(arguments (copy-sequence arguments)))
(if (symbolp (car file-arg-indices)) (if (symbolp (car file-arg-indices))
(setq method (pop file-arg-indices))) (setq method (pop file-arg-indices)))
;; Strip off the /: from the file names that have it. ;; Strip off the /: from the file names that have it.

6
lisp/net/tramp-compat.el
View file

@ -210,8 +210,10 @@ If NAME is a remote file name, check the local part of NAME."
(defsubst tramp-compat-file-name-quote (name) (defsubst tramp-compat-file-name-quote (name)
"Add the quotation prefix \"/:\" to file NAME. "Add the quotation prefix \"/:\" to file NAME.
If NAME is a remote file name, the local part of NAME is quoted." If NAME is a remote file name, the local part of NAME is quoted."
(concat (if (tramp-compat-file-name-quoted-p name)
(file-remote-p name) "/:" (or (file-remote-p name 'localname) name)))) name
(concat
(file-remote-p name) "/:" (or (file-remote-p name 'localname) name)))))
(if (fboundp 'file-name-unquote) (if (fboundp 'file-name-unquote)
(defalias 'tramp-compat-file-name-unquote 'file-name-unquote) (defalias 'tramp-compat-file-name-unquote 'file-name-unquote)

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

@ -1036,6 +1036,7 @@ of command line.")
(load . tramp-handle-load) (load . tramp-handle-load)
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name) (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-sh-handle-make-directory) (make-directory . tramp-sh-handle-make-directory)
;; `make-directory-internal' performed by default handler.
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-symbolic-link . tramp-sh-handle-make-symbolic-link) (make-symbolic-link . tramp-sh-handle-make-symbolic-link)
(process-file . tramp-sh-handle-process-file) (process-file . tramp-sh-handle-process-file)

9
lisp/net/tramp-smb.el
View file

@ -437,7 +437,7 @@ pass to the OPERATION."
(delete-directory tmpdir 'recursive)))) (delete-directory tmpdir 'recursive))))
;; We can copy recursively. ;; We can copy recursively.
;; Does not work reliably. ;; TODO: Does not work reliably.
(nil ;(and (or t1 t2) (tramp-smb-get-cifs-capabilities v)) (nil ;(and (or t1 t2) (tramp-smb-get-cifs-capabilities v))
(when (and (file-directory-p newname) (when (and (file-directory-p newname)
(not (string-equal (file-name-nondirectory dirname) (not (string-equal (file-name-nondirectory dirname)
@ -1015,7 +1015,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(save-match-data (save-match-data
(let ((base (file-name-nondirectory filename)) (let ((base (file-name-nondirectory filename))
;; We should not destroy the cache entry. ;; We should not destroy the cache entry.
(entries (copy-sequence (entries (copy-tree
(tramp-smb-get-file-entries (tramp-smb-get-file-entries
(file-name-directory filename)))) (file-name-directory filename))))
(avail (get-free-disk-space filename)) (avail (get-free-disk-space filename))
@ -1441,7 +1441,7 @@ component is used as the target of the symlink."
(tramp-set-connection-property (tramp-set-connection-property
v "process-buffer" (current-buffer)) v "process-buffer" (current-buffer))
;; Use an asynchronous processes. By this, password can ;; Use an asynchronous process. By this, password can
;; be handled. ;; be handled.
(let ((p (apply (let ((p (apply
'start-process 'start-process
@ -1456,6 +1456,9 @@ component is used as the target of the symlink."
(set-process-query-on-exit-flag p nil) (set-process-query-on-exit-flag p nil)
(tramp-process-actions p v nil tramp-smb-actions-set-acl) (tramp-process-actions p v nil tramp-smb-actions-set-acl)
(goto-char (point-max)) (goto-char (point-max))
;; This is meant for traces, and returning from the
;; function. No error is propagated outside, due to
;; the `ignore-errors' closure.
(unless (re-search-backward "tramp_exit_status [0-9]+" nil t) (unless (re-search-backward "tramp_exit_status [0-9]+" nil t)
(tramp-error (tramp-error
v 'file-error v 'file-error

6
lisp/net/tramp.el
View file

@ -670,8 +670,8 @@ It can have the following values:
`simplified' -- Ange-FTP like syntax `simplified' -- Ange-FTP like syntax
`separate' -- Syntax as defined for XEmacs originally `separate' -- Syntax as defined for XEmacs originally
Do not change the value by `setq', it must be changed only by Do not change the value by `setq', it must be changed only via
`custom-set-variables'. See also `tramp-change-syntax'." Customize. See also `tramp-change-syntax'."
:group 'tramp :group 'tramp
:version "26.1" :version "26.1"
:package-version '(Tramp . "2.3.3") :package-version '(Tramp . "2.3.3")
@ -3217,7 +3217,7 @@ User is always nil."
(tramp-error (tramp-error
v1 'file-error v1 'file-error
"Maximum number (%d) of symlinks exceeded" numchase-limit))) "Maximum number (%d) of symlinks exceeded" numchase-limit)))
result)) (directory-file-name result)))
;; Preserve trailing "/". ;; Preserve trailing "/".
(if (string-equal (file-name-nondirectory filename) "") "/" "")))) (if (string-equal (file-name-nondirectory filename) "") "/" ""))))

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

@ -1882,9 +1882,9 @@ This checks also `file-name-as-directory', `file-name-directory',
"Check `copy-file'." "Check `copy-file'."
(skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-enabled))
;; TODO: The quoted case does not work. Copy local file to remote. ;; `filename-non-special' has been fixed in Emacs 26.1, see Bug#29579.
;;(dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) (dolist (quoted (if (and tramp--test-expensive-test (tramp--test-emacs26-p))
(let (quoted) '(nil t) '(nil)))
(let ((tmp-name1 (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)) (tmp-name2 (tramp--test-make-temp-name nil quoted))
(tmp-name3 (tramp--test-make-temp-name 'local quoted))) (tmp-name3 (tramp--test-make-temp-name 'local quoted)))
@ -1984,9 +1984,9 @@ This checks also `file-name-as-directory', `file-name-directory',
"Check `rename-file'." "Check `rename-file'."
(skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-enabled))
;; TODO: The quoted case does not work. ;; `filename-non-special' has been fixed in Emacs 26.1, see Bug#29579.
;;(dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) (dolist (quoted (if (and tramp--test-expensive-test (tramp--test-emacs26-p))
(let (quoted) '(nil t) '(nil)))
(let ((tmp-name1 (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)) (tmp-name2 (tramp--test-make-temp-name nil quoted))
(tmp-name3 (tramp--test-make-temp-name 'local quoted))) (tmp-name3 (tramp--test-make-temp-name 'local quoted)))
@ -2825,7 +2825,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
;; We must unquote it. ;; We must unquote it.
(should (should
(string-equal (string-equal
(file-truename tmp-name1) (tramp-compat-file-name-unquote (file-truename tmp-name1))
(tramp-compat-file-name-unquote (file-truename tmp-name3))))) (tramp-compat-file-name-unquote (file-truename tmp-name3)))))
;; Cleanup. ;; Cleanup.
@ -2951,9 +2951,9 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-enabled))
(skip-unless (file-acl tramp-test-temporary-file-directory)) (skip-unless (file-acl tramp-test-temporary-file-directory))
;; TODO: The quoted case does not work. Copy local file to remote. ;; `filename-non-special' has been fixed in Emacs 26.1, see Bug#29579.
;;(dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) (dolist (quoted (if (and tramp--test-expensive-test (tramp--test-emacs26-p))
(let (quoted) '(nil t) '(nil)))
(let ((tmp-name1 (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)) (tmp-name2 (tramp--test-make-temp-name nil quoted))
(tmp-name3 (tramp--test-make-temp-name 'local quoted))) (tmp-name3 (tramp--test-make-temp-name 'local quoted)))
@ -2968,13 +2968,14 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(should (file-acl tmp-name2)) (should (file-acl tmp-name2))
(should (string-equal (file-acl tmp-name1) (file-acl tmp-name2))) (should (string-equal (file-acl tmp-name1) (file-acl tmp-name2)))
;; Different permissions mean different ACLs. ;; Different permissions mean different ACLs.
(set-file-modes tmp-name1 #o777) (when (not (tramp--test-windows-nt-or-smb-p))
(set-file-modes tmp-name2 #o444) (set-file-modes tmp-name1 #o777)
(should-not (set-file-modes tmp-name2 #o444)
(string-equal (file-acl tmp-name1) (file-acl tmp-name2))) (should-not
;; Copy ACL. (string-equal (file-acl tmp-name1) (file-acl tmp-name2))))
(should (set-file-acl tmp-name2 (file-acl tmp-name1))) ;; Copy ACL. Not all remote handlers support it, so we test.
(should (string-equal (file-acl tmp-name1) (file-acl tmp-name2))) (when (set-file-acl tmp-name2 (file-acl tmp-name1))
(should (string-equal (file-acl tmp-name1) (file-acl tmp-name2))))
;; An invalid ACL does not harm. ;; An invalid ACL does not harm.
(should-not (set-file-acl tmp-name2 "foo"))) (should-not (set-file-acl tmp-name2 "foo")))
@ -3028,9 +3029,9 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(not (equal (file-selinux-context tramp-test-temporary-file-directory) (not (equal (file-selinux-context tramp-test-temporary-file-directory)
'(nil nil nil nil)))) '(nil nil nil nil))))
;; TODO: The quoted case does not work. Copy local file to remote. ;; `filename-non-special' has been fixed in Emacs 26.1, see Bug#29579.
;;(dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) (dolist (quoted (if (and tramp--test-expensive-test (tramp--test-emacs26-p))
(let (quoted) '(nil t) '(nil)))
(let ((tmp-name1 (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)) (tmp-name2 (tramp--test-make-temp-name nil quoted))
(tmp-name3 (tramp--test-make-temp-name 'local quoted))) (tmp-name3 (tramp--test-make-temp-name 'local quoted)))
@ -3823,8 +3824,6 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(format "#%s#" (file-name-nondirectory tmp-name1)) (format "#%s#" (file-name-nondirectory tmp-name1))
tramp-test-temporary-file-directory)))))) tramp-test-temporary-file-directory))))))
;; TODO: The following two cases don't work yet.
(when nil
;; Use default `tramp-auto-save-directory' mechanism. ;; Use default `tramp-auto-save-directory' mechanism.
(let ((tramp-auto-save-directory tmp-name2)) (let ((tramp-auto-save-directory tmp-name2))
(with-temp-buffer (with-temp-buffer
@ -3869,7 +3868,6 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(tramp-compat-file-name-unquote tmp-name1))) (tramp-compat-file-name-unquote tmp-name1)))
tmp-name2))) tmp-name2)))
(should (file-directory-p tmp-name2))))) (should (file-directory-p tmp-name2)))))
) ;; TODO
;; Cleanup. ;; Cleanup.
(ignore-errors (delete-file tmp-name1)) (ignore-errors (delete-file tmp-name1))
@ -4084,9 +4082,9 @@ This requires restrictions of file name syntax."
(defun tramp--test-check-files (&rest files) (defun tramp--test-check-files (&rest files)
"Run a simple but comprehensive test over every file in FILES." "Run a simple but comprehensive test over every file in FILES."
;; TODO: The quoted case does not work. ;; `filename-non-special' has been fixed in Emacs 26.1, see Bug#29579.
;;(dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) (dolist (quoted (if (and tramp--test-expensive-test (tramp--test-emacs26-p))
(let (quoted) '(nil t) '(nil)))
;; We must use `file-truename' for the temporary directory, ;; We must use `file-truename' for the temporary directory,
;; because it could be located on a symlinked directory. This ;; because it could be located on a symlinked directory. This
;; would let the test fail. ;; would let the test fail.