From: Michael Albinus Date: Sat, 26 Aug 2017 13:09:55 +0000 (+0200) Subject: Fix Tramp part of Bug#28156 X-Git-Tag: emacs-26.0.90~347 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=cc7530cae09b0aa4d648d92ca0f82c81439a6b34;p=emacs.git Fix Tramp part of Bug#28156 * lisp/files.el (file-name-non-special): Use `file-name-quote' instead prefixing "/:", the file could already be quoted. * lisp/net/tramp.el (tramp-error): Handle null arguments. (tramp-handle-make-symbolic-link): * lisp/net/tramp-sh.el (tramp-sh-handle-make-symbolic-link) (tramp-sh-handle-add-name-to-file): * lisp/net/tramp-smb.el (tramp-smb-handle-add-name-to-file) (tramp-smb-handle-make-symbolic-link): Adapt implementation to stronger semantics in Emacs. (Bug#28156) * test/lisp/net/tramp-tests.el (tramp-test21-file-links): Extend test. --- diff --git a/lisp/files.el b/lisp/files.el index 77ebd94836e..ca3b055d7a6 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -6955,7 +6955,7 @@ only these files will be asked to be saved." (setq file-arg-indices (cdr file-arg-indices)))) (pcase method (`identity (car arguments)) - (`add (concat "/:" (apply operation arguments))) + (`add (file-name-quote (apply operation arguments))) (`insert-file-contents (let ((visit (nth 1 arguments))) (unwind-protect diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 50b380100ba..6251248e282 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1057,62 +1057,61 @@ Operations not mentioned here will be handled by the normal Emacs functions.") ;;; File Name Handler Functions: (defun tramp-sh-handle-make-symbolic-link - (filename linkname &optional ok-if-already-exists) + (target linkname &optional ok-if-already-exists) "Like `make-symbolic-link' for Tramp files. -If LINKNAME is a non-Tramp file, it is used verbatim as the target of -the symlink. If LINKNAME is a Tramp file, only the localname component is -used as the target of the symlink. - -If LINKNAME is a Tramp file and the localname component is relative, then -it is expanded first, before the localname component is taken. Note that -this can give surprising results if the user/host for the source and -target of the symlink differ." - (with-parsed-tramp-file-name linkname l - (let ((ln (tramp-get-remote-ln l)) - (cwd (tramp-run-real-handler - 'file-name-directory (list l-localname)))) - (unless ln - (tramp-error - l 'file-error - "Making a symbolic link. ln(1) does not exist on the remote host.")) - - ;; Do the 'confirm if exists' thing. - (when (file-exists-p linkname) - ;; What to do? - (if (or (null ok-if-already-exists) ; not allowed to exist - (and (numberp ok-if-already-exists) - (not (yes-or-no-p - (format - "File %s already exists; make it a link anyway? " - l-localname))))) - (tramp-error l 'file-already-exists l-localname) - (delete-file linkname))) - - ;; If FILENAME is a Tramp name, use just the localname component. - (when (tramp-tramp-file-p filename) - (setq filename - (tramp-file-name-localname - (tramp-dissect-file-name (expand-file-name filename))))) - - (tramp-flush-file-property l (file-name-directory l-localname)) - (tramp-flush-file-property l l-localname) - - ;; Right, they are on the same host, regardless of user, method, - ;; etc. We now make the link on the remote machine. This will - ;; occur as the user that FILENAME belongs to. - (and (tramp-send-command-and-check - l (format "cd %s" (tramp-shell-quote-argument cwd))) - (tramp-send-command-and-check - l (format - "%s -sf %s %s" - ln - (tramp-shell-quote-argument filename) - ;; The command could exceed PATH_MAX, so we use - ;; relative file names. However, relative file names - ;; could start with "-". `tramp-shell-quote-argument' - ;; does not handle this, we must do it ourselves. - (tramp-shell-quote-argument - (concat "./" (file-name-nondirectory l-localname))))))))) +If TARGET is a non-Tramp file, it is used verbatim as the target +of the symlink. If TARGET is a Tramp file, only the localname +component is used as the target of the symlink." + (if (not (tramp-tramp-file-p (expand-file-name linkname))) + (tramp-run-real-handler + 'make-symbolic-link (list target linkname ok-if-already-exists)) + + (with-parsed-tramp-file-name linkname nil + (let ((ln (tramp-get-remote-ln v)) + (cwd (tramp-run-real-handler + 'file-name-directory (list localname)))) + (unless ln + (tramp-error + v 'file-error + "Making a symbolic link. ln(1) does not exist on the remote host.")) + + ;; Do the 'confirm if exists' thing. + (when (file-exists-p linkname) + ;; What to do? + (if (or (null ok-if-already-exists) ; not allowed to exist + (and (numberp ok-if-already-exists) + (not (yes-or-no-p + (format + "File %s already exists; make it a link anyway? " + localname))))) + (tramp-error v 'file-already-exists localname) + (delete-file linkname))) + + ;; If TARGET is a Tramp name, use just the localname component. + (when (tramp-file-name-equal-p + v (tramp-dissect-file-name (expand-file-name target))) + (setq target + (tramp-file-name-localname + (tramp-dissect-file-name (expand-file-name target))))) + + (tramp-flush-file-property v (file-name-directory localname)) + (tramp-flush-file-property v localname) + + ;; Right, they are on the same host, regardless of user, method, + ;; etc. We now make the link on the remote machine. This will + ;; occur as the user that TARGET belongs to. + (and (tramp-send-command-and-check + v (format "cd %s" (tramp-shell-quote-argument cwd))) + (tramp-send-command-and-check + v (format + "%s -sf %s %s" ln + (tramp-shell-quote-argument target) + ;; The command could exceed PATH_MAX, so we use + ;; relative file names. However, relative file names + ;; could start with "-". `tramp-shell-quote-argument' + ;; does not handle this, we must do it ourselves. + (tramp-shell-quote-argument + (concat "./" (file-name-nondirectory localname)))))))))) (defun tramp-sh-handle-file-truename (filename) "Like `file-truename' for Tramp files." @@ -1918,14 +1917,18 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'" (with-parsed-tramp-file-name filename v1 (with-parsed-tramp-file-name newname v2 (let ((ln (when v1 (tramp-get-remote-ln v1)))) - (when (and (numberp ok-if-already-exists) - (file-exists-p newname) - (yes-or-no-p - (format - "File %s already exists; make it a new name anyway? " - newname))) - (tramp-error v2 'file-already-exists newname)) - (when ok-if-already-exists (setq ln (concat ln " -f"))) + + ;; Do the 'confirm if exists' thing. + (when (file-exists-p newname) + ;; What to do? + (if (or (null ok-if-already-exists) ; not allowed to exist + (and (numberp ok-if-already-exists) + (not (yes-or-no-p + (format + "File %s already exists; make it a link anyway? " + v2-localname))))) + (tramp-error v2 'file-already-exists newname) + (delete-file newname))) (tramp-flush-file-property v2 (file-name-directory v2-localname)) (tramp-flush-file-property v2 v2-localname) (tramp-barf-unless-okay diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 367beb823aa..f734b80d535 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -354,16 +354,17 @@ pass to the OPERATION." (tramp-error v2 'file-error "add-name-to-file: %s must not be a directory" filename)) - (when (and (not ok-if-already-exists) - (file-exists-p newname) - (not (numberp ok-if-already-exists)) - (y-or-n-p - (format - "File %s already exists; make it a new name anyway? " - newname))) - (tramp-error - v2 'file-error - "add-name-to-file: file %s already exists" newname)) + ;; Do the 'confirm if exists' thing. + (when (file-exists-p newname) + ;; What to do? + (if (or (null ok-if-already-exists) ; not allowed to exist + (and (numberp ok-if-already-exists) + (not (yes-or-no-p + (format + "File %s already exists; make it a link anyway? " + v2-localname))))) + (tramp-error v2 'file-already-exists newname) + (delete-file newname))) ;; We must also flush the cache of the directory, because ;; `file-attributes' reads the values from there. (tramp-flush-file-property v2 (file-name-directory v2-localname)) @@ -1095,54 +1096,56 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." v 'file-error "Couldn't make directory %s" directory)))))) (defun tramp-smb-handle-make-symbolic-link - (filename linkname &optional ok-if-already-exists) + (target linkname &optional ok-if-already-exists) "Like `make-symbolic-link' for Tramp files. -If LINKNAME is a non-Tramp file, it is used verbatim as the target of -the symlink. If LINKNAME is a Tramp file, only the localname component is -used as the target of the symlink. - -If LINKNAME is a Tramp file and the localname component is relative, then -it is expanded first, before the localname component is taken. Note that -this can give surprising results if the user/host for the source and -target of the symlink differ." - (unless (tramp-equal-remote filename linkname) - (with-parsed-tramp-file-name - (if (tramp-tramp-file-p filename) filename linkname) nil - (tramp-error - v 'file-error - "make-symbolic-link: %s" - "only implemented for same method, same user, same host"))) - (with-parsed-tramp-file-name filename v1 - (with-parsed-tramp-file-name linkname v2 - (when (file-directory-p filename) - (tramp-error - v2 'file-error - "make-symbolic-link: %s must not be a directory" filename)) - (when (and (not ok-if-already-exists) - (file-exists-p linkname) - (not (numberp ok-if-already-exists)) - (y-or-n-p - (format - "File %s already exists; make it a new name anyway? " - linkname))) - (tramp-error v2 'file-already-exists linkname)) - (unless (tramp-smb-get-cifs-capabilities v1) - (tramp-error v2 'file-error "make-symbolic-link not supported")) - ;; We must also flush the cache of the directory, because - ;; `file-attributes' reads the values from there. - (tramp-flush-file-property v2 (file-name-directory v2-localname)) - (tramp-flush-file-property v2 v2-localname) - (unless - (tramp-smb-send-command - v1 - (format - "symlink \"%s\" \"%s\"" - (tramp-smb-get-localname v1) - (tramp-smb-get-localname v2))) +If TARGET is a non-Tramp file, it is used verbatim as the target +of the symlink. If TARGET is a Tramp file, only the localname +component is used as the target of the symlink." + (if (not (tramp-tramp-file-p (expand-file-name linkname))) + (tramp-run-real-handler + 'make-symbolic-link (list target linkname ok-if-already-exists)) + + (unless (tramp-equal-remote target linkname) + (with-parsed-tramp-file-name + (if (tramp-tramp-file-p target) target linkname) nil (tramp-error - v2 'file-error - "error with make-symbolic-link, see buffer `%s' for details" - (buffer-name)))))) + v 'file-error + "make-symbolic-link: %s" + "only implemented for same method, same user, same host"))) + (with-parsed-tramp-file-name target v1 + (with-parsed-tramp-file-name linkname v2 + (when (file-directory-p target) + (tramp-error + v2 'file-error + "make-symbolic-link: %s must not be a directory" target)) + ;; Do the 'confirm if exists' thing. + (when (file-exists-p linkname) + ;; What to do? + (if (or (null ok-if-already-exists) ; not allowed to exist + (and (numberp ok-if-already-exists) + (not (yes-or-no-p + (format + "File %s already exists; make it a link anyway? " + v2-localname))))) + (tramp-error v2 'file-already-exists v2-localname) + (delete-file linkname))) + (unless (tramp-smb-get-cifs-capabilities v1) + (tramp-error v2 'file-error "make-symbolic-link not supported")) + ;; We must also flush the cache of the directory, because + ;; `file-attributes' reads the values from there. + (tramp-flush-file-property v2 (file-name-directory v2-localname)) + (tramp-flush-file-property v2 v2-localname) + (unless + (tramp-smb-send-command + v1 + (format + "symlink \"%s\" \"%s\"" + (tramp-smb-get-localname v1) + (tramp-smb-get-localname v2))) + (tramp-error + v2 'file-error + "error with make-symbolic-link, see buffer `%s' for details" + (buffer-name))))))) (defun tramp-smb-handle-process-file (program &optional infile destination display &rest args) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index ef3e62ccce3..bb68b9e9645 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1597,6 +1597,12 @@ signal identifier to be raised, remaining arguments passed to `tramp-message'. Finally, signal SIGNAL is raised." (let (tramp-message-show-message) (tramp-backtrace vec-or-proc) + (unless arguments + ;; FMT-STRING could be just a file name, as in + ;; `file-already-exists' errors. It could contain the ?\% + ;; character, as in smb domain spec. + (setq arguments (list fmt-string) + fmt-string "%s")) (when vec-or-proc (tramp-message vec-or-proc 1 "%s" @@ -2009,6 +2015,11 @@ ARGS are the arguments OPERATION has been called with." '(add-name-to-file copy-directory copy-file expand-file-name file-equal-p file-in-directory-p file-name-all-completions file-name-completion + ;; Starting with Emacs 26.1, just the 2nd argument of + ;; `make-symbolic-link' matters. For backward + ;; compatibility, we still accept the first argument as + ;; file name to be checked. Handled properly in + ;; `tramp-handle-*-make-symbolic-link'. file-newer-than-file-p make-symbolic-link rename-file)) (save-match-data (cond @@ -3262,11 +3273,18 @@ User is always nil." t))) (defun tramp-handle-make-symbolic-link - (filename linkname &optional _ok-if-already-exists) - "Like `make-symbolic-link' for Tramp files." - (with-parsed-tramp-file-name - (if (tramp-tramp-file-p filename) filename linkname) nil - (tramp-error v 'file-error "make-symbolic-link not supported"))) + (target linkname &optional ok-if-already-exists) + "Like `make-symbolic-link' for Tramp files. +This is the fallback implementation for backends which do not +support symbolic links." + (if (tramp-tramp-file-p (expand-file-name linkname)) + (tramp-error + (tramp-dissect-file-name (expand-file-name linkname)) 'file-error + "make-symbolic-link not supported") + ;; This is needed prior Emacs 26.1, where TARGET has also be + ;; checked for a file name handler. + (tramp-run-real-handler + 'make-symbolic-link (list target linkname ok-if-already-exists)))) (defun tramp-handle-shell-command (command &optional output-buffer error-buffer) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 55f4b52ccdf..3dbb522a7cd 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2587,16 +2587,19 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (not (string-equal (error-message-string err) "make-symbolic-link not supported"))))) (should (file-symlink-p tmp-name2)) - (should-error (make-symbolic-link tmp-name1 tmp-name2)) + (should-error (make-symbolic-link tmp-name1 tmp-name2) + :type 'file-already-exists) (make-symbolic-link tmp-name1 tmp-name2 'ok-if-already-exists) (should (file-symlink-p tmp-name2)) ;; `tmp-name3' is a local file name. - (should-error (make-symbolic-link tmp-name1 tmp-name3))) + (make-symbolic-link tmp-name1 tmp-name3) + (should (file-symlink-p tmp-name3))) ;; Cleanup. (ignore-errors (delete-file tmp-name1) - (delete-file tmp-name2))) + (delete-file tmp-name2) + (delete-file tmp-name3))) ;; Check `add-name-to-file'. (unwind-protect @@ -2605,7 +2608,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (file-exists-p tmp-name1)) (add-name-to-file tmp-name1 tmp-name2) (should-not (file-symlink-p tmp-name2)) - (should-error (add-name-to-file tmp-name1 tmp-name2)) + (should-error (add-name-to-file tmp-name1 tmp-name2) + :type 'file-already-exists) (add-name-to-file tmp-name1 tmp-name2 'ok-if-already-exists) (should-not (file-symlink-p tmp-name2)) ;; `tmp-name3' is a local file name. @@ -2626,10 +2630,24 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should-not (string-equal tmp-name2 (file-truename tmp-name2))) (should (string-equal (file-truename tmp-name1) (file-truename tmp-name2))) - (should (file-equal-p tmp-name1 tmp-name2))) + (should (file-equal-p tmp-name1 tmp-name2)) + ;; `tmp-name3' is a local file name. + (make-symbolic-link tmp-name1 tmp-name3) + (should (file-symlink-p tmp-name3)) + (should-not (string-equal tmp-name3 (file-truename tmp-name3))) + ;; `file-truename' returns a quoted file name for `tmp-name3'. + ;; We must unquote it. + (should + (string-equal + (file-truename tmp-name1) + (funcall + 'tramp-compat-file-name-unquote (file-truename tmp-name3))))) + + ;; Cleanup. (ignore-errors (delete-file tmp-name1) - (delete-file tmp-name2))) + (delete-file tmp-name2) + (delete-file tmp-name3))) ;; `file-truename' shall preserve trailing link of directories. (unless (file-symlink-p tramp-test-temporary-file-directory)