(start end filename &optional append visit lockname mustbenew)
"Like `write-region' for Tramp files."
(tramp-skeleton-write-region start end filename append visit lockname mustbenew
- (let ((tmpfile (tramp-compat-make-temp-file filename)))
- (when (and append (file-exists-p filename))
- (copy-file filename tmpfile 'ok)
- (set-file-modes tmpfile (logior (or (file-modes tmpfile) 0) #o0600)))
- (let (create-lockfiles)
- (write-region start end tmpfile append 'no-message))
- (with-tramp-progress-reporter
- v 3 (format-message
- "Moving tmp file `%s' to `%s'" tmpfile filename)
- (unwind-protect
- (unless (tramp-adb-execute-adb-command
- v "push" tmpfile (tramp-compat-file-name-unquote localname))
- (tramp-error v 'file-error "Cannot write: `%s'" filename))
- (delete-file tmpfile))))))
+ ;; If `start' is the empty string, it is likely that a temporary
+ ;; file is created. Do it directly.
+ (if (and (stringp start) (string-empty-p start))
+ (tramp-adb-send-command-and-check
+ v (format "echo -n \"\">%s" (tramp-shell-quote-argument localname)))
+
+ (let ((tmpfile (tramp-compat-make-temp-file filename)))
+ (when (and append (file-exists-p filename))
+ (copy-file filename tmpfile 'ok)
+ (set-file-modes tmpfile (logior (or (file-modes tmpfile) 0) #o0600)))
+ (let (create-lockfiles)
+ (write-region start end tmpfile append 'no-message))
+ (with-tramp-progress-reporter
+ v 3 (format-message
+ "Moving tmp file `%s' to `%s'" tmpfile filename)
+ (unwind-protect
+ (unless (tramp-adb-execute-adb-command
+ v "push" tmpfile
+ (tramp-compat-file-name-unquote localname))
+ (tramp-error v 'file-error "Cannot write: `%s'" filename))
+ (delete-file tmpfile)))))))
(defun tramp-adb-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- ;; ADB shell does not support "chmod -h".
- (unless (and (eq flag 'nofollow) (file-symlink-p filename))
- (tramp-flush-file-properties v localname)
+ ;; ADB shell does not support "chmod -h".
+ (unless (and (eq flag 'nofollow) (file-symlink-p filename))
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
(tramp-adb-send-command-and-check
v (format "chmod %o %s" mode (tramp-shell-quote-argument localname))))))
(defun tramp-adb-handle-set-file-times (filename &optional time flag)
"Like `set-file-times' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (tramp-flush-file-properties v localname)
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
(let ((time (if (or (null time)
(tramp-compat-time-equal-p time tramp-time-doesnt-exist)
(tramp-compat-time-equal-p time tramp-time-dont-know))
;; because the remote process could have changed them.
(when tmpinput (delete-file tmpinput))
(when process-file-side-effects
- (tramp-flush-directory-properties v ""))
+ (tramp-flush-directory-properties v "/"))
;; Return exit status.
(if (equal ret -1)
name1 (format "%s<%d>" name i)))
(setq name name1)
- (with-tramp-saved-connection-property v "process-name"
- (with-tramp-saved-connection-property v "process-buffer"
- ;; Set the new process properties.
- (tramp-set-connection-property v "process-name" name)
- (tramp-set-connection-property v "process-buffer" buffer)
- (with-current-buffer (tramp-get-connection-buffer v)
- (unwind-protect
- ;; We catch this event. Otherwise,
- ;; `make-process' could be called on the local
- ;; host.
- (save-excursion
- (save-restriction
- ;; Activate narrowing in order to save
- ;; BUFFER contents. Clear also the
- ;; modification time; otherwise we might be
- ;; interrupted by `verify-visited-file-modtime'.
- (let ((buffer-undo-list t)
- (inhibit-read-only t)
- (coding-system-for-write
- (if (symbolp coding) coding (car coding)))
- (coding-system-for-read
- (if (symbolp coding) coding (cdr coding))))
- (clear-visited-file-modtime)
- (narrow-to-region (point-max) (point-max))
- ;; We call `tramp-adb-maybe-open-connection',
- ;; in order to cleanup the prompt afterwards.
- (tramp-adb-maybe-open-connection v)
- (delete-region (point-min) (point-max))
- ;; Send the command.
- (setq p (tramp-get-connection-process v))
- (tramp-adb-send-command v command nil t) ; nooutput
- ;; Set sentinel and filter.
- (when sentinel
- (set-process-sentinel p sentinel))
- (when filter
- (set-process-filter p filter))
- (process-put p 'remote-command orig-command)
- (tramp-set-connection-property
- p "remote-command" orig-command)
- ;; Set query flag and process marker for
- ;; this process. We ignore errors,
- ;; because the process could have finished
- ;; already.
- (ignore-errors
- (set-process-query-on-exit-flag p (null noquery))
- (set-marker (process-mark p) (point))
- ;; We must flush them here already;
- ;; otherwise `rename-file', `delete-file' or
- ;; `insert-file-contents' will fail.
- (tramp-flush-connection-property v "process-name")
- (tramp-flush-connection-property
- v "process-buffer")
- ;; Copy tmpstderr file.
- (when (and (stringp stderr)
- (not (tramp-tramp-file-p stderr)))
- (add-function
- :after (process-sentinel p)
- (lambda (_proc _msg)
- (rename-file remote-tmpstderr stderr))))
- ;; Read initial output. Remove the
- ;; first line, which is the command
- ;; echo.
- (unless (eq filter t)
- (while
- (progn
- (goto-char (point-min))
- (not (re-search-forward "[\n]" nil t)))
- (tramp-accept-process-output p 0))
- (delete-region (point-min) (point)))
- ;; Provide error buffer. This shows
- ;; only initial error messages; messages
- ;; arriving later on will be inserted
- ;; when the process is deleted. The
- ;; temporary file will exist until the
- ;; process is deleted.
- (when (bufferp stderr)
- (with-current-buffer stderr
- (insert-file-contents-literally
- remote-tmpstderr 'visit))
- ;; Delete tmpstderr file.
- (add-function
- :after (process-sentinel p)
- (lambda (_proc _msg)
- (with-current-buffer stderr
- (insert-file-contents-literally
- remote-tmpstderr 'visit nil nil 'replace))
- (delete-file remote-tmpstderr))))
- ;; Return process.
- p))))
-
- ;; Save exit.
- (if (string-prefix-p tramp-temp-buffer-name (buffer-name))
- (ignore-errors
- (set-process-buffer p nil)
- (kill-buffer (current-buffer)))
- (set-buffer-modified-p bmp))))))))))))
+ (with-tramp-saved-connection-properties
+ v '("process-name" "process-buffer")
+ ;; Set the new process properties.
+ (tramp-set-connection-property v "process-name" name)
+ (tramp-set-connection-property v "process-buffer" buffer)
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (unwind-protect
+ ;; We catch this event. Otherwise, `make-process'
+ ;; could be called on the local host.
+ (save-excursion
+ (save-restriction
+ ;; Activate narrowing in order to save BUFFER
+ ;; contents. Clear also the modification
+ ;; time; otherwise we might be interrupted by
+ ;; `verify-visited-file-modtime'.
+ (let ((buffer-undo-list t)
+ (inhibit-read-only t)
+ (coding-system-for-write
+ (if (symbolp coding) coding (car coding)))
+ (coding-system-for-read
+ (if (symbolp coding) coding (cdr coding))))
+ (clear-visited-file-modtime)
+ (narrow-to-region (point-max) (point-max))
+ ;; We call `tramp-adb-maybe-open-connection',
+ ;; in order to cleanup the prompt afterwards.
+ (tramp-adb-maybe-open-connection v)
+ (delete-region (point-min) (point-max))
+ ;; Send the command.
+ (setq p (tramp-get-connection-process v))
+ (tramp-adb-send-command v command nil t) ; nooutput
+ ;; Set sentinel and filter.
+ (when sentinel
+ (set-process-sentinel p sentinel))
+ (when filter
+ (set-process-filter p filter))
+ (process-put p 'remote-command orig-command)
+ (tramp-set-connection-property
+ p "remote-command" orig-command)
+ ;; Set query flag and process marker for
+ ;; this process. We ignore errors, because
+ ;; the process could have finished already.
+ (ignore-errors
+ (set-process-query-on-exit-flag p (null noquery))
+ (set-marker (process-mark p) (point))
+ ;; We must flush them here already;
+ ;; otherwise `rename-file', `delete-file'
+ ;; or `insert-file-contents' will fail.
+ (tramp-flush-connection-property v "process-name")
+ (tramp-flush-connection-property
+ v "process-buffer")
+ ;; Copy tmpstderr file.
+ (when (and (stringp stderr)
+ (not (tramp-tramp-file-p stderr)))
+ (add-function
+ :after (process-sentinel p)
+ (lambda (_proc _msg)
+ (rename-file remote-tmpstderr stderr))))
+ ;; Read initial output. Remove the first
+ ;; line, which is the command echo.
+ (unless (eq filter t)
+ (while
+ (progn
+ (goto-char (point-min))
+ (not (re-search-forward "[\n]" nil t)))
+ (tramp-accept-process-output p 0))
+ (delete-region (point-min) (point)))
+ ;; Provide error buffer. This shows only
+ ;; initial error messages; messages
+ ;; arriving later on will be inserted when
+ ;; the process is deleted. The temporary
+ ;; file will exist until the process is
+ ;; deleted.
+ (when (bufferp stderr)
+ (with-current-buffer stderr
+ (insert-file-contents-literally
+ remote-tmpstderr 'visit))
+ ;; Delete tmpstderr file.
+ (add-function
+ :after (process-sentinel p)
+ (lambda (_proc _msg)
+ (with-current-buffer stderr
+ (insert-file-contents-literally
+ remote-tmpstderr 'visit nil nil 'replace))
+ (delete-file remote-tmpstderr))))
+ ;; Return process.
+ p))))
+
+ ;; Save exit.
+ (if (string-prefix-p tramp-temp-buffer-name (buffer-name))
+ (ignore-errors
+ (set-process-buffer p nil)
+ (kill-buffer (current-buffer)))
+ (set-buffer-modified-p bmp)))))))))))
(defun tramp-adb-handle-exec-path ()
"Like `exec-path' for Tramp files."
(file-directory-p . tramp-handle-file-directory-p)
(file-equal-p . tramp-handle-file-equal-p)
(file-executable-p . tramp-archive-handle-file-executable-p)
- (file-exists-p . tramp-handle-file-exists-p)
+ (file-exists-p . tramp-archive-handle-file-exists-p)
(file-in-directory-p . tramp-handle-file-in-directory-p)
(file-local-copy . tramp-archive-handle-file-local-copy)
(file-locked-p . ignore)
(inhibit-file-name-operation operation))
(apply operation args))))
-;;;###autoload
+;; Starting with Emacs 29, `tramp-archive-file-name-handler' is
+;; autoloaded. But it must still be in tramp-loaddefs.el for older
+;; Emacsen.
+;;;###autoload(autoload 'tramp-archive-file-name-handler "tramp-archine")
+;;;###tramp-autoload
(defun tramp-archive-file-name-handler (operation &rest args)
"Invoke the file archive related OPERATION.
First arg specifies the OPERATION, second arg ARGS is a list of
"Like `file-executable-p' for file archives."
(file-executable-p (tramp-archive-gvfs-file-name filename)))
+(defun tramp-archive-handle-file-exists-p (filename)
+ "Like `file-exists-p' for file archives."
+ (file-exists-p (tramp-archive-gvfs-file-name filename)))
+
(defun tramp-archive-handle-file-local-copy (filename)
"Like `file-local-copy' for file archives."
(file-local-copy (tramp-archive-gvfs-file-name filename)))
;; - The key is a process. These are temporary properties related to
;; an open connection. Examples: "scripts" keeps shell script
;; definitions already sent to the remote shell, "last-cmd-time" is
-;; the time stamp a command has been sent to the remote process.
+;; the timestamp a command has been sent to the remote process.
;;
;; - The key is nil. These are temporary properties related to the
;; local machine. Examples: "parse-passwd" and "parse-group" keep
;;; Code:
-(require 'tramp)
-(autoload 'time-stamp-string "time-stamp")
+(require 'tramp-compat)
+(require 'tramp-loaddefs)
+(require 'time-stamp)
;;; -- Cache --
"Get the PROPERTY of FILE from the cache context of KEY.
Return DEFAULT if not set."
;; Unify localname. Remove hop from `tramp-file-name' structure.
- (setq file (tramp-compat-file-name-unquote file)
- key (copy-tramp-file-name key))
- (setf (tramp-file-name-localname key)
- (tramp-run-real-handler #'directory-file-name (list file))
- (tramp-file-name-hop key) nil)
+ (setq key (tramp-file-name-unify key file))
(let* ((hash (tramp-get-hash-table key))
(cached (and (hash-table-p hash) (gethash property hash)))
(cached-at (and (consp cached) (format-time-string "%T" (car cached))))
(tramp-message
key 8 "%s %s %s; inhibit: %s; cache used: %s; cached at: %s"
- file property value remote-file-name-inhibit-cache cache-used cached-at)
+ (tramp-file-name-localname key)
+ property value remote-file-name-inhibit-cache cache-used cached-at)
;; For analysis purposes, count the number of getting this file attribute.
(when (>= tramp-verbose 10)
(let* ((var (intern (concat "tramp-cache-get-count-" property)))
"Set the PROPERTY of FILE to VALUE, in the cache context of KEY.
Return VALUE."
;; Unify localname. Remove hop from `tramp-file-name' structure.
- (setq file (tramp-compat-file-name-unquote file)
- key (copy-tramp-file-name key))
- (setf (tramp-file-name-localname key)
- (tramp-run-real-handler #'directory-file-name (list file))
- (tramp-file-name-hop key) nil)
+ (setq key (tramp-file-name-unify key file))
(let ((hash (tramp-get-hash-table key)))
;; We put the timestamp there.
(puthash property (cons (current-time) value) hash)
- (tramp-message key 8 "%s %s %s" file property value)
+ (tramp-message
+ key 8 "%s %s %s" (tramp-file-name-localname key) property value)
;; For analysis purposes, count the number of setting this file attribute.
(when (>= tramp-verbose 10)
(let* ((var (intern (concat "tramp-cache-set-count-" property)))
(defun tramp-flush-file-property (key file property)
"Remove PROPERTY of FILE in the cache context of KEY."
;; Unify localname. Remove hop from `tramp-file-name' structure.
- (setq file (tramp-compat-file-name-unquote file)
- key (copy-tramp-file-name key))
- (setf (tramp-file-name-localname key)
- (tramp-run-real-handler #'directory-file-name (list file))
- (tramp-file-name-hop key) nil)
+ (setq key (tramp-file-name-unify key file))
(remhash property (tramp-get-hash-table key))
- (tramp-message key 8 "%s %s" file property)
+ (tramp-message key 8 "%s %s" (tramp-file-name-localname key) property)
(when (>= tramp-verbose 10)
(let ((var (intern (concat "tramp-cache-set-count-" property))))
(makunbound var))))
(when-let ((file (file-name-directory file))
(file (directory-file-name file)))
;; Unify localname. Remove hop from `tramp-file-name' structure.
- (setq file (tramp-compat-file-name-unquote file)
- key (copy-tramp-file-name key))
- (setf (tramp-file-name-localname key) file
- (tramp-file-name-hop key) nil)
+ (setq key (tramp-file-name-unify key file))
(dolist (property (hash-table-keys (tramp-get-hash-table key)))
(when (string-match-p
"^\\(directory-\\|file-name-all-completions\\|file-entries\\)"
;;;###tramp-autoload
(defun tramp-flush-file-properties (key file)
"Remove all properties of FILE in the cache context of KEY."
- (let* ((file (tramp-run-real-handler #'directory-file-name (list file)))
- (truename (tramp-get-file-property key file "file-truename")))
+ (let ((truename (tramp-get-file-property key file "file-truename")))
;; Unify localname. Remove hop from `tramp-file-name' structure.
- (setq file (tramp-compat-file-name-unquote file)
- key (copy-tramp-file-name key))
- (setf (tramp-file-name-localname key) file
- (tramp-file-name-hop key) nil)
- (tramp-message key 8 "%s" file)
+ (setq key (tramp-file-name-unify key file))
+ (tramp-message key 8 "%s" (tramp-file-name-localname key))
(remhash key tramp-cache-data)
;; Remove file properties of symlinks.
(when (and (stringp truename)
(defun tramp-flush-directory-properties (key directory)
"Remove all properties of DIRECTORY in the cache context of KEY.
Remove also properties of all files in subdirectories."
- (setq directory (tramp-compat-file-name-unquote directory))
- (let* ((directory (tramp-run-real-handler
- #'directory-file-name (list directory)))
+ (let* ((directory
+ (directory-file-name (tramp-compat-file-name-unquote directory)))
(truename (tramp-get-file-property key directory "file-truename")))
(tramp-message key 8 "%s" directory)
(dolist (key (hash-table-keys tramp-cache-data))
;; not show proper directory contents when a file has been copied or
;; deleted before. We must apply `save-match-data', because it would
;; corrupt other packages otherwise (reported from org).
+;;;###tramp-autoload
(defun tramp-flush-file-function ()
"Flush all Tramp cache properties from `buffer-file-name'.
This is suppressed for temporary buffers."
default-directory))
(tramp-verbose 0))
(when (tramp-tramp-file-p bfn)
- (with-parsed-tramp-file-name bfn nil
- (tramp-flush-file-properties v localname)))))))
+ (tramp-flush-file-properties
+ (tramp-dissect-file-name bfn) (tramp-file-local-name bfn)))))))
(add-hook 'before-revert-hook #'tramp-flush-file-function)
(add-hook 'eshell-pre-command-hook #'tramp-flush-file-function)
(remove-hook 'kill-buffer-hook
#'tramp-flush-file-function)))
+;;;###tramp-autoload
+(defmacro with-tramp-file-property (key file property &rest body)
+ "Check in Tramp cache for PROPERTY, otherwise execute BODY and set cache.
+FILE must be a local file name on a connection identified via KEY."
+ (declare (indent 3) (debug t))
+ `(let ((value (tramp-get-file-property
+ ,key ,file ,property tramp-cache-undefined)))
+ (when (eq value tramp-cache-undefined)
+ ;; We cannot pass @body as parameter to
+ ;; `tramp-set-file-property' because it mangles our debug
+ ;; messages.
+ (setq value (progn ,@body))
+ (tramp-set-file-property ,key ,file ,property value))
+ value))
+
+;;;###tramp-autoload
+(defmacro with-tramp-saved-file-property (key file property &rest body)
+ "Save PROPERTY, run BODY, reset PROPERTY.
+Preserve timestamps."
+ (declare (indent 3) (debug t))
+ `(progn
+ ;; Unify localname. Remove hop from `tramp-file-name' structure.
+ (setq ,key (tramp-file-name-unify ,key ,file))
+ (let* ((hash (tramp-get-hash-table ,key))
+ (cached (and (hash-table-p hash) (gethash ,property hash))))
+ (unwind-protect (progn ,@body)
+ ;; Reset PROPERTY. Recompute hash, it could have been flushed.
+ (setq hash (tramp-get-hash-table ,key))
+ (if (consp cached)
+ (puthash ,property cached hash)
+ (remhash ,property hash))))))
+
+;;;###tramp-autoload
+(defmacro with-tramp-saved-file-properties (key file properties &rest body)
+ "Save PROPERTIES, run BODY, reset PROPERTIES.
+PROPERTIES is a list of file properties (strings).
+Preserve timestamps."
+ (declare (indent 3) (debug t))
+ `(progn
+ ;; Unify localname. Remove hop from `tramp-file-name' structure.
+ (setq ,key (tramp-file-name-unify ,key ,file))
+ (let* ((hash (tramp-get-hash-table ,key))
+ (values
+ (and (hash-table-p hash)
+ (mapcar
+ (lambda (property) (cons property (gethash property hash)))
+ ,properties))))
+ (unwind-protect (progn ,@body)
+ ;; Reset PROPERTIES. Recompute hash, it could have been flushed.
+ (setq hash (tramp-get-hash-table ,key))
+ (dolist (value values)
+ (if (consp (cdr value))
+ (puthash (car value) (cdr value) hash)
+ (remhash (car value) hash)))))))
+
;;; -- Properties --
;;;###tramp-autoload
(or tramp-cache-data-changed (tramp-file-name-p key)))
(remhash key tramp-cache-data))
+;;;###tramp-autoload
+(defmacro with-tramp-connection-property (key property &rest body)
+ "Check in Tramp for property PROPERTY, otherwise execute BODY and set."
+ (declare (indent 2) (debug t))
+ `(let ((value (tramp-get-connection-property
+ ,key ,property tramp-cache-undefined)))
+ (when (eq value tramp-cache-undefined)
+ ;; We cannot pass ,@body as parameter to
+ ;; `tramp-set-connection-property' because it mangles our debug
+ ;; messages.
+ (setq value (progn ,@body))
+ (tramp-set-connection-property ,key ,property value))
+ value))
+
+;;;###tramp-autoload
+(defmacro with-tramp-saved-connection-property (key property &rest body)
+ "Save PROPERTY, run BODY, reset PROPERTY."
+ (declare (indent 2) (debug t))
+ `(progn
+ (setq ,key (tramp-file-name-unify ,key))
+ (let* ((hash (tramp-get-hash-table ,key))
+ (cached (and (hash-table-p hash)
+ (gethash ,property hash tramp-cache-undefined))))
+ (unwind-protect (progn ,@body)
+ ;; Reset PROPERTY. Recompute hash, it could have been flushed.
+ (setq hash (tramp-get-hash-table ,key))
+ (if (not (eq cached tramp-cache-undefined))
+ (puthash ,property cached hash)
+ (remhash ,property hash))))))
+
+;;;###tramp-autoload
+(defmacro with-tramp-saved-connection-properties (key properties &rest body)
+ "Save PROPERTIES, run BODY, reset PROPERTIES.
+PROPERTIES is a list of file properties (strings)."
+ (declare (indent 2) (debug t))
+ `(progn
+ (setq ,key (tramp-file-name-unify ,key))
+ (let* ((hash (tramp-get-hash-table ,key))
+ (values
+ (mapcar
+ (lambda (property)
+ (cons property (gethash property hash tramp-cache-undefined)))
+ ,properties)))
+ (unwind-protect (progn ,@body)
+ ;; Reset PROPERTIES. Recompute hash, it could have been flushed.
+ (setq hash (tramp-get-hash-table ,key))
+ (dolist (value values)
+ (if (not (eq (cdr value) tramp-cache-undefined))
+ (puthash (car value) (cdr value) hash)
+ (remhash (car value) hash)))))))
+
;;;###tramp-autoload
(defun tramp-cache-print (table)
"Print hash table TABLE."
(when (bufferp buf) (kill-buffer buf)))
;; Flush file cache.
- (tramp-flush-directory-properties vec "")
+ (tramp-flush-directory-properties vec "/")
;; Flush connection cache.
(tramp-flush-connection-properties vec)
(defun tramp-crypt-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (tramp-flush-file-properties v localname)
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
(let (tramp-crypt-enabled)
(tramp-compat-set-file-modes
(tramp-crypt-encrypt-file-name filename) mode flag))))
(defun tramp-crypt-handle-set-file-times (filename &optional time flag)
"Like `set-file-times' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (tramp-flush-file-properties v localname)
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
(let (tramp-crypt-enabled)
(tramp-compat-set-file-times
(tramp-crypt-encrypt-file-name filename) time flag))))
(defun tramp-crypt-handle-set-file-uid-gid (filename &optional uid gid)
"Like `tramp-set-file-uid-gid' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (tramp-flush-file-properties v localname)
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
(let (tramp-crypt-enabled)
(tramp-set-file-uid-gid
(tramp-crypt-encrypt-file-name filename) uid gid))))
(require 'tramp)
;; Pacify byte-compiler.
-(declare-function tramp-archive-file-name-handler "tramp-archive")
(defvar ange-ftp-ftp-name-arg)
(defvar ange-ftp-ftp-name-res)
(defvar ange-ftp-name-format)
\f
;; File name primitives.
+(defun tramp-gvfs-info (filename &optional arg)
+ "Check FILENAME via `gvfs-info'.
+Set file property \"file-exists-p\" with the result."
+ (with-parsed-tramp-file-name filename nil
+ (tramp-set-file-property
+ v localname "file-exists-p"
+ (tramp-gvfs-send-command
+ v "gvfs-info" arg (tramp-gvfs-url-file-name filename)))))
+
(defun tramp-gvfs-do-copy-or-rename-file
(op filename newname &optional ok-if-already-exists keep-date
preserve-uid-gid preserve-extended-attributes)
;; 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))
+ (tramp-gvfs-info newname)
(eq op 'copy)
- (not (tramp-gvfs-send-command
- v "gvfs-info"
- (tramp-gvfs-url-file-name filename)))))
+ (not (tramp-gvfs-info filename))))
(if (or (not equal-remote)
(and equal-remote
(tramp-error
v 'file-error "Couldn't delete non-empty %s" directory)))
- (unless (tramp-gvfs-send-command
- v "gvfs-rm" (tramp-gvfs-url-file-name directory))
+ (unless (and (tramp-gvfs-send-command
+ v "gvfs-rm" (tramp-gvfs-url-file-name directory))
+ (not (tramp-gvfs-info directory)))
;; Propagate the error.
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
(tramp-flush-file-properties v localname)
(if (and delete-by-moving-to-trash trash)
(move-file-to-trash filename)
- (unless (tramp-gvfs-send-command
- v "gvfs-rm" (tramp-gvfs-url-file-name filename))
+ (unless (and (tramp-gvfs-send-command
+ v "gvfs-rm" (tramp-gvfs-url-file-name filename))
+ (not (tramp-gvfs-info filename)))
;; Propagate the error.
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
(if file-system " system" "") localname)
;; Send command.
(if file-system
- (tramp-gvfs-send-command
- v "gvfs-info" "--filesystem" (tramp-gvfs-url-file-name filename))
- (tramp-gvfs-send-command
- v "gvfs-info" (tramp-gvfs-url-file-name filename)))
+ (tramp-gvfs-info filename "--filesystem")
+ (tramp-gvfs-info filename))
;; Parse output.
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
(make-directory ldir parents))
;; Just do it.
(or (when-let ((mkdir-succeeded
- (tramp-gvfs-send-command
- v "gvfs-mkdir" (tramp-gvfs-url-file-name dir))))
+ (and
+ (tramp-gvfs-send-command
+ v "gvfs-mkdir" (tramp-gvfs-url-file-name dir))
+ (tramp-gvfs-info dir))))
(set-file-modes dir (default-file-modes))
mkdir-succeeded)
(and parents (file-directory-p dir))
(defun tramp-gvfs-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (tramp-flush-file-properties v localname)
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
(tramp-gvfs-set-attribute
v (if (eq flag 'nofollow) "-nt" "-t") "uint32"
(tramp-gvfs-url-file-name filename) "unix::mode" (number-to-string mode))))
(defun tramp-gvfs-handle-set-file-times (filename &optional time flag)
"Like `set-file-times' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (tramp-flush-file-properties v localname)
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
(tramp-gvfs-set-attribute
v (if (eq flag 'nofollow) "-nt" "-t") "uint64"
(tramp-gvfs-url-file-name filename) "time::modified"
(defun tramp-gvfs-handle-set-file-uid-gid (filename &optional uid gid)
"Like `tramp-set-file-uid-gid' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (tramp-flush-file-properties v localname)
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
(when (natnump uid)
(tramp-gvfs-set-attribute
v "-t" "uint32"
(tramp-file-name-equal-p v (tramp-dissect-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))
+ (tramp-flush-file-properties
+ v (expand-file-name target (tramp-file-local-name default-directory))))
;; If TARGET is still remote, quote it.
(if (tramp-tramp-file-p target)
(defun tramp-sh-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- ;; We need "chmod -h" when the flag is set.
- (when (or (not (eq flag 'nofollow))
- (not (file-symlink-p filename))
- (tramp-get-remote-chmod-h v))
- (tramp-flush-file-properties v localname)
+ ;; We need "chmod -h" when the flag is set.
+ (when (or (not (eq flag 'nofollow))
+ (not (file-symlink-p filename))
+ (tramp-get-remote-chmod-h (tramp-dissect-file-name filename)))
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
;; FIXME: extract the proper text from chmod's stderr.
(tramp-barf-unless-okay
v
(defun tramp-sh-handle-set-file-times (filename &optional time flag)
"Like `set-file-times' for Tramp files."
- (with-parsed-tramp-file-name filename nil
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
(when (tramp-get-remote-touch v)
- (tramp-flush-file-properties v localname)
(let ((time
(if (or (null time)
(tramp-compat-time-equal-p time tramp-time-doesnt-exist)
;; another implementation, see `dired-do-chown'. OTOH, it is mostly
;; working with su(do)? when it is needed, so it shall succeed in
;; the majority of cases.
- ;; Don't modify `last-coding-system-used' by accident.
- (let ((last-coding-system-used last-coding-system-used))
- (with-parsed-tramp-file-name filename nil
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
+ ;; Don't modify `last-coding-system-used' by accident.
+ (let ((last-coding-system-used last-coding-system-used))
(if (and (zerop (user-uid)) (tramp-local-host-p v))
;; If we are root on the local host, we can do it directly.
(tramp-set-file-uid-gid localname uid gid)
;; files.
(defun tramp-sh-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files."
- (unless (tramp-compat-string-search "/" filename)
- (all-completions
- filename
- (with-parsed-tramp-file-name (expand-file-name directory) nil
+ (with-parsed-tramp-file-name (expand-file-name directory) nil
+ (when (and (not (tramp-compat-string-search "/" filename))
+ (tramp-connectable-p v))
+ (all-completions
+ filename
(with-tramp-file-property v localname "file-name-all-completions"
(let (result)
;; Get a list of directories and files, including reliably
(file-name-directory (concat prefix localname2)))
(or (file-directory-p (concat prefix localname2))
(file-writable-p (concat prefix localname2))))
+ (with-parsed-tramp-file-name prefix nil
+ (tramp-flush-file-properties v localname2))
(tramp-do-copy-or-rename-file-directly
op (concat prefix localname1) (concat prefix localname2)
ok-if-already-exists keep-date preserve-uid-gid)
(with-temp-buffer
(unwind-protect
- (with-tramp-saved-connection-property v "process-name"
- (with-tramp-saved-connection-property v "process-buffer"
- ;; The default directory must be remote.
- (let ((default-directory
- (file-name-directory (if v1 filename newname)))
- (process-environment (copy-sequence process-environment)))
- ;; 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 copy-env
- (tramp-message
- v 6 "%s=\"%s\""
- (car copy-env) (string-join (cdr copy-env) " "))
- (setenv (car copy-env) (string-join (cdr copy-env) " ")))
- (setq
- copy-args
- (append
- copy-args
- (if remote-copy-program
- (list (if v1 (concat ">" target) (concat "<" source)))
- (list source target)))
- ;; Use an asynchronous process. By this, password
- ;; can be handled. We don't set a timeout, because
- ;; the copying of large files can last longer than
- ;; 60 secs.
- p (let ((default-directory
- tramp-compat-temporary-file-directory))
- (apply
- #'start-process
- (tramp-get-connection-name v)
- (tramp-get-connection-buffer v)
- copy-program copy-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)
-
- ;; We must adapt `tramp-local-end-of-line' for sending
- ;; the password. Also, we indicate that perhaps several
- ;; password prompts might appear.
- (let ((tramp-local-end-of-line tramp-rsh-end-of-line)
- (tramp-password-prompt-not-unique (and v1 v2)))
- (tramp-process-actions
- p v nil tramp-actions-copy-out-of-band)))))
+ (with-tramp-saved-connection-properties
+ v '("process-name" "process-buffer")
+ ;; The default directory must be remote.
+ (let ((default-directory
+ (file-name-directory (if v1 filename newname)))
+ (process-environment (copy-sequence process-environment)))
+ ;; 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 copy-env
+ (tramp-message
+ v 6 "%s=\"%s\""
+ (car copy-env) (string-join (cdr copy-env) " "))
+ (setenv (car copy-env) (string-join (cdr copy-env) " ")))
+ (setq
+ copy-args
+ (append
+ copy-args
+ (if remote-copy-program
+ (list (if v1 (concat ">" target) (concat "<" source)))
+ (list source target)))
+ ;; Use an asynchronous process. By this, password
+ ;; can be handled. We don't set a timeout, because
+ ;; the copying of large files can last longer than 60
+ ;; secs.
+ p (let ((default-directory
+ tramp-compat-temporary-file-directory))
+ (apply
+ #'start-process
+ (tramp-get-connection-name v)
+ (tramp-get-connection-buffer v)
+ copy-program copy-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)
+
+ ;; We must adapt `tramp-local-end-of-line' for sending
+ ;; the password. Also, we indicate that perhaps
+ ;; several password prompts might appear.
+ (let ((tramp-local-end-of-line tramp-rsh-end-of-line)
+ (tramp-password-prompt-not-unique (and v1 v2)))
+ (tramp-process-actions
+ p v nil tramp-actions-copy-out-of-band))))
;; Clear the remote prompt.
(when (and remote-copy-program
"Like `delete-file' for Tramp files."
(setq filename (expand-file-name filename))
(with-parsed-tramp-file-name filename nil
- (tramp-flush-file-properties v localname)
(if (and delete-by-moving-to-trash trash)
(move-file-to-trash filename)
(tramp-barf-unless-okay
v (format "rm -f %s" (tramp-shell-quote-argument localname))
- "Couldn't delete %s" filename))))
+ "Couldn't delete %s" filename))
+ (tramp-flush-file-properties v localname)))
;; Dired.
name1 (format "%s<%d>" name i)))
(setq name name1)
- (with-tramp-saved-connection-property v "process-name"
- (with-tramp-saved-connection-property v "process-buffer"
- ;; Set the new process properties.
- (tramp-set-connection-property v "process-name" name)
- (tramp-set-connection-property v "process-buffer" buffer)
- (with-current-buffer (tramp-get-connection-buffer v)
- (unwind-protect
- ;; We catch this event. Otherwise,
- ;; `make-process' could be called on the local
- ;; host.
- (save-excursion
- (save-restriction
- ;; Activate narrowing in order to save
- ;; BUFFER contents. Clear also the
- ;; modification time; otherwise we might be
- ;; interrupted by `verify-visited-file-modtime'.
- (let ((buffer-undo-list t)
- (inhibit-read-only t)
- (mark (point-max))
- (coding-system-for-write
- (if (symbolp coding) coding (car coding)))
- (coding-system-for-read
- (if (symbolp coding) coding (cdr coding))))
- (clear-visited-file-modtime)
+ (with-tramp-saved-connection-properties
+ v '("process-name" "process-buffer")
+ ;; Set the new process properties.
+ (tramp-set-connection-property v "process-name" name)
+ (tramp-set-connection-property v "process-buffer" buffer)
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (unwind-protect
+ ;; We catch this event. Otherwise, `make-process'
+ ;; could be called on the local host.
+ (save-excursion
+ (save-restriction
+ ;; Activate narrowing in order to save BUFFER
+ ;; contents. Clear also the modification
+ ;; time; otherwise we might be interrupted by
+ ;; `verify-visited-file-modtime'.
+ (let ((buffer-undo-list t)
+ (inhibit-read-only t)
+ (mark (point-max))
+ (coding-system-for-write
+ (if (symbolp coding) coding (car coding)))
+ (coding-system-for-read
+ (if (symbolp coding) coding (cdr coding))))
+ (clear-visited-file-modtime)
+ (narrow-to-region (point-max) (point-max))
+ (catch 'suppress
+ ;; Set the pid of the remote shell. This
+ ;; is needed when sending signals
+ ;; remotely.
+ (let ((pid
+ (tramp-send-command-and-read v "echo $$")))
+ (setq p (tramp-get-connection-process v))
+ (process-put p 'remote-pid pid)
+ (tramp-set-connection-property
+ p "remote-pid" pid))
+ ;; Disable carriage return to newline
+ ;; translation. This does not work on
+ ;; macOS, see Bug#50748.
+ (when (and (memq connection-type '(nil pipe))
+ (not
+ (tramp-check-remote-uname v "Darwin")))
+ (tramp-send-command v "stty -icrnl"))
+ ;; `tramp-maybe-open-connection' and
+ ;; `tramp-send-command-and-read' could
+ ;; have trashed the connection buffer.
+ ;; Remove this.
+ (widen)
+ (delete-region mark (point-max))
(narrow-to-region (point-max) (point-max))
- (catch 'suppress
- ;; Set the pid of the remote shell. This is
- ;; needed when sending signals remotely.
- (let ((pid
- (tramp-send-command-and-read v "echo $$")))
- (setq p (tramp-get-connection-process v))
- (process-put p 'remote-pid pid)
- (tramp-set-connection-property
- p "remote-pid" pid))
- ;; Disable carriage return to newline
- ;; translation. This does not work on
- ;; macOS, see Bug#50748.
- (when (and (memq connection-type '(nil pipe))
- (not
- (tramp-check-remote-uname v "Darwin")))
- (tramp-send-command v "stty -icrnl"))
- ;; `tramp-maybe-open-connection' and
- ;; `tramp-send-command-and-read' could have
- ;; trashed the connection buffer. Remove this.
- (widen)
- (delete-region mark (point-max))
- (narrow-to-region (point-max) (point-max))
- ;; Now do it.
- (if command
- ;; Send the command.
- (tramp-send-command v command nil t) ; nooutput
- ;; Check, whether a pty is associated.
- (unless (process-get p 'remote-tty)
- (tramp-error
- v 'file-error
- "pty association is not supported for `%s'"
- name))))
- ;; Set sentinel and filter.
- (when sentinel
- (set-process-sentinel p sentinel))
- (when filter
- (set-process-filter p filter))
- (process-put p 'remote-command orig-command)
- (tramp-set-connection-property
- p "remote-command" orig-command)
- ;; Set query flag and process marker for
- ;; this process. We ignore errors,
- ;; because the process could have finished
- ;; already.
- (ignore-errors
- (set-process-query-on-exit-flag p (null noquery))
- (set-marker (process-mark p) (point)))
- ;; We must flush them here already;
- ;; otherwise `delete-file' will fail.
- (tramp-flush-connection-property v "process-name")
- (tramp-flush-connection-property v "process-buffer")
- ;; Kill stderr process and delete named pipe.
- (when (bufferp stderr)
- (add-function
- :after (process-sentinel p)
- (lambda (_proc _msg)
- (ignore-errors
- (while (accept-process-output
- (get-buffer-process stderr) 0 nil t))
- (delete-process (get-buffer-process stderr)))
- (ignore-errors
- (delete-file remote-tmpstderr)))))
- ;; Return process.
- p)))
-
- ;; Save exit.
- (if (string-prefix-p tramp-temp-buffer-name (buffer-name))
- (ignore-errors
- (set-process-buffer p nil)
- (kill-buffer (current-buffer)))
- (set-buffer-modified-p bmp))))))))))))
+ ;; Now do it.
+ (if command
+ ;; Send the command.
+ (tramp-send-command v command nil t) ; nooutput
+ ;; Check, whether a pty is associated.
+ (unless (process-get p 'remote-tty)
+ (tramp-error
+ v 'file-error
+ "pty association is not supported for `%s'"
+ name))))
+ ;; Set sentinel and filter.
+ (when sentinel
+ (set-process-sentinel p sentinel))
+ (when filter
+ (set-process-filter p filter))
+ (process-put p 'remote-command orig-command)
+ (tramp-set-connection-property
+ p "remote-command" orig-command)
+ ;; Set query flag and process marker for
+ ;; this process. We ignore errors, because
+ ;; the process could have finished already.
+ (ignore-errors
+ (set-process-query-on-exit-flag p (null noquery))
+ (set-marker (process-mark p) (point)))
+ ;; We must flush them here already;
+ ;; otherwise `delete-file' will fail.
+ (tramp-flush-connection-property v "process-name")
+ (tramp-flush-connection-property v "process-buffer")
+ ;; Kill stderr process and delete named pipe.
+ (when (bufferp stderr)
+ (add-function
+ :after (process-sentinel p)
+ (lambda (_proc _msg)
+ (ignore-errors
+ (while (accept-process-output
+ (get-buffer-process stderr) 0 nil t))
+ (delete-process (get-buffer-process stderr)))
+ (ignore-errors
+ (delete-file remote-tmpstderr)))))
+ ;; Return process.
+ p)))
+
+ ;; Save exit.
+ (if (string-prefix-p tramp-temp-buffer-name (buffer-name))
+ (ignore-errors
+ (set-process-buffer p nil)
+ (kill-buffer (current-buffer)))
+ (set-buffer-modified-p bmp)))))))))))
(defun tramp-sh-get-signal-strings (vec)
"Strings to return by `process-file' in case of signals."
;; because the remote process could have changed them.
(when tmpinput (delete-file tmpinput))
(when process-file-side-effects
- (tramp-flush-directory-properties v ""))
+ (tramp-flush-directory-properties v "/"))
;; Return exit status.
(if (equal ret -1)
(start end filename &optional append visit lockname mustbenew)
"Like `write-region' for Tramp files."
(tramp-skeleton-write-region start end filename append visit lockname mustbenew
- (if (and (tramp-local-host-p v)
- ;; `file-writable-p' calls `file-expand-file-name'. We
- ;; cannot use `tramp-run-real-handler' therefore.
- (file-writable-p (file-name-directory localname))
- (or (file-directory-p localname)
- (file-writable-p localname)))
- ;; Short track: if we are on the local host, we can run directly.
- (let ((create-lockfiles (not file-locked)))
- (write-region start end localname append 'no-message lockname))
-
- (let* ((modes (tramp-default-file-modes
- filename (and (eq mustbenew 'excl) 'nofollow)))
- ;; We use this to save the value of
- ;; `last-coding-system-used' after writing the tmp file.
- ;; At the end of the function, we set
- ;; `last-coding-system-used' to this saved value. This
- ;; way, any intermediary coding systems used while
- ;; talking to the remote shell or suchlike won't hose
- ;; this variable. This approach was snarfed from
- ;; ange-ftp.el.
- coding-system-used
- ;; Write region into a tmp file. This isn't really
- ;; needed if we use an encoding function, but currently
- ;; we use it always because this makes the logic simpler.
- ;; We must also set `temporary-file-directory', because
- ;; it could point to a remote directory.
- (temporary-file-directory
- tramp-compat-temporary-file-directory)
- (tmpfile (or tramp-temp-buffer-file-name
- (tramp-compat-make-temp-file filename))))
-
- ;; If `append' is non-nil, we copy the file locally, and let
- ;; the native `write-region' implementation do the job.
- (when (and append (file-exists-p filename))
- (copy-file filename tmpfile 'ok))
-
- ;; We say `no-message' here because we don't want the visited
- ;; file modtime data to be clobbered from the temp file. We
- ;; call `set-visited-file-modtime' ourselves later on. We
- ;; must ensure that `file-coding-system-alist' matches
- ;; `tmpfile'.
- (let ((file-coding-system-alist
- (tramp-find-file-name-coding-system-alist filename tmpfile))
- create-lockfiles)
- (condition-case err
- (write-region start end tmpfile append 'no-message)
- ((error quit)
- (setq tramp-temp-buffer-file-name nil)
- (delete-file tmpfile)
- (signal (car err) (cdr err))))
-
- ;; Now, `last-coding-system-used' has the right value.
- ;; Remember it.
- (setq coding-system-used last-coding-system-used))
-
- ;; The permissions of the temporary file should be set. If
- ;; FILENAME does not exist (eq modes nil) it has been renamed
- ;; to the backup file. This case `save-buffer' handles
- ;; permissions. Ensure that it is still readable.
- (when modes
- (set-file-modes tmpfile (logior (or modes 0) #o0400)))
-
- ;; This is a bit lengthy due to the different methods possible
- ;; for file transfer. First, we check whether the method uses
- ;; an scp program. If so, we call it. Otherwise, both
- ;; encoding and decoding command must be specified. However,
- ;; if the method _also_ specifies an encoding function, then
- ;; that is used for encoding the contents of the tmp file.
- (let* ((size (file-attribute-size (file-attributes tmpfile)))
- (rem-dec (tramp-get-inline-coding v "remote-decoding" size))
- (loc-enc (tramp-get-inline-coding v "local-encoding" size)))
- (cond
- ;; `copy-file' handles direct copy and out-of-band methods.
- ((or (tramp-local-host-p v)
- (tramp-method-out-of-band-p v size))
- (if (and (not (stringp start))
- (= (or end (point-max)) (point-max))
- (= (or start (point-min)) (point-min))
- (tramp-get-method-parameter
- v 'tramp-copy-keep-tmpfile))
- (progn
- (setq tramp-temp-buffer-file-name tmpfile)
- (condition-case err
- ;; We keep the local file for performance
- ;; reasons, useful for "rsync".
- (copy-file tmpfile filename t)
- ((error quit)
- (setq tramp-temp-buffer-file-name nil)
- (delete-file tmpfile)
- (signal (car err) (cdr err)))))
- (setq tramp-temp-buffer-file-name nil)
- ;; Don't rename, in order to keep context in SELinux.
+ ;; If `start' is the empty string, it is likely that a temporary
+ ;; file is created. Do it directly.
+ (if (and (stringp start) (string-empty-p start))
+ (tramp-send-command
+ v (format "echo -n \"\">%s" (tramp-shell-quote-argument localname)))
+
+ ;; Short track: if we are on the local host, we can run directly.
+ (if (and (tramp-local-host-p v)
+ ;; `file-writable-p' calls `file-expand-file-name'. We
+ ;; cannot use `tramp-run-real-handler' therefore.
+ (file-writable-p (file-name-directory localname))
+ (or (file-directory-p localname)
+ (file-writable-p localname)))
+ (let ((create-lockfiles (not file-locked)))
+ (write-region start end localname append 'no-message lockname))
+
+ (let* ((modes (tramp-default-file-modes
+ filename (and (eq mustbenew 'excl) 'nofollow)))
+ ;; We use this to save the value of
+ ;; `last-coding-system-used' after writing the tmp
+ ;; file. At the end of the function, we set
+ ;; `last-coding-system-used' to this saved value. This
+ ;; way, any intermediary coding systems used while
+ ;; talking to the remote shell or suchlike won't hose
+ ;; this variable. This approach was snarfed from
+ ;; ange-ftp.el.
+ coding-system-used
+ ;; Write region into a tmp file. This isn't really
+ ;; needed if we use an encoding function, but currently
+ ;; we use it always because this makes the logic
+ ;; simpler. We must also set
+ ;; `temporary-file-directory', because it could point
+ ;; to a remote directory.
+ (temporary-file-directory
+ tramp-compat-temporary-file-directory)
+ (tmpfile (or tramp-temp-buffer-file-name
+ (tramp-compat-make-temp-file filename))))
+
+ ;; If `append' is non-nil, we copy the file locally, and let
+ ;; the native `write-region' implementation do the job.
+ (when (and append (file-exists-p filename))
+ (copy-file filename tmpfile 'ok))
+
+ ;; We say `no-message' here because we don't want the
+ ;; visited file modtime data to be clobbered from the temp
+ ;; file. We call `set-visited-file-modtime' ourselves later
+ ;; on. We must ensure that `file-coding-system-alist'
+ ;; matches `tmpfile'.
+ (let ((file-coding-system-alist
+ (tramp-find-file-name-coding-system-alist filename tmpfile))
+ create-lockfiles)
+ (condition-case err
+ (write-region start end tmpfile append 'no-message)
+ ((error quit)
+ (setq tramp-temp-buffer-file-name nil)
+ (delete-file tmpfile)
+ (signal (car err) (cdr err))))
+
+ ;; Now, `last-coding-system-used' has the right value.
+ ;; Remember it.
+ (setq coding-system-used last-coding-system-used))
+
+ ;; The permissions of the temporary file should be set. If
+ ;; FILENAME does not exist (eq modes nil) it has been
+ ;; renamed to the backup file. This case `save-buffer'
+ ;; handles permissions. Ensure that it is still readable.
+ (when modes
+ (set-file-modes tmpfile (logior (or modes 0) #o0400)))
+
+ ;; This is a bit lengthy due to the different methods
+ ;; possible for file transfer. First, we check whether the
+ ;; method uses an scp program. If so, we call it.
+ ;; Otherwise, both encoding and decoding command must be
+ ;; specified. However, if the method _also_ specifies an
+ ;; encoding function, then that is used for encoding the
+ ;; contents of the tmp file.
+ (let* ((size (file-attribute-size (file-attributes tmpfile)))
+ (rem-dec (tramp-get-inline-coding v "remote-decoding" size))
+ (loc-enc (tramp-get-inline-coding v "local-encoding" size)))
+ (cond
+ ;; `copy-file' handles direct copy and out-of-band methods.
+ ((or (tramp-local-host-p v)
+ (tramp-method-out-of-band-p v size))
+ (if (and (not (stringp start))
+ (= (or end (point-max)) (point-max))
+ (= (or start (point-min)) (point-min))
+ (tramp-get-method-parameter
+ v 'tramp-copy-keep-tmpfile))
+ (progn
+ (setq tramp-temp-buffer-file-name tmpfile)
+ (condition-case err
+ ;; We keep the local file for performance
+ ;; reasons, useful for "rsync".
+ (copy-file tmpfile filename t)
+ ((error quit)
+ (setq tramp-temp-buffer-file-name nil)
+ (delete-file tmpfile)
+ (signal (car err) (cdr err)))))
+ (setq tramp-temp-buffer-file-name nil)
+ ;; Don't rename, in order to keep context in SELinux.
+ (unwind-protect
+ (copy-file tmpfile filename t)
+ (delete-file tmpfile))))
+
+ ;; Use inline file transfer.
+ (rem-dec
+ ;; Encode tmpfile.
(unwind-protect
- (copy-file tmpfile filename t)
- (delete-file tmpfile))))
-
- ;; Use inline file transfer.
- (rem-dec
- ;; Encode tmpfile.
- (unwind-protect
- (with-temp-buffer
- (set-buffer-multibyte nil)
- ;; Use encoding function or command.
- (with-tramp-progress-reporter
- v 3 (format-message
- "Encoding local file `%s' using `%s'"
- tmpfile loc-enc)
- (if (functionp loc-enc)
- ;; The following `let' is a workaround for the
- ;; base64.el that comes with pgnus-0.84. If
- ;; both of the following conditions are
- ;; satisfied, it tries to write to a local
- ;; file in default-directory, but at this
- ;; point, default-directory is remote.
- ;; (`call-process-region' can't write to
- ;; remote files, it seems.) The file in
- ;; question is a tmp file anyway.
- (let ((coding-system-for-read 'binary)
- (default-directory
- tramp-compat-temporary-file-directory))
- (insert-file-contents-literally tmpfile)
- (funcall loc-enc (point-min) (point-max)))
-
- (unless (zerop (tramp-call-local-coding-command
- loc-enc tmpfile t))
- (tramp-error
- v 'file-error
- (concat "Cannot write to `%s', "
- "local encoding command `%s' failed")
- filename loc-enc))))
-
- ;; Send buffer into remote decoding command which
- ;; writes to remote file. Because this happens on
- ;; the remote host, we cannot use the function.
- (with-tramp-progress-reporter
- v 3 (format-message
- "Decoding remote file `%s' using `%s'"
- filename rem-dec)
- (goto-char (point-max))
- (unless (bolp) (newline))
- (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)
- "Couldn't write region to `%s', decode using `%s' failed"
- filename rem-dec)
- ;; When `file-precious-flag' is set, the region is
- ;; written to a temporary file. Check that the
- ;; checksum is equal to that from the local tmpfile.
- (when file-precious-flag
- (erase-buffer)
- (and
- ;; cksum runs locally, if possible.
- (zerop (tramp-call-process v "cksum" tmpfile t))
- ;; cksum runs remotely.
- (tramp-send-command-and-check
- v
- (format
- "cksum <%s"
- (tramp-shell-quote-argument localname)))
- ;; ... they are different.
- (not
- (string-equal
- (buffer-string)
- (tramp-get-buffer-string (tramp-get-buffer v))))
- (tramp-error
- v 'file-error
- "Couldn't write region to `%s', decode using `%s' failed"
- filename rem-dec)))))
-
- ;; Save exit.
- (delete-file tmpfile)))
-
- ;; That's not expected.
- (t
- (tramp-error
- v 'file-error
- (concat "Method `%s' should specify both encoding and "
- "decoding command or an scp program")
- method))))
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ ;; Use encoding function or command.
+ (with-tramp-progress-reporter
+ v 3 (format-message
+ "Encoding local file `%s' using `%s'"
+ tmpfile loc-enc)
+ (if (functionp loc-enc)
+ ;; The following `let' is a workaround for
+ ;; the base64.el that comes with pgnus-0.84.
+ ;; If both of the following conditions are
+ ;; satisfied, it tries to write to a local
+ ;; file in default-directory, but at this
+ ;; point, default-directory is remote.
+ ;; (`call-process-region' can't write to
+ ;; remote files, it seems.) The file in
+ ;; question is a tmp file anyway.
+ (let ((coding-system-for-read 'binary)
+ (default-directory
+ tramp-compat-temporary-file-directory))
+ (insert-file-contents-literally tmpfile)
+ (funcall loc-enc (point-min) (point-max)))
+
+ (unless (zerop (tramp-call-local-coding-command
+ loc-enc tmpfile t))
+ (tramp-error
+ v 'file-error
+ (concat "Cannot write to `%s', "
+ "local encoding command `%s' failed")
+ filename loc-enc))))
+
+ ;; Send buffer into remote decoding command which
+ ;; writes to remote file. Because this happens on
+ ;; the remote host, we cannot use the function.
+ (with-tramp-progress-reporter
+ v 3 (format-message
+ "Decoding remote file `%s' using `%s'"
+ filename rem-dec)
+ (goto-char (point-max))
+ (unless (bolp) (newline))
+ (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)
+ "Couldn't write region to `%s', decode using `%s' failed"
+ filename rem-dec)
+ ;; When `file-precious-flag' is set, the region
+ ;; is written to a temporary file. Check that
+ ;; the checksum is equal to that from the local
+ ;; tmpfile.
+ (when file-precious-flag
+ (erase-buffer)
+ (and
+ ;; cksum runs locally, if possible.
+ (zerop (tramp-call-process v "cksum" tmpfile t))
+ ;; cksum runs remotely.
+ (tramp-send-command-and-check
+ v (format
+ "cksum <%s" (tramp-shell-quote-argument localname)))
+ ;; ... they are different.
+ (not
+ (string-equal
+ (buffer-string)
+ (tramp-get-buffer-string (tramp-get-buffer v))))
+ (tramp-error
+ v 'file-error
+ (concat "Couldn't write region to `%s',"
+ " decode using `%s' failed")
+ filename rem-dec)))))
+
+ ;; Save exit.
+ (delete-file tmpfile)))
- ;; Make `last-coding-system-used' have the right value.
- (when coding-system-used
- (setq last-coding-system-used coding-system-used))))))
+ ;; That's not expected.
+ (t
+ (tramp-error
+ v 'file-error
+ (concat "Method `%s' should specify both encoding and "
+ "decoding command or an scp program")
+ method))))
+
+ ;; Make `last-coding-system-used' have the right value.
+ (when coding-system-used
+ (setq last-coding-system-used coding-system-used)))))))
(defvar tramp-vc-registered-file-names nil
"List used to collect file names, which are checked during `vc-registered'.")
"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))))))
+ (with-tramp-saved-connection-properties
+ v '("process-name" "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))))
localname
(tramp-run-real-handler #'expand-file-name (list localname)))))))
+(defun tramp-smb-remote-acl-p (_vec)
+ "Check, whether ACL is enabled on the remote host."
+ (and (stringp tramp-smb-acl-program) (executable-find tramp-smb-acl-program)))
+
(defun tramp-smb-action-get-acl (proc vec)
"Read ACL data from connection buffer."
(unless (process-live-p proc)
(ignore-errors
(with-parsed-tramp-file-name filename nil
(with-tramp-file-property v localname "file-acl"
- (when (executable-find tramp-smb-acl-program)
+ (when (tramp-smb-remote-acl-p v)
(let* ((share (tramp-smb-get-share v))
(localname (tramp-compat-string-replace
"\\" "/" (tramp-smb-get-localname v)))
(concat "2>" (tramp-get-remote-null-device v)))))
(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))
-
- ;; Use an asynchronous process. By this,
- ;; password can be handled.
- (let ((p (apply
- #'start-process
- (tramp-get-connection-name v)
- (tramp-get-connection-buffer v)
- tramp-smb-acl-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-get-acl)
- (when (> (point-max) (point-min))
- (substring-no-properties (buffer-string))))))))))))))
+ (with-tramp-saved-connection-properties
+ v '("process-name" "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))
+
+ ;; Use an asynchronous process. By this, password
+ ;; can be handled.
+ (let ((p (apply
+ #'start-process
+ (tramp-get-connection-name v)
+ (tramp-get-connection-buffer v)
+ tramp-smb-acl-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-get-acl)
+ (when (> (point-max) (point-min))
+ (substring-no-properties (buffer-string)))))))))))))
(defun tramp-smb-handle-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files."
;; Call it.
(condition-case nil
- (with-tramp-saved-connection-property v "process-name"
- (with-tramp-saved-connection-property v "process-buffer"
- ;; Set the new process properties.
- (tramp-set-connection-property v "process-name" name1)
- (tramp-set-connection-property
- v "process-buffer"
- (or outbuf (generate-new-buffer tramp-temp-buffer-name)))
- (with-current-buffer (tramp-get-connection-buffer v)
- ;; Preserve buffer contents.
- (narrow-to-region (point-max) (point-max))
- (tramp-smb-call-winexe v)
- (when (tramp-smb-get-share v)
- (tramp-smb-send-command
- v (format "cd //%s%s" host
- (tramp-smb-shell-quote-argument
- (file-name-directory localname)))))
- (tramp-smb-send-command v command)
- ;; Preserve command output.
- (narrow-to-region (point-max) (point-max))
- (let ((p (tramp-get-connection-process v)))
- (tramp-smb-send-command v "exit $lasterrorcode")
- (while (process-live-p p)
- (sleep-for 0.1)
- (setq ret (process-exit-status p))))
- (delete-region (point-min) (point-max))
- (widen))))
+ (with-tramp-saved-connection-properties
+ v '("process-name" "process-buffer")
+ ;; Set the new process properties.
+ (tramp-set-connection-property v "process-name" name1)
+ (tramp-set-connection-property
+ v "process-buffer"
+ (or outbuf (generate-new-buffer tramp-temp-buffer-name)))
+ (with-current-buffer (tramp-get-connection-buffer v)
+ ;; Preserve buffer contents.
+ (narrow-to-region (point-max) (point-max))
+ (tramp-smb-call-winexe v)
+ (when (tramp-smb-get-share v)
+ (tramp-smb-send-command
+ v (format "cd //%s%s" host
+ (tramp-smb-shell-quote-argument
+ (file-name-directory localname)))))
+ (tramp-smb-send-command v command)
+ ;; Preserve command output.
+ (narrow-to-region (point-max) (point-max))
+ (let ((p (tramp-get-connection-process v)))
+ (tramp-smb-send-command v "exit $lasterrorcode")
+ (while (process-live-p p)
+ (sleep-for 0.1)
+ (setq ret (process-exit-status p))))
+ (delete-region (point-min) (point-max))
+ (widen)))
;; When the user did interrupt, we should do it also. We use
;; return code -1 as marker.
(unless outbuf
(kill-buffer (tramp-get-connection-property v "process-buffer")))
(when process-file-side-effects
- (tramp-flush-directory-properties v ""))
+ (tramp-flush-directory-properties v "/"))
;; Return exit status.
(if (equal ret -1)
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-property v localname "file-acl")
- (when (and (stringp acl-string) (executable-find tramp-smb-acl-program))
+ (when (and (stringp acl-string) (tramp-smb-remote-acl-p v))
(let* ((share (tramp-smb-get-share v))
(localname (tramp-compat-string-replace
"\\" "/" (tramp-smb-get-localname v)))
"||" "echo" "tramp_exit_status" "1")))
(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))
-
- ;; Use an asynchronous process. By this, password
- ;; can be handled.
- (let ((p (apply
- #'start-process
- (tramp-get-connection-name v)
- (tramp-get-connection-buffer v)
- tramp-smb-acl-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-set-acl)
- ;; This is meant for traces, and returning from
- ;; the function. No error is propagated
- ;; outside, due to the `ignore-errors' closure.
- (unless
- (tramp-search-regexp "tramp_exit_status [[:digit:]]+")
- (tramp-error
- v 'file-error
- "Couldn't find exit status of `%s'"
- tramp-smb-acl-program))
- (skip-chars-forward "^ ")
- (when (zerop (read (current-buffer)))
- ;; Success.
- (tramp-set-file-property
- v localname "file-acl" acl-string)
- t)))))))))))
+ (with-tramp-saved-connection-properties
+ v '("process-name" "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))
+
+ ;; Use an asynchronous process. By this, password
+ ;; can be handled.
+ (let ((p (apply
+ #'start-process
+ (tramp-get-connection-name v)
+ (tramp-get-connection-buffer v)
+ tramp-smb-acl-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-set-acl)
+ ;; This is meant for traces, and returning from
+ ;; the function. No error is propagated outside,
+ ;; due to the `ignore-errors' closure.
+ (unless
+ (tramp-search-regexp "tramp_exit_status [[:digit:]]+")
+ (tramp-error
+ v 'file-error
+ "Couldn't find exit status of `%s'"
+ tramp-smb-acl-program))
+ (skip-chars-forward "^ ")
+ (when (zerop (read (current-buffer)))
+ ;; Success.
+ (tramp-set-file-property v localname "file-acl" acl-string)
+ t))))))))))
(defun tramp-smb-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- ;; smbclient chmod does not support nofollow.
- (unless (and (eq flag 'nofollow) (file-symlink-p filename))
+ ;; smbclient chmod does not support nofollow.
+ (unless (and (eq flag 'nofollow) (file-symlink-p filename))
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
(when (tramp-smb-get-cifs-capabilities v)
- (tramp-flush-file-properties v localname)
(unless (tramp-smb-send-command
v
(format "chmod %s %o" (tramp-smb-shell-quote-localname v) mode))
(i 0)
p)
(unwind-protect
- (with-tramp-saved-connection-property v "process-name"
- (with-tramp-saved-connection-property v "process-buffer"
- (save-excursion
- (save-restriction
- (while (get-process name1)
- ;; NAME must be unique as process name.
- (setq i (1+ i)
- name1 (format "%s<%d>" name i)))
- ;; Set the new process properties.
- (tramp-set-connection-property v "process-name" name1)
- (tramp-set-connection-property v "process-buffer" buffer)
- ;; Activate narrowing in order to save BUFFER contents.
- (with-current-buffer (tramp-get-connection-buffer v)
- (let ((buffer-undo-list t))
- (narrow-to-region (point-max) (point-max))
- (tramp-smb-call-winexe v)
- (when (tramp-smb-get-share v)
- (tramp-smb-send-command
- v (format
- "cd //%s%s"
- host
- (tramp-smb-shell-quote-argument
- (file-name-directory localname)))))
- (tramp-message v 6 "(%s); exit" command)
- (tramp-send-string v command)))
- (setq p (tramp-get-connection-process v))
- (when program
- (process-put p 'remote-command (cons program args))
- (tramp-set-connection-property
- p "remote-command" (cons program args)))
- ;; Return value.
- p))))
+ (with-tramp-saved-connection-properties
+ v '("process-name" "process-buffer")
+ (save-excursion
+ (save-restriction
+ (while (get-process name1)
+ ;; NAME must be unique as process name.
+ (setq i (1+ i)
+ name1 (format "%s<%d>" name i)))
+ ;; Set the new process properties.
+ (tramp-set-connection-property v "process-name" name1)
+ (tramp-set-connection-property v "process-buffer" buffer)
+ ;; Activate narrowing in order to save BUFFER contents.
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (let ((buffer-undo-list t))
+ (narrow-to-region (point-max) (point-max))
+ (tramp-smb-call-winexe v)
+ (when (tramp-smb-get-share v)
+ (tramp-smb-send-command
+ v (format
+ "cd //%s%s"
+ host
+ (tramp-smb-shell-quote-argument
+ (file-name-directory localname)))))
+ (tramp-message v 6 "(%s); exit" command)
+ (tramp-send-string v command)))
+ (setq p (tramp-get-connection-process v))
+ (when program
+ (process-put p 'remote-command (cons program args))
+ (tramp-set-connection-property
+ p "remote-command" (cons program args)))
+ ;; Return value.
+ p)))
;; Save exit.
;; FIXME: Does `tramp-get-connection-buffer' return the proper value?
tramp-smb-version
(tramp-get-connection-property
vec "smbclient-version" tramp-smb-version))
- (tramp-flush-directory-properties vec "")
+ (tramp-flush-directory-properties vec "/")
(tramp-flush-connection-properties vec))
(tramp-set-connection-property
;; them.
(when tmpinput (delete-file tmpinput))
(when process-file-side-effects
- (tramp-flush-directory-properties v ""))))))
+ (tramp-flush-directory-properties v "/"))))))
(defun tramp-sshfs-handle-rename-file
(filename newname &optional ok-if-already-exists)
(defun tramp-sshfs-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (unless (and (eq flag 'nofollow) (file-symlink-p filename))
- (tramp-flush-file-properties v localname)
+ (unless (and (eq flag 'nofollow) (file-symlink-p filename))
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
(tramp-compat-set-file-modes
(tramp-fuse-local-file-name filename) mode flag))))
(defun tramp-sshfs-handle-set-file-times (filename &optional timestamp flag)
"Like `set-file-times' for Tramp files."
- (or (file-exists-p filename) (write-region "" nil filename nil 0))
- (with-parsed-tramp-file-name filename nil
- (unless (and (eq flag 'nofollow) (file-symlink-p filename))
- (tramp-flush-file-properties v localname)
+ (unless (and (eq flag 'nofollow) (file-symlink-p filename))
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
(tramp-compat-set-file-times
(tramp-fuse-local-file-name filename) timestamp flag))))
(defun tramp-sudoedit-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- ;; It is unlikely that "chmod -h" works.
- (unless (and (eq flag 'nofollow) (file-symlink-p filename))
- (tramp-flush-file-properties v localname)
+ ;; It is unlikely that "chmod -h" works.
+ (unless (and (eq flag 'nofollow) (file-symlink-p filename))
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
(unless (tramp-sudoedit-send-command
v "chmod" (format "%o" mode)
(tramp-compat-file-name-unquote localname))
(defun tramp-sudoedit-handle-set-file-times (filename &optional time flag)
"Like `set-file-times' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (tramp-flush-file-properties v localname)
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
(let ((time
(if (or (null time)
(tramp-compat-time-equal-p time tramp-time-doesnt-exist)
(defun tramp-sudoedit-handle-set-file-uid-gid (filename &optional uid gid)
"Like `tramp-set-file-uid-gid' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (tramp-sudoedit-send-command
- v "chown"
- (format "%d:%d"
- (or uid (tramp-get-remote-uid v 'integer))
- (or gid (tramp-get-remote-gid v 'integer)))
- (tramp-unquote-file-local-name filename))))
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
+ (tramp-sudoedit-send-command
+ v "chown"
+ (format "%d:%d"
+ (or uid (tramp-get-remote-uid v 'integer))
+ (or gid (tramp-get-remote-gid v 'integer)))
+ (tramp-unquote-file-local-name filename))))
\f
;; Internal functions.
(require 'cl-lib)
(declare-function file-notify-rm-watch "filenotify")
(declare-function netrc-parse "netrc")
-(declare-function tramp-archive-file-name-handler "tramp-archive")
(defvar auto-save-file-name-transforms)
;; Reload `tramp-compat' when we reload `tramp-autoloads' of the GNU ELPA package.
If it is set to nil, all remote file names are used literally."
:type 'boolean)
+;;;###tramp-autoload
(defcustom tramp-verbose 3
"Verbosity level for Tramp messages.
Any level x includes messages for all levels 1 .. x-1. The levels are
;; work otherwise when unloading / reloading Tramp. (Bug#50869)
;;;###tramp-autoload(require 'cl-lib)
;;;###tramp-autoload
-(cl-defstruct (tramp-file-name (:type list) :named)
- method user domain host port localname hop)
+(progn
+ (cl-defstruct (tramp-file-name (:type list) :named)
+ method user domain host port localname hop))
(put #'tramp-file-name-method 'tramp-suppress-trace t)
(put #'tramp-file-name-user 'tramp-suppress-trace t)
(put #'tramp-file-name-port-or-default 'tramp-suppress-trace t)
-(defun tramp-file-name-unify (vec)
+;;;###tramp-autoload
+(defun tramp-file-name-unify (vec &optional file)
"Unify VEC by removing localname and hop from `tramp-file-name' structure.
+If FILE is a string, set it as localname.
Objects returned by this function compare `equal' if they refer to the
same connection. Make a copy in order to avoid side effects."
(when (tramp-file-name-p vec)
(setq vec (copy-tramp-file-name vec))
- (setf (tramp-file-name-localname vec) nil
+ (setf (tramp-file-name-localname vec)
+ (and (stringp file)
+ ;; FIXME: This is a sanity check. When this error
+ ;; doesn't happen for a while, it can be removed.
+ (or (file-name-absolute-p file)
+ (tramp-error
+ vec 'file-error "File `%s' must be absolute" file))
+ (directory-file-name (tramp-compat-file-name-unquote file)))
(tramp-file-name-hop vec) nil))
vec)
"Return unquoted localname component of VEC."
(tramp-compat-file-name-unquote (tramp-file-name-localname vec)))
+;;;###tramp-autoload
(defun tramp-tramp-file-p (name)
"Return t if NAME is a string with Tramp file name syntax."
(and tramp-mode (stringp name)
;; However, it is more performant than `file-local-name', and might be
;; useful where performance matters, like in operations over a bulk
;; list of file names.
+;;;###tramp-autoload
(defun tramp-file-local-name (name)
"Return the local name component of NAME.
This function removes from NAME the specification of the remote
(put #'tramp-find-host 'tramp-suppress-trace t)
+;;;###tramp-autoload
(defun tramp-dissect-file-name (name &optional nodefault)
"Return a `tramp-file-name' structure of NAME, a remote file name.
The structure consists of method, user, domain, host, port,
(put #'tramp-buffer-name 'tramp-suppress-trace t)
+;;;###tramp-autoload
(defun tramp-make-tramp-file-name (&rest args)
"Construct a Tramp file name from ARGS.
(tramp-make-tramp-file-name vec 'noloc))
(current-buffer)))))
+;;;###tramp-autoload
(defun tramp-get-connection-buffer (vec &optional dont-create)
"Get the connection buffer to be used for VEC.
Unless DONT-CREATE, the buffer is created when it doesn't exist yet.
"Return `default-directory' of BUFFER."
(buffer-local-value 'default-directory buffer))
-(put #'tramp-get-default-directory 'tramp-suppress-trace t)
-
+;;;###tramp-autoload
(defsubst tramp-get-buffer-string (&optional buffer)
"Return contents of BUFFER.
If BUFFER is not a buffer or a buffer name, return the contents
(with-current-buffer (or buffer (current-buffer))
(substring-no-properties (buffer-string))))
-(put #'tramp-get-buffer-string 'tramp-suppress-trace t)
-
(defun tramp-debug-buffer-name (vec)
"A name for the debug buffer for VEC."
(let ((method (tramp-file-name-method vec))
(defvar tramp-trace-functions nil
"A list of non-Tramp functions to be traced with `tramp-verbose' > 10.")
+;;;###tramp-autoload
(defun tramp-debug-message (vec fmt-string &rest arguments)
"Append message to debug buffer of VEC.
Message is formatted with FMT-STRING as control string and the remaining
(put #'tramp-debug-message 'tramp-suppress-trace t)
+;;;###tramp-autoload
(defvar tramp-inhibit-progress-reporter nil
"Show Tramp progress reporter in the minibuffer.
This variable is used to disable concurrent progress reporter messages.")
+;;;###tramp-autoload
(defsubst tramp-message (vec-or-proc level fmt-string &rest arguments)
"Emit a message depending on verbosity level.
VEC-OR-PROC identifies the Tramp buffer to use. It can be either a
(concat (format "(%d) # " level) fmt-string)
arguments))))))
-(put #'tramp-message 'tramp-suppress-trace t)
-
(defsubst tramp-backtrace (&optional vec-or-proc force)
"Dump a backtrace into the debug buffer.
If VEC-OR-PROC is nil, the buffer *debug tramp* is used. FORCE
vec-or-proc 10 "\n%s" (with-output-to-string (backtrace)))
(with-output-to-temp-buffer "*debug tramp*" (backtrace))))))
-(put #'tramp-backtrace 'tramp-suppress-trace t)
-
(defun tramp-error (vec-or-proc signal fmt-string &rest arguments)
"Emit an error.
VEC-OR-PROC identifies the connection to use, SIGNAL is the
(when (tramp-file-name-equal-p vec (car tramp-current-connection))
(setcdr tramp-current-connection (current-time)))))))
-(put #'tramp-error-with-buffer 'tramp-suppress-trace t)
-
;; We must make it a defun, because it is used earlier already.
(defun tramp-user-error (vec-or-proc fmt-string &rest arguments)
"Signal a user error (or \"pilot error\")."
(progn ,@body)
(error (tramp-message ,vec-or-proc 3 ,format ,err) nil))))
-(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.
(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
(if tm (cancel-timer tm))
(tramp-message ,vec ,level "%s...%s" ,message cookie)))))
-(defmacro with-tramp-file-property (vec file property &rest body)
- "Check in Tramp cache for PROPERTY, otherwise execute BODY and set cache.
-FILE must be a local file name on a connection identified via VEC."
- (declare (indent 3) (debug t))
- `(if (file-name-absolute-p ,file)
- (let ((value (tramp-get-file-property
- ,vec ,file ,property tramp-cache-undefined)))
- (when (eq value tramp-cache-undefined)
- ;; We cannot pass @body as parameter to
- ;; `tramp-set-file-property' because it mangles our debug
- ;; messages.
- (setq value (progn ,@body))
- (tramp-set-file-property ,vec ,file ,property value))
- value)
- ,@body))
-
-(defmacro with-tramp-connection-property (key property &rest body)
- "Check in Tramp for property PROPERTY, otherwise execute BODY and set."
- (declare (indent 2) (debug t))
- `(let ((value (tramp-get-connection-property
- ,key ,property tramp-cache-undefined)))
- (when (eq value tramp-cache-undefined)
- ;; We cannot pass ,@body as parameter to
- ;; `tramp-set-connection-property' because it mangles our debug
- ;; messages.
- (setq value (progn ,@body))
- (tramp-set-connection-property ,key ,property value))
- value))
-
-(defmacro with-tramp-saved-connection-property (key property &rest body)
- "Save PROPERTY, run BODY, reset PROPERTY."
- (declare (indent 2) (debug t))
- `(let ((value (tramp-get-connection-property
- ,key ,property tramp-cache-undefined)))
- (unwind-protect (progn ,@body)
- (if (eq value tramp-cache-undefined)
- (tramp-flush-connection-property ,key ,property)
- (tramp-set-connection-property ,key ,property value)))))
-
(defun tramp-drop-volume-letter (name)
"Cut off unnecessary drive letter from file NAME.
The functions `tramp-*-handle-expand-file-name' call `expand-file-name'
(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."
,@body)
(tramp-flush-directory-properties v localname)))
-(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'.
(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'.
(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
(cons
(car x)
(tramp-convert-file-attributes
- v (car x) ,id-format (cdr x))))
+ v (expand-file-name (car x) localname)
+ ,id-format (cdr x))))
(with-tramp-file-property
- v localname ",directory-files-and-attributes"
+ v localname "directory-files-and-attributes"
,@body))))
result item)
(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'.
+ "Skeleton for `tramp-*-handle-file-local-copy'.
BODY is the backend specific code."
(declare (indent 1) (debug t))
`(with-parsed-tramp-file-name (file-truename ,filename) nil
;; Trigger the `file-missing' error.
(signal 'error nil)))))
-(put #'tramp-skeleton-file-local-copy 'tramp-suppress-trace t)
+(defmacro tramp-skeleton-set-file-modes-times-uid-gid
+ (filename &rest body)
+ "Skeleton for `tramp-*-set-file-{modes,times,uid-gid}'.
+BODY is the backend specific code."
+ (declare (indent 1) (debug t))
+ `(with-parsed-tramp-file-name ,filename nil
+ (when (not (file-exists-p ,filename))
+ (tramp-error v 'file-missing ,filename))
+ (with-tramp-saved-file-properties
+ v localname
+ ;; We cannot add "file-attributes", "file-executable-p",
+ ;; "file-ownership-preserved-p", "file-readable-p",
+ ;; "file-writable-p".
+ '("file-directory-p" "file-exists-p" "file-symlinkp" "file-truename")
+ (tramp-flush-file-properties v localname))
+ ,@body))
(defmacro tramp-skeleton-write-region
(start end filename append visit lockname mustbenew &rest body)
;; We must also flush the cache of the directory, because
;; `file-attributes' reads the values from there.
(tramp-flush-file-properties v localname)
+ ;; Set the "file-exists-p" file property, because it is
+ ;; likely that it is needed shortly after `write-region'.
+ (tramp-set-file-property v localname "file-exists-p" t)
;; We must protect `last-coding-system-used', now we have
;; set it to its correct value.
(tramp-message v 0 "Wrote %s" filename))
(run-hooks 'tramp-handle-write-region-hook))))))
-(put #'tramp-skeleton-write-region 'tramp-suppress-trace t)
-
;;; Common file name handler functions for different backends:
(defvar tramp-handle-file-local-copy-hook nil
;; We don't want to run it when `non-essential' is t, or there is
;; no connection process yet.
(when (tramp-connectable-p filename)
- (not (null (file-attributes filename)))))
+ (with-parsed-tramp-file-name filename nil
+ (with-tramp-file-property v localname "file-exists-p"
+ (not (null (file-attributes filename)))))))
(defun tramp-handle-file-in-directory-p (filename directory)
"Like `file-in-directory-p' for Tramp files."
(when vec
(tramp-message vec 5 "Sentinel called: `%S' `%s'" proc event)
(tramp-flush-connection-properties proc)
- (tramp-flush-directory-properties vec ""))
+ (tramp-flush-directory-properties vec "/"))
(when (buffer-live-p buf)
(with-current-buffer buf
(when (and prompt (tramp-search-regexp (regexp-quote prompt)))
(let (create-lockfiles)
(cl-letf (((symbol-function 'tramp-remote-acl-p) #'ignore)
((symbol-function 'tramp-remote-selinux-p) #'ignore)
+ ((symbol-function 'tramp-smb-remote-acl-p) #'ignore)
((symbol-function 'tramp-sudoedit-remote-acl-p) #'ignore)
((symbol-function 'tramp-sudoedit-remote-selinux-p) #'ignore))
(tramp-file-local-name
(insert-file-contents tmp-name)
(should (string-equal (buffer-string) "foo")))
+ ;; Write empty string. Used for creation of temprorary files.
+ ;; Since Emacs 27.1.
+ (when (fboundp 'make-empty-file)
+ (with-no-warnings
+ (should-error
+ (make-empty-file tmp-name)
+ :type 'file-already-exists)
+ (delete-file tmp-name)
+ (make-empty-file tmp-name)
+ (with-temp-buffer
+ (insert-file-contents tmp-name)
+ (should (string-equal (buffer-string) "")))))
+
;; Write partly.
(with-temp-buffer
(insert "123456789")
(when (tramp--test-emacs28-p)
(with-no-warnings
(set-file-modes tmp-name1 #o222 'nofollow)
- (should (= (file-modes tmp-name1 'nofollow) #o222)))))
+ (should (= (file-modes tmp-name1 'nofollow) #o222))))
+ ;; Setting the mode for not existing files shall fail.
+ (should-error
+ (set-file-modes tmp-name2 #o777)
+ :type 'file-missing))
;; Cleanup.
(ignore-errors (delete-file tmp-name1)))
(tramp-compat-time-equal-p
(file-attribute-modification-time (file-attributes tmp-name1))
(seconds-to-time 1)))
+ ;; Setting the time for not existing files shall fail.
+ (should-error
+ (set-file-times tmp-name2)
+ :type 'file-missing)
(write-region "bla" nil tmp-name2)
(should (file-exists-p tmp-name2))
(should (file-newer-than-file-p tmp-name2 tmp-name1))
projects / emacs.git / commitdiff