From 21afc26d4df6bae35ba032d4b6b03fb7fb2bf1b3 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 3 Aug 2022 17:30:09 +0200 Subject: [PATCH] Reorganize Tramp * lisp/net/tramp-adb.el (tramp-adb-handle-write-region): Handle special case that START is "". (tramp-adb-handle-set-file-modes) (tramp-adb-handle-set-file-times): Use `tramp-skeleton-set-file-modes-times-uid-gid'. (tramp-adb-handle-make-process): Use `with-tramp-saved-connection-properties'. * lisp/net/tramp-archive.el (tramp-archive-file-name-handler-alist): Use `tramp-archive-handle-file-exists-p'. (tramp-archive-handle-file-exists-p): New defun. (tramp-archive-file-name-handler): Add ;;;###tramp-autoload cookie. * lisp/net/tramp-cache.el (tramp-compat, tramp-loaddefs) (time-stamp): Require. (tramp-get-file-property, tramp-set-file-property) (tramp-flush-file-property, tramp-flush-file-upper-properties) (tramp-flush-file-properties): Use `tramp-file-name-unify'. Adapt message. (tramp-flush-directory-properties): Simplify. (tramp-flush-file-function): Add ;;;###tramp-autoload cookie. Don't use `with-parsed-tramp-file-name', it isn't exposed. (with-tramp-file-property, with-tramp-connection-property) (with-tramp-saved-connection-property): Macros moved from tramp.el. (with-tramp-saved-file-property) (with-tramp-saved-file-properties) (with-tramp-saved-connection-properties): New defmacros. * lisp/net/tramp-cmds.el (tramp-cleanup-connection): Flush "/". * lisp/net/tramp-crypt.el (tramp-crypt-handle-set-file-modes) (tramp-crypt-handle-set-file-times) (tramp-crypt-handle-set-file-uid-gid): Use `tramp-skeleton-set-file-modes-times-uid-gid'. * lisp/net/tramp-ftp.el (tramp-archive-file-name-handler): Don't declare. * lisp/net/tramp-gvfs.el (tramp-gvfs-info): New defun. (tramp-gvfs-do-copy-or-rename-file) (tramp-gvfs-handle-delete-directory) (tramp-gvfs-handle-delete-file, tramp-gvfs-get-root-attributes) (tramp-gvfs-handle-make-directory): Use it. (tramp-gvfs-handle-set-file-modes) (tramp-gvfs-handle-set-file-times) (tramp-gvfs-handle-set-file-uid-gid): Use `tramp-skeleton-set-file-modes-times-uid-gid'. * lisp/net/tramp-sh.el (tramp-sh-handle-make-symbolic-link): Expand TARGET when flushing file properties. (tramp-sh-handle-set-file-modes, tramp-sh-handle-set-file-times) (tramp-sh-handle-set-file-uid-gid): Use `tramp-skeleton-set-file-modes-times-uid-gid'. (tramp-sh-handle-file-name-all-completions): Protect, when connection is not established yet. (tramp-do-copy-or-rename-file-directly): Flush file properties of NEWNAME when constructing a new remote file name. (tramp-do-copy-or-rename-file-out-of-band, tramp-sh-handle-make-process): Use `with-tramp-saved-connection-properties'. (tramp-sh-handle-delete-file): Flush file properties only after deleting, otherwise we get a false alarm. (tramp-sh-handle-process-file): Flush "/". (tramp-sh-handle-write-region): Handle special case that START is "". * lisp/net/tramp-smb.el (tramp-smb-handle-copy-directory) (tramp-smb-handle-file-acl, tramp-smb-handle-process-file) (tramp-smb-handle-set-file-acl) (tramp-smb-handle-start-file-process): Use `with-tramp-saved-connection-properties'. (tramp-smb-remote-acl-p): New defun. (tramp-smb-handle-file-acl, tramp-smb-handle-set-file-acl): Use it. (tramp-smb-handle-set-file-modes): Use `tramp-skeleton-set-file-modes-times-uid-gid'. (tramp-smb-handle-process-file, tramp-smb-maybe-open-connection): Flush "/". * lisp/net/tramp-sshfs.el (tramp-sshfs-handle-process-file): Flush "/". (tramp-sshfs-handle-set-file-modes) (tramp-sshfs-handle-set-file-times): Use `tramp-skeleton-set-file-modes-times-uid-gid'. * lisp/net/tramp-sudoedit.el (tramp-sudoedit-handle-set-file-modes) (tramp-sudoedit-handle-set-file-times) (tramp-sudoedit-handle-set-file-uid-gid): Use `tramp-skeleton-set-file-modes-times-uid-gid'. * lisp/net/tramp.el (tramp-archive-file-name-handler): Don't declare. (tramp-verbose, tramp-file-name-unify, tramp-tramp-file-p) (tramp-file-local-name, tramp-dissect-file-name) (tramp-make-tramp-file-name, tramp-get-connection-buffer) (tramp-get-buffer-string, tramp-debug-message) (tramp-inhibit-progress-reporter, tramp-message): Add ;;;###tramp-autoload cookie. (tramp-file-name): Expose defstruct to tramp-loaddefs.el (tramp-file-name-unify): New optional arg FILE. (tramp-get-default-directory, tramp-get-buffer-string) (tramp-message, tramp-backtrace, tramp-error-with-buffer) (tramp-with-demoted-errors, tramp-barf-if-file-missing) (tramp-skeleton-copy-directory, tramp-skeleton-delete-directory) (tramp-skeleton-directory-files) (tramp-skeleton-directory-files-and-attributes) (tramp-skeleton-file-local-copy, tramp-skeleton-write-region): Remove `tramp-suppress-trace' property, it isn't needed for defmacros and defsubsts. (with-tramp-file-property, with-tramp-connection-property) (with-tramp-saved-connection-property): Move macros to tramp-cache.el. (tramp-skeleton-directory-files-and-attributes): Fix implementation. (tramp-skeleton-file-local-copy): Fix docstring. (tramp-skeleton-set-file-modes-times-uid-gid): New defmacro. (tramp-skeleton-write-region): Set "file-exists-p" cache property. (tramp-handle-file-exists-p): Use cached value. (tramp-process-sentinel): Flush "/". (tramp-make-tramp-temp-file): Suppress also `tramp-smb-remote-acl-p'. (tramp-get-connection-buffer): * test/lisp/net/tramp-tests.el (tramp-test10-write-region) (tramp-test20-file-modes, tramp-test22-file-times): Extend tests. --- lisp/net/tramp-adb.el | 236 ++++++------ lisp/net/tramp-archive.el | 12 +- lisp/net/tramp-cache.el | 164 ++++++-- lisp/net/tramp-cmds.el | 2 +- lisp/net/tramp-crypt.el | 9 +- lisp/net/tramp-ftp.el | 1 - lisp/net/tramp-gvfs.el | 47 +-- lisp/net/tramp-sh.el | 701 ++++++++++++++++++----------------- lisp/net/tramp-smb.el | 346 ++++++++--------- lisp/net/tramp-sshfs.el | 13 +- lisp/net/tramp-sudoedit.el | 24 +- lisp/net/tramp.el | 127 +++---- test/lisp/net/tramp-tests.el | 23 +- 13 files changed, 905 insertions(+), 800 deletions(-) diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 3e780aa1a18..1d35f2b2ff7 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -517,34 +517,39 @@ Emacs dired can't find files." (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)) @@ -827,7 +832,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; 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) @@ -923,102 +928,99 @@ implementation will be used." 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." diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index b2244941102..fda1441615e 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -240,7 +240,7 @@ It must be supported by libarchive(3).") (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) @@ -322,7 +322,11 @@ arguments to pass to the OPERATION." (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 @@ -645,6 +649,10 @@ offered." "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))) diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index 68f4fda4756..289df2f9aad 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -48,7 +48,7 @@ ;; - 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 @@ -75,8 +75,9 @@ ;;; Code: -(require 'tramp) -(autoload 'time-stamp-string "time-stamp") +(require 'tramp-compat) +(require 'tramp-loaddefs) +(require 'time-stamp) ;;; -- Cache -- @@ -133,11 +134,7 @@ If KEY is `tramp-cache-undefined', don't create anything, and return nil." "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)))) @@ -161,7 +158,8 @@ Return DEFAULT if not set." (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))) @@ -181,15 +179,12 @@ Return DEFAULT if not set." "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))) @@ -214,13 +209,9 @@ Return VALUE." (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)))) @@ -232,10 +223,7 @@ Return VALUE." (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\\)" @@ -245,14 +233,10 @@ Return VALUE." ;;;###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) @@ -265,9 +249,8 @@ Return VALUE." (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)) @@ -288,6 +271,7 @@ Remove also properties of all files in subdirectories." ;; 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." @@ -299,8 +283,8 @@ 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) @@ -314,6 +298,61 @@ This is suppressed for temporary buffers." (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 @@ -396,6 +435,57 @@ used to cache connection properties of the local machine." (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." diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el index 5c8012e553b..f7704864ec6 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el @@ -139,7 +139,7 @@ When called interactively, a Tramp connection has to be selected." (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) diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index 4fcd132ab0a..7f385292626 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el @@ -824,24 +824,21 @@ WILDCARD is not supported." (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)))) diff --git a/lisp/net/tramp-ftp.el b/lisp/net/tramp-ftp.el index d4bbb944793..dd7e0f9f342 100644 --- a/lisp/net/tramp-ftp.el +++ b/lisp/net/tramp-ftp.el @@ -31,7 +31,6 @@ (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) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 2f97b2cb916..0b40ff867f2 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -960,6 +960,15 @@ The global value will always be nil; it is bound where needed.") ;; 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) @@ -1046,12 +1055,9 @@ file names." ;; 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 @@ -1111,8 +1117,9 @@ file names." (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)) @@ -1125,8 +1132,9 @@ file names." (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)) @@ -1239,10 +1247,8 @@ If FILE-SYSTEM is non-nil, return file system attributes." (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)) @@ -1547,8 +1553,10 @@ If FILE-SYSTEM is non-nil, return file system attributes." (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)) @@ -1582,16 +1590,14 @@ If FILE-SYSTEM is non-nil, return file system attributes." (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" @@ -1644,8 +1650,7 @@ ID-FORMAT valid values are `string' and `integer'." (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" diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 172933859c1..d88e388cd56 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1113,7 +1113,8 @@ component is used as the target of the symlink." (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) @@ -1465,12 +1466,11 @@ of." (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 @@ -1482,9 +1482,8 @@ of." (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) @@ -1543,9 +1542,9 @@ ID-FORMAT valid values are `string' and `integer'." ;; 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) @@ -1767,10 +1766,11 @@ ID-FORMAT valid values are `string' and `integer'." ;; 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 @@ -2197,6 +2197,8 @@ the uid and gid from FILENAME." (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) @@ -2406,52 +2408,52 @@ The method used must be an out-of-band method." (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 @@ -2510,12 +2512,12 @@ The method used must be an out-of-band method." "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. @@ -2966,102 +2968,102 @@ implementation will be used." 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." @@ -3242,7 +3244,7 @@ implementation will be used." ;; 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) @@ -3334,194 +3336,201 @@ implementation will be used." (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'.") diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 29abdb575d3..a81a8f13636 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -523,49 +523,49 @@ arguments to pass to the OPERATION." "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)))) @@ -751,6 +751,10 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." 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) @@ -774,7 +778,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (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))) @@ -799,31 +803,31 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (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." @@ -1311,32 +1315,32 @@ component is used as the target of the symlink." ;; 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. @@ -1356,7 +1360,7 @@ component is used as the target of the symlink." (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) @@ -1427,7 +1431,7 @@ component is used as the target of the symlink." (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))) @@ -1455,52 +1459,50 @@ component is used as the target of the symlink." "||" "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)) @@ -1524,38 +1526,38 @@ component is used as the target of the symlink." (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? @@ -1933,7 +1935,7 @@ If ARGUMENT is non-nil, use it as argument for 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 diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el index d7c918fbc83..a9225db434e 100644 --- a/lisp/net/tramp-sshfs.el +++ b/lisp/net/tramp-sshfs.el @@ -333,7 +333,7 @@ arguments to pass to the OPERATION." ;; 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) @@ -355,18 +355,15 @@ arguments to pass to the OPERATION." (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)))) diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index 5ec68e904e7..3564a1b7b44 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -484,10 +484,9 @@ the result will be a local, non-Tramp, file name." (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)) @@ -542,8 +541,7 @@ the result will be a local, non-Tramp, file name." (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) @@ -730,13 +728,13 @@ ID-FORMAT valid values are `string' and `integer'." (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)))) ;; Internal functions. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 0afa6fc4312..aac63882ced 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -62,7 +62,6 @@ (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. @@ -97,6 +96,7 @@ 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 @@ -1441,8 +1441,9 @@ calling HANDLER.") ;; 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) @@ -1485,13 +1486,22 @@ If nil, return `tramp-default-port'." (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) @@ -1525,6 +1535,7 @@ entry does not exist, return nil." "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) @@ -1546,6 +1557,7 @@ entry does not exist, return nil." ;; 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 @@ -1637,6 +1649,7 @@ This is HOST, if non-nil. Otherwise, do a lookup in (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, @@ -1747,6 +1760,7 @@ See `tramp-dissect-file-name' for details." (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. @@ -1856,6 +1870,7 @@ Unless DONT-CREATE, the buffer is created when it doesn't exist yet." (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. @@ -1912,8 +1927,7 @@ version, the function does nothing." "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 @@ -1921,8 +1935,6 @@ of `current-buffer'." (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)) @@ -2034,6 +2046,7 @@ They are completed by \"M-x TAB\" only in Tramp debug buffers." (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 @@ -2107,10 +2120,12 @@ ARGUMENTS to actually emit the message (if applicable)." (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 @@ -2163,8 +2178,6 @@ applicable)." (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 @@ -2177,8 +2190,6 @@ This function is meant for debugging purposes." 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 @@ -2246,8 +2257,6 @@ an input event arrives. The other arguments are passed to `tramp-error'." (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\")." @@ -2284,8 +2293,6 @@ the resulting error message." (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. @@ -2302,8 +2309,6 @@ does not exist, otherwise propagate the error." (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 @@ -2399,45 +2404,6 @@ without a visible progress reporter." (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' @@ -3424,8 +3390,6 @@ BODY is the backend specific code." (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." @@ -3441,8 +3405,6 @@ 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'. @@ -3474,8 +3436,6 @@ BODY is the backend specific code." (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'. @@ -3485,7 +3445,6 @@ BODY is the backend specific code." (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 @@ -3493,9 +3452,10 @@ BODY is the backend specific code." (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) @@ -3524,10 +3484,8 @@ BODY is the backend specific code." (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 @@ -3541,7 +3499,22 @@ BODY is the backend specific code." ;; 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) @@ -3602,6 +3575,9 @@ BODY is the backend specific code." ;; 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. @@ -3645,8 +3621,6 @@ BODY is the backend specific code." (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 @@ -3843,7 +3817,9 @@ Let-bind it when necessary.") ;; 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." @@ -5620,7 +5596,7 @@ the remote host use line-endings as defined in the variable (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))) @@ -6049,6 +6025,7 @@ Return the local name of the temporary file." (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 diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 5a8d9100e18..63ccd05a263 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2481,6 +2481,19 @@ This checks also `file-name-as-directory', `file-name-directory', (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") @@ -3790,7 +3803,11 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." (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))) @@ -4153,6 +4170,10 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (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)) -- 2.39.2