diff options
| author | Michael Albinus | 2017-12-06 20:49:30 +0100 |
|---|---|---|
| committer | Michael Albinus | 2017-12-09 11:33:48 +0100 |
| commit | 9d9cbafce2d8ca00f61cc276d8a2a08c8211e82d (patch) | |
| tree | 83090cc3d9f1da817133c00f3e7cb00f6c87b046 /lisp | |
| parent | 01db80046f41c94569efd5dcdb11a1e46b3f16f3 (diff) | |
| download | emacs-9d9cbafce2d8ca00f61cc276d8a2a08c8211e82d.tar.gz emacs-9d9cbafce2d8ca00f61cc276d8a2a08c8211e82d.zip | |
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.
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/files.el | 111 | ||||
| -rw-r--r-- | lisp/net/tramp-compat.el | 6 | ||||
| -rw-r--r-- | lisp/net/tramp-sh.el | 1 | ||||
| -rw-r--r-- | lisp/net/tramp-smb.el | 9 | ||||
| -rw-r--r-- | lisp/net/tramp.el | 2 |
5 files changed, 71 insertions, 58 deletions
diff --git a/lisp/files.el b/lisp/files.el index a7ad40b76cd..8045ba5c22b 100644 --- a/lisp/files.el +++ b/lisp/files.el | |||
| @@ -6956,60 +6956,67 @@ only these files will be asked to be saved." | |||
| 6956 | ;; We depend on being the last handler on the list, | 6956 | ;; We depend on being the last handler on the list, |
| 6957 | ;; so that anything else which does need handling | 6957 | ;; so that anything else which does need handling |
| 6958 | ;; has been handled already. | 6958 | ;; has been handled already. |
| 6959 | ;; So it is safe for us to inhibit *all* magic file name handlers. | 6959 | ;; So it is safe for us to inhibit *all* magic file name handlers for |
| 6960 | ;; operations, which return a file name. See Bug#29579. | ||
| 6960 | 6961 | ||
| 6961 | (defun file-name-non-special (operation &rest arguments) | 6962 | (defun file-name-non-special (operation &rest arguments) |
| 6962 | (let ((file-name-handler-alist nil) | 6963 | (let* ((op-returns-file-name-list |
| 6963 | (default-directory | 6964 | '(expand-file-name file-name-directory file-name-as-directory |
| 6964 | ;; Some operations respect file name handlers in | 6965 | directory-file-name file-name-sans-versions |
| 6965 | ;; `default-directory'. Because core function like | 6966 | find-backup-file-name file-remote-p)) |
| 6966 | ;; `call-process' don't care about file name handlers in | 6967 | (file-name-handler-alist |
| 6967 | ;; `default-directory', we here have to resolve the | 6968 | (and |
| 6968 | ;; directory into a local one. For `process-file', | 6969 | (not (memq operation op-returns-file-name-list)) |
| 6969 | ;; `start-file-process', and `shell-command', this fixes | 6970 | file-name-handler-alist)) |
| 6970 | ;; Bug#25949. | 6971 | (default-directory |
| 6971 | (if (memq operation '(insert-directory process-file start-file-process | 6972 | ;; Some operations respect file name handlers in |
| 6972 | shell-command)) | 6973 | ;; `default-directory'. Because core function like |
| 6973 | (directory-file-name | 6974 | ;; `call-process' don't care about file name handlers in |
| 6974 | (expand-file-name | 6975 | ;; `default-directory', we here have to resolve the |
| 6975 | (unhandled-file-name-directory default-directory))) | 6976 | ;; directory into a local one. For `process-file', |
| 6976 | default-directory)) | 6977 | ;; `start-file-process', and `shell-command', this fixes |
| 6977 | ;; Get a list of the indices of the args which are file names. | 6978 | ;; Bug#25949. |
| 6978 | (file-arg-indices | 6979 | (if (memq operation |
| 6979 | (cdr (or (assq operation | 6980 | '(insert-directory process-file start-file-process |
| 6980 | ;; The first six are special because they | 6981 | shell-command)) |
| 6981 | ;; return a file name. We want to include the /: | 6982 | (directory-file-name |
| 6982 | ;; in the return value. | 6983 | (expand-file-name |
| 6983 | ;; So just avoid stripping it in the first place. | 6984 | (unhandled-file-name-directory default-directory))) |
| 6984 | '((expand-file-name . nil) | 6985 | default-directory)) |
| 6985 | (file-name-directory . nil) | 6986 | ;; Get a list of the indices of the args which are file names. |
| 6986 | (file-name-as-directory . nil) | 6987 | (file-arg-indices |
| 6987 | (directory-file-name . nil) | 6988 | (cdr (or (assq operation |
| 6988 | (file-name-sans-versions . nil) | 6989 | ;; The first seven are special because they |
| 6989 | (find-backup-file-name . nil) | 6990 | ;; return a file name. We want to include the /: |
| 6990 | ;; `identity' means just return the first arg | 6991 | ;; in the return value. |
| 6991 | ;; not stripped of its quoting. | 6992 | ;; So just avoid stripping it in the first place. |
| 6992 | (substitute-in-file-name identity) | 6993 | (append |
| 6993 | ;; `add' means add "/:" to the result. | 6994 | (mapcar 'list op-returns-file-name-list) |
| 6994 | (file-truename add 0) | 6995 | '(;; `identity' means just return the first arg |
| 6995 | (insert-file-contents insert-file-contents 0) | 6996 | ;; not stripped of its quoting. |
| 6996 | ;; `unquote-then-quote' means set buffer-file-name | 6997 | (substitute-in-file-name identity) |
| 6997 | ;; temporarily to unquoted filename. | 6998 | ;; `add' means add "/:" to the result. |
| 6998 | (verify-visited-file-modtime unquote-then-quote) | 6999 | (file-truename add 0) |
| 6999 | ;; List the arguments which are filenames. | 7000 | (insert-file-contents insert-file-contents 0) |
| 7000 | (file-name-completion 1) | 7001 | ;; `unquote-then-quote' means set buffer-file-name |
| 7001 | (file-name-all-completions 1) | 7002 | ;; temporarily to unquoted filename. |
| 7002 | (write-region 2 5) | 7003 | (verify-visited-file-modtime unquote-then-quote) |
| 7003 | (rename-file 0 1) | 7004 | ;; List the arguments which are filenames. |
| 7004 | (copy-file 0 1) | 7005 | (file-name-completion 1) |
| 7005 | (make-symbolic-link 0 1) | 7006 | (file-name-all-completions 1) |
| 7006 | (add-name-to-file 0 1))) | 7007 | (write-region 2 5) |
| 7007 | ;; For all other operations, treat the first argument only | 7008 | (rename-file 0 1) |
| 7008 | ;; as the file name. | 7009 | (copy-file 0 1) |
| 7009 | '(nil 0)))) | 7010 | (copy-directory 0 1) |
| 7010 | method | 7011 | (file-in-directory-p 0 1) |
| 7011 | ;; Copy ARGUMENTS so we can replace elements in it. | 7012 | (make-symbolic-link 0 1) |
| 7012 | (arguments (copy-sequence arguments))) | 7013 | (add-name-to-file 0 1)))) |
| 7014 | ;; For all other operations, treat the first argument only | ||
| 7015 | ;; as the file name. | ||
| 7016 | '(nil 0)))) | ||
| 7017 | method | ||
| 7018 | ;; Copy ARGUMENTS so we can replace elements in it. | ||
| 7019 | (arguments (copy-sequence arguments))) | ||
| 7013 | (if (symbolp (car file-arg-indices)) | 7020 | (if (symbolp (car file-arg-indices)) |
| 7014 | (setq method (pop file-arg-indices))) | 7021 | (setq method (pop file-arg-indices))) |
| 7015 | ;; Strip off the /: from the file names that have it. | 7022 | ;; 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." | |||
| 210 | (defsubst tramp-compat-file-name-quote (name) | 210 | (defsubst tramp-compat-file-name-quote (name) |
| 211 | "Add the quotation prefix \"/:\" to file NAME. | 211 | "Add the quotation prefix \"/:\" to file NAME. |
| 212 | If NAME is a remote file name, the local part of NAME is quoted." | 212 | If NAME is a remote file name, the local part of NAME is quoted." |
| 213 | (concat | 213 | (if (tramp-compat-file-name-quoted-p name) |
| 214 | (file-remote-p name) "/:" (or (file-remote-p name 'localname) name)))) | 214 | name |
| 215 | (concat | ||
| 216 | (file-remote-p name) "/:" (or (file-remote-p name 'localname) name))))) | ||
| 215 | 217 | ||
| 216 | (if (fboundp 'file-name-unquote) | 218 | (if (fboundp 'file-name-unquote) |
| 217 | (defalias 'tramp-compat-file-name-unquote 'file-name-unquote) | 219 | (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.") | |||
| 1036 | (load . tramp-handle-load) | 1036 | (load . tramp-handle-load) |
| 1037 | (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) | 1037 | (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) |
| 1038 | (make-directory . tramp-sh-handle-make-directory) | 1038 | (make-directory . tramp-sh-handle-make-directory) |
| 1039 | ;; `make-directory-internal' performed by default handler. | ||
| 1039 | (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) | 1040 | (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) |
| 1040 | (make-symbolic-link . tramp-sh-handle-make-symbolic-link) | 1041 | (make-symbolic-link . tramp-sh-handle-make-symbolic-link) |
| 1041 | (process-file . tramp-sh-handle-process-file) | 1042 | (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." | |||
| 437 | (delete-directory tmpdir 'recursive)))) | 437 | (delete-directory tmpdir 'recursive)))) |
| 438 | 438 | ||
| 439 | ;; We can copy recursively. | 439 | ;; We can copy recursively. |
| 440 | ;; Does not work reliably. | 440 | ;; TODO: Does not work reliably. |
| 441 | (nil ;(and (or t1 t2) (tramp-smb-get-cifs-capabilities v)) | 441 | (nil ;(and (or t1 t2) (tramp-smb-get-cifs-capabilities v)) |
| 442 | (when (and (file-directory-p newname) | 442 | (when (and (file-directory-p newname) |
| 443 | (not (string-equal (file-name-nondirectory dirname) | 443 | (not (string-equal (file-name-nondirectory dirname) |
| @@ -1015,7 +1015,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." | |||
| 1015 | (save-match-data | 1015 | (save-match-data |
| 1016 | (let ((base (file-name-nondirectory filename)) | 1016 | (let ((base (file-name-nondirectory filename)) |
| 1017 | ;; We should not destroy the cache entry. | 1017 | ;; We should not destroy the cache entry. |
| 1018 | (entries (copy-sequence | 1018 | (entries (copy-tree |
| 1019 | (tramp-smb-get-file-entries | 1019 | (tramp-smb-get-file-entries |
| 1020 | (file-name-directory filename)))) | 1020 | (file-name-directory filename)))) |
| 1021 | (avail (get-free-disk-space filename)) | 1021 | (avail (get-free-disk-space filename)) |
| @@ -1441,7 +1441,7 @@ component is used as the target of the symlink." | |||
| 1441 | (tramp-set-connection-property | 1441 | (tramp-set-connection-property |
| 1442 | v "process-buffer" (current-buffer)) | 1442 | v "process-buffer" (current-buffer)) |
| 1443 | 1443 | ||
| 1444 | ;; Use an asynchronous processes. By this, password can | 1444 | ;; Use an asynchronous process. By this, password can |
| 1445 | ;; be handled. | 1445 | ;; be handled. |
| 1446 | (let ((p (apply | 1446 | (let ((p (apply |
| 1447 | 'start-process | 1447 | 'start-process |
| @@ -1456,6 +1456,9 @@ component is used as the target of the symlink." | |||
| 1456 | (set-process-query-on-exit-flag p nil) | 1456 | (set-process-query-on-exit-flag p nil) |
| 1457 | (tramp-process-actions p v nil tramp-smb-actions-set-acl) | 1457 | (tramp-process-actions p v nil tramp-smb-actions-set-acl) |
| 1458 | (goto-char (point-max)) | 1458 | (goto-char (point-max)) |
| 1459 | ;; This is meant for traces, and returning from the | ||
| 1460 | ;; function. No error is propagated outside, due to | ||
| 1461 | ;; the `ignore-errors' closure. | ||
| 1459 | (unless (re-search-backward "tramp_exit_status [0-9]+" nil t) | 1462 | (unless (re-search-backward "tramp_exit_status [0-9]+" nil t) |
| 1460 | (tramp-error | 1463 | (tramp-error |
| 1461 | v 'file-error | 1464 | v 'file-error |
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 433baed6ed6..2fdc651a372 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el | |||
| @@ -3217,7 +3217,7 @@ User is always nil." | |||
| 3217 | (tramp-error | 3217 | (tramp-error |
| 3218 | v1 'file-error | 3218 | v1 'file-error |
| 3219 | "Maximum number (%d) of symlinks exceeded" numchase-limit))) | 3219 | "Maximum number (%d) of symlinks exceeded" numchase-limit))) |
| 3220 | result)) | 3220 | (directory-file-name result))) |
| 3221 | 3221 | ||
| 3222 | ;; Preserve trailing "/". | 3222 | ;; Preserve trailing "/". |
| 3223 | (if (string-equal (file-name-nondirectory filename) "") "/" "")))) | 3223 | (if (string-equal (file-name-nondirectory filename) "") "/" "")))) |