From a1bbc490155b61a634a6d0b165000ce35b93aa35 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 6 Dec 2017 20:49:30 +0100 Subject: [PATCH] Fix Bug#29579 * 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. --- lisp/files.el | 111 +++++++++++++++++++---------------- lisp/net/tramp-compat.el | 6 +- lisp/net/tramp-sh.el | 1 + lisp/net/tramp-smb.el | 9 ++- lisp/net/tramp.el | 6 +- test/lisp/net/tramp-tests.el | 50 ++++++++-------- 6 files changed, 97 insertions(+), 86 deletions(-) diff --git a/lisp/files.el b/lisp/files.el index ef4c2ea8185..4b6d4e88acb 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -6975,60 +6975,67 @@ only these files will be asked to be saved." ;; We depend on being the last handler on the list, ;; so that anything else which does need handling ;; 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) - (let ((file-name-handler-alist nil) - (default-directory - ;; Some operations respect file name handlers in - ;; `default-directory'. Because core function like - ;; `call-process' don't care about file name handlers in - ;; `default-directory', we here have to resolve the - ;; directory into a local one. For `process-file', - ;; `start-file-process', and `shell-command', this fixes - ;; Bug#25949. - (if (memq operation '(insert-directory process-file start-file-process - shell-command)) - (directory-file-name - (expand-file-name - (unhandled-file-name-directory default-directory))) - default-directory)) - ;; Get a list of the indices of the args which are file names. - (file-arg-indices - (cdr (or (assq operation - ;; The first six are special because they - ;; return a file name. We want to include the /: - ;; in the return value. - ;; So just avoid stripping it in the first place. - '((expand-file-name . nil) - (file-name-directory . nil) - (file-name-as-directory . nil) - (directory-file-name . nil) - (file-name-sans-versions . nil) - (find-backup-file-name . nil) - ;; `identity' means just return the first arg - ;; not stripped of its quoting. - (substitute-in-file-name identity) - ;; `add' means add "/:" to the result. - (file-truename add 0) - (insert-file-contents insert-file-contents 0) - ;; `unquote-then-quote' means set buffer-file-name - ;; temporarily to unquoted filename. - (verify-visited-file-modtime unquote-then-quote) - ;; List the arguments which are filenames. - (file-name-completion 1) - (file-name-all-completions 1) - (write-region 2 5) - (rename-file 0 1) - (copy-file 0 1) - (make-symbolic-link 0 1) - (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))) + (let* ((op-returns-file-name-list + '(expand-file-name file-name-directory file-name-as-directory + directory-file-name file-name-sans-versions + find-backup-file-name file-remote-p)) + (file-name-handler-alist + (and + (not (memq operation op-returns-file-name-list)) + file-name-handler-alist)) + (default-directory + ;; Some operations respect file name handlers in + ;; `default-directory'. Because core function like + ;; `call-process' don't care about file name handlers in + ;; `default-directory', we here have to resolve the + ;; directory into a local one. For `process-file', + ;; `start-file-process', and `shell-command', this fixes + ;; Bug#25949. + (if (memq operation + '(insert-directory process-file start-file-process + shell-command)) + (directory-file-name + (expand-file-name + (unhandled-file-name-directory default-directory))) + default-directory)) + ;; Get a list of the indices of the args which are file names. + (file-arg-indices + (cdr (or (assq operation + ;; The first seven are special because they + ;; return a file name. We want to include the /: + ;; in the return value. + ;; So just avoid stripping it in the first place. + (append + (mapcar 'list op-returns-file-name-list) + '(;; `identity' means just return the first arg + ;; not stripped of its quoting. + (substitute-in-file-name identity) + ;; `add' means add "/:" to the result. + (file-truename add 0) + (insert-file-contents insert-file-contents 0) + ;; `unquote-then-quote' means set buffer-file-name + ;; temporarily to unquoted filename. + (verify-visited-file-modtime unquote-then-quote) + ;; List the arguments which are filenames. + (file-name-completion 1) + (file-name-all-completions 1) + (write-region 2 5) + (rename-file 0 1) + (copy-file 0 1) + (copy-directory 0 1) + (file-in-directory-p 0 1) + (make-symbolic-link 0 1) + (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)) (setq method (pop file-arg-indices))) ;; Strip off the /: from the file names that have it. diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 9326f7b1864..9cdfc065128 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -210,8 +210,10 @@ If NAME is a remote file name, check the local part of NAME." (defsubst tramp-compat-file-name-quote (name) "Add the quotation prefix \"/:\" to file NAME. If NAME is a remote file name, the local part of NAME is quoted." - (concat - (file-remote-p name) "/:" (or (file-remote-p name 'localname) name)))) + (if (tramp-compat-file-name-quoted-p name) + name + (concat + (file-remote-p name) "/:" (or (file-remote-p name 'localname) name))))) (if (fboundp 'file-name-unquote) (defalias 'tramp-compat-file-name-unquote 'file-name-unquote) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index acb5a12ba2a..14c1a4049aa 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1036,6 +1036,7 @@ of command line.") (load . tramp-handle-load) (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) (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-symbolic-link . tramp-sh-handle-make-symbolic-link) (process-file . tramp-sh-handle-process-file) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index eb0d6b50731..a4d4b4e0bcf 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -437,7 +437,7 @@ pass to the OPERATION." (delete-directory tmpdir 'recursive)))) ;; We can copy recursively. - ;; Does not work reliably. + ;; TODO: Does not work reliably. (nil ;(and (or t1 t2) (tramp-smb-get-cifs-capabilities v)) (when (and (file-directory-p newname) (not (string-equal (file-name-nondirectory dirname) @@ -1015,7 +1015,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (save-match-data (let ((base (file-name-nondirectory filename)) ;; We should not destroy the cache entry. - (entries (copy-sequence + (entries (copy-tree (tramp-smb-get-file-entries (file-name-directory filename)))) (avail (get-free-disk-space filename)) @@ -1441,7 +1441,7 @@ component is used as the target of the symlink." (tramp-set-connection-property v "process-buffer" (current-buffer)) - ;; Use an asynchronous processes. By this, password can + ;; Use an asynchronous process. By this, password can ;; be handled. (let ((p (apply 'start-process @@ -1456,6 +1456,9 @@ component is used as the target of the symlink." (set-process-query-on-exit-flag p nil) (tramp-process-actions p v nil tramp-smb-actions-set-acl) (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) (tramp-error v 'file-error diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 124da173484..2fdc651a372 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -670,8 +670,8 @@ It can have the following values: `simplified' -- Ange-FTP like syntax `separate' -- Syntax as defined for XEmacs originally -Do not change the value by `setq', it must be changed only by -`custom-set-variables'. See also `tramp-change-syntax'." +Do not change the value by `setq', it must be changed only via +Customize. See also `tramp-change-syntax'." :group 'tramp :version "26.1" :package-version '(Tramp . "2.3.3") @@ -3217,7 +3217,7 @@ User is always nil." (tramp-error v1 'file-error "Maximum number (%d) of symlinks exceeded" numchase-limit))) - result)) + (directory-file-name result))) ;; Preserve trailing "/". (if (string-equal (file-name-nondirectory filename) "") "/" "")))) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index b0fe3f83e97..0490daa9575 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -1882,9 +1882,9 @@ This checks also `file-name-as-directory', `file-name-directory', "Check `copy-file'." (skip-unless (tramp--test-enabled)) - ;; TODO: The quoted case does not work. Copy local file to remote. - ;;(dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) - (let (quoted) + ;; `filename-non-special' has been fixed in Emacs 26.1, see Bug#29579. + (dolist (quoted (if (and tramp--test-expensive-test (tramp--test-emacs26-p)) + '(nil t) '(nil))) (let ((tmp-name1 (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))) @@ -1984,9 +1984,9 @@ This checks also `file-name-as-directory', `file-name-directory', "Check `rename-file'." (skip-unless (tramp--test-enabled)) - ;; TODO: The quoted case does not work. - ;;(dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) - (let (quoted) + ;; `filename-non-special' has been fixed in Emacs 26.1, see Bug#29579. + (dolist (quoted (if (and tramp--test-expensive-test (tramp--test-emacs26-p)) + '(nil t) '(nil))) (let ((tmp-name1 (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))) @@ -2825,7 +2825,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; We must unquote it. (should (string-equal - (file-truename tmp-name1) + (tramp-compat-file-name-unquote (file-truename tmp-name1)) (tramp-compat-file-name-unquote (file-truename tmp-name3))))) ;; 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 (file-acl tramp-test-temporary-file-directory)) - ;; TODO: The quoted case does not work. Copy local file to remote. - ;;(dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) - (let (quoted) + ;; `filename-non-special' has been fixed in Emacs 26.1, see Bug#29579. + (dolist (quoted (if (and tramp--test-expensive-test (tramp--test-emacs26-p)) + '(nil t) '(nil))) (let ((tmp-name1 (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))) @@ -2968,13 +2968,14 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (file-acl tmp-name2)) (should (string-equal (file-acl tmp-name1) (file-acl tmp-name2))) ;; Different permissions mean different ACLs. - (set-file-modes tmp-name1 #o777) - (set-file-modes tmp-name2 #o444) - (should-not - (string-equal (file-acl tmp-name1) (file-acl tmp-name2))) - ;; Copy ACL. - (should (set-file-acl tmp-name2 (file-acl tmp-name1))) - (should (string-equal (file-acl tmp-name1) (file-acl tmp-name2))) + (when (not (tramp--test-windows-nt-or-smb-p)) + (set-file-modes tmp-name1 #o777) + (set-file-modes tmp-name2 #o444) + (should-not + (string-equal (file-acl tmp-name1) (file-acl tmp-name2)))) + ;; Copy ACL. Not all remote handlers support it, so we test. + (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. (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) '(nil nil nil nil)))) - ;; TODO: The quoted case does not work. Copy local file to remote. - ;;(dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) - (let (quoted) + ;; `filename-non-special' has been fixed in Emacs 26.1, see Bug#29579. + (dolist (quoted (if (and tramp--test-expensive-test (tramp--test-emacs26-p)) + '(nil t) '(nil))) (let ((tmp-name1 (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))) @@ -3823,8 +3824,6 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (format "#%s#" (file-name-nondirectory tmp-name1)) tramp-test-temporary-file-directory)))))) - ;; TODO: The following two cases don't work yet. - (when nil ;; Use default `tramp-auto-save-directory' mechanism. (let ((tramp-auto-save-directory tmp-name2)) (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))) tmp-name2))) (should (file-directory-p tmp-name2))))) - ) ;; TODO ;; Cleanup. (ignore-errors (delete-file tmp-name1)) @@ -4084,9 +4082,9 @@ This requires restrictions of file name syntax." (defun tramp--test-check-files (&rest files) "Run a simple but comprehensive test over every file in FILES." - ;; TODO: The quoted case does not work. - ;;(dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) - (let (quoted) + ;; `filename-non-special' has been fixed in Emacs 26.1, see Bug#29579. + (dolist (quoted (if (and tramp--test-expensive-test (tramp--test-emacs26-p)) + '(nil t) '(nil))) ;; We must use `file-truename' for the temporary directory, ;; because it could be located on a symlinked directory. This ;; would let the test fail. -- 2.39.2