[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 9ed5c39aad: Refactor Tramp
|
From: |
Michael Albinus |
|
Subject: |
master 9ed5c39aad: Refactor Tramp |
|
Date: |
Sun, 24 Jul 2022 10:02:22 -0400 (EDT) |
branch: master
commit 9ed5c39aad09571314097be91cb28e7504614421
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>
Refactor Tramp
* lisp/net/tramp-adb.el (tramp-adb-file-name-handler-alist):
Use `tramp-adb-handle-get-remote-gid' and
`tramp-adb-handle-get-remote-uid'.
(tramp-adb-handle-file-attributes): Use `tramp-convert-file-attributes'.
(tramp-do-parse-file-attributes-with-ls): Remove ID-FORMAT.
(tramp-adb-handle-directory-files-and-attributes):
Use `tramp-skeleton-directory-files-and-attributes'.
(tramp-adb-handle-file-local-copy): Use `tramp-skeleton-file-local-copy'.
(tramp-adb-handle-copy-file, tramp-adb-handle-rename-file):
Use `tramp-barf-if-file-missing'.
(tramp-adb-handle-get-remote-uid)
(tramp-adb-handle-get-remote-gid): New defuns.
* lisp/net/tramp-archive.el (tramp-archive-file-name-handler-alist):
Use `tramp-archive-handle-directory-files'.
(tramp-archive-handle-directory-files): New defun.
* lisp/net/tramp-cache.el (tramp-file-property-p): New defun.
* lisp/net/tramp-compat.el (tramp-compat-take): New defalias.
* lisp/net/tramp-crypt.el (tramp-crypt-do-copy-or-rename-file):
Use `tramp-barf-if-file-missing'.
(tramp-crypt-handle-directory-files):
Use `tramp-skeleton-directory-files'.
* lisp/net/tramp-fuse.el (tramp-fuse-handle-directory-files):
Use `tramp-skeleton-directory-files'.
* lisp/net/tramp-gvfs.el (tramp-gvfs-do-copy-or-rename-file):
Use `tramp-barf-if-file-missing'.
* lisp/net/tramp-rclone.el (tramp-rclone-do-copy-or-rename-file):
Use `tramp-barf-if-file-missing'.
* lisp/net/tramp-sh.el (tramp-readlink-file-truename)
(tramp-stat-file-attributes)
(tramp-stat-directory-files-and-attributes): New defconsts.
(tramp-perl-file-attributes)
(tramp-perl-directory-files-and-attributes): Adapt.
(tramp-sh-handle-make-symbolic-link): Flush TARGET file properties.
(tramp-sh-handle-file-truename): Use `tramp-readlink-file-truename'
(tramp-sh-handle-file-exists-p)
(tramp-sh-handle-file-executable-p)
(tramp-sh-handle-file-readable-p)
(tramp-sh-handle-file-directory-p)
(tramp-sh-handle-file-writable-p): Adapt check of file properties.
(tramp-sh-handle-file-attributes): Simplify.
(tramp-do-file-attributes-with-ls): Remove ID-FORMAT. Combine two
remote commands. Compute both versions of uid and gid together.
(tramp-do-file-attributes-with-perl)
(tramp-do-directory-files-and-attributes-with-perl):
Remove ID-FORMAT.
(tramp-do-file-attributes-with-stat): Remove ID-FORMAT. Use
`tramp-stat-file-attributes'.
(tramp-sh-handle-directory-files-and-attributes):
Use `tramp-skeleton-directory-files-and-attributes'.
(tramp-do-directory-files-and-attributes-with-stat):
Remove ID-FORMAT. Use `tramp-stat-directory-files-and-attributes'.
(tramp-sh-handle-copy-directory): Use `tramp-skeleton-copy-directory'.
(tramp-do-copy-or-rename-file): Use `tramp-barf-if-file-missing'.
(tramp-sh-handle-file-local-copy): Use `tramp-skeleton-file-local-copy'.
(tramp-sh-handle-write-region): Combine two remote commands.
(tramp-sh-gio-monitor-process-filter): Simplify `cond' call.
(tramp-expand-script): Extend for ls, readling and stat.
(tramp-open-connection-setup-interactive-shell): Do not set
`tramp-end-of-output'.
(tramp-open-connection-setup-interactive-shell): Do not send
prompt formatting command, it's superfluous.
(tramp-send-command-and-check): Rearrange in order to accept also
heredoc scripts.
(tramp-convert-file-attributes): Move function to tramp.el.
(tramp-get-remote-id): Set connection property.
(tramp-get-remote-uid-with-id): Use it.
(tramp-get-remote-python): Don't check for python2 anymore.
* lisp/net/tramp-smb.el (tramp-smb-file-name-handler-alist):
Use `tramp-handle-directory-files'.
(tramp-smb-handle-copy-directory): Use `tramp-skeleton-copy-directory'.
(tramp-smb-handle-directory-files): Remove.
(tramp-smb-handle-file-attributes): Use `tramp-convert-file-attributes'.
(tramp-smb-do-file-attributes-with-stat): Remove ID-FORMAT.
(tramp-smb-handle-file-local-copy): Use `tramp-skeleton-file-local-copy'.
* lisp/net/tramp-sudoedit.el (tramp-sudoedit-do-copy-or-rename-file):
Use `tramp-barf-if-file-missing'.
(tramp-sudoedit-file-attributes): New defconst.
(tramp-sudoedit-handle-file-attributes): Simplify code.
* lisp/net/tramp.el (tramp-setup-debug-buffer): Set debug buffer
as not modified.
(tramp-barf-if-file-missing, tramp-skeleton-copy-directory)
(tramp-skeleton-directory-files)
(tramp-skeleton-directory-files-and-attributes)
(tramp-skeleton-file-local-copy): New macros.
(tramp-handle-copy-directory): Use `tramp-skeleton-copy-directory'.
(tramp-handle-directory-files): Use `tramp-skeleton-directory-files'.
(tramp-handle-file-local-copy): Use `tramp-skeleton-file-local-copy'.
(tramp-handle-insert-file-contents): Use `tramp-barf-if-file-missing'.
(tramp-get-process-attributes, tramp-action-out-of-band):
Simplify `cond' call.
(tramp-check-cached-permissions): Simplify.
(tramp-make-tramp-temp-file): Reimplement.
* test/lisp/net/tramp-archive-tests.el (tramp-copy-size-limit):
Don't set.
* test/lisp/net/tramp-tests.el (tramp--test-enabled):
Remove superfluous test files.
(tramp-test21-file-links): Protect file name deletion.
---
lisp/net/tramp-adb.el | 338 +++++++------
lisp/net/tramp-archive.el | 23 +-
lisp/net/tramp-cache.el | 6 +
lisp/net/tramp-compat.el | 9 +
lisp/net/tramp-crypt.el | 149 +++---
lisp/net/tramp-fuse.el | 52 +-
lisp/net/tramp-gvfs.el | 160 +++---
lisp/net/tramp-rclone.el | 79 ++-
lisp/net/tramp-sh.el | 913 ++++++++++++++++-------------------
lisp/net/tramp-smb.el | 461 ++++++++----------
lisp/net/tramp-sudoedit.el | 161 +++---
lisp/net/tramp.el | 417 +++++++++++-----
test/lisp/net/tramp-archive-tests.el | 2 -
test/lisp/net/tramp-tests.el | 15 +-
14 files changed, 1437 insertions(+), 1348 deletions(-)
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index de55856830..3e780aa1a1 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -182,8 +182,8 @@ It is used for TCP/IP devices."
(substitute-in-file-name . tramp-handle-substitute-in-file-name)
(temporary-file-directory . tramp-handle-temporary-file-directory)
(tramp-get-home-directory . ignore)
- (tramp-get-remote-gid . ignore)
- (tramp-get-remote-uid . ignore)
+ (tramp-get-remote-gid . tramp-adb-handle-get-remote-gid)
+ (tramp-get-remote-uid . tramp-adb-handle-get-remote-uid)
(tramp-set-file-uid-gid . ignore)
(unhandled-file-name-directory . ignore)
(unlock-file . tramp-handle-unlock-file)
@@ -252,21 +252,19 @@ arguments to pass to the OPERATION."
(defun tramp-adb-handle-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files."
- (unless id-format (setq id-format 'integer))
- (ignore-errors
- (with-parsed-tramp-file-name filename nil
- (with-tramp-file-property
- v localname (format "file-attributes-%s" id-format)
- (and
- (tramp-adb-send-command-and-check
- v (format "%s -d -l %s"
- (tramp-adb-get-ls-command v)
- (tramp-shell-quote-argument localname)))
- (with-current-buffer (tramp-get-buffer v)
- (tramp-adb-sh-fix-ls-output)
- (cdar (tramp-do-parse-file-attributes-with-ls v id-format))))))))
-
-(defun tramp-do-parse-file-attributes-with-ls (vec &optional id-format)
+ ;; The result is cached in `tramp-convert-file-attributes'.
+ (with-parsed-tramp-file-name filename nil
+ (tramp-convert-file-attributes v localname id-format
+ (and
+ (tramp-adb-send-command-and-check
+ v (format "%s -d -l %s"
+ (tramp-adb-get-ls-command v)
+ (tramp-shell-quote-argument localname)))
+ (with-current-buffer (tramp-get-buffer v)
+ (tramp-adb-sh-fix-ls-output)
+ (cdar (tramp-do-parse-file-attributes-with-ls v)))))))
+
+(defun tramp-do-parse-file-attributes-with-ls (vec)
"Parse `file-attributes' for Tramp files using the ls(1) command."
(with-current-buffer (tramp-get-buffer vec)
(goto-char (point-min))
@@ -290,8 +288,8 @@ arguments to pass to the OPERATION."
(or is-dir symlink-target)
1 ;link-count
;; no way to handle numeric ids in Androids ash
- (if (eq id-format 'integer) 0 uid)
- (if (eq id-format 'integer) 0 gid)
+ (cons uid tramp-unknown-id-integer)
+ (cons gid tramp-unknown-id-integer)
tramp-time-dont-know ; atime
;; `date-to-time' checks `iso8601-parse', which might fail.
(let (signal-hook-function)
@@ -308,54 +306,28 @@ arguments to pass to the OPERATION."
(defun tramp-adb-handle-directory-files-and-attributes
(directory &optional full match nosort id-format count)
"Like `directory-files-and-attributes' for Tramp files."
- (unless (file-exists-p directory)
- (tramp-error (tramp-dissect-file-name directory) 'file-missing directory))
- (when (file-directory-p directory)
- (with-parsed-tramp-file-name (expand-file-name directory) nil
- (copy-tree
- (with-tramp-file-property
- v localname (format "directory-files-and-attributes-%s-%s-%s-%s-%s"
- full match id-format nosort count)
- (with-current-buffer (tramp-get-buffer v)
- (when (tramp-adb-send-command-and-check
- v (format "%s -a -l %s"
- (tramp-adb-get-ls-command v)
- (tramp-shell-quote-argument localname)))
- ;; We insert also filename/. and filename/.., because "ls" doesn't.
- ;; Looks like it does include them in toybox, since Android 6.
- (unless (re-search-backward "\\.$" nil t)
- (narrow-to-region (point-max) (point-max))
- (tramp-adb-send-command
- v (format "%s -d -a -l %s %s"
- (tramp-adb-get-ls-command v)
- (tramp-shell-quote-argument
- (tramp-compat-file-name-concat localname "."))
- (tramp-shell-quote-argument
- (tramp-compat-file-name-concat localname ".."))))
- (widen)))
- (tramp-adb-sh-fix-ls-output)
- (let ((result (tramp-do-parse-file-attributes-with-ls
- v (or id-format 'integer))))
- (when full
- (setq result
- (mapcar
- (lambda (x)
- (cons (expand-file-name (car x) directory) (cdr x)))
- result)))
- (unless nosort
- (setq result
- (sort result (lambda (x y) (string< (car x) (car y))))))
-
- (setq result (delq nil
- (mapcar
- (lambda (x) (if (or (not match)
- (string-match-p
- match (car x)))
- x))
- result)))
- (when (and (natnump count) (> count 0))
- (setq result (tramp-compat-ntake count result)))
- result)))))))
+ (tramp-skeleton-directory-files-and-attributes
+ directory full match nosort id-format count
+ (with-current-buffer (tramp-get-buffer v)
+ (when (tramp-adb-send-command-and-check
+ v (format "%s -a -l %s"
+ (tramp-adb-get-ls-command v)
+ (tramp-shell-quote-argument localname)))
+ ;; We insert also filename/. and filename/.., because "ls"
+ ;; doesn't. Looks like it does include them in toybox, since
+ ;; Android 6.
+ (unless (re-search-backward "\\.$" nil t)
+ (narrow-to-region (point-max) (point-max))
+ (tramp-adb-send-command
+ v (format "%s -d -a -l %s %s"
+ (tramp-adb-get-ls-command v)
+ (tramp-shell-quote-argument
+ (tramp-compat-file-name-concat localname "."))
+ (tramp-shell-quote-argument
+ (tramp-compat-file-name-concat localname ".."))))
+ (widen)))
+ (tramp-adb-sh-fix-ls-output)
+ (tramp-do-parse-file-attributes-with-ls v))))
(defun tramp-adb-get-ls-command (vec)
"Determine `ls' command and its arguments."
@@ -502,22 +474,18 @@ Emacs dired can't find files."
(defun tramp-adb-handle-file-local-copy (filename)
"Like `file-local-copy' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (unless (file-exists-p (file-truename filename))
- (tramp-error v 'file-missing filename))
- (let ((tmpfile (tramp-compat-make-temp-file filename)))
- (with-tramp-progress-reporter
- v 3 (format "Fetching %s to tmp file %s" filename tmpfile)
- ;; "adb pull ..." does not always return an error code.
- (unless
- (and (tramp-adb-execute-adb-command
- v "pull" (tramp-compat-file-name-unquote localname) tmpfile)
- (file-exists-p tmpfile))
- (ignore-errors (delete-file tmpfile))
- (tramp-error
- v 'file-error "Cannot make local copy of file `%s'" filename))
- (set-file-modes tmpfile (logior (or (file-modes filename) 0) #o0400)))
- tmpfile)))
+ (tramp-skeleton-file-local-copy filename
+ (with-tramp-progress-reporter
+ v 3 (format "Fetching %s to tmp file %s" filename tmpfile)
+ ;; "adb pull ..." does not always return an error code.
+ (unless
+ (and (tramp-adb-execute-adb-command
+ v "pull" (tramp-compat-file-name-unquote localname) tmpfile)
+ (file-exists-p tmpfile))
+ (ignore-errors (delete-file tmpfile))
+ (tramp-error
+ v 'file-error "Cannot make local copy of file `%s'" filename))
+ (set-file-modes tmpfile (logior (or (file-modes filename) 0) #o0400)))))
(defun tramp-adb-handle-file-executable-p (filename)
"Like `file-executable-p' for Tramp files."
@@ -617,62 +585,61 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
;; let-bind `jka-compr-inhibit' to t.
(jka-compr-inhibit t))
(with-parsed-tramp-file-name (if t1 filename newname) nil
- (unless (file-exists-p filename)
- (tramp-error v 'file-missing filename))
- (when (and (not ok-if-already-exists) (file-exists-p newname))
- (tramp-error v 'file-already-exists newname))
- (when (and (file-directory-p newname)
- (not (directory-name-p newname)))
- (tramp-error v 'file-error "File is a directory %s" newname))
-
- (with-tramp-progress-reporter
- v 0 (format "Copying %s to %s" filename newname)
- (if (and t1 t2 (tramp-equal-remote filename newname))
- (let ((l1 (tramp-file-local-name filename))
- (l2 (tramp-file-local-name newname)))
- ;; We must also flush the cache of the directory,
- ;; because `file-attributes' reads the values from
- ;; there.
- (tramp-flush-file-properties v l2)
- ;; Short track.
- (tramp-adb-barf-unless-okay
- v (format
- "cp -f %s %s"
- (tramp-shell-quote-argument l1)
- (tramp-shell-quote-argument l2))
- "Error copying %s to %s" filename newname))
-
- (if-let ((tmpfile (file-local-copy filename)))
- ;; Remote filename.
- (condition-case err
- (rename-file tmpfile newname ok-if-already-exists)
- ((error quit)
- (delete-file tmpfile)
- (signal (car err) (cdr err))))
-
- ;; Remote newname.
- (when (and (file-directory-p newname)
- (directory-name-p newname))
- (setq newname
- (expand-file-name
- (file-name-nondirectory filename) newname)))
-
- (with-parsed-tramp-file-name newname nil
- (when (and (not ok-if-already-exists)
- (file-exists-p newname))
- (tramp-error v 'file-already-exists newname))
-
- ;; We must also flush the cache of the directory,
- ;; because `file-attributes' reads the values from
- ;; there.
- (tramp-flush-file-properties v localname)
- (unless (tramp-adb-execute-adb-command
- v "push"
- (tramp-compat-file-name-unquote filename)
- (tramp-compat-file-name-unquote localname))
- (tramp-error
- v 'file-error
- "Cannot copy `%s' `%s'" filename newname))))))))
+ (tramp-barf-if-file-missing v filename
+ (when (and (not ok-if-already-exists) (file-exists-p newname))
+ (tramp-error v 'file-already-exists newname))
+ (when (and (file-directory-p newname)
+ (not (directory-name-p newname)))
+ (tramp-error v 'file-error "File is a directory %s" newname))
+
+ (with-tramp-progress-reporter
+ v 0 (format "Copying %s to %s" filename newname)
+ (if (and t1 t2 (tramp-equal-remote filename newname))
+ (let ((l1 (tramp-file-local-name filename))
+ (l2 (tramp-file-local-name newname)))
+ ;; We must also flush the cache of the directory,
+ ;; because `file-attributes' reads the values from
+ ;; there.
+ (tramp-flush-file-properties v l2)
+ ;; Short track.
+ (tramp-adb-barf-unless-okay
+ v (format
+ "cp -f %s %s"
+ (tramp-shell-quote-argument l1)
+ (tramp-shell-quote-argument l2))
+ "Error copying %s to %s" filename newname))
+
+ (if-let ((tmpfile (file-local-copy filename)))
+ ;; Remote filename.
+ (condition-case err
+ (rename-file tmpfile newname ok-if-already-exists)
+ ((error quit)
+ (delete-file tmpfile)
+ (signal (car err) (cdr err))))
+
+ ;; Remote newname.
+ (when (and (file-directory-p newname)
+ (directory-name-p newname))
+ (setq newname
+ (expand-file-name
+ (file-name-nondirectory filename) newname)))
+
+ (with-parsed-tramp-file-name newname nil
+ (when (and (not ok-if-already-exists)
+ (file-exists-p newname))
+ (tramp-error v 'file-already-exists newname))
+
+ ;; We must also flush the cache of the directory,
+ ;; because `file-attributes' reads the values from
+ ;; there.
+ (tramp-flush-file-properties v localname)
+ (unless (tramp-adb-execute-adb-command
+ v "push"
+ (tramp-compat-file-name-unquote filename)
+ (tramp-compat-file-name-unquote localname))
+ (tramp-error
+ v 'file-error
+ "Cannot copy `%s' `%s'" filename newname)))))))))
;; KEEP-DATE handling.
(when keep-date
@@ -698,37 +665,38 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
;; let-bind `jka-compr-inhibit' to t.
(jka-compr-inhibit t))
(with-parsed-tramp-file-name (if t1 filename newname) nil
- (unless (file-exists-p filename)
- (tramp-error v 'file-missing filename))
- (when (and (not ok-if-already-exists) (file-exists-p newname))
- (tramp-error v 'file-already-exists newname))
- (when (and (file-directory-p newname)
- (not (directory-name-p newname)))
- (tramp-error v 'file-error "File is a directory %s" newname))
-
- (with-tramp-progress-reporter
- v 0 (format "Renaming %s to %s" filename newname)
- (if (and t1 t2
- (tramp-equal-remote filename newname)
- (not (file-directory-p filename)))
- (let ((l1 (tramp-file-local-name filename))
- (l2 (tramp-file-local-name newname)))
- ;; We must also flush the cache of the directory, because
- ;; `file-attributes' reads the values from there.
- (tramp-flush-file-properties v l1)
- (tramp-flush-file-properties v l2)
- ;; Short track.
- (tramp-adb-barf-unless-okay
- v (format
- "mv -f %s %s"
- (tramp-shell-quote-argument l1)
- (tramp-shell-quote-argument l2))
- "Error renaming %s to %s" filename newname))
-
- ;; Rename by copy.
- (copy-file
- filename newname ok-if-already-exists 'keep-time 'preserve-uid-gid)
- (delete-file filename)))))))
+ (tramp-barf-if-file-missing v filename
+ (when (and (not ok-if-already-exists) (file-exists-p newname))
+ (tramp-error v 'file-already-exists newname))
+ (when (and (file-directory-p newname)
+ (not (directory-name-p newname)))
+ (tramp-error v 'file-error "File is a directory %s" newname))
+
+ (with-tramp-progress-reporter
+ v 0 (format "Renaming %s to %s" filename newname)
+ (if (and t1 t2
+ (tramp-equal-remote filename newname)
+ (not (file-directory-p filename)))
+ (let ((l1 (tramp-file-local-name filename))
+ (l2 (tramp-file-local-name newname)))
+ ;; We must also flush the cache of the directory,
+ ;; because `file-attributes' reads the values from
+ ;; there.
+ (tramp-flush-file-properties v l1)
+ (tramp-flush-file-properties v l2)
+ ;; Short track.
+ (tramp-adb-barf-unless-okay
+ v (format
+ "mv -f %s %s"
+ (tramp-shell-quote-argument l1)
+ (tramp-shell-quote-argument l2))
+ "Error renaming %s to %s" filename newname))
+
+ ;; Rename by copy.
+ (copy-file
+ filename newname ok-if-already-exists
+ 'keep-time 'preserve-uid-gid)
+ (delete-file filename))))))))
(defun tramp-adb-get-signal-strings (vec)
"Strings to return by `process-file' in case of signals."
@@ -1067,6 +1035,36 @@ implementation will be used."
;; The equivalent to `exec-directory'.
`(,(tramp-file-local-name (expand-file-name default-directory)))))
+(defun tramp-adb-handle-get-remote-uid (vec id-format)
+ "Like `tramp-get-remote-uid' for Tramp files.
+ ID-FORMAT valid values are `string' and `integer'."
+ ;; The result is cached in `tramp-get-remote-uid'.
+ (tramp-adb-send-command
+ vec
+ (format "id -u%s %s"
+ (if (equal id-format 'integer) "" "n")
+ (if (equal id-format 'integer)
+ "" "| sed -e s/^/\\\"/ -e s/\\$/\\\"/")))
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ ;; Read the expression.
+ (goto-char (point-min))
+ (read (current-buffer))))
+
+(defun tramp-adb-handle-get-remote-gid (vec id-format)
+ "Like `tramp-get-remote-gid' for Tramp files.
+ID-FORMAT valid values are `string' and `integer'."
+ ;; The result is cached in `tramp-get-remote-gid'.
+ (tramp-adb-send-command
+ vec
+ (format "id -g%s %s"
+ (if (equal id-format 'integer) "" "n")
+ (if (equal id-format 'integer)
+ "" "| sed -e s/^/\\\"/ -e s/\\$/\\\"/")))
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ ;; Read the expression.
+ (goto-char (point-min))
+ (read (current-buffer))))
+
(defun tramp-adb-get-device (vec)
"Return full host name from VEC to be used in shell execution.
E.g. a host name \"192.168.1.1#5555\" returns \"192.168.1.1:5555\"
diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el
index 47f14861e3..4f106a6b59 100644
--- a/lisp/net/tramp-archive.el
+++ b/lisp/net/tramp-archive.el
@@ -227,7 +227,7 @@ It must be supported by libarchive(3).")
(delete-file . tramp-archive-handle-not-implemented)
;; `diff-latest-backup-file' performed by default handler.
(directory-file-name . tramp-archive-handle-directory-file-name)
- (directory-files . tramp-handle-directory-files)
+ (directory-files . tramp-archive-handle-directory-files)
(directory-files-and-attributes
. tramp-handle-directory-files-and-attributes)
(dired-compress-file . tramp-archive-handle-not-implemented)
@@ -612,6 +612,27 @@ offered."
;; example. So we return `directory'.
directory)))
+(defun tramp-archive-handle-directory-files
+ (directory &optional full match nosort count)
+ "Like `directory-files' for Tramp files."
+ (unless (file-exists-p directory)
+ (tramp-error (tramp-dissect-file-name directory) 'file-missing directory))
+ (when (file-directory-p directory)
+ (setq directory (file-name-as-directory (expand-file-name directory)))
+ (let ((temp (nreverse (file-name-all-completions "" directory)))
+ result item)
+
+ (while temp
+ (setq item (directory-file-name (pop temp)))
+ (when (or (null match) (string-match-p match item))
+ (push (if full (concat directory item) item)
+ result)))
+ (unless nosort
+ (setq result (sort result #'string<)))
+ (when (and (natnump count) (> count 0))
+ (setq result (tramp-compat-ntake count result)))
+ result)))
+
(defun tramp-archive-handle-dired-uncache (dir)
"Like `dired-uncache' for file archives."
(dired-uncache (tramp-archive-gvfs-file-name dir)))
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index dbebcad1a8..68f4fda475 100644
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -204,6 +204,12 @@ Return VALUE."
(dolist (var (all-completions "tramp-cache-set-count-" obarray))
(unintern var obarray))))
+;;;###tramp-autoload
+(defun tramp-file-property-p (key file property)
+ "Check whether PROPERTY of FILE is defined in the cache context of KEY."
+ (not (eq (tramp-get-file-property key file property tramp-cache-undefined)
+ tramp-cache-undefined)))
+
;;;###tramp-autoload
(defun tramp-flush-file-property (key file property)
"Remove PROPERTY of FILE in the cache context of KEY."
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index 1286255c89..ef5b1f7ec9 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -294,6 +294,15 @@ CONDITION can also be a list of error conditions."
(setq secret (funcall secret)))
secret))))
+;; Function `take' is new in Emacs 29.1.
+(defalias 'tramp-compat-take
+ (if (fboundp 'take)
+ #'take
+ (lambda (n list)
+ (when (and (natnump n) (> n 0))
+ (if (>= n (length list))
+ list (butlast list (- (length list) n)))))))
+
;; Function `ntake' is new in Emacs 29.1.
(defalias 'tramp-compat-ntake
(if (fboundp 'ntake)
diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el
index 804d6e5bd1..4fcd132ab0 100644
--- a/lisp/net/tramp-crypt.el
+++ b/lisp/net/tramp-crypt.el
@@ -600,62 +600,61 @@ absolute file names."
(delete-directory filename 'recursive)))
(with-parsed-tramp-file-name (if t1 filename newname) nil
- (unless (file-exists-p filename)
- (tramp-error v 'file-missing filename))
- (when (and (not ok-if-already-exists) (file-exists-p newname))
- (tramp-error v 'file-already-exists newname))
- (when (and (file-directory-p newname)
- (not (directory-name-p newname)))
- (tramp-error v 'file-error "File is a directory %s" newname))
-
- (with-tramp-progress-reporter
- v 0 (format "%s %s to %s" msg-operation filename newname)
- (if (and t1 t2 (string-equal t1 t2))
- ;; Both files are on the same encrypted remote directory.
- (let (tramp-crypt-enabled)
- (if (eq op 'copy)
- (copy-file
- encrypt-filename encrypt-newname ok-if-already-exists
- keep-date preserve-uid-gid preserve-extended-attributes)
- (rename-file
- encrypt-filename encrypt-newname ok-if-already-exists)))
-
- (let* ((tmpdir (tramp-compat-make-temp-file filename 'dir))
- (tmpfile1
- (expand-file-name
- (file-name-nondirectory encrypt-filename) tmpdir))
- (tmpfile2
- (expand-file-name
- (file-name-nondirectory encrypt-newname) tmpdir))
- tramp-crypt-enabled)
- (cond
- ;; Source and target file are on an encrypted remote directory.
- ((and t1 t2)
- (if (eq op 'copy)
- (copy-file
- encrypt-filename encrypt-newname ok-if-already-exists
- keep-date preserve-uid-gid preserve-extended-attributes)
- (rename-file
- encrypt-filename encrypt-newname ok-if-already-exists)))
- ;; Source file is on an encrypted remote directory.
- (t1
- (if (eq op 'copy)
- (copy-file
- encrypt-filename tmpfile1 t keep-date preserve-uid-gid
- preserve-extended-attributes)
- (rename-file encrypt-filename tmpfile1 t))
- (tramp-crypt-decrypt-file t1 tmpfile1 tmpfile2)
- (rename-file tmpfile2 newname ok-if-already-exists))
- ;; Target file is on an encrypted remote directory.
- (t2
- (if (eq op 'copy)
- (copy-file
- filename tmpfile1 t keep-date preserve-uid-gid
- preserve-extended-attributes)
- (rename-file filename tmpfile1 t))
- (tramp-crypt-encrypt-file t2 tmpfile1 tmpfile2)
- (rename-file tmpfile2 encrypt-newname ok-if-already-exists)))
- (delete-directory tmpdir 'recursive))))))
+ (tramp-barf-if-file-missing v filename
+ (when (and (not ok-if-already-exists) (file-exists-p newname))
+ (tramp-error v 'file-already-exists newname))
+ (when (and (file-directory-p newname)
+ (not (directory-name-p newname)))
+ (tramp-error v 'file-error "File is a directory %s" newname))
+
+ (with-tramp-progress-reporter
+ v 0 (format "%s %s to %s" msg-operation filename newname)
+ (if (and t1 t2 (string-equal t1 t2))
+ ;; Both files are on the same encrypted remote directory.
+ (let (tramp-crypt-enabled)
+ (if (eq op 'copy)
+ (copy-file
+ encrypt-filename encrypt-newname ok-if-already-exists
+ keep-date preserve-uid-gid preserve-extended-attributes)
+ (rename-file
+ encrypt-filename encrypt-newname ok-if-already-exists)))
+
+ (let* ((tmpdir (tramp-compat-make-temp-file filename 'dir))
+ (tmpfile1
+ (expand-file-name
+ (file-name-nondirectory encrypt-filename) tmpdir))
+ (tmpfile2
+ (expand-file-name
+ (file-name-nondirectory encrypt-newname) tmpdir))
+ tramp-crypt-enabled)
+ (cond
+ ;; Source and target file are on an encrypted remote directory.
+ ((and t1 t2)
+ (if (eq op 'copy)
+ (copy-file
+ encrypt-filename encrypt-newname ok-if-already-exists
+ keep-date preserve-uid-gid preserve-extended-attributes)
+ (rename-file
+ encrypt-filename encrypt-newname ok-if-already-exists)))
+ ;; Source file is on an encrypted remote directory.
+ (t1
+ (if (eq op 'copy)
+ (copy-file
+ encrypt-filename tmpfile1 t keep-date preserve-uid-gid
+ preserve-extended-attributes)
+ (rename-file encrypt-filename tmpfile1 t))
+ (tramp-crypt-decrypt-file t1 tmpfile1 tmpfile2)
+ (rename-file tmpfile2 newname ok-if-already-exists))
+ ;; Target file is on an encrypted remote directory.
+ (t2
+ (if (eq op 'copy)
+ (copy-file
+ filename tmpfile1 t keep-date preserve-uid-gid
+ preserve-extended-attributes)
+ (rename-file filename tmpfile1 t))
+ (tramp-crypt-encrypt-file t2 tmpfile1 tmpfile2)
+ (rename-file tmpfile2 encrypt-newname ok-if-already-exists)))
+ (delete-directory tmpdir 'recursive)))))))
(when (and t1 (eq op 'rename))
(with-parsed-tramp-file-name filename v1
@@ -702,36 +701,14 @@ absolute file names."
(defun tramp-crypt-handle-directory-files
(directory &optional full match nosort count)
"Like `directory-files' for Tramp files."
- (unless (file-exists-p directory)
- (tramp-error (tramp-dissect-file-name directory) 'file-missing directory))
- (when (file-directory-p directory)
- (setq directory (file-name-as-directory (expand-file-name directory)))
- (let* (tramp-crypt-enabled
- (result
- (directory-files (tramp-crypt-encrypt-file-name directory) 'full)))
- (setq result
- (mapcar (lambda (x) (tramp-crypt-decrypt-file-name x)) result))
- (when match
- (setq result
- (delq
- nil
- (mapcar
- (lambda (x)
- (when (string-match-p match (substring x (length directory)))
- x))
- result))))
- (unless full
- (setq result
- (mapcar
- (lambda (x)
- (replace-regexp-in-string
- (concat "^" (regexp-quote directory)) "" x))
- result)))
- (unless nosort
- (setq result (sort result #'string<)))
- (when (and (natnump count) (> count 0))
- (setq result (tramp-compat-ntake count result)))
- result)))
+ (tramp-skeleton-directory-files directory full match nosort count
+ (let (tramp-crypt-enabled)
+ (mapcar
+ (lambda (x)
+ (replace-regexp-in-string
+ (concat "^" (regexp-quote directory)) ""
+ (tramp-crypt-decrypt-file-name x)))
+ (directory-files (tramp-crypt-encrypt-file-name directory) 'full)))))
(defun tramp-crypt-handle-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files."
diff --git a/lisp/net/tramp-fuse.el b/lisp/net/tramp-fuse.el
index 2ff106d602..486a3cc57b 100644
--- a/lisp/net/tramp-fuse.el
+++ b/lisp/net/tramp-fuse.el
@@ -58,36 +58,30 @@
(defun tramp-fuse-handle-directory-files
(directory &optional full match nosort count)
"Like `directory-files' for Tramp files."
- (unless (file-exists-p directory)
- (tramp-error (tramp-dissect-file-name directory) 'file-missing directory))
- (when (file-directory-p directory)
- (setq directory (file-name-as-directory (expand-file-name directory)))
- (with-parsed-tramp-file-name directory nil
- (let ((result
- (tramp-compat-directory-files
- (tramp-fuse-local-file-name directory) full match nosort count)))
+ (let ((result
+ (tramp-skeleton-directory-files directory full match nosort count
+ ;; Some storage systems do not return "." and "..".
+ (delete-dups
+ (append
+ '("." "..")
+ (tramp-fuse-remove-hidden-files
+ (tramp-compat-directory-files
+ (tramp-fuse-local-file-name directory))))))))
+ (if full
;; Massage the result.
- (when full
- (let ((local (concat "^" (regexp-quote (tramp-fuse-mount-point v))))
- (remote (directory-file-name
- (funcall
- (if (tramp-compat-file-name-quoted-p directory)
- #'tramp-compat-file-name-quote #'identity)
- (file-remote-p directory)))))
- (setq result
- (mapcar
- (lambda (x) (replace-regexp-in-string local remote x))
- result))))
- ;; Some storage systems do not return "." and "..".
- (dolist (item '(".." "."))
- (when (and (string-match-p (or match (regexp-quote item)) item)
- (not
- (member (if full (setq item (concat directory item)) item)
- result)))
- (setq result (cons item result))))
- ;; Return result.
- (tramp-fuse-remove-hidden-files
- (if nosort result (sort result #'string<)))))))
+ (let ((local (concat
+ "^" (regexp-quote
+ (tramp-fuse-mount-point
+ (tramp-dissect-file-name directory)))))
+ (remote (directory-file-name
+ (funcall
+ (if (tramp-compat-file-name-quoted-p directory)
+ #'tramp-compat-file-name-quote #'identity)
+ (file-remote-p directory)))))
+ (mapcar
+ (lambda (x) (replace-regexp-in-string local remote x))
+ result))
+ result)))
(defun tramp-fuse-handle-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files."
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 03a6a46e80..d9afcf93c1 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -1002,84 +1002,83 @@ file names."
(msg-operation (if (eq op 'copy) "Copying" "Renaming")))
(with-parsed-tramp-file-name (if t1 filename newname) nil
- (unless (file-exists-p filename)
- (tramp-error v 'file-missing filename))
- (when (and (not ok-if-already-exists) (file-exists-p newname))
- (tramp-error v 'file-already-exists newname))
- (when (and (file-directory-p newname)
- (not (directory-name-p newname)))
- (tramp-error v 'file-error "File is a directory %s" newname))
-
- (cond
- ;; We cannot rename volatile files, as used by Google-drive.
- ((and (not equal-remote) volatile)
- (prog1 (copy-file
- filename newname ok-if-already-exists keep-date
- preserve-uid-gid preserve-extended-attributes)
- (delete-file filename)))
-
- ;; We cannot copy or rename directly.
- ((or (and equal-remote
- (tramp-get-connection-property v "direct-copy-failed"))
- (and t1 (not (tramp-gvfs-file-name-p filename)))
- (and t2 (not (tramp-gvfs-file-name-p newname))))
- (let ((tmpfile (tramp-compat-make-temp-file filename)))
- (if (eq op 'copy)
- (copy-file
- filename tmpfile t keep-date preserve-uid-gid
- preserve-extended-attributes)
- (rename-file filename tmpfile t))
- (rename-file tmpfile newname ok-if-already-exists)))
-
- ;; Direct action.
- (t (with-tramp-progress-reporter
- v 0 (format "%s %s to %s" msg-operation filename newname)
- (unless
- (and (apply
- #'tramp-gvfs-send-command v gvfs-operation
- (append
- (and (eq op 'copy) (or keep-date preserve-uid-gid)
- '("--preserve"))
- (list
- (tramp-gvfs-url-file-name filename)
- (tramp-gvfs-url-file-name newname))))
- ;; Some backends do not return a proper error
- ;; code in case of direct copy/move. Apply
- ;; sanity checks.
- (or (not equal-remote)
- (tramp-gvfs-send-command
- v "gvfs-info" (tramp-gvfs-url-file-name newname))
- (eq op 'copy)
- (not (tramp-gvfs-send-command
- v "gvfs-info"
- (tramp-gvfs-url-file-name filename)))))
-
- (if (or (not equal-remote)
- (and equal-remote
- (tramp-get-connection-property
- v "direct-copy-failed")))
- ;; Propagate the error.
- (with-current-buffer (tramp-get-connection-buffer v)
- (goto-char (point-min))
- (tramp-error-with-buffer
- nil v 'file-error
- "%s failed, see buffer `%s' for details."
- msg-operation (buffer-name)))
-
- ;; Some WebDAV server, like the one from QNAP, do
- ;; not support direct copy/move. Try a fallback.
- (tramp-set-connection-property v "direct-copy-failed" t)
- (tramp-gvfs-do-copy-or-rename-file
- op filename newname ok-if-already-exists keep-date
- preserve-uid-gid preserve-extended-attributes))))
-
- (when (and t1 (eq op 'rename))
- (with-parsed-tramp-file-name filename nil
- (tramp-flush-file-properties v localname)))
-
- (when t2
- (with-parsed-tramp-file-name newname nil
- (tramp-flush-file-properties v localname)))))))))
+ (tramp-barf-if-file-missing v filename
+ (when (and (not ok-if-already-exists) (file-exists-p newname))
+ (tramp-error v 'file-already-exists newname))
+ (when (and (file-directory-p newname)
+ (not (directory-name-p newname)))
+ (tramp-error v 'file-error "File is a directory %s" newname))
+
+ (cond
+ ;; We cannot rename volatile files, as used by Google-drive.
+ ((and (not equal-remote) volatile)
+ (prog1 (copy-file
+ filename newname ok-if-already-exists keep-date
+ preserve-uid-gid preserve-extended-attributes)
+ (delete-file filename)))
+
+ ;; We cannot copy or rename directly.
+ ((or (and equal-remote
+ (tramp-get-connection-property v "direct-copy-failed"))
+ (and t1 (not (tramp-gvfs-file-name-p filename)))
+ (and t2 (not (tramp-gvfs-file-name-p newname))))
+ (let ((tmpfile (tramp-compat-make-temp-file filename)))
+ (if (eq op 'copy)
+ (copy-file
+ filename tmpfile t keep-date preserve-uid-gid
+ preserve-extended-attributes)
+ (rename-file filename tmpfile t))
+ (rename-file tmpfile newname ok-if-already-exists)))
+
+ ;; Direct action.
+ (t (with-tramp-progress-reporter
+ v 0 (format "%s %s to %s" msg-operation filename newname)
+ (unless
+ (and (apply
+ #'tramp-gvfs-send-command v gvfs-operation
+ (append
+ (and (eq op 'copy) (or keep-date preserve-uid-gid)
+ '("--preserve"))
+ (list
+ (tramp-gvfs-url-file-name filename)
+ (tramp-gvfs-url-file-name newname))))
+ ;; Some backends do not return a proper error
+ ;; code in case of direct copy/move. Apply
+ ;; sanity checks.
+ (or (not equal-remote)
+ (tramp-gvfs-send-command
+ v "gvfs-info" (tramp-gvfs-url-file-name newname))
+ (eq op 'copy)
+ (not (tramp-gvfs-send-command
+ v "gvfs-info"
+ (tramp-gvfs-url-file-name filename)))))
+
+ (if (or (not equal-remote)
+ (and equal-remote
+ (tramp-get-connection-property
+ v "direct-copy-failed")))
+ ;; Propagate the error.
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (goto-char (point-min))
+ (tramp-error-with-buffer
+ nil v 'file-error
+ "%s failed, see buffer `%s' for details."
+ msg-operation (buffer-name)))
+
+ ;; Some WebDAV server, like the one from QNAP, do
+ ;; not support direct copy/move. Try a fallback.
+ (tramp-set-connection-property v "direct-copy-failed" t)
+ (tramp-gvfs-do-copy-or-rename-file
+ op filename newname ok-if-already-exists keep-date
+ preserve-uid-gid preserve-extended-attributes))))
+
+ (when (and t1 (eq op 'rename))
+ (with-parsed-tramp-file-name filename nil
+ (tramp-flush-file-properties v localname)))
+
+ (when t2
+ (with-parsed-tramp-file-name newname nil
+ (tramp-flush-file-properties v localname))))))))))
(defun tramp-gvfs-handle-copy-file
(filename newname &optional ok-if-already-exists keep-date
@@ -1626,6 +1625,7 @@ VEC or USER, or if there is no home directory, return
nil."
(defun tramp-gvfs-handle-get-remote-uid (vec id-format)
"The uid of the remote connection VEC, in ID-FORMAT.
ID-FORMAT valid values are `string' and `integer'."
+ ;; The result is cached in `tramp-get-remote-uid'.
(if (equal id-format 'string)
(tramp-file-name-user vec)
(when-let ((localname
@@ -1636,6 +1636,7 @@ ID-FORMAT valid values are `string' and `integer'."
(defun tramp-gvfs-handle-get-remote-gid (vec id-format)
"The gid of the remote connection VEC, in ID-FORMAT.
ID-FORMAT valid values are `string' and `integer'."
+ ;; The result is cached in `tramp-get-remote-gid'.
(when-let ((localname
(tramp-get-connection-property (tramp-get-process vec) "share")))
(file-attribute-group-id
@@ -1795,7 +1796,8 @@ a downcased host name only."
(progn
(message "%s" message)
0)
- (with-tramp-connection-property (tramp-get-process v)
message
+ (with-tramp-connection-property
+ (tramp-get-process v) message
;; In theory, there can be several choices.
;; Until now, there is only the question
;; whether to accept an unknown host
diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el
index bbc7685131..5bee5641bb 100644
--- a/lisp/net/tramp-rclone.el
+++ b/lisp/net/tramp-rclone.el
@@ -225,46 +225,45 @@ file names."
(msg-operation (if (eq op 'copy) "Copying" "Renaming")))
(with-parsed-tramp-file-name (if t1 filename newname) nil
- (unless (file-exists-p filename)
- (tramp-error v 'file-missing filename))
- (when (and (not ok-if-already-exists) (file-exists-p newname))
- (tramp-error v 'file-already-exists newname))
- (when (and (file-directory-p newname)
- (not (directory-name-p newname)))
- (tramp-error v 'file-error "File is a directory %s" newname))
-
- (if (or (and t1 (not (tramp-rclone-file-name-p filename)))
- (and t2 (not (tramp-rclone-file-name-p newname))))
-
- ;; We cannot copy or rename directly.
- (let ((tmpfile (tramp-compat-make-temp-file filename)))
- (if (eq op 'copy)
- (copy-file
- filename tmpfile t keep-date preserve-uid-gid
- preserve-extended-attributes)
- (rename-file filename tmpfile t))
- (rename-file tmpfile newname ok-if-already-exists))
-
- ;; Direct action.
- (with-tramp-progress-reporter
- v 0 (format "%s %s to %s" msg-operation filename newname)
- (unless (zerop
- (tramp-rclone-send-command
- v rclone-operation
- (tramp-rclone-remote-file-name filename)
- (tramp-rclone-remote-file-name newname)))
- (tramp-error
- v 'file-error
- "Error %s `%s' `%s'" msg-operation filename newname)))
-
- (when (and t1 (eq op 'rename))
- (while (file-exists-p filename)
- (with-parsed-tramp-file-name filename v1
- (tramp-flush-file-properties v1 v1-localname))))
-
- (when t2
- (with-parsed-tramp-file-name newname v2
- (tramp-flush-file-properties v2 v2-localname))))))))
+ (tramp-barf-if-file-missing v filename
+ (when (and (not ok-if-already-exists) (file-exists-p newname))
+ (tramp-error v 'file-already-exists newname))
+ (when (and (file-directory-p newname)
+ (not (directory-name-p newname)))
+ (tramp-error v 'file-error "File is a directory %s" newname))
+
+ (if (or (and t1 (not (tramp-rclone-file-name-p filename)))
+ (and t2 (not (tramp-rclone-file-name-p newname))))
+
+ ;; We cannot copy or rename directly.
+ (let ((tmpfile (tramp-compat-make-temp-file filename)))
+ (if (eq op 'copy)
+ (copy-file
+ filename tmpfile t keep-date preserve-uid-gid
+ preserve-extended-attributes)
+ (rename-file filename tmpfile t))
+ (rename-file tmpfile newname ok-if-already-exists))
+
+ ;; Direct action.
+ (with-tramp-progress-reporter
+ v 0 (format "%s %s to %s" msg-operation filename newname)
+ (unless (zerop
+ (tramp-rclone-send-command
+ v rclone-operation
+ (tramp-rclone-remote-file-name filename)
+ (tramp-rclone-remote-file-name newname)))
+ (tramp-error
+ v 'file-error
+ "Error %s `%s' `%s'" msg-operation filename newname)))
+
+ (when (and t1 (eq op 'rename))
+ (while (file-exists-p filename)
+ (with-parsed-tramp-file-name filename v1
+ (tramp-flush-file-properties v1 v1-localname))))
+
+ (when t2
+ (with-parsed-tramp-file-name newname v2
+ (tramp-flush-file-properties v2 v2-localname)))))))))
(defun tramp-rclone-handle-copy-file
(filename newname &optional ok-if-already-exists keep-date
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index e772af9e0a..6d32622742 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -620,6 +620,21 @@ on the remote file system.
Format specifiers are replaced by `tramp-expand-script', percent
characters need to be doubled.")
+(defconst tramp-readlink-file-truename
+ (format
+ (concat
+ "(echo -n %s &&"
+ " %%r --no-newline --canonicalize-missing \"$1\" &&"
+ " echo %s) |"
+ " sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g'")
+ tramp-stat-marker
+ tramp-stat-marker
+ tramp-stat-quoted-marker)
+ "Shell function to produce output suitable for use with `file-truename'
+on the remote file system.
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
+
(defconst tramp-perl-file-name-all-completions
"%p -e '
opendir(d, $ARGV[0]) || die(\"$ARGV[0]: $!\\nfail\\n\");
@@ -666,14 +681,14 @@ else
{
$type = \"nil\"
};
-$uid = ($ARGV[1] eq \"integer\") ? $stat[4] : \"\\\"\" . getpwuid($stat[4]) .
\"\\\"\";
-$gid = ($ARGV[1] eq \"integer\") ? $stat[5] : \"\\\"\" . getgrgid($stat[5]) .
\"\\\"\";
printf(
- \"(%%s %%u %%s %%s (%%u %%u) (%%u %%u) (%%u %%u) %%u %%u t %%u -1)\\n\",
+ \"(%%s %%u (%%s . %%u) (%%s . %%u) (%%u %%u) (%%u %%u) (%%u %%u) %%u %%u t
%%u -1)\\n\",
$type,
$stat[3],
- $uid,
- $gid,
+ \"\\\"\" . getpwuid($stat[4]) . \"\\\"\",
+ $stat[4],
+ \"\\\"\" . getgrgid($stat[5]) . \"\\\"\",
+ $stat[5],
$stat[8] >> 16 & 0xffff,
$stat[8] & 0xffff,
$stat[9] >> 16 & 0xffff,
@@ -683,12 +698,29 @@ printf(
$stat[7],
$stat[2],
$stat[1]
-);' \"$1\" \"$2\" %n"
+);' \"$1\" %n"
"Perl script to produce output suitable for use with `file-attributes'
on the remote file system.
Format specifiers are replaced by `tramp-expand-script', percent
characters need to be doubled.")
+(defconst tramp-stat-file-attributes
+ (format
+ (concat
+ "(%%s -c"
+ " '((%s%%%%N%s) %%%%h (%s%%%%U%s . %%%%u) (%s%%%%G%s . %%%%g)"
+ " %%%%X %%%%Y %%%%Z %%%%s %s%%%%A%s t %%%%i -1)' \"$1\" %%n || echo nil) |"
+ " sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g'")
+ tramp-stat-marker tramp-stat-marker ; %%N
+ tramp-stat-marker tramp-stat-marker ; %%U
+ tramp-stat-marker tramp-stat-marker ; %%G
+ tramp-stat-marker tramp-stat-marker ; %%A
+ tramp-stat-quoted-marker)
+ "Shell function to produce output suitable for use with `file-attributes'
+on the remote file system.
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
+
(defconst tramp-perl-directory-files-and-attributes
"%p -e '
chdir($ARGV[0]) or printf(\"\\\"Cannot change to $ARGV[0]: $''!''\\\"\\n\"),
exit();
@@ -715,16 +747,16 @@ for($i = 0; $i < $n; $i++)
{
$type = \"nil\"
};
- $uid = ($ARGV[1] eq \"integer\") ? $stat[4] : \"\\\"\" .
getpwuid($stat[4]) . \"\\\"\";
- $gid = ($ARGV[1] eq \"integer\") ? $stat[5] : \"\\\"\" .
getgrgid($stat[5]) . \"\\\"\";
$filename =~ s/\"/\\\\\"/g;
printf(
- \"(\\\"%%s\\\" %%s %%u %%s %%s (%%u %%u) (%%u %%u) (%%u %%u) %%u %%u t
%%u -1)\\n\",
+ \"(\\\"%%s\\\" %%s %%u (%%s . %%u) (%%s . %%u) (%%u %%u) (%%u %%u)
(%%u %%u) %%u %%u t %%u -1)\\n\",
$filename,
$type,
$stat[3],
- $uid,
- $gid,
+ \"\\\"\" . getpwuid($stat[4]) . \"\\\"\",
+ $stat[4],
+ \"\\\"\" . getgrgid($stat[5]) . \"\\\"\",
+ $stat[5],
$stat[8] >> 16 & 0xffff,
$stat[8] & 0xffff,
$stat[9] >> 16 & 0xffff,
@@ -735,12 +767,38 @@ for($i = 0; $i < $n; $i++)
$stat[2],
$stat[1]);
}
-printf(\")\\n\");' \"$1\" \"$2\" %n"
+printf(\")\\n\");' \"$1\" %n"
"Perl script implementing `directory-files-and-attributes' as Lisp `read'able
output.
Format specifiers are replaced by `tramp-expand-script', percent
characters need to be doubled.")
+(defconst tramp-stat-directory-files-and-attributes
+ (format
+ (concat
+ ;; We must care about file names with spaces, or starting with
+ ;; "-"; this would confuse xargs. "ls -aQ" might be a solution,
+ ;; but it does not work on all remote systems. Therefore, we use
+ ;; \000 as file separator. `tramp-sh--quoting-style-options' do
+ ;; not work for file names with spaces piped to "xargs".
+ ;; Apostrophes in the stat output are masked as
+ ;; `tramp-stat-marker', in order to make a proper shell escape of
+ ;; them in file names.
+ "cd \"$1\" && echo \"(\"; (%%l -a | tr '\\n\\r' '\\000\\000' |"
+ " xargs -0 %%s -c"
+ " '(%s%%%%n%s (%s%%%%N%s) %%%%h (%s%%%%U%s . %%%%u) (%s%%%%G%s . %%%%g)
%%%%X %%%%Y %%%%Z %%%%s %s%%%%A%s t %%%%i -1)'"
+ " -- %%n | sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g'); echo \")\"")
+ tramp-stat-marker tramp-stat-marker ; %n
+ tramp-stat-marker tramp-stat-marker ; %N
+ tramp-stat-marker tramp-stat-marker ; %U
+ tramp-stat-marker tramp-stat-marker ; %G
+ tramp-stat-marker tramp-stat-marker ; %A
+ tramp-stat-quoted-marker)
+ "Shell function implementing `directory-files-and-attributes' as Lisp
+`read'able output.
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
+
;; These two use base64 encoding.
(defconst tramp-perl-encode-with-module
"%p -MMIME::Base64 -0777 -ne 'print encode_base64($_)' %n"
@@ -1068,7 +1126,9 @@ component is used as the target of the symlink."
(let ((non-essential t))
(when (and (tramp-tramp-file-p target)
(tramp-file-name-equal-p v (tramp-dissect-file-name target)))
- (setq target (tramp-file-local-name (expand-file-name target)))))
+ (setq target (tramp-file-local-name (expand-file-name target))))
+ ;; There could be a cyclic link.
+ (tramp-flush-file-properties v target))
;; If TARGET is still remote, quote it.
(if (tramp-tramp-file-p target)
@@ -1130,36 +1190,31 @@ component is used as the target of the symlink."
(tramp-make-tramp-file-name
v
(with-tramp-file-property v localname "file-truename"
- (let (result) ; result steps in reverse order
- (tramp-message v 4 "Finding true name for `%s'" filename)
- (cond
- ;; Use GNU readlink --canonicalize-missing where available.
- ((tramp-get-remote-readlink v)
- (tramp-send-command-and-check
- v
- (format "%s --canonicalize-missing %s"
- (tramp-get-remote-readlink v)
- (tramp-shell-quote-argument localname)))
- (with-current-buffer (tramp-get-connection-buffer v)
- (goto-char (point-min))
- (setq result (buffer-substring (point-min) (point-at-eol)))))
-
- ;; Use Perl implementation.
- ((and (tramp-get-remote-perl v)
- (tramp-get-connection-property v "perl-file-spec")
- (tramp-get-connection-property v "perl-cwd-realpath"))
- (tramp-maybe-send-script
- v tramp-perl-file-truename "tramp_perl_file_truename")
- (setq result
- (tramp-send-command-and-read
- v
- (format "tramp_perl_file_truename %s"
- (tramp-shell-quote-argument localname)))))
-
- ;; Do it yourself.
- (t (setq
- result
- (tramp-file-local-name (tramp-handle-file-truename filename)))))
+ (tramp-message v 4 "Finding true name for `%s'" filename)
+ (let ((result
+ (cond
+ ;; Use GNU readlink --canonicalize-missing where
+ ;; available.
+ ((tramp-get-remote-readlink v)
+ (tramp-maybe-send-script
+ v tramp-readlink-file-truename
"tramp_readlink_file_truename")
+ (tramp-send-command-and-read
+ v (format "tramp_readlink_file_truename %s"
+ (tramp-shell-quote-argument localname))))
+
+ ;; Use Perl implementation.
+ ((and (tramp-get-remote-perl v)
+ (tramp-get-connection-property v "perl-file-spec")
+ (tramp-get-connection-property v "perl-cwd-realpath"))
+ (tramp-maybe-send-script
+ v tramp-perl-file-truename "tramp_perl_file_truename")
+ (tramp-send-command-and-read
+ v (format "tramp_perl_file_truename %s"
+ (tramp-shell-quote-argument localname))))
+
+ ;; Do it yourself.
+ (t (tramp-file-local-name
+ (tramp-handle-file-truename filename))))))
;; Detect cycle.
(when (and (file-symlink-p filename)
@@ -1184,37 +1239,28 @@ component is used as the target of the symlink."
(when (tramp-connectable-p filename)
(with-parsed-tramp-file-name filename nil
(with-tramp-file-property v localname "file-exists-p"
- (or (not (null (tramp-get-file-property
- v localname "file-attributes-integer")))
- (not (null (tramp-get-file-property
- v localname "file-attributes-string")))
- (tramp-send-command-and-check
- v
- (format
- "%s %s"
- (tramp-get-file-exists-command v)
- (tramp-shell-quote-argument localname))))))))
+ (if (tramp-file-property-p v localname "file-attributes")
+ (not (null (tramp-get-file-property v localname "file-attributes")))
+ (tramp-send-command-and-check
+ v
+ (format
+ "%s %s"
+ (tramp-get-file-exists-command v)
+ (tramp-shell-quote-argument localname))))))))
(defun tramp-sh-handle-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files."
- (unless id-format (setq id-format 'integer))
- (ignore-errors
- ;; Don't modify `last-coding-system-used' by accident.
- (let ((last-coding-system-used last-coding-system-used))
- (with-parsed-tramp-file-name (expand-file-name filename) nil
- (with-tramp-file-property
- v localname (format "file-attributes-%s" id-format)
- (tramp-convert-file-attributes
- v
- (or
- (cond
- ((tramp-get-remote-stat v)
- (tramp-do-file-attributes-with-stat v localname id-format))
- ((tramp-get-remote-perl v)
- (tramp-do-file-attributes-with-perl v localname id-format))
- (t nil))
- ;; The scripts could fail, for example with huge file size.
- (tramp-do-file-attributes-with-ls v localname id-format))))))))
+ ;; The result is cached in `tramp-convert-file-attributes'.
+ ;; Don't modify `last-coding-system-used' by accident.
+ (let ((last-coding-system-used last-coding-system-used))
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (tramp-convert-file-attributes v localname id-format
+ (cond
+ ((tramp-get-remote-stat v)
+ (tramp-do-file-attributes-with-stat v localname))
+ ((tramp-get-remote-perl v)
+ (tramp-do-file-attributes-with-perl v localname))
+ (t (tramp-do-file-attributes-with-ls v localname)))))))
(defconst tramp-sunos-unames (regexp-opt '("SunOS 5.10" "SunOS 5.11"))
"Regexp to determine remote SunOS.")
@@ -1230,29 +1276,40 @@ component is used as the target of the symlink."
(tramp-get-ls-command-with vec "-w"))
""))
-(defun tramp-do-file-attributes-with-ls (vec localname &optional id-format)
+(defun tramp-do-file-attributes-with-ls (vec localname)
"Implement `file-attributes' for Tramp files using the ls(1) command."
(let (symlinkp dirp
res-inode res-filemodes res-numlinks
- res-uid res-gid res-size res-symlink-target)
+ res-uid-string res-gid-string res-uid-integer res-gid-integer
+ res-size res-symlink-target)
(tramp-message vec 5 "file attributes with ls: %s" localname)
;; We cannot send all three commands combined, it could exceed
;; NAME_MAX or PATH_MAX. Happened on macOS, for example.
- (when (or (tramp-send-command-and-check
- vec
- (format "%s %s"
- (tramp-get-file-exists-command vec)
- (tramp-shell-quote-argument localname)))
- (tramp-send-command-and-check
- vec
- (format "%s -h %s"
- (tramp-get-test-command vec)
- (tramp-shell-quote-argument localname))))
+ (when (tramp-send-command-and-check
+ vec
+ (format "cd %s && (%s %s || %s -h %s)"
+ (tramp-shell-quote-argument
+ (tramp-run-real-handler
+ #'file-name-directory (list localname)))
+ (tramp-get-file-exists-command vec)
+ (if (string-empty-p (file-name-nondirectory localname))
+ "."
+ (tramp-shell-quote-argument
+ (file-name-nondirectory localname)))
+ (tramp-get-test-command vec)
+ (if (string-empty-p (file-name-nondirectory localname))
+ "."
+ (tramp-shell-quote-argument
+ (file-name-nondirectory localname)))))
(tramp-send-command
vec
- (format "%s %s %s %s"
+ (format "%s -ild %s %s; %s -lnd %s %s"
+ (tramp-get-ls-command vec)
+ ;; On systems which have no quoting style, file names
+ ;; with special characters could fail.
+ (tramp-sh--quoting-style-options vec)
+ (tramp-shell-quote-argument localname)
(tramp-get-ls-command vec)
- (if (eq id-format 'integer) "-ildn" "-ild")
;; On systems which have no quoting style, file names
;; with special characters could fail.
(tramp-sh--quoting-style-options vec)
@@ -1268,17 +1325,12 @@ component is used as the target of the symlink."
;; ... number links
(setq res-numlinks (read (current-buffer)))
;; ... uid and gid
- (setq res-uid (read (current-buffer)))
- (setq res-gid (read (current-buffer)))
- (if (eq id-format 'integer)
- (progn
- (unless (numberp res-uid)
- (setq res-uid tramp-unknown-id-integer))
- (unless (numberp res-gid)
- (setq res-gid tramp-unknown-id-integer)))
- (progn
- (unless (stringp res-uid) (setq res-uid (symbol-name res-uid)))
- (unless (stringp res-gid) (setq res-gid (symbol-name res-gid)))))
+ (setq res-uid-string (read (current-buffer)))
+ (setq res-gid-string (read (current-buffer)))
+ (unless (stringp res-uid-string)
+ (setq res-uid-string (symbol-name res-uid-string)))
+ (unless (stringp res-gid-string)
+ (setq res-gid-string (symbol-name res-gid-string)))
;; ... size
(setq res-size (read (current-buffer)))
;; From the file modes, figure out other stuff.
@@ -1291,7 +1343,20 @@ component is used as the target of the symlink."
(if (looking-at-p "\"")
(read (current-buffer))
(buffer-substring (point) (point-at-eol)))))
- ;; Return data gathered.
+ (forward-line)
+ ;; ... file mode flags
+ (read (current-buffer))
+ ;; ... number links
+ (read (current-buffer))
+ ;; ... uid and gid
+ (setq res-uid-integer (read (current-buffer)))
+ (setq res-gid-integer (read (current-buffer)))
+ (unless (numberp res-uid-integer)
+ (setq res-uid-integer tramp-unknown-id-integer))
+ (unless (numberp res-gid-integer)
+ (setq res-gid-integer tramp-unknown-id-integer))
+
+ ;; Return data gathered.
(list
;; 0. t for directory, string (name linked to) for symbolic
;; link, or nil.
@@ -1299,9 +1364,9 @@ component is used as the target of the symlink."
;; 1. Number of links to file.
res-numlinks
;; 2. File uid.
- res-uid
+ (cons res-uid-string res-uid-integer)
;; 3. File gid.
- res-gid
+ (cons res-gid-string res-gid-integer)
;; 4. Last access time.
;; 5. Last modification time.
;; 6. Last status change time.
@@ -1318,42 +1383,23 @@ component is used as the target of the symlink."
;; 11. Device number. Will be replaced by a virtual device number.
-1))))))
-(defun tramp-do-file-attributes-with-perl
- (vec localname &optional id-format)
+(defun tramp-do-file-attributes-with-perl (vec localname)
"Implement `file-attributes' for Tramp files using a Perl script."
(tramp-message vec 5 "file attributes with perl: %s" localname)
(tramp-maybe-send-script
vec tramp-perl-file-attributes "tramp_perl_file_attributes")
(tramp-send-command-and-read
- vec
- (format "tramp_perl_file_attributes %s %s"
- (tramp-shell-quote-argument localname) id-format)))
+ vec (format "tramp_perl_file_attributes %s"
+ (tramp-shell-quote-argument localname))))
-(defun tramp-do-file-attributes-with-stat
- (vec localname &optional id-format)
+(defun tramp-do-file-attributes-with-stat (vec localname)
"Implement `file-attributes' for Tramp files using stat(1) command."
(tramp-message vec 5 "file attributes with stat: %s" localname)
+ (tramp-maybe-send-script
+ vec tramp-stat-file-attributes "tramp_stat_file_attributes")
(tramp-send-command-and-read
- vec
- (format
- (concat
- ;; Apostrophes in the stat output are masked as
- ;; `tramp-stat-marker', in order to make a proper shell escape of
- ;; them in file names.
- "(%s -c '((%s%%N%s) %%h %s %s %%X %%Y %%Z %%s %s%%A%s t %%i -1)' %s |"
- " sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g')")
- (tramp-get-remote-stat vec)
- tramp-stat-marker tramp-stat-marker
- (if (eq id-format 'integer)
- "%u"
- (eval-when-compile (concat tramp-stat-marker "%U" tramp-stat-marker)))
- (if (eq id-format 'integer)
- "%g"
- (eval-when-compile (concat tramp-stat-marker "%G" tramp-stat-marker)))
- tramp-stat-marker tramp-stat-marker
- (tramp-shell-quote-argument localname)
- tramp-stat-quoted-marker)
- 'noerror))
+ vec (format "tramp_stat_file_attributes %s"
+ (tramp-shell-quote-argument localname))))
(defun tramp-sh-handle-set-visited-file-modtime (&optional time-list)
"Like `set-visited-file-modtime' for Tramp files."
@@ -1486,6 +1532,7 @@ VEC or USER, or if there is no home directory, return
nil."
(defun tramp-sh-handle-get-remote-uid (vec id-format)
"The uid of the remote connection VEC, in ID-FORMAT.
ID-FORMAT valid values are `string' and `integer'."
+ ;; The result is cached in `tramp-get-remote-uid'.
(ignore-errors
(cond
((tramp-get-remote-id vec) (tramp-get-remote-uid-with-id vec id-format))
@@ -1496,6 +1543,7 @@ ID-FORMAT valid values are `string' and `integer'."
(defun tramp-sh-handle-get-remote-gid (vec id-format)
"The gid of the remote connection VEC, in ID-FORMAT.
ID-FORMAT valid values are `string' and `integer'."
+ ;; The result is cached in `tramp-get-remote-gid'.
(ignore-errors
(cond
((tramp-get-remote-id vec) (tramp-get-remote-gid-with-id vec id-format))
@@ -1620,16 +1668,18 @@ ID-FORMAT valid values are `string' and `integer'."
(with-tramp-file-property v localname "file-executable-p"
;; Examine `file-attributes' cache to see if request can be
;; satisfied without remote operation.
- (or (tramp-check-cached-permissions v ?x)
- (tramp-check-cached-permissions v ?s)
- (tramp-run-test "-x" filename)))))
+ (if (tramp-file-property-p v localname "file-attributes")
+ (or (tramp-check-cached-permissions v ?x)
+ (tramp-check-cached-permissions v ?s))
+ (tramp-run-test "-x" filename)))))
(defun tramp-sh-handle-file-readable-p (filename)
"Like `file-readable-p' for Tramp files."
(with-parsed-tramp-file-name filename nil
(with-tramp-file-property v localname "file-readable-p"
- (or (tramp-handle-file-readable-p filename)
- (tramp-run-test "-r" filename)))))
+ (if (tramp-file-property-p v localname "file-attributes")
+ (tramp-handle-file-readable-p filename)
+ (tramp-run-test "-r" filename)))))
;; Functions implemented using the basic functions above.
@@ -1642,19 +1692,28 @@ ID-FORMAT valid values are `string' and `integer'."
;; be expected that this is always a directory.
(or (zerop (length localname))
(with-tramp-file-property v localname "file-directory-p"
- (tramp-run-test "-d" filename)))))
+ (if-let
+ ((truename (tramp-get-file-property v localname "file-truename"))
+ (attr-p (tramp-file-property-p
+ v (tramp-file-local-name truename) "file-attributes")))
+ (eq (file-attribute-type
+ (tramp-get-file-property
+ v (tramp-file-local-name truename) "file-attributes"))
+ t)
+ (tramp-run-test "-d" filename))))))
(defun tramp-sh-handle-file-writable-p (filename)
"Like `file-writable-p' for Tramp files."
(with-parsed-tramp-file-name filename nil
(with-tramp-file-property v localname "file-writable-p"
(if (file-exists-p filename)
- ;; Examine `file-attributes' cache to see if request can be
- ;; satisfied without remote operation.
- (or (tramp-check-cached-permissions v ?w)
- (tramp-run-test "-w" filename))
+ (if (tramp-file-property-p v localname "file-attributes")
+ ;; Examine `file-attributes' cache to see if request can
+ ;; be satisfied without remote operation.
+ (tramp-check-cached-permissions v ?w)
+ (tramp-run-test "-w" filename))
;; If file doesn't exist, check if directory is writable.
- (and (tramp-run-test "-d" (file-name-directory filename))
+ (and (file-exists-p (file-name-directory filename))
(tramp-run-test "-w" (file-name-directory filename)))))))
(defun tramp-sh-handle-file-ownership-preserved-p (filename &optional group)
@@ -1683,51 +1742,18 @@ ID-FORMAT valid values are `string' and `integer'."
(defun tramp-sh-handle-directory-files-and-attributes
(directory &optional full match nosort id-format count)
"Like `directory-files-and-attributes' for Tramp files."
- (unless id-format (setq id-format 'integer))
- (unless (file-exists-p directory)
- (tramp-error (tramp-dissect-file-name directory) 'file-missing directory))
- (when (file-directory-p directory)
- (setq directory (expand-file-name directory))
- (let* ((temp
- (copy-tree
- (with-parsed-tramp-file-name directory nil
- (with-tramp-file-property
- v localname
- (format "directory-files-and-attributes-%s" id-format)
- (mapcar
- (lambda (x)
- (cons (car x) (tramp-convert-file-attributes v (cdr x))))
- (cond
- ((tramp-get-remote-stat v)
- (tramp-do-directory-files-and-attributes-with-stat
- v localname id-format))
- ((tramp-get-remote-perl v)
- (tramp-do-directory-files-and-attributes-with-perl
- v localname id-format))
- (t nil)))))))
- result item)
-
- (while temp
- (setq item (pop temp))
- (when (or (null match) (string-match-p match (car item)))
- (when full
- (setcar item (expand-file-name (car item) directory)))
- (push item result)))
-
- (unless nosort
- (setq result (sort result (lambda (x y) (string< (car x) (car y))))))
-
- (when (and (natnump count) (> count 0))
- (setq result (tramp-compat-ntake count result)))
-
- (or result
- ;; The scripts could fail, for example with huge file size.
- (tramp-handle-directory-files-and-attributes
- directory full match nosort id-format count)))))
+ (tramp-skeleton-directory-files-and-attributes
+ directory full match nosort id-format count
+ (cond
+ ((tramp-get-remote-stat v)
+ (tramp-do-directory-files-and-attributes-with-stat
+ v localname))
+ ((tramp-get-remote-perl v)
+ (tramp-do-directory-files-and-attributes-with-perl
+ v localname)))))
;; FIXME: Fix function to work with count parameter.
-(defun tramp-do-directory-files-and-attributes-with-perl
- (vec localname &optional id-format)
+(defun tramp-do-directory-files-and-attributes-with-perl (vec localname)
"Implement `directory-files-and-attributes' for Tramp files using a Perl
script."
(tramp-message vec 5 "directory-files-and-attributes with perl: %s"
localname)
(tramp-maybe-send-script
@@ -1735,50 +1761,21 @@ ID-FORMAT valid values are `string' and `integer'."
"tramp_perl_directory_files_and_attributes")
(let ((object
(tramp-send-command-and-read
- vec
- (format "tramp_perl_directory_files_and_attributes %s %s"
- (tramp-shell-quote-argument localname) id-format))))
+ vec (format "tramp_perl_directory_files_and_attributes %s"
+ (tramp-shell-quote-argument localname)))))
(when (stringp object) (tramp-error vec 'file-error object))
object))
;; FIXME: Fix function to work with count parameter.
-(defun tramp-do-directory-files-and-attributes-with-stat
- (vec localname &optional id-format)
+(defun tramp-do-directory-files-and-attributes-with-stat (vec localname)
"Implement `directory-files-and-attributes' for Tramp files with stat(1)
command."
(tramp-message vec 5 "directory-files-and-attributes with stat: %s"
localname)
+ (tramp-maybe-send-script
+ vec tramp-stat-directory-files-and-attributes
+ "tramp_stat_directory_files_and_attributes")
(tramp-send-command-and-read
- vec
- (format
- (concat
- ;; We must care about file names with spaces, or starting with
- ;; "-"; this would confuse xargs. "ls -aQ" might be a solution,
- ;; but it does not work on all remote systems. Therefore, we use
- ;; \000 as file separator. `tramp-sh--quoting-style-options' do
- ;; not work for file names with spaces piped to "xargs".
- ;; Apostrophes in the stat output are masked as
- ;; `tramp-stat-marker', in order to make a proper shell escape of
- ;; them in file names.
- "cd %s && echo \"(\"; (%s %s -a | tr '\\n\\r' '\\000\\000' | "
- "xargs -0 %s -c "
- "'(%s%%n%s (%s%%N%s) %%h %s %s %%X %%Y %%Z %%s %s%%A%s t %%i -1)' "
- "-- 2>%s | sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g'); echo \")\"")
- (tramp-shell-quote-argument localname)
- (tramp-get-ls-command vec)
- ;; On systems which have no quoting style, file names with special
- ;; characters could fail.
- (tramp-sh--quoting-style-options vec)
- (tramp-get-remote-stat vec)
- tramp-stat-marker tramp-stat-marker
- tramp-stat-marker tramp-stat-marker
- (if (eq id-format 'integer)
- "%u"
- (eval-when-compile (concat tramp-stat-marker "%U" tramp-stat-marker)))
- (if (eq id-format 'integer)
- "%g"
- (eval-when-compile (concat tramp-stat-marker "%G" tramp-stat-marker)))
- tramp-stat-marker tramp-stat-marker
- (tramp-get-remote-null-device vec)
- tramp-stat-quoted-marker)))
+ vec (format "tramp_stat_directory_files_and_attributes %s"
+ (tramp-shell-quote-argument localname))))
;; This function should return "foo/" for directories and "bar" for
;; files.
@@ -1900,59 +1897,62 @@ ID-FORMAT valid values are `string' and `integer'."
(defun tramp-sh-handle-copy-directory
(dirname newname &optional keep-date parents copy-contents)
"Like `copy-directory' for Tramp files."
- (let ((t1 (tramp-tramp-file-p dirname))
- (t2 (tramp-tramp-file-p newname))
- target)
- (with-parsed-tramp-file-name (if t1 dirname newname) nil
- (unless (file-exists-p dirname)
- (tramp-error v 'file-missing dirname))
-
- ;; `copy-directory-create-symlink' exists since Emacs 28.1.
- (if (and (bound-and-true-p copy-directory-create-symlink)
- (setq target (file-symlink-p dirname))
- (tramp-equal-remote dirname newname))
- (make-symbolic-link
- target
- (if (directory-name-p newname)
- (concat newname (file-name-nondirectory dirname)) newname)
- t)
-
- (if (and (not copy-contents)
- (tramp-get-method-parameter v 'tramp-copy-recursive)
- ;; When DIRNAME and NEWNAME are remote, they must
- ;; have the same method.
- (or (null t1) (null t2)
- (string-equal
- (tramp-file-name-method (tramp-dissect-file-name dirname))
- (tramp-file-name-method
- (tramp-dissect-file-name newname)))))
- ;; scp or rsync DTRT.
- (progn
- (when (and (file-directory-p newname)
- (not (directory-name-p newname)))
- (tramp-error v 'file-already-exists newname))
- (setq dirname (directory-file-name (expand-file-name dirname))
- newname (directory-file-name (expand-file-name newname)))
- (when (and (file-directory-p newname)
- (not (string-equal (file-name-nondirectory dirname)
- (file-name-nondirectory newname))))
- (setq newname
- (expand-file-name
- (file-name-nondirectory dirname) newname)))
- (unless (file-directory-p (file-name-directory newname))
- (make-directory (file-name-directory newname) parents))
- (tramp-do-copy-or-rename-file-out-of-band
- 'copy dirname newname 'ok-if-already-exists keep-date))
-
- ;; We must do it file-wise.
- (tramp-run-real-handler
- #'copy-directory
- (list dirname newname keep-date parents copy-contents))))
-
- ;; When newname did exist, we have wrong cached values.
- (when t2
- (with-parsed-tramp-file-name newname nil
- (tramp-flush-file-properties v localname))))))
+ (tramp-skeleton-copy-directory
+ dirname newname keep-date parents copy-contents
+ (let ((t1 (tramp-tramp-file-p dirname))
+ (t2 (tramp-tramp-file-p newname))
+ target)
+ (with-parsed-tramp-file-name (if t1 dirname newname) nil
+ (unless (file-exists-p dirname)
+ (tramp-error v 'file-missing dirname))
+
+ ;; `copy-directory-create-symlink' exists since Emacs 28.1.
+ (if (and (bound-and-true-p copy-directory-create-symlink)
+ (setq target (file-symlink-p dirname))
+ (tramp-equal-remote dirname newname))
+ (make-symbolic-link
+ target
+ (if (directory-name-p newname)
+ (concat newname (file-name-nondirectory dirname)) newname)
+ t)
+
+ (if (and (not copy-contents)
+ (tramp-get-method-parameter v 'tramp-copy-recursive)
+ ;; When DIRNAME and NEWNAME are remote, they must
+ ;; have the same method.
+ (or (null t1) (null t2)
+ (string-equal
+ (tramp-file-name-method
+ (tramp-dissect-file-name dirname))
+ (tramp-file-name-method
+ (tramp-dissect-file-name newname)))))
+ ;; scp or rsync DTRT.
+ (progn
+ (when (and (file-directory-p newname)
+ (not (directory-name-p newname)))
+ (tramp-error v 'file-already-exists newname))
+ (setq dirname (directory-file-name (expand-file-name dirname))
+ newname (directory-file-name (expand-file-name newname)))
+ (when (and (file-directory-p newname)
+ (not (string-equal (file-name-nondirectory dirname)
+ (file-name-nondirectory
newname))))
+ (setq newname
+ (expand-file-name
+ (file-name-nondirectory dirname) newname)))
+ (unless (file-directory-p (file-name-directory newname))
+ (make-directory (file-name-directory newname) parents))
+ (tramp-do-copy-or-rename-file-out-of-band
+ 'copy dirname newname 'ok-if-already-exists keep-date))
+
+ ;; We must do it file-wise.
+ (tramp-run-real-handler
+ #'copy-directory
+ (list dirname newname keep-date parents copy-contents))))
+
+ ;; When newname did exist, we have wrong cached values.
+ (when t2
+ (with-parsed-tramp-file-name newname nil
+ (tramp-flush-file-properties v localname)))))))
(defun tramp-sh-handle-rename-file
(filename newname &optional ok-if-already-exists)
@@ -1997,98 +1997,101 @@ file names."
(copy-directory filename newname keep-date t)
(when (eq op 'rename) (delete-directory filename 'recursive)))
+ ;; FIXME: This should be optimized. Computing `file-attributes'
+ ;; checks already, whether the file exists.
(let ((t1 (tramp-tramp-file-p filename))
(t2 (tramp-tramp-file-p newname))
(length (file-attribute-size
(file-attributes (file-truename filename))))
- (attributes (and preserve-extended-attributes
- (file-extended-attributes filename)))
(msg-operation (if (eq op 'copy) "Copying" "Renaming")))
(with-parsed-tramp-file-name (if t1 filename newname) nil
- (unless (file-exists-p filename)
+ (unless length
(tramp-error v 'file-missing filename))
- (when (and (not ok-if-already-exists) (file-exists-p newname))
- (tramp-error v 'file-already-exists newname))
- (when (and (file-directory-p newname)
- (not (directory-name-p newname)))
- (tramp-error v 'file-error "File is a directory %s" newname))
+ (tramp-barf-if-file-missing v filename
+ (when (and (not ok-if-already-exists) (file-exists-p newname))
+ (tramp-error v 'file-already-exists newname))
+ (when (and (file-directory-p newname)
+ (not (directory-name-p newname)))
+ (tramp-error v 'file-error "File is a directory %s" newname))
- (with-tramp-progress-reporter
- v 0 (format "%s %s to %s" msg-operation filename newname)
+ (with-tramp-progress-reporter
+ v 0 (format "%s %s to %s" msg-operation filename newname)
- (cond
- ;; Both are Tramp files.
- ((and t1 t2)
- (with-parsed-tramp-file-name filename v1
- (with-parsed-tramp-file-name newname v2
- (cond
- ;; Shortcut: if method, host, user are the same for
- ;; both files, we invoke `cp' or `mv' on the remote
- ;; host directly.
- ((tramp-equal-remote filename newname)
- (tramp-do-copy-or-rename-file-directly
- op filename newname
- ok-if-already-exists keep-date preserve-uid-gid))
-
- ;; Try out-of-band operation.
- ((and
- (tramp-method-out-of-band-p v1 length)
- (tramp-method-out-of-band-p v2 length))
- (tramp-do-copy-or-rename-file-out-of-band
- op filename newname ok-if-already-exists keep-date))
-
- ;; No shortcut was possible. So we copy the file
- ;; first. If the operation was `rename', we go back
- ;; and delete the original file (if the copy was
- ;; successful). The approach is simple-minded: we
- ;; create a new buffer, insert the contents of the
- ;; source file into it, then write out the buffer to
- ;; the target file. The advantage is that it doesn't
- ;; matter which file name handlers are used for the
- ;; source and target file.
- (t
- (tramp-do-copy-or-rename-file-via-buffer
- op filename newname ok-if-already-exists keep-date))))))
-
- ;; One file is a Tramp file, the other one is local.
- ((or t1 t2)
(cond
- ;; Fast track on local machine.
- ((tramp-local-host-p v)
- (tramp-do-copy-or-rename-file-directly
- op filename newname
- ok-if-already-exists keep-date preserve-uid-gid))
-
- ;; If the Tramp file has an out-of-band method, the
- ;; corresponding copy-program can be invoked.
- ((tramp-method-out-of-band-p v length)
- (tramp-do-copy-or-rename-file-out-of-band
- op filename newname ok-if-already-exists keep-date))
-
- ;; Use the inline method via a Tramp buffer.
- (t (tramp-do-copy-or-rename-file-via-buffer
- op filename newname ok-if-already-exists keep-date))))
-
- (t
- ;; One of them must be a Tramp file.
- (error "Tramp implementation says this cannot happen")))
-
- ;; Handle `preserve-extended-attributes'. We ignore possible
- ;; errors, because ACL strings could be incompatible.
- (when attributes
- (ignore-errors
- (set-file-extended-attributes newname attributes)))
-
- ;; In case of `rename', we must flush the cache of the source file.
- (when (and t1 (eq op 'rename))
- (with-parsed-tramp-file-name filename v1
- (tramp-flush-file-properties v1 v1-localname)))
-
- ;; When newname did exist, we have wrong cached values.
- (when t2
- (with-parsed-tramp-file-name newname v2
- (tramp-flush-file-properties v2 v2-localname))))))))
+ ;; Both are Tramp files.
+ ((and t1 t2)
+ (with-parsed-tramp-file-name filename v1
+ (with-parsed-tramp-file-name newname v2
+ (cond
+ ;; Shortcut: if method, host, user are the same for
+ ;; both files, we invoke `cp' or `mv' on the remote
+ ;; host directly.
+ ((tramp-equal-remote filename newname)
+ (tramp-do-copy-or-rename-file-directly
+ op filename newname
+ ok-if-already-exists keep-date preserve-uid-gid))
+
+ ;; Try out-of-band operation.
+ ((and
+ (tramp-method-out-of-band-p v1 length)
+ (tramp-method-out-of-band-p v2 length))
+ (tramp-do-copy-or-rename-file-out-of-band
+ op filename newname ok-if-already-exists keep-date))
+
+ ;; No shortcut was possible. So we copy the file
+ ;; first. If the operation was `rename', we go
+ ;; back and delete the original file (if the copy
+ ;; was successful). The approach is simple-minded:
+ ;; we create a new buffer, insert the contents of
+ ;; the source file into it, then write out the
+ ;; buffer to the target file. The advantage is
+ ;; that it doesn't matter which file name handlers
+ ;; are used for the source and target file.
+ (t
+ (tramp-do-copy-or-rename-file-via-buffer
+ op filename newname ok-if-already-exists keep-date))))))
+
+ ;; One file is a Tramp file, the other one is local.
+ ((or t1 t2)
+ (cond
+ ;; Fast track on local machine.
+ ((tramp-local-host-p v)
+ (tramp-do-copy-or-rename-file-directly
+ op filename newname
+ ok-if-already-exists keep-date preserve-uid-gid))
+
+ ;; If the Tramp file has an out-of-band method, the
+ ;; corresponding copy-program can be invoked.
+ ((tramp-method-out-of-band-p v length)
+ (tramp-do-copy-or-rename-file-out-of-band
+ op filename newname ok-if-already-exists keep-date))
+
+ ;; Use the inline method via a Tramp buffer.
+ (t (tramp-do-copy-or-rename-file-via-buffer
+ op filename newname ok-if-already-exists keep-date))))
+
+ (t
+ ;; One of them must be a Tramp file.
+ (error "Tramp implementation says this cannot happen")))
+
+ ;; Handle `preserve-extended-attributes'. We ignore
+ ;; possible errors, because ACL strings could be
+ ;; incompatible.
+ (when-let ((attributes (and preserve-extended-attributes
+ (file-extended-attributes filename))))
+ (ignore-errors
+ (set-file-extended-attributes newname attributes)))
+
+ ;; In case of `rename', we must flush the cache of the source file.
+ (when (and t1 (eq op 'rename))
+ (with-parsed-tramp-file-name filename v1
+ (tramp-flush-file-properties v1 v1-localname)))
+
+ ;; When newname did exist, we have wrong cached values.
+ (when t2
+ (with-parsed-tramp-file-name newname v2
+ (tramp-flush-file-properties v2 v2-localname)))))))))
(defun tramp-do-copy-or-rename-file-via-buffer
(op filename newname ok-if-already-exists keep-date)
@@ -3269,15 +3272,10 @@ implementation will be used."
(defun tramp-sh-handle-file-local-copy (filename)
"Like `file-local-copy' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (unless (file-exists-p (file-truename filename))
- (tramp-error v 'file-missing filename))
-
- (let* ((size (file-attribute-size
- (file-attributes (file-truename filename))))
- (rem-enc (tramp-get-inline-coding v "remote-encoding" size))
- (loc-dec (tramp-get-inline-coding v "local-decoding" size))
- (tmpfile (tramp-compat-make-temp-file filename)))
+ (tramp-skeleton-file-local-copy filename
+ (if-let ((size (file-attribute-size (file-attributes filename)))
+ (rem-enc (tramp-get-inline-coding v "remote-encoding" size))
+ (loc-dec (tramp-get-inline-coding v "local-decoding" size)))
(condition-case err
(cond
@@ -3308,7 +3306,7 @@ implementation will be used."
(let (file-name-handler-alist
(coding-system-for-write 'binary)
(default-directory
- tramp-compat-temporary-file-directory))
+ tramp-compat-temporary-file-directory))
(with-temp-file tmpfile
(set-buffer-multibyte nil)
(insert-buffer-substring (tramp-get-buffer v))
@@ -3343,8 +3341,8 @@ implementation will be used."
(delete-file tmpfile)
(signal (car err) (cdr err))))
- (run-hooks 'tramp-handle-file-local-copy-hook)
- tmpfile)))
+ ;; Impossible to copy. Trigger `file-missing' error.
+ (setq tmpfile nil))))
(defun tramp-sh-handle-write-region
(start end filename &optional append visit lockname mustbenew)
@@ -3490,16 +3488,14 @@ implementation will be used."
filename rem-dec)
(goto-char (point-max))
(unless (bolp) (newline))
- (tramp-send-command
+ (tramp-barf-unless-okay
v
(format
(concat rem-dec " <<'%s'\n%s%s")
(tramp-shell-quote-argument localname)
tramp-end-of-heredoc
(buffer-string)
- tramp-end-of-heredoc))
- (tramp-barf-unless-okay
- v nil
+ tramp-end-of-heredoc)
"Couldn't write region to `%s', decode using `%s' failed"
filename rem-dec)
;; When `file-precious-flag' is set, the region is
@@ -3814,8 +3810,7 @@ Fall back to normal file name handler if no Tramp handler
exists."
(setq pos (match-end 0))
(cond
((getenv "EMACS_EMBA_CI") 'GInotifyFileMonitor)
- ((eq system-type 'cygwin) 'GPollFileMonitor)
- (t nil)))
+ ((eq system-type 'cygwin) 'GPollFileMonitor)))
;; TODO: What happens, if several monitor names are reported?
((string-match "\
Supported arguments for GIO_USE_FILE_MONITOR environment variable:
@@ -3927,14 +3922,14 @@ Supported arguments for GIO_USE_FILE_MONITOR
environment variable:
(defun tramp-expand-script (vec script)
"Expand SCRIPT with remote files or commands.
-\"%a\", \"%h\", \"%o\" and \"%p\" format specifiers are replaced
-by the respective `awk', `hexdump', `od' and `perl' commands.
-\"%n\" is replaced by \"2>/dev/null\", and \"%t\" is replaced by
-a temporary file name.
-If VEC is nil, the respective local commands are used.
-If there is a format specifier which cannot be expanded, this
+\"%a\", \"%h\", \"%l\", \"%o\", \"%p\", \"%r\" and \"%s\" format
+specifiers are replaced by the respective `awk', `hexdump', `ls',
+`od', `perl', `readlink' and `stat' commands. \"%n\" is replaced
+by \"2>/dev/null\", and \"%t\" is replaced by a temporary file
+name. If VEC is nil, the respective local commands are used. If
+there is a format specifier which cannot be expanded, this
function returns nil."
- (if (not (string-match-p "\\(^\\|[^%]\\)%[ahnopt]" script))
+ (if (not (string-match-p "\\(^\\|[^%]\\)%[ahlnoprst]" script))
script
(catch 'wont-work
(let ((awk (when (string-match-p "\\(^\\|[^%]\\)%a" script)
@@ -3952,6 +3947,11 @@ function returns nil."
(if (eq system-type 'windows-nt) ""
(concat "2>" null-device)))
(throw 'wont-work nil))))
+ (ls (when (string-match-p "\\(^\\|[^%]\\)%l" script)
+ (format "%s %s"
+ (or (tramp-get-ls-command vec)
+ (throw 'wont-work nil))
+ (tramp-sh--quoting-style-options vec))))
(od (when (string-match-p "\\(^\\|[^%]\\)%o" script)
(or (if vec (tramp-get-remote-od vec) (executable-find "od"))
(throw 'wont-work nil))))
@@ -3960,6 +3960,17 @@ function returns nil."
(if vec
(tramp-get-remote-perl vec) (executable-find "perl"))
(throw 'wont-work nil))))
+ (readlink (when (string-match-p "\\(^\\|[^%]\\)%r" script)
+ (or
+ (if vec
+ (tramp-get-remote-readlink vec)
+ (executable-find "readlink"))
+ (throw 'wont-work nil))))
+ (stat (when (string-match-p "\\(^\\|[^%]\\)%s" script)
+ (or
+ (if vec
+ (tramp-get-remote-stat vec) (executable-find "stat"))
+ (throw 'wont-work nil))))
(tmp (when (string-match-p "\\(^\\|[^%]\\)%t" script)
(or
(if vec
@@ -3968,7 +3979,9 @@ function returns nil."
(throw 'wont-work nil)))))
(format-spec
script
- (format-spec-make ?a awk ?h hdmp ?n dev ?o od ?p perl ?t tmp))))))
+ (format-spec-make
+ ?a awk ?h hdmp ?l ls ?n dev ?o od ?p perl
+ ?r readlink ?s stat ?t tmp))))))
(defun tramp-maybe-send-script (vec script name)
"Define in remote shell function NAME implemented as SCRIPT.
@@ -4284,8 +4297,7 @@ seconds. If not, it produces an error message with the
given ERROR-ARGS."
"Set up an interactive shell.
Mainly sets the prompt and the echo correctly. PROC is the shell
process to set up. VEC specifies the connection."
- (let ((tramp-end-of-output tramp-initial-end-of-output)
- (case-fold-search t))
+ (let ((case-fold-search t))
(tramp-open-shell vec (tramp-get-method-parameter vec 'tramp-remote-shell))
(tramp-message vec 5 "Setting up remote shell environment")
@@ -4312,12 +4324,6 @@ process to set up. VEC specifies the connection."
;; width magic interferes with them.
(tramp-send-command vec "stty icanon erase ^H cols 32767" t))))
- (tramp-message vec 5 "Setting shell prompt")
- (tramp-send-command
- vec (format "PS1=%s PS2='' PS3='' PROMPT_COMMAND=''"
- (tramp-shell-quote-argument tramp-end-of-output))
- t)
-
;; Check whether the output of "uname -sr" has been changed. If
;; yes, this is a strong indication that we must expire all
;; connection properties. We start again with
@@ -5264,16 +5270,23 @@ executed in a subshell, ie surrounded by parentheses.
If
DONT-SUPPRESS-ERR is non-nil, stderr won't be sent to \"/dev/null\".
Optional argument EXIT-STATUS, if non-nil, triggers the return of
the exit status."
- (tramp-send-command
- vec
- (concat (if subshell "( " "")
- command
- (if command
- (if dont-suppress-err
- "; " (format " 2>%s; " (tramp-get-remote-null-device vec)))
- "")
- "echo tramp_exit_status $?"
- (if subshell " )" "")))
+ (let (cmd data)
+ (if (and (stringp command)
+ (string-match (format ".*<<'%s'.*" tramp-end-of-heredoc) command))
+ (setq cmd (match-string 0 command)
+ data (substring command (match-end 0)))
+ (setq cmd command))
+ (tramp-send-command
+ vec
+ (concat (if subshell "( " "")
+ cmd
+ (if cmd
+ (if dont-suppress-err
+ "; " (format " 2>%s; " (tramp-get-remote-null-device
vec)))
+ "")
+ "echo tramp_exit_status $?"
+ (if subshell " )" "")
+ data)))
(with-current-buffer (tramp-get-connection-buffer vec)
(unless (tramp-search-regexp "tramp_exit_status [[:digit:]]+")
(tramp-error
@@ -5328,94 +5341,6 @@ raises an error."
"`%s' does not return a valid Lisp expression: `%s'"
command (buffer-string))))))))
-;; FIXME: Move to tramp.el?
-;;;###tramp-autoload
-(defun tramp-convert-file-attributes (vec attr)
- "Convert `file-attributes' ATTR generated by perl script, stat or ls.
-Convert file mode bits to string and set virtual device number.
-Return ATTR."
- (when attr
- (save-match-data
- ;; Remove color escape sequences from symlink.
- (when (stringp (car attr))
- (while (string-match tramp-display-escape-sequence-regexp (car attr))
- (setcar attr (replace-match "" nil nil (car attr)))))
- ;; Convert uid and gid. Use `tramp-unknown-id-integer' as
- ;; indication of unusable value.
- (when (and (numberp (nth 2 attr)) (< (nth 2 attr) 0))
- (setcar (nthcdr 2 attr) tramp-unknown-id-integer))
- (when (and (floatp (nth 2 attr))
- (<= (nth 2 attr) most-positive-fixnum))
- (setcar (nthcdr 2 attr) (round (nth 2 attr))))
- (when (and (numberp (nth 3 attr)) (< (nth 3 attr) 0))
- (setcar (nthcdr 3 attr) tramp-unknown-id-integer))
- (when (and (floatp (nth 3 attr))
- (<= (nth 3 attr) most-positive-fixnum))
- (setcar (nthcdr 3 attr) (round (nth 3 attr))))
- ;; Convert last access time.
- (unless (listp (nth 4 attr))
- (setcar (nthcdr 4 attr) (seconds-to-time (nth 4 attr))))
- ;; Convert last modification time.
- (unless (listp (nth 5 attr))
- (setcar (nthcdr 5 attr) (seconds-to-time (nth 5 attr))))
- ;; Convert last status change time.
- (unless (listp (nth 6 attr))
- (setcar (nthcdr 6 attr) (seconds-to-time (nth 6 attr))))
- ;; Convert file size.
- (when (< (nth 7 attr) 0)
- (setcar (nthcdr 7 attr) -1))
- (when (and (floatp (nth 7 attr))
- (<= (nth 7 attr) most-positive-fixnum))
- (setcar (nthcdr 7 attr) (round (nth 7 attr))))
- ;; Convert file mode bits to string.
- (unless (stringp (nth 8 attr))
- (setcar (nthcdr 8 attr) (tramp-file-mode-from-int (nth 8 attr)))
- (when (stringp (car attr))
- (aset (nth 8 attr) 0 ?l)))
- ;; Convert directory indication bit.
- (when (string-prefix-p "d" (nth 8 attr))
- (setcar attr t))
- ;; Convert symlink from `tramp-do-file-attributes-with-stat'.
- ;; Decode also multibyte string.
- (when (consp (car attr))
- (setcar attr
- (and (stringp (caar attr))
- (string-match ".+ -> .\\(.+\\)." (caar attr))
- (decode-coding-string
- (match-string 1 (caar attr)) 'utf-8))))
- ;; Set file's gid change bit.
- (setcar (nthcdr 9 attr)
- (if (numberp (nth 3 attr))
- (not (= (nth 3 attr)
- (tramp-get-remote-gid vec 'integer)))
- (not (string-equal
- (nth 3 attr)
- (tramp-get-remote-gid vec 'string)))))
- ;; Convert inode.
- (when (floatp (nth 10 attr))
- (setcar (nthcdr 10 attr)
- (condition-case nil
- (let ((high (nth 10 attr))
- middle low)
- (if (<= high most-positive-fixnum)
- (floor high)
- ;; The low 16 bits.
- (setq low (mod high #x10000)
- high (/ high #x10000))
- (if (<= high most-positive-fixnum)
- (cons (floor high) (floor low))
- ;; The middle 24 bits.
- (setq middle (mod high #x1000000)
- high (/ high #x1000000))
- (cons (floor high)
- (cons (floor middle) (floor low))))))
- ;; Inodes can be incredible huge. We must hide this.
- (error (tramp-get-inode vec)))))
- ;; Set virtual device number.
- (setcar (nthcdr 11 attr)
- (tramp-get-device vec)))
- attr))
-
(defun tramp-shell-case-fold (string)
"Convert STRING to shell glob pattern which ignores case."
(mapconcat
@@ -5797,18 +5722,25 @@ This command is returned only if
`delete-by-moving-to-trash' is non-nil."
(while (and dl (setq result (tramp-find-executable vec cmd dl t t)))
;; Check POSIX parameter.
(when (tramp-send-command-and-check vec (format "%s -u" result))
+ (tramp-set-connection-property
+ vec "uid-integer"
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (goto-char (point-min))
+ (read (current-buffer))))
(throw 'id-found result))
(setq dl (cdr dl))))))))
(defun tramp-get-remote-uid-with-id (vec id-format)
"Implement `tramp-get-remote-uid' for Tramp files using `id'."
- (tramp-send-command-and-read
- vec
- (format "%s -u%s %s"
- (tramp-get-remote-id vec)
- (if (equal id-format 'integer) "" "n")
- (if (equal id-format 'integer)
- "" "| sed -e s/^/\\\"/ -e s/\\$/\\\"/"))))
+ ;; `tramp-get-remote-id' sets already connection property "uid-integer".
+ (with-tramp-connection-property vec (format "uid-%s" id-format)
+ (tramp-send-command-and-read
+ vec
+ (format "%s -u%s %s"
+ (tramp-get-remote-id vec)
+ (if (equal id-format 'integer) "" "n")
+ (if (equal id-format 'integer)
+ "" "| sed -e s/^/\\\"/ -e s/\\$/\\\"/")))))
(defun tramp-get-remote-uid-with-perl (vec id-format)
"Implement `tramp-get-remote-uid' for Tramp files using a Perl script."
@@ -5825,7 +5757,6 @@ This command is returned only if
`delete-by-moving-to-trash' is non-nil."
(with-tramp-connection-property vec "python"
(tramp-message vec 5 "Finding a suitable `python' command")
(or (tramp-find-executable vec "python" (tramp-get-remote-path vec))
- (tramp-find-executable vec "python2" (tramp-get-remote-path vec))
(tramp-find-executable vec "python3" (tramp-get-remote-path vec)))))
(defun tramp-get-remote-uid-with-python (vec id-format)
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 5789b8f947..29abdb575d 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -232,7 +232,7 @@ See `tramp-actions-before-shell' for more info.")
(delete-file . tramp-smb-handle-delete-file)
;; `diff-latest-backup-file' performed by default handler.
(directory-file-name . tramp-handle-directory-file-name)
- (directory-files . tramp-smb-handle-directory-files)
+ (directory-files . tramp-handle-directory-files)
(directory-files-and-attributes
. tramp-handle-directory-files-and-attributes)
(dired-compress-file . ignore)
@@ -416,175 +416,181 @@ arguments to pass to the OPERATION."
(defun tramp-smb-handle-copy-directory
(dirname newname &optional keep-date parents copy-contents)
"Like `copy-directory' for Tramp files."
- (let ((t1 (tramp-tramp-file-p dirname))
- (t2 (tramp-tramp-file-p newname))
- target)
- (with-parsed-tramp-file-name (if t1 dirname newname) nil
- (unless (file-exists-p dirname)
- (tramp-error v 'file-missing dirname))
-
- ;; `copy-directory-create-symlink' exists since Emacs 28.1.
- (if (and (bound-and-true-p copy-directory-create-symlink)
- (setq target (file-symlink-p dirname))
- (tramp-equal-remote dirname newname))
- (make-symbolic-link
- target
- (if (directory-name-p newname)
- (concat newname (file-name-nondirectory dirname)) newname)
- t)
-
- (if copy-contents
- ;; We must do it file-wise.
- (tramp-run-real-handler
- #'copy-directory
- (list dirname newname keep-date parents copy-contents))
-
- (setq dirname (expand-file-name dirname)
- newname (expand-file-name newname))
- (with-tramp-progress-reporter
- v 0 (format "Copying %s to %s" dirname newname)
- (unless (file-exists-p dirname)
- (tramp-error v 'file-missing dirname))
- (when (and (file-directory-p newname)
- (not (directory-name-p newname)))
- (tramp-error v 'file-already-exists newname))
- (cond
- ;; We must use a local temporary directory.
- ((and t1 t2)
- (let ((tmpdir (tramp-compat-make-temp-name)))
- (unwind-protect
- (progn
- (make-directory tmpdir)
- (copy-directory
- dirname (file-name-as-directory tmpdir)
- keep-date 'parents)
- (copy-directory
- (expand-file-name (file-name-nondirectory dirname)
tmpdir)
- newname keep-date parents))
- (delete-directory tmpdir 'recursive))))
-
- ;; We can copy recursively.
- ;; TODO: Does not work reliably.
- (nil ;(and (or t1 t2) (tramp-smb-get-cifs-capabilities v))
+ (tramp-skeleton-copy-directory
+ dirname newname keep-date parents copy-contents
+ (let ((t1 (tramp-tramp-file-p dirname))
+ (t2 (tramp-tramp-file-p newname))
+ target)
+ (with-parsed-tramp-file-name (if t1 dirname newname) nil
+ (unless (file-exists-p dirname)
+ (tramp-error v 'file-missing dirname))
+
+ ;; `copy-directory-create-symlink' exists since Emacs 28.1.
+ (if (and (bound-and-true-p copy-directory-create-symlink)
+ (setq target (file-symlink-p dirname))
+ (tramp-equal-remote dirname newname))
+ (make-symbolic-link
+ target
+ (if (directory-name-p newname)
+ (concat newname (file-name-nondirectory dirname)) newname)
+ t)
+
+ (if copy-contents
+ ;; We must do it file-wise.
+ (tramp-run-real-handler
+ #'copy-directory
+ (list dirname newname keep-date parents copy-contents))
+
+ (setq dirname (expand-file-name dirname)
+ newname (expand-file-name newname))
+ (with-tramp-progress-reporter
+ v 0 (format "Copying %s to %s" dirname newname)
(when (and (file-directory-p newname)
- (not (string-equal (file-name-nondirectory dirname)
- (file-name-nondirectory newname))))
- (setq newname
- (expand-file-name
- (file-name-nondirectory dirname) newname))
- (if t2 (setq v (tramp-dissect-file-name newname))))
- (if (not (file-directory-p newname))
- (make-directory newname parents))
-
- (let* ((share (tramp-smb-get-share v))
- (localname (file-name-as-directory
- (tramp-compat-string-replace
- "\\" "/" (tramp-smb-get-localname v))))
- (tmpdir (tramp-compat-make-temp-name))
- (args (list (concat "//" host "/" share) "-E"))
- (options tramp-smb-options))
-
- (if (not (zerop (length user)))
- (setq args (append args (list "-U" user)))
- (setq args (append args (list "-N"))))
-
- (when domain (setq args (append args (list "-W" domain))))
- (when port (setq args (append args (list "-p" port))))
- (when tramp-smb-conf
- (setq args (append args (list "-s" tramp-smb-conf))))
- (while options
- (setq args
- (append args `("--option" ,(format "%s" (car options))))
- options (cdr options)))
- (setq args
- (if t1
- ;; Source is remote.
+ (not (directory-name-p newname)))
+ (tramp-error v 'file-already-exists newname))
+ (cond
+ ;; We must use a local temporary directory.
+ ((and t1 t2)
+ (let ((tmpdir (tramp-compat-make-temp-name)))
+ (unwind-protect
+ (progn
+ (make-directory tmpdir)
+ (copy-directory
+ dirname (file-name-as-directory tmpdir)
+ keep-date 'parents)
+ (copy-directory
+ (expand-file-name
+ (file-name-nondirectory dirname) tmpdir)
+ newname keep-date parents))
+ (delete-directory tmpdir 'recursive))))
+
+ ;; We can copy recursively.
+ ;; FIXME: Does not work reliably.
+ (nil ;(and (or t1 t2) (tramp-smb-get-cifs-capabilities v))
+ (when (and (file-directory-p newname)
+ (not (string-equal (file-name-nondirectory dirname)
+ (file-name-nondirectory
newname))))
+ (setq newname
+ (expand-file-name
+ (file-name-nondirectory dirname) newname))
+ (if t2 (setq v (tramp-dissect-file-name newname))))
+ (if (not (file-directory-p newname))
+ (make-directory newname parents))
+
+ (let* ((share (tramp-smb-get-share v))
+ (localname (file-name-as-directory
+ (tramp-compat-string-replace
+ "\\" "/" (tramp-smb-get-localname v))))
+ (tmpdir (tramp-compat-make-temp-name))
+ (args (list (concat "//" host "/" share) "-E"))
+ (options tramp-smb-options))
+
+ (if (not (zerop (length user)))
+ (setq args (append args (list "-U" user)))
+ (setq args (append args (list "-N"))))
+
+ (when domain (setq args (append args (list "-W" domain))))
+ (when port (setq args (append args (list "-p" port))))
+ (when tramp-smb-conf
+ (setq args (append args (list "-s" tramp-smb-conf))))
+ (while options
+ (setq args
(append args
+ `("--option" ,(format "%s" (car options))))
+ options (cdr options)))
+ (setq args
+ (if t1
+ ;; Source is remote.
+ (append args
+ (list "-D"
+ (tramp-unquote-shell-quote-argument
+ localname)
+ "-c"
+ (tramp-unquote-shell-quote-argument
+ "tar qc - *")
+ "|" "tar" "xfC" "-"
+ (tramp-unquote-shell-quote-argument
+ tmpdir)))
+ ;; Target is remote.
+ (append (list
+ "tar" "cfC" "-"
+ (tramp-unquote-shell-quote-argument dirname)
+ "." "|")
+ args
(list "-D" (tramp-unquote-shell-quote-argument
localname)
"-c" (tramp-unquote-shell-quote-argument
- "tar qc - *")
- "|" "tar" "xfC" "-"
- (tramp-unquote-shell-quote-argument
- tmpdir)))
- ;; Target is remote.
- (append (list
- "tar" "cfC" "-"
- (tramp-unquote-shell-quote-argument dirname)
- "." "|")
- args
- (list "-D" (tramp-unquote-shell-quote-argument
- localname)
- "-c" (tramp-unquote-shell-quote-argument
- "tar qx -")))))
-
- (unwind-protect
- (with-tramp-saved-connection-property v "process-name"
- (with-tramp-saved-connection-property v "process-buffer"
- (with-temp-buffer
- ;; Set the transfer process properties.
- (tramp-set-connection-property
- v "process-name" (buffer-name (current-buffer)))
- (tramp-set-connection-property
- v "process-buffer" (current-buffer))
-
- (when t1
- ;; The smbclient tar command creates
- ;; always complete paths. We must emulate
- ;; the directory structure, and symlink to
- ;; the real target.
- (make-directory
- (expand-file-name
- ".." (concat tmpdir localname))
- 'parents)
- (make-symbolic-link
- newname
- (directory-file-name (concat tmpdir localname))))
-
- ;; Use an asynchronous processes. By this,
- ;; password can be handled.
- (let* ((default-directory tmpdir)
- (p (apply
- #'start-process
- (tramp-get-connection-name v)
- (tramp-get-connection-buffer v)
- tramp-smb-program args)))
-
- (tramp-message
- v 6 "%s" (string-join (process-command p) " "))
- (process-put p 'vector v)
- (process-put p 'adjust-window-size-function
#'ignore)
- (set-process-query-on-exit-flag p nil)
- (tramp-process-actions
- p v nil tramp-smb-actions-with-tar)
-
- (while (process-live-p p)
- (sleep-for 0.1))
- (tramp-message v 6 "\n%s" (buffer-string))))))
-
- ;; Save exit.
- (when t1 (delete-directory tmpdir 'recursive))))
-
- ;; Handle KEEP-DATE argument.
- (when keep-date
- (tramp-compat-set-file-times
- newname
- (file-attribute-modification-time (file-attributes dirname))
- (unless ok-if-already-exists 'nofollow)))
-
- ;; Set the mode.
- (unless keep-date
- (set-file-modes newname (tramp-default-file-modes dirname)))
-
- ;; When newname did exist, we have wrong cached values.
- (when t2
- (with-parsed-tramp-file-name newname nil
- (tramp-flush-file-properties v localname))))
-
- ;; We must do it file-wise.
- (t
- (tramp-run-real-handler
- #'copy-directory (list dirname newname keep-date
parents))))))))))
+ "tar qx -")))))
+
+ (unwind-protect
+ (with-tramp-saved-connection-property v "process-name"
+ (with-tramp-saved-connection-property v "process-buffer"
+ (with-temp-buffer
+ ;; Set the transfer process properties.
+ (tramp-set-connection-property
+ v "process-name" (buffer-name (current-buffer)))
+ (tramp-set-connection-property
+ v "process-buffer" (current-buffer))
+
+ (when t1
+ ;; The smbclient tar command creates
+ ;; always complete paths. We must
+ ;; emulate the directory structure, and
+ ;; symlink to the real target.
+ (make-directory
+ (expand-file-name
+ ".." (concat tmpdir localname))
+ 'parents)
+ (make-symbolic-link
+ newname
+ (directory-file-name (concat tmpdir localname))))
+
+ ;; Use an asynchronous processes. By
+ ;; this, password can be handled.
+ (let* ((default-directory tmpdir)
+ (p (apply
+ #'start-process
+ (tramp-get-connection-name v)
+ (tramp-get-connection-buffer v)
+ tramp-smb-program args)))
+
+ (tramp-message
+ v 6 "%s" (string-join (process-command p) " "))
+ (process-put p 'vector v)
+ (process-put
+ p 'adjust-window-size-function #'ignore)
+ (set-process-query-on-exit-flag p nil)
+ (tramp-process-actions
+ p v nil tramp-smb-actions-with-tar)
+
+ (while (process-live-p p)
+ (sleep-for 0.1))
+ (tramp-message v 6 "\n%s" (buffer-string))))))
+
+ ;; Save exit.
+ (when t1 (delete-directory tmpdir 'recursive))))
+
+ ;; Handle KEEP-DATE argument.
+ (when keep-date
+ (tramp-compat-set-file-times
+ newname
+ (file-attribute-modification-time (file-attributes dirname))
+ (unless ok-if-already-exists 'nofollow)))
+
+ ;; Set the mode.
+ (unless keep-date
+ (set-file-modes newname (tramp-default-file-modes dirname)))
+
+ ;; When newname did exist, we have wrong cached values.
+ (when t2
+ (with-parsed-tramp-file-name newname nil
+ (tramp-flush-file-properties v localname))))
+
+ ;; We must do it file-wise.
+ (t
+ (tramp-run-real-handler
+ #'copy-directory
+ (list dirname newname keep-date parents)))))))))))
(defun tramp-smb-handle-copy-file
(filename newname &optional ok-if-already-exists keep-date
@@ -706,37 +712,6 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(search-forward-regexp tramp-smb-errors nil t)
(tramp-error v 'file-error "%s `%s'" (match-string 0)
filename)))))))
-(defun tramp-smb-handle-directory-files
- (directory &optional full match nosort count)
- "Like `directory-files' for Tramp files."
- (unless (file-exists-p directory)
- (tramp-error (tramp-dissect-file-name directory) 'file-missing directory))
- (let ((result (mapcar #'directory-file-name
- (file-name-all-completions "" directory))))
- ;; Discriminate with regexp.
- (when match
- (setq result
- (delete nil
- (mapcar (lambda (x) (when (string-match-p match x) x))
- result))))
-
- ;; Sort them if necessary.
- (unless nosort
- (setq result (sort result #'string-lessp)))
-
- ;; Return count number of results.
- (when (and (natnump count) (> count 0))
- (setq result (tramp-compat-ntake count result)))
-
- ;; Prepend directory.
- (when full
- (setq result
- (mapcar
- (lambda (x) (format "%s/%s" (directory-file-name directory) x))
- result)))
-
- result))
-
(defun tramp-smb-handle-expand-file-name (name &optional dir)
"Like `expand-file-name' for Tramp files."
;; If DIR is not given, use DEFAULT-DIRECTORY or "/".
@@ -852,24 +827,21 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(defun tramp-smb-handle-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files."
- (unless id-format (setq id-format 'integer))
- (ignore-errors
- (with-parsed-tramp-file-name filename nil
- (with-tramp-file-property
- v localname (format "file-attributes-%s" id-format)
+ ;; The result is cached in `tramp-convert-file-attributes'.
+ (with-parsed-tramp-file-name filename nil
+ (tramp-convert-file-attributes v localname id-format
+ (ignore-errors
(if (tramp-smb-get-stat-capability v)
- (tramp-smb-do-file-attributes-with-stat v id-format)
- ;; Reading just the filename entry via "dir localname" is not
- ;; possible, because when filename is a directory, some
- ;; smbclient versions return the content of the directory, and
- ;; other versions don't. Therefore, the whole content of the
- ;; upper directory is retrieved, and the entry of the filename
- ;; is extracted from.
+ (tramp-smb-do-file-attributes-with-stat v)
+ ;; Reading just the filename entry via "dir localname" is
+ ;; not possible, because when filename is a directory, some
+ ;; smbclient versions return the content of the directory,
+ ;; and other versions don't. Therefore, the whole content
+ ;; of the upper directory is retrieved, and the entry of the
+ ;; filename is extracted from.
(let* ((entries (tramp-smb-get-file-entries
(file-name-directory filename)))
(entry (assoc (file-name-nondirectory filename) entries))
- (uid (if (equal id-format 'string) "nobody" -1))
- (gid (if (equal id-format 'string) "nogroup" -1))
(inode (tramp-get-inode v))
(device (tramp-get-device v)))
@@ -877,19 +849,21 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(when entry
(list (and (tramp-compat-string-search "d" (nth 1 entry))
t) ;0 file type
- -1 ;1 link count
- uid ;2 uid
- gid ;3 gid
+ -1 ;1 link count
+ (cons
+ tramp-unknown-id-string tramp-unknown-id-integer) ;2 uid
+ (cons
+ tramp-unknown-id-string tramp-unknown-id-integer) ;3 gid
tramp-time-dont-know ;4 atime
(nth 3 entry) ;5 mtime
tramp-time-dont-know ;6 ctime
(nth 2 entry) ;7 size
(nth 1 entry) ;8 mode
- nil ;9 gid weird
- inode ;10 inode number
+ nil ;9 gid weird
+ inode ;10 inode number
device)))))))) ;11 file system number
-(defun tramp-smb-do-file-attributes-with-stat (vec &optional id-format)
+(defun tramp-smb-do-file-attributes-with-stat (vec)
"Implement `file-attributes' for Tramp files using `stat' command."
(tramp-message
vec 5 "file attributes with stat: %s" (tramp-file-name-localname vec))
@@ -920,10 +894,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
"Uid:\\s-+\\([[:digit:]]+\\)\\s-+"
"Gid:\\s-+\\([[:digit:]]+\\)"))
(setq mode (match-string 1)
- uid (if (equal id-format 'string) (match-string 2)
- (string-to-number (match-string 2)))
- gid (if (equal id-format 'string) (match-string 3)
- (string-to-number (match-string 3)))))
+ uid (match-string 2)
+ gid (match-string 3)))
((looking-at
(concat
"Access:\\s-+"
@@ -977,26 +949,23 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
;; Return the result.
(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))))))))
+ (list id link (cons uid (string-to-number uid))
+ (cons gid (string-to-number gid)) gid atime mtime ctime size
+ mode nil inode (tramp-get-device vec))))))))
(defun tramp-smb-handle-file-local-copy (filename)
"Like `file-local-copy' for Tramp files."
- (with-parsed-tramp-file-name (file-truename filename) nil
- (unless (file-exists-p (file-truename filename))
- (tramp-error v 'file-missing filename))
- (let ((tmpfile (tramp-compat-make-temp-file filename)))
- (with-tramp-progress-reporter
- v 3 (format "Fetching %s to tmp file %s" filename tmpfile)
- (unless (tramp-smb-send-command
- v (format "get %s %s"
- (tramp-smb-shell-quote-localname v)
- (tramp-smb-shell-quote-argument tmpfile)))
- ;; Oops, an error. We shall cleanup.
- (delete-file tmpfile)
- (tramp-error
- v 'file-error "Cannot make local copy of file `%s'" filename)))
- tmpfile)))
+ (tramp-skeleton-file-local-copy filename
+ (with-tramp-progress-reporter
+ v 3 (format "Fetching %s to tmp file %s" filename tmpfile)
+ (unless (tramp-smb-send-command
+ v (format "get %s %s"
+ (tramp-smb-shell-quote-localname v)
+ (tramp-smb-shell-quote-argument tmpfile)))
+ ;; Oops, an error. We shall cleanup.
+ (delete-file tmpfile)
+ (tramp-error
+ v 'file-error "Cannot make local copy of file `%s'" filename)))))
;; This function should return "foo/" for directories and "bar" for
;; files.
@@ -2060,24 +2029,6 @@ If ARGUMENT is non-nil, use it as argument for
tramp-smb-actions-with-share
tramp-smb-actions-without-share))
- ;; Check server version.
- ;; FIXME: With recent smbclient versions, this
- ;; information isn't printed anymore.
- ;; (unless argument
- ;; (with-current-buffer (tramp-get-connection-buffer vec)
- ;; (goto-char (point-min))
- ;; (search-forward-regexp tramp-smb-server-version nil t)
- ;; (let ((smbserver-version (match-string 0)))
- ;; (unless
- ;; (string-equal
- ;; smbserver-version
- ;; (tramp-get-connection-property
- ;; vec "smbserver-version" smbserver-version))
- ;; (tramp-flush-directory-properties vec "")
- ;; (tramp-flush-connection-properties vec))
- ;; (tramp-set-connection-property
- ;; vec "smbserver-version" smbserver-version))))
-
;; Set chunksize to 1. smbclient reads its input
;; character by character; if we send the string
;; at once, it is read painfully slow.
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index 420a593644..5ec68e904e 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -241,6 +241,8 @@ absolute file names."
(copy-directory filename newname keep-date t)
(when (eq op 'rename) (delete-directory filename 'recursive)))
+ ;; FIXME: This should be optimized. Computing `file-attributes'
+ ;; checks already, whether the file exists.
(let ((t1 (tramp-sudoedit-file-name-p filename))
(t2 (tramp-sudoedit-file-name-p newname))
(file-times (file-attribute-modification-time
@@ -256,62 +258,61 @@ absolute file names."
(msg-operation (if (eq op 'copy) "Copying" "Renaming")))
(with-parsed-tramp-file-name (if t1 filename newname) nil
- (unless (file-exists-p filename)
- (tramp-error v 'file-missing filename))
- (when (and (not ok-if-already-exists) (file-exists-p newname))
- (tramp-error v 'file-already-exists newname))
- (when (and (file-directory-p newname)
- (not (directory-name-p newname)))
- (tramp-error v 'file-error "File is a directory %s" newname))
-
- (if (or (and (file-remote-p filename) (not t1))
- (and (file-remote-p newname) (not t2)))
- ;; We cannot copy or rename directly.
- (let ((tmpfile (tramp-compat-make-temp-file filename)))
- (if (eq op 'copy)
- (copy-file filename tmpfile t)
- (rename-file filename tmpfile t))
- (rename-file tmpfile newname ok-if-already-exists))
-
- ;; Direct action.
- (with-tramp-progress-reporter
- v 0 (format "%s %s to %s" msg-operation filename newname)
- (unless (tramp-sudoedit-send-command
- v sudoedit-operation
- (tramp-unquote-file-local-name filename)
- (tramp-unquote-file-local-name newname))
- (tramp-error
- v 'file-error
- "Error %s `%s' `%s'" msg-operation filename newname))))
-
- ;; When `newname' is local, we must change the ownership to
- ;; the local user.
- (unless (file-remote-p newname)
- (tramp-set-file-uid-gid
- (concat (file-remote-p filename) newname)
- (tramp-get-local-uid 'integer)
- (tramp-get-local-gid 'integer)))
-
- ;; Set the time and mode. Mask possible errors.
- (when keep-date
- (ignore-errors
- (tramp-compat-set-file-times
- newname file-times (unless ok-if-already-exists 'nofollow))
- (set-file-modes newname file-modes)))
-
- ;; Handle `preserve-extended-attributes'. We ignore possible
- ;; errors, because ACL strings could be incompatible.
- (when attributes
- (ignore-errors
- (set-file-extended-attributes newname attributes)))
-
- (when (and t1 (eq op 'rename))
- (with-parsed-tramp-file-name filename v1
- (tramp-flush-file-properties v1 v1-localname)))
-
- (when t2
- (with-parsed-tramp-file-name newname v2
- (tramp-flush-file-properties v2 v2-localname)))))))
+ (tramp-barf-if-file-missing v filename
+ (when (and (not ok-if-already-exists) (file-exists-p newname))
+ (tramp-error v 'file-already-exists newname))
+ (when (and (file-directory-p newname)
+ (not (directory-name-p newname)))
+ (tramp-error v 'file-error "File is a directory %s" newname))
+
+ (if (or (and (file-remote-p filename) (not t1))
+ (and (file-remote-p newname) (not t2)))
+ ;; We cannot copy or rename directly.
+ (let ((tmpfile (tramp-compat-make-temp-file filename)))
+ (if (eq op 'copy)
+ (copy-file filename tmpfile t)
+ (rename-file filename tmpfile t))
+ (rename-file tmpfile newname ok-if-already-exists))
+
+ ;; Direct action.
+ (with-tramp-progress-reporter
+ v 0 (format "%s %s to %s" msg-operation filename newname)
+ (unless (tramp-sudoedit-send-command
+ v sudoedit-operation
+ (tramp-unquote-file-local-name filename)
+ (tramp-unquote-file-local-name newname))
+ (tramp-error
+ v 'file-error
+ "Error %s `%s' `%s'" msg-operation filename newname))))
+
+ ;; When `newname' is local, we must change the ownership to
+ ;; the local user.
+ (unless (file-remote-p newname)
+ (tramp-set-file-uid-gid
+ (concat (file-remote-p filename) newname)
+ (tramp-get-local-uid 'integer)
+ (tramp-get-local-gid 'integer)))
+
+ ;; Set the time and mode. Mask possible errors.
+ (when keep-date
+ (ignore-errors
+ (tramp-compat-set-file-times
+ newname file-times (unless ok-if-already-exists 'nofollow))
+ (set-file-modes newname file-modes)))
+
+ ;; Handle `preserve-extended-attributes'. We ignore possible
+ ;; errors, because ACL strings could be incompatible.
+ (when attributes
+ (ignore-errors
+ (set-file-extended-attributes newname attributes)))
+
+ (when (and t1 (eq op 'rename))
+ (with-parsed-tramp-file-name filename v1
+ (tramp-flush-file-properties v1 v1-localname)))
+
+ (when t2
+ (with-parsed-tramp-file-name newname v2
+ (tramp-flush-file-properties v2 v2-localname))))))))
(defun tramp-sudoedit-handle-copy-file
(filename newname &optional ok-if-already-exists keep-date
@@ -407,34 +408,30 @@ the result will be a local, non-Tramp, file name."
;; provided by `tramp-sudoedit-send-command-string'. Add it.
(and (stringp result) (concat result "\n"))))))
+(defconst tramp-sudoedit-file-attributes
+ (format
+ ;; Apostrophes in the stat output are masked as
+ ;; `tramp-stat-marker', in order to make a proper shell escape of
+ ;; them in file names. They are replaced in
+ ;; `tramp-sudoedit-send-command-and-read'.
+ (concat "((%s%%N%s) %%h (%s%%U%s . %%u) (%s%%G%s . %%g)"
+ " %%X %%Y %%Z %%s %s%%A%s t %%i -1)")
+ tramp-stat-marker tramp-stat-marker ; %%N
+ tramp-stat-marker tramp-stat-marker ; %%U
+ tramp-stat-marker tramp-stat-marker ; %%G
+ tramp-stat-marker tramp-stat-marker) ; %%A
+ "stat format string to produce output suitable for use with
+`file-attributes' on the remote file system.")
+
(defun tramp-sudoedit-handle-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files."
- (unless id-format (setq id-format 'integer))
+ ;; The result is cached in `tramp-convert-file-attributes'.
(with-parsed-tramp-file-name (expand-file-name filename) nil
- (with-tramp-file-property
- v localname (format "file-attributes-%s" id-format)
- (tramp-message v 5 "file attributes: %s" localname)
- (ignore-errors
- (tramp-convert-file-attributes
- v
- (tramp-sudoedit-send-command-and-read
- v "env" "QUOTING_STYLE=locale" "stat" "-c"
- (format
- ;; Apostrophes in the stat output are masked as
- ;; `tramp-stat-marker', in order to make a proper shell
- ;; escape of them in file names.
- "((%s%%N%s) %%h %s %s %%X %%Y %%Z %%s %s%%A%s t %%i -1)"
- tramp-stat-marker tramp-stat-marker
- (if (eq id-format 'integer)
- "%u"
- (eval-when-compile
- (concat tramp-stat-marker "%U" tramp-stat-marker)))
- (if (eq id-format 'integer)
- "%g"
- (eval-when-compile
- (concat tramp-stat-marker "%G" tramp-stat-marker)))
- tramp-stat-marker tramp-stat-marker)
- (tramp-compat-file-name-unquote localname)))))))
+ (tramp-convert-file-attributes v localname id-format
+ (tramp-sudoedit-send-command-and-read
+ v "env" "QUOTING_STYLE=locale" "stat" "-c"
+ tramp-sudoedit-file-attributes
+ (tramp-compat-file-name-unquote localname)))))
(defun tramp-sudoedit-handle-file-executable-p (filename)
"Like `file-executable-p' for Tramp files."
@@ -718,6 +715,7 @@ VEC or USER, or if there is no home directory, return nil."
(defun tramp-sudoedit-handle-get-remote-uid (vec id-format)
"The uid of the remote connection VEC, in ID-FORMAT.
ID-FORMAT valid values are `string' and `integer'."
+ ;; The result is cached in `tramp-get-remote-uid'.
(if (equal id-format 'integer)
(tramp-sudoedit-send-command-and-read vec "id" "-u")
(tramp-sudoedit-send-command-string vec "id" "-un")))
@@ -725,6 +723,7 @@ ID-FORMAT valid values are `string' and `integer'."
(defun tramp-sudoedit-handle-get-remote-gid (vec id-format)
"The gid of the remote connection VEC, in ID-FORMAT.
ID-FORMAT valid values are `string' and `integer'."
+ ;; The result is cached in `tramp-get-remote-gid'.
(if (equal id-format 'integer)
(tramp-sudoedit-send-command-and-read vec "id" "-g")
(tramp-sudoedit-send-command-string vec "id" "-gn")))
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index b11fd293cc..3f78c8d658 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -1957,7 +1957,8 @@ The outline level is equal to the verbosity of the Tramp
message."
They are completed by \"M-x TAB\" only in Tramp debug buffers."
(with-current-buffer buffer
(string-equal
- (buffer-substring (point-min) (min (+ (point-min) 10) (point-max))) ";;
Emacs:")))
+ (buffer-substring (point-min) (min (+ (point-min) 10) (point-max)))
+ ";; Emacs:")))
(put #'tramp-debug-buffer-command-completion-p 'tramp-suppress-trace t)
@@ -1984,6 +1985,7 @@ They are completed by \"M-x TAB\" only in Tramp debug
buffers."
,(eval tramp-debug-font-lock-keywords t)))
;; Do not edit the debug buffer.
(use-local-map special-mode-map)
+ (set-buffer-modified-p nil)
;; For debugging purposes.
(local-set-key "\M-n" 'clone-buffer)
(add-hook 'clone-buffer-hook #'tramp-setup-debug-buffer nil 'local))
@@ -2272,6 +2274,24 @@ the resulting error message."
(put #'tramp-with-demoted-errors 'tramp-suppress-trace t)
+;; This macro shall optimize the cases where an `file-exists-p' call
+;; is invoked first. Often, the file exists, so the remote command is
+;; superfluous.
+(defmacro tramp-barf-if-file-missing (vec filename &rest body)
+ "Execute BODY and return the result.
+In case if an error, raise a `file-missing' error if FILENAME
+does not exist, otherwise propagate the error."
+ (declare (indent 2) (debug (symbolp form body)))
+ (let ((err (make-symbol "err")))
+ `(condition-case ,err
+ (progn ,@body)
+ (error
+ (if (not (file-exists-p ,filename))
+ (tramp-error ,vec 'file-missing ,filename)
+ (signal (car ,err) (cdr ,err)))))))
+
+(put #'tramp-barf-if-file-missing 'tramp-suppress-trace t)
+
(defun tramp-test-message (fmt-string &rest arguments)
"Emit a Tramp message according `default-directory'."
(cond
@@ -3375,6 +3395,22 @@ User is always nil."
;;; Skeleton macros for file name handler functions.
+(defmacro tramp-skeleton-copy-directory
+ (directory _newname &optional _keep-date _parents _copy-contents &rest body)
+ "Skeleton for `tramp-*-handle-copy-directory'.
+BODY is the backend specific code."
+ (declare (indent 5) (debug t))
+ ;; `copy-directory' creates NEWNAME before running this check. So
+ ;; we do it ourselves. Therefore, we cannot also run
+ ;; `tramp-barf-if-file-missing'.
+ `(progn
+ (unless (file-exists-p ,directory)
+ (tramp-error
+ (tramp-dissect-file-name ,directory) 'file-missing ,directory))
+ ,@body))
+
+(put #'tramp-skeleton-copy-directory 'tramp-suppress-trace t)
+
(defmacro tramp-skeleton-delete-directory (directory recursive trash &rest
body)
"Skeleton for `tramp-*-handle-delete-directory'.
BODY is the backend specific code."
@@ -3392,6 +3428,106 @@ BODY is the backend specific code."
(put #'tramp-skeleton-delete-directory 'tramp-suppress-trace t)
+(defmacro tramp-skeleton-directory-files
+ (directory &optional full match nosort count &rest body)
+ "Skeleton for `tramp-*-handle-directory-files'.
+BODY is the backend specific code."
+ (declare (indent 5) (debug t))
+ `(or
+ (with-parsed-tramp-file-name ,directory nil
+ (tramp-barf-if-file-missing v ,directory
+ (when (file-directory-p ,directory)
+ (setq ,directory
+ (file-name-as-directory (expand-file-name ,directory)))
+ (let ((temp
+ (with-tramp-file-property v localname "directory-files"
,@body))
+ result item)
+ (while temp
+ (setq item (directory-file-name (pop temp)))
+ (when (or (null ,match) (string-match-p ,match item))
+ (push (if ,full (concat ,directory item) item)
+ result)))
+ (unless ,nosort
+ (setq result (sort result #'string<)))
+ (when (and (natnump ,count) (> ,count 0))
+ (setq result (tramp-compat-ntake ,count result)))
+ result))))
+
+ ;; Error handling.
+ (if (not (file-exists-p ,directory))
+ (tramp-error
+ (tramp-dissect-file-name ,directory) 'file-missing ,directory)
+ nil)))
+
+(put #'tramp-skeleton-directory-files 'tramp-suppress-trace t)
+
+(defmacro tramp-skeleton-directory-files-and-attributes
+ (directory &optional full match nosort id-format count &rest body)
+ "Skeleton for `tramp-*-handle-directory-files-and-attributes'.
+BODY is the backend specific code."
+ (declare (indent 6) (debug t))
+ `(or
+ (with-parsed-tramp-file-name ,directory nil
+ (tramp-barf-if-file-missing v ,directory
+ (when (file-directory-p ,directory)
+ (setq ,directory (expand-file-name ,directory))
+ (let ((temp
+ (copy-tree
+ (mapcar
+ (lambda (x)
+ (cons
+ (car x)
+ (tramp-convert-file-attributes
+ v (car x) ,id-format (cdr x))))
+ (with-tramp-file-property
+ v localname ",directory-files-and-attributes"
+ ,@body))))
+ result item)
+
+ (while temp
+ (setq item (pop temp))
+ (when (or (null ,match) (string-match-p ,match (car item)))
+ (when ,full
+ (setcar item (expand-file-name (car item) ,directory)))
+ (push item result)))
+
+ (unless ,nosort
+ (setq result
+ (sort result (lambda (x y) (string< (car x) (car y))))))
+
+ (when (and (natnump ,count) (> ,count 0))
+ (setq result (tramp-compat-ntake ,count result)))
+
+ (or result
+ ;; The scripts could fail, for example with huge file size.
+ (tramp-handle-directory-files-and-attributes
+ ,directory ,full ,match ,nosort ,id-format ,count))))))
+
+ ;; Error handling.
+ (if (not (file-exists-p ,directory))
+ (tramp-error
+ (tramp-dissect-file-name ,directory) 'file-missing ,directory)
+ nil)))
+
+(put #'tramp-skeleton-directory-files-and-attributes 'tramp-suppress-trace t)
+
+(defmacro tramp-skeleton-file-local-copy (filename &rest body)
+ "Skeleton for `tramp-*-handle-file-local-copy-files'.
+BODY is the backend specific code."
+ (declare (indent 1) (debug t))
+ `(with-parsed-tramp-file-name (file-truename ,filename) nil
+ (tramp-barf-if-file-missing v ,filename
+ (or
+ (let ((tmpfile (tramp-compat-make-temp-file ,filename)))
+ ,@body
+ (run-hooks 'tramp-handle-file-local-copy-hook)
+ tmpfile)
+
+ ;; Trigger the `file-missing' error.
+ (signal 'error nil)))))
+
+(put #'tramp-skeleton-file-local-copy 'tramp-suppress-trace t)
+
(defmacro tramp-skeleton-write-region
(start end filename append visit lockname mustbenew &rest body)
"Skeleton for `tramp-*-handle-write-region'.
@@ -3585,14 +3721,12 @@ Let-bind it when necessary.")
(defun tramp-handle-copy-directory
(directory newname &optional keep-date parents copy-contents)
"Like `copy-directory' for Tramp files."
- ;; `copy-directory' creates NEWNAME before running this check. So
- ;; we do it ourselves.
- (unless (file-exists-p directory)
- (tramp-error (tramp-dissect-file-name directory) 'file-missing directory))
- ;; We must do it file-wise.
- (tramp-run-real-handler
- #'copy-directory
- (list directory newname keep-date parents copy-contents)))
+ (tramp-skeleton-copy-directory
+ directory newname keep-date parents copy-contents
+ ;; We must do it file-wise.
+ (tramp-run-real-handler
+ #'copy-directory
+ (list directory newname keep-date parents copy-contents))))
(defun tramp-handle-directory-file-name (directory)
"Like `directory-file-name' for Tramp files."
@@ -3608,23 +3742,8 @@ Let-bind it when necessary.")
(defun tramp-handle-directory-files (directory &optional full match nosort
count)
"Like `directory-files' for Tramp files."
- (unless (file-exists-p directory)
- (tramp-error (tramp-dissect-file-name directory) 'file-missing directory))
- (when (file-directory-p directory)
- (setq directory (file-name-as-directory (expand-file-name directory)))
- (let ((temp (nreverse (file-name-all-completions "" directory)))
- result item)
-
- (while temp
- (setq item (directory-file-name (pop temp)))
- (when (or (null match) (string-match-p match item))
- (push (if full (concat directory item) item)
- result)))
- (unless nosort
- (setq result (sort result #'string<)))
- (when (and (natnump count) (> count 0))
- (setq result (tramp-compat-ntake count result)))
- result)))
+ (tramp-skeleton-directory-files directory full match nosort count
+ (nreverse (file-name-all-completions "" directory))))
(defun tramp-handle-directory-files-and-attributes
(directory &optional full match nosort id-format count)
@@ -3722,12 +3841,8 @@ Let-bind it when necessary.")
(defun tramp-handle-file-local-copy (filename)
"Like `file-local-copy' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (unless (file-exists-p filename)
- (tramp-error v 'file-missing filename))
- (let ((tmpfile (tramp-compat-make-temp-file filename)))
- (copy-file filename tmpfile 'ok-if-already-exists 'keep-time)
- tmpfile)))
+ (tramp-skeleton-file-local-copy filename
+ (copy-file filename tmpfile 'ok-if-already-exists 'keep-time)))
(defun tramp-handle-file-modes (filename &optional flag)
"Like `file-modes' for Tramp files."
@@ -4048,13 +4163,10 @@ Let-bind it when necessary.")
(let (result local-copy remote-copy)
(with-parsed-tramp-file-name filename nil
(unwind-protect
- (if (not (file-exists-p filename))
- (let ((tramp-verbose (if visit 0 tramp-verbose)))
- (tramp-error v 'file-missing filename))
-
- (with-tramp-progress-reporter
- v 3 (format-message "Inserting `%s'" filename)
- (condition-case err
+ (condition-case err
+ (tramp-barf-if-file-missing v filename
+ (with-tramp-progress-reporter
+ v 3 (format-message "Inserting `%s'" filename)
(if (and (tramp-local-host-p v)
(let (file-name-handler-alist)
(file-readable-p localname)))
@@ -4067,7 +4179,7 @@ Let-bind it when necessary.")
;; When we shall insert only a part of the file, we
;; copy this part. This works only for the shell file
- ;; name handlers. It doesn't work for encrypted files.
+ ;; name handlers. It doesn't work for encrypted files.
(when (and (or beg end)
(tramp-sh-file-name-handler-p v)
(null tramp-crypt-enabled))
@@ -4131,12 +4243,16 @@ Let-bind it when necessary.")
filename local-copy)))
(setq result
(insert-file-contents
- local-copy visit beg end replace))))
- (error
- (add-hook 'find-file-not-found-functions
- `(lambda () (signal ',(car err) ',(cdr err)))
- nil t)
- (signal (car err) (cdr err))))))
+ local-copy visit beg end replace))))))
+
+ (file-error
+ (let ((tramp-verbose (if visit 0 tramp-verbose)))
+ (tramp-error v 'file-missing filename)))
+ (error
+ (add-hook 'find-file-not-found-functions
+ `(lambda () (signal ',(car err) ',(cdr err)))
+ nil t)
+ (signal (car err) (cdr err))))
;; Save exit.
(when visit
@@ -4288,8 +4404,7 @@ It is not guaranteed, that all process attributes as
described in
(funcall (cdr elt)))
((null (cdr elt))
(search-forward-regexp "\\s-+")
- (buffer-substring (point) (line-end-position)))
- (t nil)))
+ (buffer-substring (point) (line-end-position)))))
res))
;; `nice' could be `-'.
(setq res (rassq-delete-all '- res))
@@ -5199,8 +5314,7 @@ Wait, until the connection buffer changes."
(tramp-message vec 3 "Process has finished.")
(throw 'tramp-action 'ok))
(tramp-message vec 3 "Process has died.")
- (throw 'tramp-action 'out-of-band-failed))))
- (t nil)))
+ (throw 'tramp-action 'out-of-band-failed))))))
;;; Functions for processing the actions:
@@ -5711,51 +5825,140 @@ VEC is used for tracing."
"Check `file-attributes' caches for VEC.
Return t if according to the cache access type ACCESS is known to
be granted."
- (let (result
- (offset (cond
- ((eq ?r access) 1)
- ((eq ?w access) 2)
- ((eq ?x access) 3)
- ((eq ?s access) 3))))
- (dolist (suffix '("string" "integer") result)
- (setq
- result
- (or
- result
- (let ((file-attr
- (or
- (tramp-get-file-property
- vec (tramp-file-name-localname vec)
- (concat "file-attributes-" suffix) nil)
- (file-attributes
- (tramp-make-tramp-file-name vec) (intern suffix))))
- (remote-uid (tramp-get-remote-uid vec (intern suffix)))
- (remote-gid (tramp-get-remote-gid vec (intern suffix)))
- (unknown-id
- (if (string-equal suffix "string")
- tramp-unknown-id-string tramp-unknown-id-integer)))
- (and
- file-attr
- (or
- ;; Not a symlink.
- (eq t (file-attribute-type file-attr))
- (null (file-attribute-type file-attr)))
- (or
- ;; World accessible.
- (eq access (aref (file-attribute-modes file-attr) (+ offset 6)))
- ;; User accessible and owned by user.
- (and
- (eq access (aref (file-attribute-modes file-attr) offset))
- (or (equal remote-uid unknown-id)
- (equal remote-uid (file-attribute-user-id file-attr))
- (equal unknown-id (file-attribute-user-id file-attr))))
- ;; Group accessible and owned by user's principal group.
- (and
- (eq access
- (aref (file-attribute-modes file-attr) (+ offset 3)))
- (or (equal remote-gid unknown-id)
- (equal remote-gid (file-attribute-group-id file-attr))
- (equal unknown-id (file-attribute-group-id
file-attr))))))))))))
+ (when-let ((offset (cond
+ ((eq ?r access) 1)
+ ((eq ?w access) 2)
+ ((eq ?x access) 3)
+ ((eq ?s access) 3)))
+ (file-attr (file-attributes (tramp-make-tramp-file-name vec)))
+ (remote-uid (tramp-get-remote-uid vec 'integer))
+ (remote-gid (tramp-get-remote-gid vec 'integer)))
+ (or
+ ;; Not a symlink.
+ (eq t (file-attribute-type file-attr))
+ (null (file-attribute-type file-attr)))
+ (or
+ ;; World accessible.
+ (eq access (aref (file-attribute-modes file-attr) (+ offset 6)))
+ ;; User accessible and owned by user.
+ (and
+ (eq access (aref (file-attribute-modes file-attr) offset))
+ (or (equal remote-uid tramp-unknown-id-integer)
+ (equal remote-uid (file-attribute-user-id file-attr))
+ (equal tramp-unknown-id-integer (file-attribute-user-id file-attr))))
+ ;; Group accessible and owned by user's principal group.
+ (and
+ (eq access
+ (aref (file-attribute-modes file-attr) (+ offset 3)))
+ (or (equal remote-gid tramp-unknown-id-integer)
+ (equal remote-gid (file-attribute-group-id file-attr))
+ (equal tramp-unknown-id-integer
+ (file-attribute-group-id file-attr)))))))
+
+(defmacro tramp-convert-file-attributes (vec localname id-format attr)
+ "Convert `file-attributes' ATTR generated Tramp backend functions.
+Convert file mode bits to string and set virtual device number.
+Set file uid and gid according to ID-FORMAT. LOCALNAME is used
+to cache the result. Return the modified ATTR."
+ (declare (indent 3) (debug t))
+ `(with-tramp-file-property
+ ,vec ,localname (format "file-attributes-%s" (or ,id-format 'integer))
+ (when-let
+ ((result
+ (with-tramp-file-property ,vec ,localname "file-attributes"
+ (when-let ((attr ,attr))
+ (save-match-data
+ ;; Remove color escape sequences from symlink.
+ (when (stringp (car attr))
+ (while (string-match
+ tramp-display-escape-sequence-regexp (car attr))
+ (setcar attr (replace-match "" nil nil (car attr)))))
+ ;; Convert uid and gid. Use `tramp-unknown-id-integer'
+ ;; as indication of unusable value.
+ (when (consp (nth 2 attr))
+ (when (and (numberp (cdr (nth 2 attr)))
+ (< (cdr (nth 2 attr)) 0))
+ (setcdr (car (nthcdr 2 attr)) tramp-unknown-id-integer))
+ (when (and (floatp (cdr (nth 2 attr)))
+ (<= (cdr (nth 2 attr)) most-positive-fixnum))
+ (setcdr (car (nthcdr 2 attr)) (round (cdr (nth 2 attr))))))
+ (when (consp (nth 3 attr))
+ (when (and (numberp (cdr (nth 3 attr)))
+ (< (cdr (nth 3 attr)) 0))
+ (setcdr (car (nthcdr 3 attr)) tramp-unknown-id-integer))
+ (when (and (floatp (cdr (nth 3 attr)))
+ (<= (cdr (nth 3 attr)) most-positive-fixnum))
+ (setcdr (car (nthcdr 3 attr)) (round (cdr (nth 3 attr))))))
+ ;; Convert last access time.
+ (unless (listp (nth 4 attr))
+ (setcar (nthcdr 4 attr) (seconds-to-time (nth 4 attr))))
+ ;; Convert last modification time.
+ (unless (listp (nth 5 attr))
+ (setcar (nthcdr 5 attr) (seconds-to-time (nth 5 attr))))
+ ;; Convert last status change time.
+ (unless (listp (nth 6 attr))
+ (setcar (nthcdr 6 attr) (seconds-to-time (nth 6 attr))))
+ ;; Convert file size.
+ (when (< (nth 7 attr) 0)
+ (setcar (nthcdr 7 attr) -1))
+ (when (and (floatp (nth 7 attr))
+ (<= (nth 7 attr) most-positive-fixnum))
+ (setcar (nthcdr 7 attr) (round (nth 7 attr))))
+ ;; Convert file mode bits to string.
+ (unless (stringp (nth 8 attr))
+ (setcar (nthcdr 8 attr)
+ (tramp-file-mode-from-int (nth 8 attr)))
+ (when (stringp (car attr))
+ (aset (nth 8 attr) 0 ?l)))
+ ;; Convert directory indication bit.
+ (when (string-prefix-p "d" (nth 8 attr))
+ (setcar attr t))
+ ;; Convert symlink from `tramp-do-file-attributes-with-stat'.
+ ;; Decode also multibyte string.
+ (when (consp (car attr))
+ (setcar attr
+ (and (stringp (caar attr))
+ (string-match ".+ -> .\\(.+\\)." (caar attr))
+ (decode-coding-string
+ (match-string 1 (caar attr)) 'utf-8))))
+ ;; Set file's gid change bit.
+ (setcar
+ (nthcdr 9 attr)
+ (not (= (cdr (nth 3 attr))
+ (or (tramp-get-remote-gid ,vec 'integer)
+ tramp-unknown-id-integer))))
+ ;; Convert inode.
+ (when (floatp (nth 10 attr))
+ (setcar (nthcdr 10 attr)
+ (condition-case nil
+ (let ((high (nth 10 attr))
+ middle low)
+ (if (<= high most-positive-fixnum)
+ (floor high)
+ ;; The low 16 bits.
+ (setq low (mod high #x10000)
+ high (/ high #x10000))
+ (if (<= high most-positive-fixnum)
+ (cons (floor high) (floor low))
+ ;; The middle 24 bits.
+ (setq middle (mod high #x1000000)
+ high (/ high #x1000000))
+ (cons (floor high)
+ (cons (floor middle) (floor low))))))
+ ;; Inodes can be incredible huge. We
+ ;; must hide this.
+ (error (tramp-get-inode ,vec)))))
+ ;; Set virtual device number.
+ (setcar (nthcdr 11 attr)
+ (tramp-get-device ,vec))
+ attr)))))
+
+ ;; Return normalized result.
+ (append (tramp-compat-take 2 result)
+ (if (eq ,id-format 'string)
+ (list (car (nth 2 result)) (car (nth 3 result)))
+ (list (cdr (nth 2 result)) (cdr (nth 3 result))))
+ (nthcdr 4 result)))))
(defun tramp-get-home-directory (vec &optional user)
"The remote home directory for connection VEC as local file name.
@@ -5828,21 +6031,15 @@ This handles also chrooted environments, which are not
regarded as local."
(defun tramp-make-tramp-temp-file (vec)
"Create a temporary file on the remote host identified by VEC.
Return the local name of the temporary file."
- (let (result)
- (while (not result)
- ;; `make-temp-file' would be the natural choice for
- ;; implementation. But it calls `write-region' internally,
- ;; which also needs a temporary file - we would end in an
- ;; infinite loop.
- (setq result (tramp-make-tramp-temp-name vec))
- (if (file-exists-p result)
- (setq result nil)
- ;; This creates the file by side effect.
- (set-file-times result)
- (set-file-modes result #o0700)))
-
- ;; Return the local part.
- (tramp-file-local-name result)))
+ (let (create-lockfiles)
+ (cl-letf (((symbol-function 'tramp-remote-acl-p) #'ignore)
+ ((symbol-function 'tramp-remote-selinux-p) #'ignore)
+ ((symbol-function 'tramp-sudoedit-remote-acl-p) #'ignore)
+ ((symbol-function 'tramp-sudoedit-remote-selinux-p) #'ignore))
+ (tramp-file-local-name
+ (make-temp-file
+ (expand-file-name
+ tramp-temp-name-prefix (tramp-get-remote-tmpdir vec)))))))
(defun tramp-delete-temp-file-function ()
"Remove temporary files related to current buffer."
diff --git a/test/lisp/net/tramp-archive-tests.el
b/test/lisp/net/tramp-archive-tests.el
index 54d1ecf365..f51037aabb 100644
--- a/test/lisp/net/tramp-archive-tests.el
+++ b/test/lisp/net/tramp-archive-tests.el
@@ -31,7 +31,6 @@
(require 'ert)
(require 'ert-x)
(require 'tramp-archive)
-(defvar tramp-copy-size-limit)
(defvar tramp-persistency-file-name)
;; `ert-resource-file' was introduced in Emacs 28.1.
@@ -96,7 +95,6 @@ Do not hexlify \"/\". This hexlified string is used in
`file:///' URLs."
(setq password-cache-expiry nil
tramp-cache-read-persistent-data t ;; For auth-sources.
- tramp-copy-size-limit nil
tramp-persistency-file-name nil
tramp-verbose 0)
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 55a6feba9b..e2abb77591 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -201,6 +201,14 @@ being the result.")
(file-writable-p ert-remote-temporary-file-directory))))))
(when (cdr tramp--test-enabled-checked)
+ ;; Remove old test files.
+ (dolist (dir `(,temporary-file-directory
+ ,ert-remote-temporary-file-directory))
+ (dolist (file (directory-files dir 'full "^\\(.#\\)?tramp-test"))
+ (ignore-errors
+ (if (file-directory-p file)
+ (delete-directory file 'recursive)
+ (delete-file file)))))
;; Cleanup connection.
(ignore-errors
(tramp-cleanup-connection tramp-test-vec nil 'keep-password)))
@@ -4078,10 +4086,9 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(setq tmp-name3 (concat (file-remote-p tmp-name3) tmp-name2)))))
;; Cleanup.
- (ignore-errors
- (delete-file tmp-name2)
- (delete-file tmp-name3)
- (delete-directory tmp-name1 'recursive)))
+ (ignore-errors (delete-file tmp-name2))
+ (ignore-errors (delete-file tmp-name3))
+ (ignore-errors (delete-directory tmp-name1 'recursive)))
;; Detect cyclic symbolic links.
(unwind-protect
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- master 9ed5c39aad: Refactor Tramp,
Michael Albinus <=