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

Further fixes in tramp-smb.el

Browse source 
* lisp/net/tramp-smb.el (tramp-smb-handle-file-truename): New defun.
(tramp-smb-file-name-handler-alist): Use it.
(tramp-smb-handle-make-symbolic-link): Unquote target.

* test/lisp/net/tramp-tests.el
(tramp--test-ignore-make-symbolic-link-error): New defmacro.
(tramp-test18-file-attributes, tramp-test21-file-links)
(tramp--test-check-files): Use it.
This commit is contained in:
Michael Albinus 2017-08-28 18:08:16 +02:00
parent 32cdfa0e9c
commit 3a19e6ec23
2 changed files with 91 additions and 81 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -253,7 +253,7 @@ See `tramp-actions-before-shell' for more info.")
(file-remote-p . tramp-handle-file-remote-p)
;; `file-selinux-context' performed by default handler.
(file-symlink-p . tramp-handle-file-symlink-p)
;; `file-truename' performed by default handler.
(file-truename . tramp-smb-handle-file-truename)
(file-writable-p . tramp-smb-handle-file-writable-p)
(find-backup-file-name . tramp-handle-find-backup-file-name)
;; `find-file-noselect' performed by default handler.
@ -947,6 +947,23 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(nth 0 x))))
(tramp-smb-get-file-entries directory))))))))
(defun tramp-smb-handle-file-truename (filename)
"Like `file-truename' for Tramp files."
(format
"%s%s"
(with-parsed-tramp-file-name (expand-file-name filename) nil
(tramp-make-tramp-file-name
method user domain host port
(with-tramp-file-property v localname "file-truename"
(funcall
(if (tramp-compat-file-name-quoted-p localname)
'tramp-compat-file-name-quote 'identity)
;; We don't follow symlink of symlink.
(or (file-symlink-p filename) localname)))))
;; Preserve trailing "/".
(if (string-equal (file-name-nondirectory filename) "") "/" "")))
(defun tramp-smb-handle-file-writable-p (filename)
"Like `file-writable-p' for Tramp files."
(if (file-exists-p filename)
@ -1147,8 +1164,9 @@ component is used as the target of the symlink."
(unless
(tramp-smb-send-command
v
(format "symlink \"%s\" \"%s\"" target (tramp-smb-get-localname v)))
v (format "symlink \"%s\" \"%s\""
(tramp-compat-file-name-unquote target)
(tramp-smb-get-localname v)))
(tramp-error
v 'file-error
"error with make-symbolic-link, see buffer `%s' for details"

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

@ -2374,6 +2374,20 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
(ignore-errors (delete-directory tmp-name1 'recursive))
(ignore-errors (delete-directory tmp-name2 'recursive))))))
;; Method "smb" supports `make-symbolic-link' only if the remote host
;; has CIFS capabilities. tramp-adb.el and tramp-gvfs.el do not
;; support symbolic links at all.
(defmacro tramp--test-ignore-make-symbolic-link-error (&rest body)
"Run BODY, ignoring \"make-symbolic-link not supported\" file error."
(declare (indent defun) (debug t))
`(condition-case err
(progn ,@body)
((error quit debug)
(unless (and (eq (car err) 'file-error)
(string-equal (error-message-string err)
"make-symbolic-link not supported"))
(signal (car err) (cdr err))))))
(ert-deftest tramp-test18-file-attributes ()
"Check `file-attributes'.
This tests also `file-readable-p', `file-regular-p' and
@ -2429,26 +2443,22 @@ This tests also `file-readable-p', `file-regular-p' and
(should (stringp (nth 2 attr))) ;; Uid.
(should (stringp (nth 3 attr))) ;; Gid.
(condition-case err
(progn
(when (tramp--test-sh-p)
(should (file-ownership-preserved-p tmp-name2 'group)))
(make-symbolic-link tmp-name1 tmp-name2)
(should (file-exists-p tmp-name2))
(should (file-symlink-p tmp-name2))
(when (tramp--test-sh-p)
(should (file-ownership-preserved-p tmp-name2 'group)))
(setq attr (file-attributes tmp-name2))
(should
(string-equal
(funcall
(if quoted 'tramp-compat-file-name-quote 'identity)
(car attr))
(file-remote-p (file-truename tmp-name1) 'localname)))
(delete-file tmp-name2))
(file-error
(should (string-equal (error-message-string err)
"make-symbolic-link not supported"))))
(tramp--test-ignore-make-symbolic-link-error
(when (tramp--test-sh-p)
(should (file-ownership-preserved-p tmp-name2 'group)))
(make-symbolic-link tmp-name1 tmp-name2)
(should (file-exists-p tmp-name2))
(should (file-symlink-p tmp-name2))
(when (tramp--test-sh-p)
(should (file-ownership-preserved-p tmp-name2 'group)))
(setq attr (file-attributes tmp-name2))
(should
(string-equal
(funcall
(if quoted 'tramp-compat-file-name-quote 'identity)
(car attr))
(file-remote-p (file-truename tmp-name1) 'localname)))
(delete-file tmp-name2))
;; Check, that "//" in symlinks are handled properly.
(with-temp-buffer
@ -2574,18 +2584,10 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
;; Check `make-symbolic-link'.
(unwind-protect
(progn
(tramp--test-ignore-make-symbolic-link-error
(write-region "foo" nil tmp-name1)
(should (file-exists-p tmp-name1))
;; Method "smb" supports `make-symbolic-link' only if the
;; remote host has CIFS capabilities. tramp-adb.el and
;; tramp-gvfs.el do not support symbolic links at all.
(condition-case err
(make-symbolic-link tmp-name1 tmp-name2)
(file-error
(skip-unless
(not (string-equal (error-message-string err)
"make-symbolic-link not supported")))))
(make-symbolic-link tmp-name1 tmp-name2)
(should
(string-equal
(funcall
@ -2659,7 +2661,9 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(should-not (file-symlink-p tmp-name2))
(should (file-regular-p tmp-name2))
;; `tmp-name3' is a local file name.
(should-error (add-name-to-file tmp-name1 tmp-name3)))
(should-error
(add-name-to-file tmp-name1 tmp-name3)
:type 'file-error))
;; Cleanup.
(ignore-errors
@ -2668,7 +2672,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
;; Check `file-truename'.
(unwind-protect
(progn
(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)
@ -3615,31 +3619,23 @@ This requires restrictions of file name syntax."
(copy-file file2 tmp-name1)
(should (file-exists-p file1))
;; Method "smb" supports `make-symbolic-link' only if the
;; remote host has CIFS capabilities. tramp-adb.el and
;; tramp-gvfs.el do not support symbolic links at all.
(condition-case err
(progn
(make-symbolic-link file1 file3)
(should (file-symlink-p file3))
(should
(string-equal
(expand-file-name file1) (file-truename file3)))
(should
(string-equal
(funcall
(if quoted 'tramp-compat-file-name-quote 'identity)
(car (file-attributes file3)))
(file-remote-p (file-truename file1) 'localname)))
;; Check file contents.
(with-temp-buffer
(insert-file-contents file3)
(should (string-equal (buffer-string) elt)))
(delete-file file3))
(file-error
(should
(string-equal (error-message-string err)
"make-symbolic-link not supported"))))))
(tramp--test-ignore-make-symbolic-link-error
(make-symbolic-link file1 file3)
(should (file-symlink-p file3))
(should
(string-equal
(expand-file-name file1) (file-truename file3)))
(should
(string-equal
(funcall
(if quoted 'tramp-compat-file-name-quote 'identity)
(car (file-attributes file3)))
(file-remote-p (file-truename file1) 'localname)))
;; Check file contents.
(with-temp-buffer
(insert-file-contents file3)
(should (string-equal (buffer-string) elt)))
(delete-file file3))))
;; Check file names.
(should (equal (directory-files
@ -3692,27 +3688,23 @@ This requires restrictions of file name syntax."
elt))
;; Check symlink in `directory-files-and-attributes'.
(condition-case err
(progn
(make-symbolic-link file2 file3)
(should (file-symlink-p file3))
(should
(string-equal
(caar (directory-files-and-attributes
file1 nil (regexp-quote elt1)))
elt1))
(should
(string-equal
(funcall
(if quoted 'tramp-compat-file-name-quote 'identity)
(cadr (car (directory-files-and-attributes
file1 nil (regexp-quote elt1)))))
(file-remote-p (file-truename file2) 'localname)))
(delete-file file3)
(should-not (file-exists-p file3)))
(file-error
(should (string-equal (error-message-string err)
"make-symbolic-link not supported"))))
(tramp--test-ignore-make-symbolic-link-error
(make-symbolic-link file2 file3)
(should (file-symlink-p file3))
(should
(string-equal
(caar (directory-files-and-attributes
file1 nil (regexp-quote elt1)))
elt1))
(should
(string-equal
(funcall
(if quoted 'tramp-compat-file-name-quote 'identity)
(cadr (car (directory-files-and-attributes
file1 nil (regexp-quote elt1)))))
(file-remote-p (file-truename file2) 'localname)))
(delete-file file3)
(should-not (file-exists-p file3)))
(delete-file file2)
(should-not (file-exists-p file2))