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

Work on Tramp's (symbolic) links

Browse source 
* doc/misc/tramp.texi (Traces and Profiles): Mention the
backtrace when tramp-verbose is greater than or equal to 10.

* lisp/net/tramp-adb.el (tramp-adb-file-name-handler-alist):
Use `tramp-handle-add-name-to-file'.

* lisp/net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist): Use
`tramp-handle-add-name-to-file' and `tramp-handle-file-truename'.

* lisp/net/tramp-sh.el (tramp-sh-handle-make-symbolic-link): Improve.

* lisp/net/tramp-smb.el (tramp-smb-errors):
Add "NT_STATUS_CONNECTION_DISCONNECTED" and
"NT_STATUS_OBJECT_PATH_SYNTAX_BAD".
(tramp-smb-file-name-handler-alist): Use `tramp-handle-file-truename'.
(tramp-smb-do-file-attributes-with-stat): Return non-nil only
if one of the attributes is non-nil.
(tramp-smb-handle-file-local-copy): Use `file-truename'.
(tramp-smb-handle-file-truename): Move to tramp.el.
(tramp-smb-handle-insert-directory): Show symlinks.
(tramp-smb-handle-make-symbolic-link): Improve.
(tramp-smb-read-file-entry): Handle extended file modes in Samba.

* lisp/net/tramp.el (tramp-handle-add-name-to-file)
(tramp-handle-file-truename): New defuns.

* test/lisp/net/tramp-tests.el (tramp-test21-file-links): Extend test.
(tramp--test-check-files): Make check for "smb".
This commit is contained in:
Michael Albinus 2017-09-04 13:10:52 +02:00
parent 9314e6c56e
commit 8a65d7a731
7 changed files with 233 additions and 138 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
doc/misc/tramp.texi
View file

@ -3837,6 +3837,10 @@ both the error and the signal have to be set as follows:
@end group
@end lisp
If @code{tramp-verbose} is greater than or equal to 10, Lisp
backtraces are also added to the @value{tramp} debug buffer in case of
errors.
To enable stepping through @value{tramp} function call traces, they
have to be specifically enabled as shown in this code:

2
lisp/net/tramp-adb.el
View file

@ -97,7 +97,7 @@ It is used for TCP/IP devices."
;;;###tramp-autoload
(defconst tramp-adb-file-name-handler-alist
'((access-file . ignore)
(add-name-to-file . tramp-adb-handle-copy-file)
(add-name-to-file . tramp-handle-add-name-to-file)
;; `byte-compiler-base-file-name' performed by default handler.
;; `copy-directory' performed by default handler.
(copy-file . tramp-adb-handle-copy-file)

4
lisp/net/tramp-gvfs.el
View file

@ -453,7 +453,7 @@ Every entry is a list (NAME ADDRESS).")
;;;###tramp-autoload
(defconst tramp-gvfs-file-name-handler-alist
'((access-file . ignore)
(add-name-to-file . tramp-gvfs-handle-copy-file)
(add-name-to-file . tramp-handle-add-name-to-file)
;; `byte-compiler-base-file-name' performed by default handler.
;; `copy-directory' performed by default handler.
(copy-file . tramp-gvfs-handle-copy-file)
@ -494,7 +494,7 @@ Every entry is a list (NAME ADDRESS).")
(file-remote-p . tramp-handle-file-remote-p)
(file-selinux-context . ignore)
(file-symlink-p . tramp-handle-file-symlink-p)
;; `file-truename' performed by default handler.
(file-truename . tramp-handle-file-truename)
(file-writable-p . tramp-gvfs-handle-file-writable-p)
(find-backup-file-name . tramp-handle-find-backup-file-name)
;; `find-file-noselect' performed by default handler.

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

@ -1063,52 +1063,59 @@ component is used as the target of the symlink."
'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
;; If TARGET is a Tramp name, use just the localname component.
(when (and (tramp-tramp-file-p target)
(tramp-file-name-equal-p v (tramp-dissect-file-name target)))
(setq target
(tramp-file-name-localname
(tramp-dissect-file-name (expand-file-name target)))))
;; If TARGET is still remote, quote it.
(if (tramp-tramp-file-p target)
(make-symbolic-link
(let (file-name-handler-alist) (tramp-compat-file-name-quote target))
linkname ok-if-already-exists)
(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)))
;; 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 (and (tramp-tramp-file-p target)
(tramp-file-name-equal-p
v (tramp-dissect-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)
(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))))))))))
;; 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."

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

@ -130,6 +130,7 @@ call, letting the SMB client use the default one."
"NT_STATUS_ACCOUNT_LOCKED_OUT"
"NT_STATUS_BAD_NETWORK_NAME"
"NT_STATUS_CANNOT_DELETE"
"NT_STATUS_CONNECTION_DISCONNECTED"
"NT_STATUS_CONNECTION_REFUSED"
"NT_STATUS_DIRECTORY_NOT_EMPTY"
"NT_STATUS_DUPLICATE_NAME"
@ -148,6 +149,7 @@ call, letting the SMB client use the default one."
"NT_STATUS_OBJECT_NAME_COLLISION"
"NT_STATUS_OBJECT_NAME_INVALID"
"NT_STATUS_OBJECT_NAME_NOT_FOUND"
"NT_STATUS_OBJECT_PATH_SYNTAX_BAD"
"NT_STATUS_PASSWORD_MUST_CHANGE"
"NT_STATUS_SHARING_VIOLATION"
"NT_STATUS_TRUSTED_RELATIONSHIP_FAILURE"
@ -253,7 +255,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 . tramp-smb-handle-file-truename)
(file-truename . tramp-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.
@ -900,8 +902,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(setq id (match-string 1))))
;; Return the result.
(list id link uid gid atime mtime ctime size mode nil inode
(tramp-get-device vec)))))))
(when (or id link uid gid atime mtime ctime size mode inode)
(list id link uid gid atime mtime ctime size mode nil inode
(tramp-get-device vec))))))))
(defun tramp-smb-handle-file-directory-p (filename)
"Like `file-directory-p' for Tramp files."
@ -912,8 +915,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(defun tramp-smb-handle-file-local-copy (filename)
"Like `file-local-copy' for Tramp files."
(with-parsed-tramp-file-name filename nil
(unless (file-exists-p filename)
(with-parsed-tramp-file-name (file-truename filename) nil
(unless (file-exists-p (file-truename filename))
(tramp-error
v tramp-file-missing
"Cannot make local copy of non-existing file `%s'" filename))
@ -947,23 +950,6 @@ 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)
@ -1046,11 +1032,14 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(mapc
(lambda (x)
(when (not (zerop (length (nth 0 x))))
(when (string-match "l" switches)
(let ((attr
(when (tramp-smb-get-stat-capability v)
(ignore-errors
(file-attributes filename 'string)))))
(let ((attr
(when (tramp-smb-get-stat-capability v)
(ignore-errors
(file-attributes
(expand-file-name
(nth 0 x) (file-name-directory filename))
'string)))))
(when (string-match "l" switches)
(insert
(format
"%10s %3d %-8s %-8s %8s %s "
@ -1064,20 +1053,27 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
tramp-half-a-year)
"%b %e %R"
"%b %e %Y")
(nth 3 x)))))) ; date
(nth 3 x))))) ; date
;; We mark the file name. The inserted name could be
;; from somewhere else, so we use the relative file name
;; of `default-directory'.
(let ((start (point)))
(insert
(format
"%s\n"
(file-relative-name
(expand-file-name
(nth 0 x) (file-name-directory filename))
(when full-directory-p (file-name-directory filename)))))
(put-text-property start (1- (point)) 'dired-filename t))
;; We mark the file name. The inserted name could be
;; from somewhere else, so we use the relative file name
;; of `default-directory'.
(let ((start (point)))
(insert
(format
"%s"
(file-relative-name
(expand-file-name
(nth 0 x) (file-name-directory filename))
(when full-directory-p (file-name-directory filename)))))
(put-text-property start (point) 'dired-filename t))
;; Insert symlink.
(when (and (string-match "l" switches)
(stringp (tramp-compat-file-attribute-type attr)))
(insert " -> " (tramp-compat-file-attribute-type attr))))
(insert "\n")
(forward-line)
(beginning-of-line)))
entries))))))
@ -1134,43 +1130,48 @@ component is used as the target of the symlink."
'make-symbolic-link (list target linkname ok-if-already-exists))
(with-parsed-tramp-file-name linkname nil
;; 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)))
(unless (tramp-smb-get-cifs-capabilities v)
(tramp-error v 'file-error "make-symbolic-link not supported"))
;; If TARGET is a Tramp name, use just the localname component.
(when (and (tramp-tramp-file-p target)
(tramp-file-name-equal-p
v (tramp-dissect-file-name (expand-file-name target))))
(tramp-file-name-equal-p v (tramp-dissect-file-name target)))
(setq target
(tramp-file-name-localname
(tramp-dissect-file-name (expand-file-name target)))))
;; We must also flush the cache of the directory, because
;; `file-attributes' reads the values from there.
(tramp-flush-file-property v (file-name-directory localname))
(tramp-flush-file-property v localname)
;; If TARGET is still remote, quote it.
(if (tramp-tramp-file-p target)
(make-symbolic-link
(let (file-name-handler-alist) (tramp-compat-file-name-quote target))
linkname ok-if-already-exists)
(unless
(tramp-smb-send-command
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"
(buffer-name))))))
;; 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)))
(unless (tramp-smb-get-cifs-capabilities v)
(tramp-error v '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 v (file-name-directory localname))
(tramp-flush-file-property v localname)
(unless
(tramp-smb-send-command
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"
(buffer-name)))))))
(defun tramp-smb-handle-process-file
(program &optional infile destination display &rest args)
@ -1723,13 +1724,17 @@ Result is the list (LOCALNAME MODE SIZE MTIME)."
(if (string-match "\\([0-9]+\\)$" line)
(let ((length (- (max 10 (1+ (length (match-string 1 line)))))))
(setq size (string-to-number (match-string 1 line)))
(when (string-match "\\([ADHRSV]+\\)" (substring line length))
(when (string-match
"\\([ACDEHNORrsSTV]+\\)" (substring line length))
(setq length (+ length (match-end 0))))
(setq line (substring line 0 length)))
(cl-return))
;; mode: ARCH, DIR, HIDDEN, RONLY, SYSTEM, VOLID.
(if (string-match "\\([ADHRSV]+\\)?$" line)
;; mode: ARCHIVE, COMPRESSED, DIRECTORY, ENCRYPTED, HIDDEN,
;; NONINDEXED, NORMAL, OFFLINE, READONLY,
;; REPARSE_POINT, SPARSE, SYSTEM, TEMPORARY, VOLID.
(if (string-match "\\([ACDEHNORrsSTV]+\\)?$" line)
(setq
mode (or (match-string 1 line) "")
mode (save-match-data (format

68
lisp/net/tramp.el
View file

@ -2824,6 +2824,33 @@ User is always nil."
(defvar tramp-handle-write-region-hook nil
"Normal hook to be run at the end of `tramp-*-handle-write-region'.")
(defun tramp-handle-add-name-to-file
(filename newname &optional ok-if-already-exists)
"Like `add-name-to-file' for Tramp files."
(with-parsed-tramp-file-name
(if (tramp-tramp-file-p newname) newname filename) nil
(unless (tramp-equal-remote filename newname)
(tramp-error
v 'file-error
"add-name-to-file: %s"
"only implemented for same method, same user, same host"))
;; 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? "
localname)))))
(tramp-error v 'file-already-exists newname)
(delete-file newname)))
(tramp-flush-file-property v (file-name-directory localname))
(tramp-flush-file-property v localname)
(copy-file
filename newname 'ok-if-already-exists 'keep-time
'preserve-uid-gid 'preserve-permissions)))
(defun tramp-handle-directory-file-name (directory)
"Like `directory-file-name' for Tramp files."
;; If localname component of filename is "/", leave it unchanged.
@ -3068,6 +3095,47 @@ User is always nil."
(let ((x (tramp-compat-file-attribute-type (file-attributes filename))))
(and (stringp x) x)))
(defun tramp-handle-file-truename (filename)
"Like `file-truename' for Tramp files."
(let ((result filename)
(numchase 0)
;; Don't make the following value larger than
;; necessary. People expect an error message in a
;; timely fashion when something is wrong;
;; otherwise they might think that Emacs is hung.
;; Of course, correctness has to come first.
(numchase-limit 20)
symlink-target)
(format
"%s%s"
(with-parsed-tramp-file-name (expand-file-name result) v1
(with-tramp-file-property v1 v1-localname "file-truename"
(while (and (setq symlink-target (file-symlink-p result))
(< numchase numchase-limit))
(setq numchase (1+ numchase)
result
(with-parsed-tramp-file-name (expand-file-name result) v2
(tramp-make-tramp-file-name
v2-method v2-user v2-domain v2-host v2-port
(funcall
(if (tramp-compat-file-name-quoted-p v2-localname)
'tramp-compat-file-name-quote 'identity)
(if (stringp symlink-target)
(if (file-remote-p symlink-target)
(let (file-name-handler-alist)
(tramp-compat-file-name-quote symlink-target))
symlink-target)
v2-localname)))))
(when (>= numchase numchase-limit)
(tramp-error
v1 'file-error
"Maximum number (%d) of symlinks exceeded" numchase-limit)))
result))
;; Preserve trailing "/".
(if (string-equal (file-name-nondirectory filename) "") "/" ""))))
(defun tramp-handle-find-backup-file-name (filename)
"Like `find-backup-file-name' for Tramp files."
(with-parsed-tramp-file-name filename nil

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

@ -2607,7 +2607,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(should-error
(make-symbolic-link tmp-name1 tmp-name2)
:type 'file-already-exists)
;; 0 means interactive case.
;; number means interactive case.
(cl-letf (((symbol-function 'yes-or-no-p) 'ignore))
(should-error
(make-symbolic-link tmp-name1 tmp-name2 0)
@ -2659,7 +2659,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(should-error
(add-name-to-file tmp-name1 tmp-name2)
:type 'file-already-exists)
;; 0 means interactive case.
;; number means interactive case.
(cl-letf (((symbol-function 'yes-or-no-p) 'ignore))
(should-error
(add-name-to-file tmp-name1 tmp-name2 0)
@ -2685,6 +2685,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(tramp--test-ignore-make-symbolic-link-error
(write-region "foo" nil tmp-name1)
(should (file-exists-p tmp-name1))
(should (string-equal tmp-name1 (file-truename tmp-name1)))
(make-symbolic-link tmp-name1 tmp-name2)
(should (file-symlink-p tmp-name2))
(should-not (string-equal tmp-name2 (file-truename tmp-name2)))
@ -2727,7 +2728,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(file-truename tmp-name1))
(tmp-name2 (tramp--test-make-temp-name nil quoted))
(tmp-name3 tmp-name2)
(number-nesting 50))
(number-nesting 15))
(dotimes (_ number-nesting)
(make-symbolic-link
tmp-name3
@ -2741,7 +2742,13 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
:type tramp-file-missing)
(should-error
(with-temp-buffer (insert-file-contents tmp-name3))
:type tramp-file-missing)))
:type tramp-file-missing)
;; `directory-files' does not show symlinks to
;; non-existing targets in the "smb" case. So we remove
;; the symlinks manually.
(while (stringp (setq tmp-name2 (file-symlink-p tmp-name3)))
(delete-file tmp-name3)
(setq tmp-name3 (concat (file-remote-p tmp-name3) tmp-name2)))))
;; Cleanup.
(ignore-errors (delete-directory tmp-name1 'recursive)))
@ -3750,23 +3757,27 @@ This requires restrictions of file name syntax."
elt))
;; Check symlink in `directory-files-and-attributes'.
;; It does not work in the "smb" case, only relative
;; symlinks to existing files are shown there.
(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)))
(unless
(tramp-smb-file-name-p tramp-test-temporary-file-directory)
(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))