(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)
(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))
(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)
(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."
(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."
;; 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
;; 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."
;; 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\"
(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)
;; 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)))
(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."
(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)
(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
(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."
(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."
(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
(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
(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
(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
(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
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\");
{
$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,
$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();
{
$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,
$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"
(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)
(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)
(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.")
(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)
;; ... 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.
(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.
;; 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.
;; 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."
(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))
(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))
(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.
;; 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)
(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
"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.
(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)
(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)
(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
(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))
(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)
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
(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:
(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)
(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))))
(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
(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.
"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")
;; 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
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
"`%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
(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."
(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)
(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)
(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
(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 "/".
(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)))
(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))
"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-+"
;; 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.
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.
(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
(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
;; 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."
(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")))
(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")))
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)
,(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))
(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
;;; 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."
(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'.
(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."
(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)
(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."
(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)))
;; 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))
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
(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))
(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:
"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.
(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."
(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.
(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)
(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)))
(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
projects / emacs.git / commitdiff