[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 8ce96f0d4d: Fix handling of "process-*" properties in Tramp
|
From: |
Michael Albinus |
|
Subject: |
master 8ce96f0d4d: Fix handling of "process-*" properties in Tramp |
|
Date: |
Fri, 17 Jun 2022 12:53:33 -0400 (EDT) |
branch: master
commit 8ce96f0d4d3b8c80a8b6165b69a67310afdf6a3a
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>
Fix handling of "process-*" properties in Tramp
* lisp/net/tramp.el (tramp-local-host-regexp): Add "localhost4".
(with-tramp-saved-connection-property): New defmacro.
* lisp/net/tramp-adb.el (tramp-adb-handle-make-process):
* lisp/net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band)
(tramp-sh-handle-make-process):
* 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 it. (Bug#55832)
---
lisp/net/tramp-adb.el | 93 +++++++-------
lisp/net/tramp-sh.el | 258 +++++++++++++++++++-------------------
lisp/net/tramp-smb.el | 335 +++++++++++++++++++++++++-------------------------
lisp/net/tramp.el | 15 ++-
4 files changed, 361 insertions(+), 340 deletions(-)
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 8268b2d167..0c3d87cc91 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -942,7 +942,8 @@ implementation will be used."
(or (null program) tramp-process-connection-type))
(bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
(name1 name)
- (i 0))
+ (i 0)
+ p)
(when (string-match-p "[[:multibyte:]]" command)
(tramp-error
@@ -953,9 +954,6 @@ implementation will be used."
(setq i (1+ i)
name1 (format "%s<%d>" name i)))
(setq name name1)
- ;; 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
@@ -963,45 +961,52 @@ implementation will be used."
;; 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.
- (let* ((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)
+ (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
- 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;
+ v "process-buffer" buffer)
+ ;; 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))))
+
+ ;; Copy tmpstderr file. "process-buffer"
+ ;; and "process-name" must be reset 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
@@ -1038,13 +1043,13 @@ implementation will be used."
p))))
;; Save exit.
+ ;; FIXME: Does `tramp-get-connection-process' return
+ ;; the proper value?
(if (string-prefix-p tramp-temp-buffer-name (buffer-name))
(ignore-errors
(set-process-buffer (tramp-get-connection-process v) nil)
(kill-buffer (current-buffer)))
- (set-buffer-modified-p bmp))
- (tramp-flush-connection-property v "process-name")
- (tramp-flush-connection-property v "process-buffer")))))))))
+ (set-buffer-modified-p bmp))))))))))
(defun tramp-adb-handle-exec-path ()
"Like `exec-path' for Tramp files."
@@ -1360,7 +1365,7 @@ connection if a previous connection has died for some
reason."
(funcall orig-fun)))
(add-function
- :around (symbol-function #'shell-mode) #'tramp-adb-tolerate-tilde)
+ :around (symbol-function #'shell-mode) #'tramp-adb-tolerate-tilde)
(add-hook 'tramp-adb-unload-hook
(lambda ()
(remove-function
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 8f8b81186b..eccc15efe7 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -2417,53 +2417,53 @@ The method used must be an out-of-band method."
(with-temp-buffer
(unwind-protect
- ;; 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)))
-
- ;; Reset the transfer process properties.
- (tramp-flush-connection-property v "process-name")
- (tramp-flush-connection-property v "process-buffer")
+ (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)))))
+
;; Clear the remote prompt.
(when (and remote-copy-program
(not (tramp-send-command-and-check v nil)))
@@ -2976,94 +2976,99 @@ implementation will be used."
(setq i (1+ i)
name1 (format "%s<%d>" name i)))
(setq name name1)
- ;; 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))
- ;; 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)))
- ;; 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)))
+ (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)
+ ;; 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))
+ ;; 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)))
+ ;; 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))
- (tramp-flush-connection-property v "process-name")
- (tramp-flush-connection-property v "process-buffer")))))))))
+ (set-buffer-modified-p bmp))))))))))
(defun tramp-sh-get-signal-strings (vec)
"Strings to return by `process-file' in case of signals."
@@ -6133,5 +6138,4 @@ function cell is returned to be applied on a buffer."
;; * Support hostname canonicalization in ~/.ssh/config.
;; <https://stackoverflow.com/questions/70205232/>
-
;;; tramp-sh.el ends here
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 3654910133..528463c5a7 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -519,50 +519,50 @@ arguments to pass to the OPERATION."
"tar qx -")))))
(unwind-protect
- (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))))
-
- ;; Reset the transfer process properties.
- (tramp-flush-connection-property v "process-name")
- (tramp-flush-connection-property v "process-buffer")
+ (with-tramp-saved-connection-property v "process-name"
+ (with-tramp-saved-connection-property v "process-buffer"
+ (with-temp-buffer
+ ;; Set the transfer process properties.
+ (tramp-set-connection-property
+ v "process-name" (buffer-name (current-buffer)))
+ (tramp-set-connection-property
+ v "process-buffer" (current-buffer))
+
+ (when t1
+ ;; The smbclient tar command creates
+ ;; always complete paths. We must emulate
+ ;; the directory structure, and symlink to
+ ;; the real target.
+ (make-directory
+ (expand-file-name
+ ".." (concat tmpdir localname))
+ 'parents)
+ (make-symbolic-link
+ newname
+ (directory-file-name (concat tmpdir localname))))
+
+ ;; Use an asynchronous processes. By this,
+ ;; password can be handled.
+ (let* ((default-directory tmpdir)
+ (p (apply
+ #'start-process
+ (tramp-get-connection-name v)
+ (tramp-get-connection-buffer v)
+ tramp-smb-program args)))
+
+ (tramp-message
+ v 6 "%s" (string-join (process-command p) " "))
+ (process-put p 'vector v)
+ (process-put p 'adjust-window-size-function
#'ignore)
+ (set-process-query-on-exit-flag p nil)
+ (tramp-process-actions
+ p v nil tramp-smb-actions-with-tar)
+
+ (while (process-live-p p)
+ (sleep-for 0.1))
+ (tramp-message v 6 "\n%s" (buffer-string))))))
+
+ ;; Save exit.
(when t1 (delete-directory tmpdir 'recursive))))
;; Handle KEEP-DATE argument.
@@ -824,33 +824,31 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(concat "2>" (tramp-get-remote-null-device
v)))))
(unwind-protect
- (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)))))
-
- ;; Reset the transfer process properties.
- (tramp-flush-connection-property v "process-name")
- (tramp-flush-connection-property v "process-buffer"))))))))
+ (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))))))))))))))
(defun tramp-smb-handle-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files."
@@ -1342,33 +1340,34 @@ component is used as the target of the symlink."
(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"
- (or outbuf (generate-new-buffer tramp-temp-buffer-name)))
-
;; Call it.
(condition-case nil
- (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-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))))
;; When the user did interrupt, we should do it also. We use
;; return code -1 as marker.
@@ -1383,9 +1382,8 @@ component is used as the target of the symlink."
;; Cleanup. We remove all file cache values for the connection,
;; because the remote process could have changed them.
- (tramp-flush-connection-property v "process-name")
- (tramp-flush-connection-property v "process-buffer")
(when tmpinput (delete-file tmpinput))
+ ;; FIXME: Does connection-property "process-buffer" still exist?
(unless outbuf
(kill-buffer (tramp-get-connection-property v "process-buffer" nil)))
(when process-file-side-effects
@@ -1488,42 +1486,44 @@ component is used as the target of the symlink."
"||" "echo" "tramp_exit_status" "1")))
(unwind-protect
- (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)))
-
- ;; Reset the transfer process properties.
- (tramp-flush-connection-property v "process-name")
- (tramp-flush-connection-property v "process-buffer")))))))
+ (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)))))))))))
(defun tramp-smb-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
@@ -1555,46 +1555,47 @@ component is used as the target of the symlink."
(i 0)
p)
(unwind-protect
- (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-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))))
;; Save exit.
+ ;; FIXME: Does `tramp-get-connection-buffer' return the proper value?
(with-current-buffer (tramp-get-connection-buffer v)
(if (tramp-compat-string-search tramp-temp-buffer-name (buffer-name))
(progn
(set-process-buffer (tramp-get-connection-process v) nil)
(kill-buffer (current-buffer)))
- (set-buffer-modified-p bmp)))
- (tramp-flush-connection-property v "process-name")
- (tramp-flush-connection-property v "process-buffer")))))
+ (set-buffer-modified-p bmp)))))))
(defun tramp-smb-handle-substitute-in-file-name (filename)
"Like `substitute-in-file-name' for Tramp files.
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index e4b14cfbc2..59a2710e00 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -522,11 +522,12 @@ host runs a restricted shell, it shall be added to this
list, too."
(concat
"\\`"
(regexp-opt
- (list "localhost" "localhost6" tramp-system-name "127.0.0.1" "::1") t)
+ `("localhost" "localhost4" "localhost6" ,tramp-system-name "127.0.0.1"
"::1")
+ t)
"\\'")
"Host names which are regarded as local host.
If the local host runs a chrooted environment, set this to nil."
- :version "27.1"
+ :version "29.1"
:type '(choice (const :tag "Chrooted environment" nil)
(regexp :tag "Host regexp")))
@@ -2393,6 +2394,16 @@ FILE must be a local file name on a connection
identified via VEC."
(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'
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- master 8ce96f0d4d: Fix handling of "process-*" properties in Tramp,
Michael Albinus <=