[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master 8a65d7a: Work on Tramp's (symbolic) links
|
From: |
Michael Albinus |
|
Subject: |
[Emacs-diffs] master 8a65d7a: Work on Tramp's (symbolic) links |
|
Date: |
Mon, 4 Sep 2017 07:11:04 -0400 (EDT) |
branch: master
commit 8a65d7a73199315f58588876b6fd34c866814c7c
Author: Michael Albinus <address@hidden>
Commit: Michael Albinus <address@hidden>
Work on Tramp's (symbolic) links
* 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".
---
doc/misc/tramp.texi | 4 ++
lisp/net/tramp-adb.el | 2 +-
lisp/net/tramp-gvfs.el | 4 +-
lisp/net/tramp-sh.el | 95 ++++++++++++++-------------
lisp/net/tramp-smb.el | 153 ++++++++++++++++++++++---------------------
lisp/net/tramp.el | 68 +++++++++++++++++++
test/lisp/net/tramp-tests.el | 51 +++++++++------
7 files changed, 236 insertions(+), 141 deletions(-)
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index 1b751a0..5e0b1d8 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -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:
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 6e662df..6e8dd2f 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -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)
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 48f50a3..6567991 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -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.
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 85966f1..597ca6a 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -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)))
-
- ;; 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)
-
- ;; 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))))))))))
+ ;; 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)))
+
+ (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."
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 0b05cdb..8368cff 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -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
-
- ;; 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))
+ (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"
+ (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
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 1a5cda7..f4b69db 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -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
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 662163f..c61e5dc 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -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))
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] master 8a65d7a: Work on Tramp's (symbolic) links,
Michael Albinus <=