Function: tramp-sh-handle-write-region
tramp-sh-handle-write-region is a byte-compiled function defined in
tramp-sh.el.gz.
Signature
(tramp-sh-handle-write-region START END FILENAME &optional APPEND VISIT LOCKNAME MUSTBENEW)
Documentation
Like write-region for Tramp files.
Source Code
;; Defined in /usr/src/emacs/lisp/net/tramp-sh.el.gz
(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 (tramp-compat-file-attribute-user-id
(file-attributes filename 'integer))
(tramp-get-remote-uid v 'integer)))
(gid (or (tramp-compat-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 (tramp-compat-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
(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)
(with-current-buffer (tramp-get-buffer v)
(buffer-string))))
(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)
;; 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 (tramp-compat-file-attribute-modification-time file-attr)
(current-time)))
(when (and (= (tramp-compat-file-attribute-user-id file-attr) uid)
(= (tramp-compat-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)))))