@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:
;;;###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)
;;;###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)
(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.
'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."
"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"
"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"
(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.
(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."
(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))
(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)
(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 "
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))))))
'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)
(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
(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.
(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
(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)
(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)
(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)))
(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
: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)))
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))
projects / emacs.git / commitdiff