From 47fe7a5983a97c3e806e90340f3cd6ab3f0c49b2 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Tue, 3 May 2022 14:14:37 +0200 Subject: [PATCH] Handle file name handler in write-region's VISIT arg * lisp/net/tramp.el (tramp-skeleton-delete-directory): Move up. (tramp-skeleton-write-region): New defmacro. Handle also file name handler in VISIT. (Bug#55166) (tramp-handle-write-region): * lisp/net/tramp-adb.el (tramp-adb-handle-write-region): * lisp/net/tramp-sh.el (tramp-sh-handle-write-region): * lisp/net/tramp-smb.el (tramp-smb-handle-write-region): * lisp/net/tramp-sshfs.el (tramp-sshfs-handle-write-region): Use it. --- lisp/net/tramp-adb.el | 52 +---- lisp/net/tramp-sh.el | 432 ++++++++++++++++++---------------------- lisp/net/tramp-smb.el | 52 +---- lisp/net/tramp-sshfs.el | 45 +---- lisp/net/tramp.el | 185 +++++++++++------ 5 files changed, 318 insertions(+), 448 deletions(-) diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index d897594f8d8..251d5191cb2 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -548,28 +548,8 @@ Emacs dired can't find files." (defun tramp-adb-handle-write-region (start end filename &optional append visit lockname mustbenew) "Like `write-region' for Tramp files." - (setq filename (expand-file-name filename) - lockname (file-truename (or lockname filename))) - (with-parsed-tramp-file-name filename nil - (when (and mustbenew (file-exists-p filename) - (or (eq mustbenew 'excl) - (not - (y-or-n-p - (format "File %s exists; overwrite anyway?" filename))))) - (tramp-error v 'file-already-exists filename)) - - (let ((file-locked (eq (file-locked-p lockname) t)) - (curbuf (current-buffer)) - (tmpfile (tramp-compat-make-temp-file filename))) - - ;; Lock file. - (when (and (not (auto-save-file-name-p (file-name-nondirectory filename))) - (file-remote-p lockname) - (not file-locked)) - (setq file-locked t) - ;; `lock-file' exists since Emacs 28.1. - (tramp-compat-funcall 'lock-file lockname)) - + (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))) @@ -582,33 +562,7 @@ Emacs dired can't find files." (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))) - - ;; We must also flush the cache of the directory, because - ;; `file-attributes' reads the values from there. - (tramp-flush-file-properties v localname) - - (unless (equal curbuf (current-buffer)) - (tramp-error - v 'file-error - "Buffer has changed from `%s' to `%s'" curbuf (current-buffer))) - - ;; Set file modification time. - (when (or (eq visit t) (stringp visit)) - (set-visited-file-modtime - (or (file-attribute-modification-time (file-attributes filename)) - (current-time)))) - - ;; Unlock file. - (when file-locked - ;; `unlock-file' exists since Emacs 28.1. - (tramp-compat-funcall 'unlock-file lockname)) - - ;; The end. - (when (and (null noninteractive) - (or (eq visit t) (string-or-null-p visit))) - (tramp-message v 0 "Wrote %s" filename)) - (run-hooks 'tramp-handle-write-region-hook)))) + (delete-file tmpfile)))))) (defun tramp-adb-handle-set-file-modes (filename mode &optional flag) "Like `set-file-modes' for Tramp files." diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 5e0a67dbb3c..ba4cdb0ab52 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -3328,251 +3328,197 @@ implementation will be used." (defun tramp-sh-handle-write-region (start end filename &optional append visit lockname mustbenew) "Like `write-region' for Tramp files." - (setq filename (expand-file-name filename) - lockname (file-truename (or lockname filename))) - (with-parsed-tramp-file-name filename nil - (when (and mustbenew (file-exists-p filename) - (or (eq mustbenew 'excl) - (not - (y-or-n-p - (format "File %s exists; overwrite anyway?" filename))))) - (tramp-error v 'file-already-exists filename)) - - (let ((file-locked (eq (file-locked-p lockname) t)) - (uid (or (file-attribute-user-id (file-attributes filename 'integer)) - (tramp-get-remote-uid v 'integer))) - (gid (or (file-attribute-group-id (file-attributes filename 'integer)) - (tramp-get-remote-gid v 'integer)))) - - ;; Lock file. - (when (and (not (auto-save-file-name-p (file-name-nondirectory filename))) - (file-remote-p lockname) - (not file-locked)) - (setq file-locked t) - ;; `lock-file' exists since Emacs 28.1. - (tramp-compat-funcall 'lock-file lockname)) - - (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. - (unwind-protect - (copy-file tmpfile filename t) - (delete-file tmpfile)))) - - ;; Use inline file transfer. - (rem-dec - ;; Encode tmpfile. + (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. (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-send-command - v - (format - (concat rem-dec " <<'%s'\n%s%s") - (tramp-shell-quote-argument localname) - tramp-end-of-heredoc - (buffer-string) - tramp-end-of-heredoc)) - (tramp-barf-unless-okay - v nil - "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))) - - ;; 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)))) - - (tramp-flush-file-properties v localname) + (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-send-command + v + (format + (concat rem-dec " <<'%s'\n%s%s") + (tramp-shell-quote-argument localname) + tramp-end-of-heredoc + (buffer-string) + tramp-end-of-heredoc)) + (tramp-barf-unless-okay + v nil + "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)))) - ;; We must protect `last-coding-system-used', now we have set it - ;; to its correct value. - (let (last-coding-system-used (need-chown t)) - ;; Set file modification time. - (when (or (eq visit t) (stringp visit)) - (let ((file-attr (file-attributes filename 'integer))) - (set-visited-file-modtime - ;; We must pass modtime explicitly, because FILENAME can - ;; be different from (buffer-file-name), f.e. if - ;; `file-precious-flag' is set. - (or (file-attribute-modification-time file-attr) - (current-time))) - (when (and (= (file-attribute-user-id file-attr) uid) - (= (file-attribute-group-id file-attr) gid)) - (setq need-chown nil)))) - - ;; Set the ownership. - (when need-chown - (tramp-set-file-uid-gid filename uid gid)) - - ;; Unlock file. - (when file-locked - ;; `unlock-file' exists since Emacs 28.1. - (tramp-compat-funcall 'unlock-file lockname)) - - (when (and (null noninteractive) - (or (eq visit t) (string-or-null-p visit))) - (tramp-message v 0 "Wrote %s" filename)) - (run-hooks 'tramp-handle-write-region-hook))))) + ;; 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 4af5a4204f2..968c1daccbf 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -1617,28 +1617,8 @@ VEC or USER, or if there is no home directory, return nil." (defun tramp-smb-handle-write-region (start end filename &optional append visit lockname mustbenew) "Like `write-region' for Tramp files." - (setq filename (expand-file-name filename) - lockname (file-truename (or lockname filename))) - (with-parsed-tramp-file-name filename nil - (when (and mustbenew (file-exists-p filename) - (or (eq mustbenew 'excl) - (not - (y-or-n-p - (format "File %s exists; overwrite anyway?" filename))))) - (tramp-error v 'file-already-exists filename)) - - (let ((file-locked (eq (file-locked-p lockname) t)) - (curbuf (current-buffer)) - (tmpfile (tramp-compat-make-temp-file filename))) - - ;; Lock file. - (when (and (not (auto-save-file-name-p (file-name-nondirectory filename))) - (file-remote-p lockname) - (not file-locked)) - (setq file-locked t) - ;; `lock-file' exists since Emacs 28.1. - (tramp-compat-funcall 'lock-file lockname)) - + (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)) ;; We say `no-message' here because we don't want the visited file @@ -1654,33 +1634,7 @@ VEC or USER, or if there is no home directory, return nil." v (format "put %s \"%s\"" tmpfile (tramp-smb-get-localname v))) (tramp-error v 'file-error "Cannot write `%s'" filename)) - (delete-file tmpfile))) - - ;; We must also flush the cache of the directory, because - ;; `file-attributes' reads the values from there. - (tramp-flush-file-properties v localname) - - (unless (equal curbuf (current-buffer)) - (tramp-error - v 'file-error - "Buffer has changed from `%s' to `%s'" curbuf (current-buffer))) - - ;; Set file modification time. - (when (or (eq visit t) (stringp visit)) - (set-visited-file-modtime - (or (file-attribute-modification-time (file-attributes filename)) - (current-time)))) - - ;; Unlock file. - (when file-locked - ;; `unlock-file' exists since Emacs 28.1. - (tramp-compat-funcall 'unlock-file lockname)) - - ;; The end. - (when (and (null noninteractive) - (or (eq visit t) (string-or-null-p visit))) - (tramp-message v 0 "Wrote %s" filename)) - (run-hooks 'tramp-handle-write-region-hook)))) + (delete-file tmpfile)))))) ;; Internal file name functions. diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el index 02c0da3f184..61bf165f308 100644 --- a/lisp/net/tramp-sshfs.el +++ b/lisp/net/tramp-sshfs.el @@ -373,47 +373,10 @@ arguments to pass to the OPERATION." (defun tramp-sshfs-handle-write-region (start end filename &optional append visit lockname mustbenew) "Like `write-region' for Tramp files." - (setq filename (expand-file-name filename) - lockname (file-truename (or lockname filename))) - (with-parsed-tramp-file-name filename nil - (when (and mustbenew (file-exists-p filename) - (or (eq mustbenew 'excl) - (not - (y-or-n-p - (format "File %s exists; overwrite anyway?" filename))))) - (tramp-error v 'file-already-exists filename)) - - (let ((file-locked (eq (file-locked-p lockname) t))) - - ;; Lock file. - (when (and (not (auto-save-file-name-p (file-name-nondirectory filename))) - (file-remote-p lockname) - (not file-locked)) - (setq file-locked t) - ;; `lock-file' exists since Emacs 28.1. - (tramp-compat-funcall 'lock-file lockname)) - - (let (create-lockfiles) - (write-region - start end (tramp-fuse-local-file-name filename) append 'nomessage) - (tramp-flush-file-properties v localname)) - - ;; Set file modification time. - (when (or (eq visit t) (stringp visit)) - (set-visited-file-modtime - (or (file-attribute-modification-time (file-attributes filename)) - (current-time)))) - - ;; Unlock file. - (when file-locked - ;; `unlock-file' exists since Emacs 28.1. - (tramp-compat-funcall 'unlock-file lockname)) - - ;; The end. - (when (and (null noninteractive) - (or (eq visit t) (string-or-null-p visit))) - (tramp-message v 0 "Wrote %s" filename)) - (run-hooks 'tramp-handle-write-region-hook)))) + (tramp-skeleton-write-region start end filename append visit lockname mustbenew + (let (create-lockfiles) + (write-region + start end (tramp-fuse-local-file-name filename) append 'nomessage)))) ;; File name conversions. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 3d288611792..b889f1f8848 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3353,6 +3353,121 @@ User is always nil." (forward-line 1) result)) +;;; Skeleton macros for file name handler functions. + +(defmacro tramp-skeleton-delete-directory (directory recursive trash &rest body) + "Skeleton for `tramp-*-handle-delete-directory'. +BODY is the backend specific code." + (declare (indent 3) (debug t)) + `(with-parsed-tramp-file-name (expand-file-name ,directory) nil + (if (and delete-by-moving-to-trash ,trash) + ;; Move non-empty dir to trash only if recursive deletion was + ;; requested. + (if (not (or ,recursive (tramp-compat-directory-empty-p ,directory))) + (tramp-error + v 'file-error "Directory is not empty, not moving to trash") + (move-file-to-trash ,directory)) + ,@body) + (tramp-flush-directory-properties v localname))) + +(put #'tramp-skeleton-delete-directory 'tramp-suppress-trace t) + +(defmacro tramp-skeleton-write-region + (start end filename append visit lockname mustbenew &rest body) + "Skeleton for `tramp-*-handle-write-region'. +BODY is the backend specific code." + (declare (indent 7) (debug t)) + `(with-parsed-tramp-file-name (expand-file-name ,filename) nil + (setq ,filename (expand-file-name ,filename) + ,lockname (file-truename (or ,lockname ,filename))) + ;; Sometimes, there is another file name handler responsible for + ;; VISIT, for example `jka-compr-handler'. We must respect this. + ;; See Bug#55166. + (let ((handler (and (stringp ,visit) + (let ((inhibit-file-name-handlers + (cons 'tramp-file-name-handler + inhibit-file-name-handlers)) + (inhibit-file-name-operation 'write-region)) + (find-file-name-handler ,visit 'write-region))))) + (if handler + (progn + (tramp-message + v 5 "Calling handler `%s' for visiting `%s'" handler ,visit) + (funcall + handler 'write-region + ,start ,end ,filename ,append ,visit ,lockname ,mustbenew)) + + (when (and ,mustbenew (file-exists-p ,filename) + (or (eq ,mustbenew 'excl) + (not + (y-or-n-p + (format + "File %s exists; overwrite anyway?" ,filename))))) + (tramp-error v 'file-already-exists ,filename)) + + (let ((file-locked (eq (file-locked-p ,lockname) t)) + (uid (or (file-attribute-user-id + (file-attributes ,filename 'integer)) + (tramp-get-remote-uid v 'integer))) + (gid (or (file-attribute-group-id + (file-attributes ,filename 'integer)) + (tramp-get-remote-gid v 'integer))) + (curbuf (current-buffer))) + + ;; Lock file. + (when (and (not (auto-save-file-name-p + (file-name-nondirectory ,filename))) + (file-remote-p ,lockname) + (not file-locked)) + (setq file-locked t) + ;; `lock-file' exists since Emacs 28.1. + (tramp-compat-funcall 'lock-file ,lockname)) + + ;; The body. + ,@body + + ;; We must protect `last-coding-system-used', now we have + ;; set it to its correct value. + (let (last-coding-system-used (need-chown t)) + ;; Set file modification time. + (when (or (eq ,visit t) (stringp ,visit)) + (let ((file-attr (file-attributes ,filename 'integer))) + (set-visited-file-modtime + ;; We must pass modtime explicitly, because FILENAME + ;; can be different from (buffer-file-name), f.e. if + ;; `file-precious-flag' is set. + (or (file-attribute-modification-time file-attr) + (current-time))) + (when (and (= (file-attribute-user-id file-attr) uid) + (= (file-attribute-group-id file-attr) gid)) + (setq need-chown nil)))) + + ;; Set the ownership. + (when need-chown + (tramp-set-file-uid-gid ,filename uid gid))) + + ;; We must also flush the cache of the directory, because + ;; `file-attributes' reads the values from there. + (tramp-flush-file-properties v localname) + + ;; Unlock file. + (when file-locked + ;; `unlock-file' exists since Emacs 28.1. + (tramp-compat-funcall 'unlock-file ,lockname)) + + ;; Sanity check. + (unless (equal curbuf (current-buffer)) + (tramp-error + v 'file-error + "Buffer has changed from `%s' to `%s'" curbuf (current-buffer))) + + (when (and (null noninteractive) + (or (eq ,visit t) (string-or-null-p ,visit))) + (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 @@ -4827,33 +4942,10 @@ of." (defun tramp-handle-write-region (start end filename &optional append visit lockname mustbenew) "Like `write-region' for Tramp files." - (setq filename (expand-file-name filename) - lockname (file-truename (or lockname filename))) - (with-parsed-tramp-file-name filename nil - (when (and mustbenew (file-exists-p filename) - (or (eq mustbenew 'excl) - (not - (y-or-n-p - (format "File %s exists; overwrite anyway?" filename))))) - (tramp-error v 'file-already-exists filename)) - - (let ((file-locked (eq (file-locked-p lockname) t)) - (tmpfile (tramp-compat-make-temp-file filename)) + (tramp-skeleton-write-region start end filename append visit lockname mustbenew + (let ((tmpfile (tramp-compat-make-temp-file filename)) (modes (tramp-default-file-modes - filename (and (eq mustbenew 'excl) 'nofollow))) - (uid (or (file-attribute-user-id (file-attributes filename 'integer)) - (tramp-get-remote-uid v 'integer))) - (gid (or (file-attribute-group-id (file-attributes filename 'integer)) - (tramp-get-remote-gid v 'integer)))) - - ;; Lock file. - (when (and (not (auto-save-file-name-p (file-name-nondirectory filename))) - (file-remote-p lockname) - (not file-locked)) - (setq file-locked t) - ;; `lock-file' exists since Emacs 28.1. - (tramp-compat-funcall 'lock-file lockname)) - + filename (and (eq mustbenew 'excl) 'nofollow)))) (when (and append (file-exists-p filename)) (copy-file filename tmpfile 'ok)) ;; The permissions of the temporary file should be set. If @@ -4872,29 +4964,7 @@ of." (error (delete-file tmpfile) (tramp-error - v 'file-error "Couldn't write region to `%s'" filename))) - - (tramp-flush-file-properties v localname) - - ;; Set file modification time. - (when (or (eq visit t) (stringp visit)) - (set-visited-file-modtime - (or (file-attribute-modification-time (file-attributes filename)) - (current-time)))) - - ;; Set the ownership. - (tramp-set-file-uid-gid filename uid gid) - - ;; Unlock file. - (when file-locked - ;; `unlock-file' exists since Emacs 28.1. - (tramp-compat-funcall 'unlock-file lockname)) - - ;; The end. - (when (and (null noninteractive) - (or (eq visit t) (string-or-null-p visit))) - (tramp-message v 0 "Wrote %s" filename)) - (run-hooks 'tramp-handle-write-region-hook)))) + v 'file-error "Couldn't write region to `%s'" filename)))))) ;; This is used in tramp-sh.el and tramp-sudoedit.el. (defconst tramp-stat-marker "/////" @@ -6176,23 +6246,6 @@ If VEC is `tramp-null-hop', return local null device." (let ((default-directory (tramp-make-tramp-file-name vec))) (tramp-compat-null-device))))) -(defmacro tramp-skeleton-delete-directory (directory recursive trash &rest body) - "Skeleton for `tramp-*-handle-delete-directory'. -BODY is the backend specific code." - (declare (indent 3) (debug t)) - `(with-parsed-tramp-file-name (expand-file-name ,directory) nil - (if (and delete-by-moving-to-trash ,trash) - ;; Move non-empty dir to trash only if recursive deletion was - ;; requested. - (if (not (or ,recursive (tramp-compat-directory-empty-p ,directory))) - (tramp-error - v 'file-error "Directory is not empty, not moving to trash") - (move-file-to-trash ,directory)) - ,@body) - (tramp-flush-directory-properties v localname))) - -(put #'tramp-skeleton-delete-directory 'tramp-suppress-trace t) - ;; Checklist for `tramp-unload-hook' ;; - Unload all `tramp-*' packages ;; - Reset `file-name-handler-alist' -- 2.39.5