mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 10:30:25 -08:00
Code Issues Projects Releases Wiki Activity

Refactor Tramp

Browse source 
* 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.
This commit is contained in:
Michael Albinus 2022-07-24 16:02:10 +02:00
parent 295efb6025
commit 9ed5c39aad
14 changed files with 1380 additions and 1291 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -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))))))))
;; 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 &optional id-format)
(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))
(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))
(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))))
(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)))
;; 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))
(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))))))))
;; 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))
(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))
(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)))))))
;; 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\"

23
lisp/net/tramp-archive.el
View file

@ -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)))

6
lisp/net/tramp-cache.el
View file

@ -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."

9
lisp/net/tramp-compat.el
View file

@ -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)

145
lisp/net/tramp-crypt.el
View file

@ -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))
(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)))
(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))))))
(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."

52
lisp/net/tramp-fuse.el
View file

@ -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."

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

@ -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))
(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)))
(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)))
;; 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)))))
;; 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)))
(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))))
;; 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 (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)))))))))
(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

69
lisp/net/tramp-rclone.el
View file

@ -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))
(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))))
(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))
;; 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)))
;; 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 (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))))))))
(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

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

File diff suppressed because it is too large Load diff

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

@ -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))
(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)
;; `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))
(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))
(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))
(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))))
(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))
;; 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))
(if (not (zerop (length user)))
(setq args (append args (list "-U" user)))
(setq args (append args (list "-N"))))
(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))
(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.
(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 -")))))
"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))
(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))))
(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)))
;; 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)
(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))))))
(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))))
;; 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)))
;; 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)))
;; 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))))
;; 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))))))))))
;; 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.

147
lisp/net/tramp-sudoedit.el
View file

@ -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))
(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))
(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))))
;; 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)))
;; 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)))
;; 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)))
;; 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 (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)))))))
(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")))

417
lisp/net/tramp.el
View file

@ -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."