[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/android 7ce7a004f68: Merge remote-tracking branch 'origin/master
|
From: |
Po Lu |
|
Subject: |
feature/android 7ce7a004f68: Merge remote-tracking branch 'origin/master' into feature/android |
|
Date: |
Sat, 29 Jul 2023 20:16:10 -0400 (EDT) |
branch: feature/android
commit 7ce7a004f68753beafb12830e28c459c4b5b6273
Merge: 9c5e9bb9be6 4038f1b40d3
Author: Po Lu <luangruo@yahoo.com>
Commit: Po Lu <luangruo@yahoo.com>
Merge remote-tracking branch 'origin/master' into feature/android
---
doc/misc/tramp.texi | 17 +-
lisp/format.el | 11 +-
lisp/jsonrpc.el | 4 +-
lisp/net/tramp-adb.el | 212 ++++++++--------
lisp/net/tramp-cmds.el | 4 +-
lisp/net/tramp-compat.el | 2 +-
lisp/net/tramp-crypt.el | 142 +++++------
lisp/net/tramp-gvfs.el | 260 ++++++++++----------
lisp/net/tramp-message.el | 572 +++++++++++++++++++++++++++++++++++++++++++
lisp/net/tramp-rclone.el | 102 ++++----
lisp/net/tramp-sh.el | 482 ++++++++++++++++++------------------
lisp/net/tramp-smb.el | 327 +++++++++++++------------
lisp/net/tramp-sshfs.el | 99 ++++----
lisp/net/tramp-sudoedit.el | 35 +--
lisp/net/tramp.el | 480 ++++--------------------------------
lisp/net/trampver.el | 2 +
test/lisp/net/tramp-tests.el | 27 +-
17 files changed, 1508 insertions(+), 1270 deletions(-)
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index 1d8e0095328..e518330c9b0 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -6054,6 +6054,7 @@ wrapping the timer function body as follows:
@chapter How to Customize Traces
@vindex tramp-verbose
@vindex tramp-debug-to-file
+@vindex tramp-debug-command-messages
@value{tramp} messages are raised with verbosity levels ranging from 0
to 10. @value{tramp} does not display all messages; only those with a
@@ -6075,9 +6076,10 @@ The verbosity levels are
@*@indent @w{11} call traces (maintainer only)
With @code{tramp-verbose} greater than or equal to 4, messages are
-also written to a @value{tramp} debug buffer. Such debug buffers are
-essential to bug and problem analyzes. For @value{tramp} bug reports,
-set the @code{tramp-verbose} level to 6 (@pxref{Bug Reports}).
+also written to the @value{tramp} debug buffer @file{*debug
+tramp/foo*}. Such debug buffers are essential to bug and problem
+analyzes. For @value{tramp} bug reports, set the @code{tramp-verbose}
+level to 6 (@pxref{Bug Reports}).
The debug buffer is in
@ifinfo
@@ -6121,7 +6123,14 @@ directory}. Use this option with care, because it could
decrease the
performance of @value{tramp} actions.
If @code{tramp-verbose} is greater than or equal to 11, @value{tramp}
-function call traces are written to the buffer @file{*trace-output*}.
+function call traces are written to the buffer @file{*trace tramp/foo*}.
+
+When @code{tramp-debug-command-messages} is non-@code{nil} and
+@code{tramp-verbose} is greater than or equal to 6, the debug buffer
+contains all messages with verbosity level 6 (sent and received
+strings), and the entry and exit messages for the function
+@code{tramp-file-name-handler}. This is intended for @value{tramp}
+maintainers, analyzing the remote commands for performance analysis.
@node GNU Free Documentation License
diff --git a/lisp/format.el b/lisp/format.el
index b2dba16659b..5c72a78f325 100644
--- a/lisp/format.el
+++ b/lisp/format.el
@@ -87,11 +87,16 @@
rot13-region rot13-region t nil)
(duden ,(purecopy "Duden Ersatzdarstellung")
nil
- ,(purecopy "diac") iso-iso2duden t nil)
+ ;; FROM-FN used to call the "diac" command which is not widely
+ ;; available and apparently not under a free software license:
+ ;; https://nm.wu-wien.ac.at/nm/download/file/diac4.tar.gz
+ ;; Reliable round-trip conversion is not possible anyway
+ ;; and would be by heuristic method, so use nil for now.
+ nil iso-iso2duden t nil)
(de646 ,(purecopy "German ASCII (ISO 646)")
nil
- ,(purecopy "recode -f iso646-ge:latin1")
- ,(purecopy "recode -f latin1:iso646-ge") t nil)
+ ,(purecopy "iconv -f iso646-de -t utf-8")
+ ,(purecopy "iconv -f utf-8 -t iso646-de") t nil)
(denet ,(purecopy "net German")
nil
iso-german iso-cvt-read-only t nil)
diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el
index ccf0f966574..52ffb220d8b 100644
--- a/lisp/jsonrpc.el
+++ b/lisp/jsonrpc.el
@@ -223,7 +223,7 @@ object, using the keywords `:code', `:message' and `:data'."
(apply #'format-message (car args) (cdr args))))
(signal 'jsonrpc-error
`(,msg
- (jsonrpc-error-code . ,32603)
+ (jsonrpc-error-code . -32603)
(jsonrpc-error-message . ,msg))))
(cl-destructuring-bind (&key code message data) args
(signal 'jsonrpc-error
@@ -698,7 +698,7 @@ TIMEOUT is nil)."
:params params)
(puthash id
(list (or success-fn
- (jsonrpc-lambda (&rest _ignored)
+ (lambda (&rest _ignored)
(jsonrpc--debug
connection (list :message "success ignored"
:id id))))
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 2b5369ea3b5..3d4dacb393c 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -209,8 +209,10 @@ It is used for TCP/IP devices."
First arg specifies the OPERATION, second arg is a list of
arguments to pass to the OPERATION."
(if-let ((fn (assoc operation tramp-adb-file-name-handler-alist)))
- (save-match-data (apply (cdr fn) args))
- (tramp-run-real-handler operation args)))
+ (prog1 (save-match-data (apply (cdr fn) args))
+ (setq tramp-debug-message-fnh-function (cdr fn)))
+ (prog1 (tramp-run-real-handler operation args)
+ (setq tramp-debug-message-fnh-function operation))))
;;;###tramp-autoload
(tramp--with-startup
@@ -273,7 +275,7 @@ arguments to pass to the OPERATION."
(with-current-buffer (tramp-get-buffer vec)
(goto-char (point-min))
(let (file-properties)
- (while (re-search-forward tramp-adb-ls-toolbox-regexp nil t)
+ (while (search-forward-regexp tramp-adb-ls-toolbox-regexp nil t)
(let* ((mod-string (match-string 1))
(is-dir (eq ?d (aref mod-string 0)))
(is-symlink (eq ?l (aref mod-string 0)))
@@ -319,7 +321,7 @@ arguments to pass to the OPERATION."
(tramp-shell-quote-argument localname)))
;; We insert also filename/. and filename/.., because "ls"
;; doesn't on some file systems, like "sdcard".
- (unless (re-search-backward (rx "." eol) nil t)
+ (unless (search-backward-regexp (rx "." eol) nil t)
(narrow-to-region (point-max) (point-max))
(tramp-adb-send-command
v (format "%s -d -a -l %s %s | cat"
@@ -1142,7 +1144,7 @@ error and non-nil on success."
;; There must be a better solution by setting the correct coding
;; system, but this requires changes in core Tramp.
(goto-char (point-min))
- (while (re-search-forward (rx (+ "\r") eol) nil t)
+ (while (search-forward-regexp (rx (+ "\r") eol) nil t)
(replace-match "" nil nil)))))))
(defun tramp-adb-send-command-and-check (vec command &optional exit-status)
@@ -1186,12 +1188,12 @@ FMT and ARGS are passed to `error'."
(let ((inhibit-read-only t))
(goto-char (point-min))
;; ADB terminal sends "^H" sequences.
- (when (re-search-forward (rx "<" (+ "\b")) (line-end-position) t)
+ (when (search-forward-regexp (rx "<" (+ "\b")) (line-end-position)
t)
(forward-line 1)
(delete-region (point-min) (point)))
;; Delete the prompt.
(goto-char (point-min))
- (when (re-search-forward prompt (line-end-position) t)
+ (when (search-forward-regexp prompt (line-end-position) t)
(forward-line 1)
(delete-region (point-min) (point)))
(when (tramp-search-regexp prompt)
@@ -1211,102 +1213,106 @@ connection if a previous connection has died for some
reason."
(unless (tramp-connectable-p vec)
(throw 'non-essential 'non-essential))
- (let* ((buf (tramp-get-connection-buffer vec))
- (p (get-buffer-process buf))
- (host (tramp-file-name-host vec))
- (user (tramp-file-name-user vec))
- (device (tramp-adb-get-device vec)))
-
- ;; Maybe we know already that "su" is not supported. We cannot
- ;; use a connection property, because we have not checked yet
- ;; whether it is still the same device.
- (when (and user (not (tramp-get-file-property vec "/" "su-command-p" t)))
- (tramp-error vec 'file-error "Cannot switch to user `%s'" user))
-
- (unless (process-live-p p)
- (save-match-data
- (when (and p (processp p)) (delete-process p))
- (if (tramp-string-empty-or-nil-p device)
- (tramp-error vec 'file-error "Device %s not connected" host))
- (with-tramp-progress-reporter vec 3 "Opening adb shell connection"
- (let* ((coding-system-for-read 'utf-8-dos) ; Is this correct?
- (process-connection-type tramp-process-connection-type)
- (args (tramp-expand-args
- vec 'tramp-login-args ?d (or device "")))
- (p (let ((default-directory
- tramp-compat-temporary-file-directory))
- (apply #'start-process (tramp-get-connection-name vec) buf
- tramp-adb-program args)))
- (prompt (md5 (concat (prin1-to-string process-environment)
- (current-time-string)))))
- ;; Wait for initial prompt. On some devices, it needs an
- ;; initial RET, in order to get it.
- (sleep-for 0.1)
- (tramp-send-string vec tramp-rsh-end-of-line)
- (tramp-adb-wait-for-output p 30)
- (unless (process-live-p p)
- (tramp-error vec 'file-error "Terminated!"))
-
- ;; Set sentinel. Initialize variables.
- (set-process-sentinel p #'tramp-process-sentinel)
- (tramp-post-process-creation p vec)
-
- ;; Set connection-local variables.
- (tramp-set-connection-local-variables vec)
-
- ;; Change prompt.
- (tramp-set-connection-property
- p "prompt" (rx "///" (literal prompt) "#$"))
- (tramp-adb-send-command
- vec (format "PS1=\"///\"\"%s\"\"#$\"" prompt))
-
- ;; Disable line editing.
- (tramp-adb-send-command
- vec "set +o vi +o vi-esccomplete +o vi-tabcomplete +o emacs")
-
- ;; Dump option settings in the traces.
- (when (>= tramp-verbose 9)
- (tramp-adb-send-command vec "set -o"))
-
- ;; Check whether the properties have been changed. If
- ;; yes, this is a strong indication that we must expire all
- ;; connection properties. We start again.
- (tramp-message vec 5 "Checking system information")
- (tramp-adb-send-command
- vec
- (concat
- "echo \\\"`getprop ro.product.model` "
- "`getprop ro.product.version` "
- "`getprop ro.build.version.release`\\\""))
- (let ((old-getprop (tramp-get-connection-property vec "getprop"))
- (new-getprop
- (tramp-set-connection-property
- vec "getprop"
- (with-current-buffer (tramp-get-connection-buffer vec)
- ;; Read the expression.
- (goto-char (point-min))
- (read (current-buffer))))))
- (when (and (stringp old-getprop)
- (not (string-equal old-getprop new-getprop)))
- (tramp-message
- vec 3
- "Connection reset, because remote host changed from `%s' to
`%s'"
- old-getprop new-getprop)
- (tramp-cleanup-connection vec t)
- (tramp-adb-maybe-open-connection vec)))
-
- ;; Change user if indicated.
- (when user
- (tramp-adb-send-command vec (format "su %s" user))
- (unless (tramp-adb-send-command-and-check vec nil)
- (delete-process p)
- ;; Do not flush, we need the nil value.
- (tramp-set-file-property vec "/" "su-command-p" nil)
- (tramp-error
- vec 'file-error "Cannot switch to user `%s'" user)))
-
- ;; Mark it as connected.
- (tramp-set-connection-property p "connected" t)))))))
+ (with-tramp-debug-message vec "Opening connection"
+ (let* ((buf (tramp-get-connection-buffer vec))
+ (p (get-buffer-process buf))
+ (host (tramp-file-name-host vec))
+ (user (tramp-file-name-user vec))
+ (device (tramp-adb-get-device vec)))
+
+ ;; Maybe we know already that "su" is not supported. We cannot
+ ;; use a connection property, because we have not checked yet
+ ;; whether it is still the same device.
+ (when (and user (not (tramp-get-file-property vec "/" "su-command-p" t)))
+ (tramp-error vec 'file-error "Cannot switch to user `%s'" user))
+
+ (unless (process-live-p p)
+ (save-match-data
+ (when (and p (processp p)) (delete-process p))
+ (if (tramp-string-empty-or-nil-p device)
+ (tramp-error vec 'file-error "Device %s not connected" host))
+ (with-tramp-progress-reporter vec 3 "Opening adb shell connection"
+ (let* ((coding-system-for-read 'utf-8-dos) ; Is this correct?
+ (process-connection-type tramp-process-connection-type)
+ (args (tramp-expand-args
+ vec 'tramp-login-args ?d (or device "")))
+ (p (let ((default-directory
+ tramp-compat-temporary-file-directory))
+ (apply
+ #'start-process (tramp-get-connection-name vec) buf
+ tramp-adb-program args)))
+ (prompt (md5 (concat (prin1-to-string process-environment)
+ (current-time-string)))))
+ ;; Wait for initial prompt. On some devices, it needs
+ ;; an initial RET, in order to get it.
+ (sleep-for 0.1)
+ (tramp-send-string vec tramp-rsh-end-of-line)
+ (tramp-adb-wait-for-output p 30)
+ (unless (process-live-p p)
+ (tramp-error vec 'file-error "Terminated!"))
+
+ ;; Set sentinel. Initialize variables.
+ (set-process-sentinel p #'tramp-process-sentinel)
+ (tramp-post-process-creation p vec)
+
+ ;; Set connection-local variables.
+ (tramp-set-connection-local-variables vec)
+
+ ;; Change prompt.
+ (tramp-set-connection-property
+ p "prompt" (rx "///" (literal prompt) "#$"))
+ (tramp-adb-send-command
+ vec (format "PS1=\"///\"\"%s\"\"#$\"" prompt))
+
+ ;; Disable line editing.
+ (tramp-adb-send-command
+ vec "set +o vi +o vi-esccomplete +o vi-tabcomplete +o emacs")
+
+ ;; Dump option settings in the traces.
+ (when (>= tramp-verbose 9)
+ (tramp-adb-send-command vec "set -o"))
+
+ ;; Check whether the properties have been changed. If
+ ;; yes, this is a strong indication that we must expire
+ ;; all connection properties. We start again.
+ (tramp-message vec 5 "Checking system information")
+ (tramp-adb-send-command
+ vec
+ (concat
+ "echo \\\"`getprop ro.product.model` "
+ "`getprop ro.product.version` "
+ "`getprop ro.build.version.release`\\\""))
+ (let ((old-getprop (tramp-get-connection-property vec "getprop"))
+ (new-getprop
+ (tramp-set-connection-property
+ vec "getprop"
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ ;; Read the expression.
+ (goto-char (point-min))
+ (read (current-buffer))))))
+ (when (and (stringp old-getprop)
+ (not (string-equal old-getprop new-getprop)))
+ (tramp-message
+ vec 3
+ (concat
+ "Connection reset, because remote host changed "
+ "from `%s' to `%s'")
+ old-getprop new-getprop)
+ (tramp-cleanup-connection vec t)
+ (tramp-adb-maybe-open-connection vec)))
+
+ ;; Change user if indicated.
+ (when user
+ (tramp-adb-send-command vec (format "su %s" user))
+ (unless (tramp-adb-send-command-and-check vec nil)
+ (delete-process p)
+ ;; Do not flush, we need the nil value.
+ (tramp-set-file-property vec "/" "su-command-p" nil)
+ (tramp-error
+ vec 'file-error "Cannot switch to user `%s'" user)))
+
+ ;; Mark it as connected.
+ (tramp-set-connection-property p "connected" t))))))))
;;; Default connection-local variables for Tramp.
diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el
index 07f449a3a2e..3c9b9e984e6 100644
--- a/lisp/net/tramp-cmds.el
+++ b/lisp/net/tramp-cmds.el
@@ -738,7 +738,7 @@ buffer in your bug report.
;; Beautify encoded values.
(goto-char (point-min))
- (while (re-search-forward
+ (while (search-forward-regexp
(rx "'" (group "(decode-coding-string")) nil 'noerror)
(replace-match "\\1"))
(goto-char (point-max))
@@ -766,7 +766,7 @@ buffer in your bug report.
(setq buffer-read-only nil)
(goto-char (point-min))
(while (not (eobp))
- (if (re-search-forward tramp-buf-regexp (line-end-position) t)
+ (if (search-forward-regexp tramp-buf-regexp (line-end-position) t)
(forward-line 1)
(forward-line 0)
(let ((start (point)))
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index bb7b266dd35..61359562ee3 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -202,7 +202,7 @@ Add the extension of F, if existing."
(let ((matches 0)
(case-fold-search nil))
(goto-char start)
- (while (re-search-forward regexp end t)
+ (while (search-forward-regexp regexp end t)
(replace-match replacement t)
(setq matches (1+ matches)))
(and (not (zerop matches))
diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el
index 9d52966b817..c85f566c4d5 100644
--- a/lisp/net/tramp-crypt.el
+++ b/lisp/net/tramp-crypt.el
@@ -279,8 +279,10 @@ arguments to pass to the OPERATION."
(apply #'tramp-crypt-file-name-for-operation operation args))
(fn (and (tramp-crypt-file-name-p filename)
(assoc operation tramp-crypt-file-name-handler-alist))))
- (save-match-data (apply (cdr fn) args))
- (tramp-crypt-run-real-handler operation args)))
+ (prog1 (save-match-data (apply (cdr fn) args))
+ (setq tramp-debug-message-fnh-function (cdr fn)))
+ (prog1 (tramp-run-real-handler operation args)
+ (setq tramp-debug-message-fnh-function operation))))
;;;###tramp-autoload
(progn (defun tramp-register-crypt-file-name-handler ()
@@ -312,73 +314,75 @@ connection if a previous connection has died for some
reason."
;; For password handling, we need a process bound to the connection
;; buffer. Therefore, we create a dummy process. Maybe there is a
;; better solution?
- (unless (get-buffer-process (tramp-get-connection-buffer vec))
- (let ((p (make-network-process
- :name (tramp-get-connection-name vec)
- :buffer (tramp-get-connection-buffer vec)
- :server t :host 'local :service t :noquery t)))
- (tramp-post-process-creation p vec)))
-
- ;; The following operations must be performed without
- ;; `tramp-crypt-file-name-handler'.
- (let* (tramp-crypt-enabled
- ;; Don't check for a proper method.
- (non-essential t)
- (remote-config
- (expand-file-name
- tramp-crypt-encfs-config (tramp-crypt-get-remote-dir vec)))
- (local-config (tramp-crypt-config-file-name vec)))
- ;; There is no local encfs6 config file.
- (unless (file-exists-p local-config)
- (if (and tramp-crypt-save-encfs-config-remote
- (file-exists-p remote-config))
- ;; Copy remote encfs6 config file if possible.
- (copy-file remote-config local-config 'ok 'keep)
-
- ;; Create local encfs6 config file otherwise.
- (let* ((default-directory tramp-compat-temporary-file-directory)
- (tmpdir1 (file-name-as-directory
- (tramp-compat-make-temp-file " .crypt" 'dir-flag)))
- (tmpdir2 (file-name-as-directory
- (tramp-compat-make-temp-file " .nocrypt" 'dir-flag))))
- ;; Enable `auth-source', unless "emacs -Q" has been called.
- (tramp-set-connection-property
- vec "first-password-request" tramp-cache-read-persistent-data)
- (with-temp-buffer
- (insert
- (tramp-read-passwd
- (tramp-get-connection-process vec)
- (format
- "New EncFS Password for %s " (tramp-crypt-get-remote-dir vec))))
- (when
- (zerop
- (tramp-call-process-region
- vec (point-min) (point-max)
- tramp-crypt-encfs-program nil (tramp-get-connection-buffer
vec)
- nil tramp-crypt-encfs-option "--extpass=cat" tmpdir1 tmpdir2))
- ;; Save the password.
- (ignore-errors
- (and (functionp tramp-password-save-function)
- (funcall tramp-password-save-function)))))
-
- ;; Write local config file. Suppress file name IV chaining mode.
- (with-temp-file local-config
- (insert-file-contents
- (expand-file-name tramp-crypt-encfs-config tmpdir1))
- (when (search-forward
- "<chainedNameIV>1</chainedNameIV>" nil 'noerror)
- (replace-match "<chainedNameIV>0</chainedNameIV>")))
-
- ;; Unmount encfs. Delete temporary directories.
- (tramp-call-process
- vec tramp-crypt-encfs-program nil nil nil
- "--unmount" tmpdir1 tmpdir2)
- (delete-directory tmpdir1 'recursive)
- (delete-directory tmpdir2)
-
- ;; Copy local encfs6 config file to remote.
- (when tramp-crypt-save-encfs-config-remote
- (copy-file local-config remote-config 'ok 'keep)))))))
+ (with-tramp-debug-message vec "Opening connection"
+ (unless (get-buffer-process (tramp-get-connection-buffer vec))
+ (let ((p (make-network-process
+ :name (tramp-get-connection-name vec)
+ :buffer (tramp-get-connection-buffer vec)
+ :server t :host 'local :service t :noquery t)))
+ (tramp-post-process-creation p vec)))
+
+ ;; The following operations must be performed without
+ ;; `tramp-crypt-file-name-handler'.
+ (let* (tramp-crypt-enabled
+ ;; Don't check for a proper method.
+ (non-essential t)
+ (remote-config
+ (expand-file-name
+ tramp-crypt-encfs-config (tramp-crypt-get-remote-dir vec)))
+ (local-config (tramp-crypt-config-file-name vec)))
+ ;; There is no local encfs6 config file.
+ (unless (file-exists-p local-config)
+ (if (and tramp-crypt-save-encfs-config-remote
+ (file-exists-p remote-config))
+ ;; Copy remote encfs6 config file if possible.
+ (copy-file remote-config local-config 'ok 'keep)
+
+ ;; Create local encfs6 config file otherwise.
+ (let* ((default-directory tramp-compat-temporary-file-directory)
+ (tmpdir1 (file-name-as-directory
+ (tramp-compat-make-temp-file " .crypt" 'dir-flag)))
+ (tmpdir2 (file-name-as-directory
+ (tramp-compat-make-temp-file " .nocrypt"
'dir-flag))))
+ ;; Enable `auth-source', unless "emacs -Q" has been called.
+ (tramp-set-connection-property
+ vec "first-password-request" tramp-cache-read-persistent-data)
+ (with-temp-buffer
+ (insert
+ (tramp-read-passwd
+ (tramp-get-connection-process vec)
+ (format
+ "New EncFS Password for %s " (tramp-crypt-get-remote-dir
vec))))
+ (when
+ (zerop
+ (tramp-call-process-region
+ vec (point-min) (point-max)
+ tramp-crypt-encfs-program nil
+ (tramp-get-connection-buffer vec) nil
+ tramp-crypt-encfs-option "--extpass=cat" tmpdir1 tmpdir2))
+ ;; Save the password.
+ (ignore-errors
+ (and (functionp tramp-password-save-function)
+ (funcall tramp-password-save-function)))))
+
+ ;; Write local config file. Suppress file name IV chaining mode.
+ (with-temp-file local-config
+ (insert-file-contents
+ (expand-file-name tramp-crypt-encfs-config tmpdir1))
+ (when (search-forward
+ "<chainedNameIV>1</chainedNameIV>" nil 'noerror)
+ (replace-match "<chainedNameIV>0</chainedNameIV>")))
+
+ ;; Unmount encfs. Delete temporary directories.
+ (tramp-call-process
+ vec tramp-crypt-encfs-program nil nil nil
+ "--unmount" tmpdir1 tmpdir2)
+ (delete-directory tmpdir1 'recursive)
+ (delete-directory tmpdir2)
+
+ ;; Copy local encfs6 config file to remote.
+ (when tramp-crypt-save-encfs-config-remote
+ (copy-file local-config remote-config 'ok 'keep))))))))
(defun tramp-crypt-send-command (vec &rest args)
"Send encfsctl command to connection VEC.
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 27dbf324924..72cf4a6a4b3 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -895,8 +895,10 @@ arguments to pass to the OPERATION."
(and (tramp-tramp-file-p filename)
(tramp-dissect-file-name filename)))
(fn (assoc operation tramp-gvfs-file-name-handler-alist)))
- (save-match-data (apply (cdr fn) args))
- (tramp-run-real-handler operation args)))
+ (prog1 (save-match-data (apply (cdr fn) args))
+ (setq tramp-debug-message-fnh-function (cdr fn)))
+ (prog1 (tramp-run-real-handler operation args)
+ (setq tramp-debug-message-fnh-function operation))))
;;;###tramp-autoload
(when (featurep 'dbusbind)
@@ -1308,7 +1310,7 @@ If FILE-SYSTEM is non-nil, return file system attributes."
;; Parse output.
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
- (while (re-search-forward
+ (while (search-forward-regexp
(if file-system
tramp-gvfs-file-system-attributes-regexp
tramp-gvfs-file-attributes-with-gvfs-info-regexp)
@@ -2182,137 +2184,139 @@ connection if a previous connection has died for some
reason."
(unless (tramp-connectable-p vec)
(throw 'non-essential 'non-essential))
- ;; Sanity check.
- (let ((method (tramp-file-name-method vec)))
- (unless (member
- (or (assoc-default
- method '(("smb" . "smb-share")
- ("davs" . "dav")
- ("nextcloud" . "dav")
- ("afp". "afp-volume")
- ("gdrive" . "google-drive")))
- method)
- tramp-gvfs-mounttypes)
- (tramp-error vec 'file-error "Method `%s' not supported by GVFS"
method)))
-
- ;; For password handling, we need a process bound to the connection
- ;; buffer. Therefore, we create a dummy process. Maybe there is a
- ;; better solution?
- (unless (get-buffer-process (tramp-get-connection-buffer vec))
- (let ((p (make-network-process
- :name (tramp-get-connection-name vec)
- :buffer (tramp-get-connection-buffer vec)
- :server t :host 'local :service t :noquery t)))
- (tramp-post-process-creation p vec)
-
- ;; Set connection-local variables.
- (tramp-set-connection-local-variables vec)))
-
- (unless (tramp-gvfs-connection-mounted-p vec)
- (let ((method (tramp-file-name-method vec))
- (user (tramp-file-name-user vec))
- (host (tramp-file-name-host vec))
- (localname (tramp-file-name-unquote-localname vec))
- (object-path
- (tramp-gvfs-object-path (tramp-make-tramp-file-name vec 'noloc))))
-
- (when (and (string-equal method "afp")
- (string-equal localname "/"))
- (tramp-user-error vec "Filename must contain an AFP volume"))
-
- (when (and (string-match-p (rx "dav" (? "s")) method)
- (string-equal localname "/"))
- (tramp-user-error vec "Filename must contain a WebDAV share"))
-
- (when (and (string-equal method "smb")
- (string-equal localname "/"))
- (tramp-user-error vec "Filename must contain a Windows share"))
-
- (when (member method tramp-goa-methods)
- ;; Ensure that GNOME Online Accounts are cached.
- (tramp-get-goa-accounts vec)
- (when (tramp-get-connection-property
- (tramp-get-goa-account vec) "FilesDisabled" t)
- (tramp-user-error
- vec "There is no Online Account `%s'"
- (tramp-make-tramp-file-name vec 'noloc))))
-
- (with-tramp-progress-reporter
- vec 3
- (if (tramp-string-empty-or-nil-p user)
- (format "Opening connection for %s using %s" host method)
- (format "Opening connection for %s@%s using %s" user host method))
-
- ;; Enable `auth-source'.
- (tramp-set-connection-property
- vec "first-password-request" tramp-cache-read-persistent-data)
-
- ;; There will be a callback of "askPassword" when a password is needed.
- (dbus-register-method
- :session dbus-service-emacs object-path
- tramp-gvfs-interface-mountoperation "askPassword"
- #'tramp-gvfs-handler-askpassword)
- (dbus-register-method
- :session dbus-service-emacs object-path
- tramp-gvfs-interface-mountoperation "AskPassword"
- #'tramp-gvfs-handler-askpassword)
-
- ;; There could be a callback of "askQuestion" when adding
- ;; fingerprints or checking certificates.
- (dbus-register-method
- :session dbus-service-emacs object-path
- tramp-gvfs-interface-mountoperation "askQuestion"
- #'tramp-gvfs-handler-askquestion)
- (dbus-register-method
- :session dbus-service-emacs object-path
- tramp-gvfs-interface-mountoperation "AskQuestion"
- #'tramp-gvfs-handler-askquestion)
-
- ;; The call must be asynchronously, because of the "askPassword"
- ;; or "askQuestion" callbacks.
- (if (string-match-p (rx "(so)" eol) tramp-gvfs-mountlocation-signature)
+ (with-tramp-debug-message vec "Opening connection"
+ ;; Sanity check.
+ (let ((method (tramp-file-name-method vec)))
+ (unless (member
+ (or (assoc-default
+ method '(("smb" . "smb-share")
+ ("davs" . "dav")
+ ("nextcloud" . "dav")
+ ("afp". "afp-volume")
+ ("gdrive" . "google-drive")))
+ method)
+ tramp-gvfs-mounttypes)
+ (tramp-error
+ vec 'file-error "Method `%s' not supported by GVFS" method)))
+
+ ;; For password handling, we need a process bound to the
+ ;; connection buffer. Therefore, we create a dummy process.
+ ;; Maybe there is a better solution?
+ (unless (get-buffer-process (tramp-get-connection-buffer vec))
+ (let ((p (make-network-process
+ :name (tramp-get-connection-name vec)
+ :buffer (tramp-get-connection-buffer vec)
+ :server t :host 'local :service t :noquery t)))
+ (tramp-post-process-creation p vec)
+
+ ;; Set connection-local variables.
+ (tramp-set-connection-local-variables vec)))
+
+ (unless (tramp-gvfs-connection-mounted-p vec)
+ (let ((method (tramp-file-name-method vec))
+ (user (tramp-file-name-user vec))
+ (host (tramp-file-name-host vec))
+ (localname (tramp-file-name-unquote-localname vec))
+ (object-path
+ (tramp-gvfs-object-path (tramp-make-tramp-file-name vec 'noloc))))
+
+ (when (and (string-equal method "afp")
+ (string-equal localname "/"))
+ (tramp-user-error vec "Filename must contain an AFP volume"))
+
+ (when (and (string-match-p (rx "dav" (? "s")) method)
+ (string-equal localname "/"))
+ (tramp-user-error vec "Filename must contain a WebDAV share"))
+
+ (when (and (string-equal method "smb")
+ (string-equal localname "/"))
+ (tramp-user-error vec "Filename must contain a Windows share"))
+
+ (when (member method tramp-goa-methods)
+ ;; Ensure that GNOME Online Accounts are cached.
+ (tramp-get-goa-accounts vec)
+ (when (tramp-get-connection-property
+ (tramp-get-goa-account vec) "FilesDisabled" t)
+ (tramp-user-error
+ vec "There is no Online Account `%s'"
+ (tramp-make-tramp-file-name vec 'noloc))))
+
+ (with-tramp-progress-reporter
+ vec 3
+ (if (tramp-string-empty-or-nil-p user)
+ (format "Opening connection for %s using %s" host method)
+ (format "Opening connection for %s@%s using %s" user host method))
+
+ ;; Enable `auth-source'.
+ (tramp-set-connection-property
+ vec "first-password-request" tramp-cache-read-persistent-data)
+
+ ;; There will be a callback of "askPassword" when a password is
needed.
+ (dbus-register-method
+ :session dbus-service-emacs object-path
+ tramp-gvfs-interface-mountoperation "askPassword"
+ #'tramp-gvfs-handler-askpassword)
+ (dbus-register-method
+ :session dbus-service-emacs object-path
+ tramp-gvfs-interface-mountoperation "AskPassword"
+ #'tramp-gvfs-handler-askpassword)
+
+ ;; There could be a callback of "askQuestion" when adding
+ ;; fingerprints or checking certificates.
+ (dbus-register-method
+ :session dbus-service-emacs object-path
+ tramp-gvfs-interface-mountoperation "askQuestion"
+ #'tramp-gvfs-handler-askquestion)
+ (dbus-register-method
+ :session dbus-service-emacs object-path
+ tramp-gvfs-interface-mountoperation "AskQuestion"
+ #'tramp-gvfs-handler-askquestion)
+
+ ;; The call must be asynchronously, because of the
+ ;; "askPassword" or "askQuestion" callbacks.
+ (if (string-match-p (rx "(so)" eol)
tramp-gvfs-mountlocation-signature)
+ (with-tramp-dbus-call-method vec nil
+ :session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker
+ tramp-gvfs-interface-mounttracker tramp-gvfs-mountlocation
+ (tramp-gvfs-mount-spec vec)
+ `(:struct :string ,(dbus-get-unique-name :session)
+ :object-path ,object-path))
(with-tramp-dbus-call-method vec nil
:session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker
tramp-gvfs-interface-mounttracker tramp-gvfs-mountlocation
(tramp-gvfs-mount-spec vec)
- `(:struct :string ,(dbus-get-unique-name :session)
- :object-path ,object-path))
- (with-tramp-dbus-call-method vec nil
- :session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker
- tramp-gvfs-interface-mounttracker tramp-gvfs-mountlocation
- (tramp-gvfs-mount-spec vec)
- :string (dbus-get-unique-name :session) :object-path object-path))
-
- ;; We must wait, until the mount is applied. This will be
- ;; indicated by the "mounted" signal, i.e. the "fuse-mountpoint"
- ;; file property.
- (with-timeout
- ((or (tramp-get-method-parameter vec 'tramp-connection-timeout)
- tramp-connection-timeout)
- (if (tramp-string-empty-or-nil-p (tramp-file-name-user vec))
+ :string (dbus-get-unique-name :session) :object-path object-path))
+
+ ;; We must wait, until the mount is applied. This will be
+ ;; indicated by the "mounted" signal, i.e. the
+ ;; "fuse-mountpoint" file property.
+ (with-timeout
+ ((or (tramp-get-method-parameter vec 'tramp-connection-timeout)
+ tramp-connection-timeout)
+ (if (tramp-string-empty-or-nil-p (tramp-file-name-user vec))
+ (tramp-error
+ vec 'file-error
+ "Timeout reached mounting %s using %s" host method)
(tramp-error
vec 'file-error
- "Timeout reached mounting %s using %s" host method)
- (tramp-error
- vec 'file-error
- "Timeout reached mounting %s@%s using %s" user host method)))
- (while (not (tramp-get-file-property vec "/" "fuse-mountpoint"))
- (read-event nil nil 0.1)))
-
- ;; If `tramp-gvfs-handler-askquestion' has returned "No", it
- ;; is marked with the fuse-mountpoint "/". We shall react.
- (when (string-equal
- (tramp-get-file-property vec "/" "fuse-mountpoint" "") "/")
- (tramp-error vec 'file-error "FUSE mount denied"))
-
- ;; Save the password.
- (ignore-errors
- (and (functionp tramp-password-save-function)
- (funcall tramp-password-save-function)))
-
- ;; Mark it as connected.
- (tramp-set-connection-property
- (tramp-get-connection-process vec) "connected" t)))))
+ "Timeout reached mounting %s@%s using %s" user host method)))
+ (while (not (tramp-get-file-property vec "/" "fuse-mountpoint"))
+ (read-event nil nil 0.1)))
+
+ ;; If `tramp-gvfs-handler-askquestion' has returned "No", it
+ ;; is marked with the fuse-mountpoint "/". We shall react.
+ (when (string-equal
+ (tramp-get-file-property vec "/" "fuse-mountpoint" "") "/")
+ (tramp-error vec 'file-error "FUSE mount denied"))
+
+ ;; Save the password.
+ (ignore-errors
+ (and (functionp tramp-password-save-function)
+ (funcall tramp-password-save-function)))
+
+ ;; Mark it as connected.
+ (tramp-set-connection-property
+ (tramp-get-connection-process vec) "connected" t))))))
(defun tramp-gvfs-gio-tool-p (vec)
"Check, whether the gio tool is available."
diff --git a/lisp/net/tramp-message.el b/lisp/net/tramp-message.el
new file mode 100644
index 00000000000..bfefd95096d
--- /dev/null
+++ b/lisp/net/tramp-message.el
@@ -0,0 +1,572 @@
+;;; tramp-message.el --- Tramp messages -*- lexical-binding:t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; Author: Michael Albinus <michael.albinus@gmx.de>
+;; Keywords: comm, processes
+;; Package: tramp
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This package collects all Tramp functions to trace. This is driven
+;; by the user option `tramp-verbose'. The following buffers are
+;; created:
+;;
+;; - *debug tramp/method user@host*
+;;
+;; This buffer is created when `tramp-verbose' is greater than or
+;; equal 4. It contains all messages with a level up to `tramp-verbose'.
+;;
+;; When `tramp-debug-command-messages' is non-nil and
+;; `tramp-verbose' is greater than or equal 6, the buffer contains
+;; all messages with level 6 and the entry/exit messages of
+;; `tramp-file-name-handler'. This is intended to analyze which
+;; remote commands are sent for a given file name operation.
+;;
+;; - *trace tramp/method user@host*
+;;
+;; This buffer is created by the trace.el package when
+;; `tramp-verbose' is is greater than or equal 11. It traces all
+;; functions with suffix "tramp-" except those function with the
+;; property `tramp-suppress-trace'.
+
+;;; Code:
+
+(require 'tramp-loaddefs)
+(require 'help-mode)
+
+(declare-function tramp-compat-string-replace "tramp-compat")
+(declare-function tramp-file-name-equal-p "tramp")
+(declare-function tramp-get-default-directory "tramp")
+(defvar tramp-compat-temporary-file-directory)
+
+;;;###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
+
+ 0 silent (no tramp messages at all)
+ 1 errors
+ 2 warnings
+ 3 connection to remote hosts (default level)
+ 4 activities
+ 5 internal
+ 6 sent and received strings
+ 7 connection properties
+ 8 file caching
+ 9 test commands
+10 traces (huge)
+11 call traces (maintainer only)."
+ :group 'tramp
+ :type 'integer)
+
+(defcustom tramp-debug-to-file nil
+ "Whether Tramp debug messages shall be saved to file.
+The debug file has the same name as the debug buffer, written to
+`tramp-compat-temporary-file-directory'."
+ :group 'tramp
+ :version "28.1"
+ :type 'boolean)
+
+(defcustom tramp-debug-command-messages nil
+ "Whether to write only command messages to the debug buffer.
+This has only effect if `tramp-verbose' is greater than or equal 6."
+ :group 'tramp
+ :version "30.1"
+ :type 'boolean)
+
+(defconst tramp-debug-outline-regexp
+ (rx ;; Timestamp.
+ (+ digit) ":" (+ digit) ":" (+ digit) "." (+ digit) blank
+ ;; Thread.
+ (? (group "#<thread " (+ nonl) ">") blank)
+ ;; Function name, verbosity.
+ (group (+ (any "-" alnum))) " (" (group (+ digit)) ") #")
+ "Used for highlighting Tramp debug buffers in `outline-mode'.
+When it is used for regexp matching, the regexp groups are
+
+ 1 for the thread name (optional)
+ 2 for the function name
+ 3 for the verbosity level.")
+
+(defconst tramp-debug-font-lock-keywords
+ ;; FIXME: Make it a function instead of an ELisp expression, so you
+ ;; can evaluate it with `funcall' rather than `eval'!
+ ;; Also, in `font-lock-defaults' you can specify a function name for
+ ;; the "KEYWORDS" part, so font-lock calls it to get the actual keywords!
+ '(list
+ (rx bol (regexp tramp-debug-outline-regexp) (+ nonl))
+ '(1 font-lock-warning-face t t)
+ '(0 (outline-font-lock-face) keep t))
+ "Used for highlighting Tramp debug buffers in `outline-mode'.")
+
+(defun tramp-debug-outline-level ()
+ "Return the depth to which a statement is nested in the outline.
+Point must be at the beginning of a header line.
+
+The outline level is equal to the verbosity of the Tramp message."
+ (1+ (string-to-number (match-string 3))))
+
+(put #'tramp-debug-outline-level 'tramp-suppress-trace t)
+
+;; This function takes action since Emacs 28.1, when
+;; `read-extended-command-predicate' is set to
+;; `command-completion-default-include-p'.
+(defun tramp-debug-buffer-command-completion-p (_symbol buffer)
+ "A predicate for Tramp interactive commands.
+They are completed by \"M-x TAB\" only in Tramp debug buffers."
+ (with-current-buffer buffer
+ (string-equal
+ (buffer-substring (point-min) (min (+ (point-min) 10) (point-max)))
+ ";; Emacs:")))
+
+(put #'tramp-debug-buffer-command-completion-p 'tramp-suppress-trace t)
+
+(defun tramp-setup-debug-buffer ()
+ "Function to setup debug buffers."
+ ;; (declare (completion tramp-debug-buffer-command-completion-p))
+ (interactive)
+ (set-buffer-file-coding-system 'utf-8)
+ (setq buffer-undo-list t)
+ ;; Activate `outline-mode'. This runs `text-mode-hook' and
+ ;; `outline-mode-hook'. We must prevent that local processes die.
+ ;; Yes: I've seen `flyspell-mode', which starts "ispell".
+ ;; `(custom-declare-variable outline-minor-mode-prefix ...)' raises
+ ;; on error in `(outline-mode)', we don't want to see it in the
+ ;; traces.
+ (let ((default-directory tramp-compat-temporary-file-directory))
+ (outline-mode))
+ (setq-local outline-level 'tramp-debug-outline-level)
+ (setq-local font-lock-keywords
+ ;; FIXME: This `(t FOO . BAR)' representation in
+ ;; `font-lock-keywords' is supposed to be an internal
+ ;; implementation "detail". Don't abuse it here!
+ `(t (eval ,tramp-debug-font-lock-keywords t)
+ ,(eval tramp-debug-font-lock-keywords t)))
+ ;; Do not edit the debug buffer.
+ (use-local-map special-mode-map)
+ (set-buffer-modified-p nil)
+ ;; For debugging purposes.
+ (local-set-key "\M-n" 'clone-buffer)
+ (add-hook 'clone-buffer-hook #'tramp-setup-debug-buffer nil 'local))
+
+(put #'tramp-setup-debug-buffer 'tramp-suppress-trace t)
+
+(function-put
+ #'tramp-setup-debug-buffer 'completion-predicate
+ #'tramp-debug-buffer-command-completion-p)
+
+(defun tramp-debug-buffer-name (vec)
+ "A name for the debug buffer of VEC."
+ (let ((method (tramp-file-name-method vec))
+ (user-domain (tramp-file-name-user-domain vec))
+ (host-port (tramp-file-name-host-port vec)))
+ (if (or (null user-domain) (string-empty-p user-domain))
+ (format "*debug tramp/%s %s*" method host-port)
+ (format "*debug tramp/%s %s@%s*" method user-domain host-port))))
+
+(put #'tramp-debug-buffer-name 'tramp-suppress-trace t)
+
+(defun tramp-get-debug-buffer (vec)
+ "Get the debug buffer of VEC."
+ (with-current-buffer (get-buffer-create (tramp-debug-buffer-name vec))
+ (when (bobp)
+ (tramp-setup-debug-buffer))
+ (current-buffer)))
+
+(put #'tramp-get-debug-buffer 'tramp-suppress-trace t)
+
+(defun tramp-get-debug-file-name (vec)
+ "Get the debug file name for VEC."
+ (expand-file-name
+ (tramp-compat-string-replace "/" " " (tramp-debug-buffer-name vec))
+ tramp-compat-temporary-file-directory))
+
+(put #'tramp-get-debug-file-name 'tramp-suppress-trace t)
+
+(defun tramp-trace-buffer-name (vec)
+ "A name for the trace buffer for VEC."
+ (tramp-compat-string-replace "*debug" "*trace" (tramp-debug-buffer-name
vec)))
+
+(put #'tramp-trace-buffer-name 'tramp-suppress-trace t)
+
+(defvar tramp-trace-functions nil
+ "A list of non-Tramp functions to be traced with `tramp-verbose' > 10.")
+
+(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
+ARGUMENTS to actually emit the message (if applicable)."
+ (let ((inhibit-message t)
+ create-lockfiles file-name-handler-alist message-log-max
+ signal-hook-function)
+ (with-current-buffer (tramp-get-debug-buffer vec)
+ (goto-char (point-max))
+ (let ((point (point)))
+ (when (bobp)
+ ;; Headline.
+ (insert
+ (format
+ ";; Emacs: %s Tramp: %s -*- mode: outline; coding: utf-8; -*-"
+ emacs-version tramp-version))
+ (when (>= tramp-verbose 10)
+ (let ((tramp-verbose 0))
+ (insert
+ (format
+ "\n;; Location: %s Git: %s/%s"
+ (locate-library "tramp")
+ (or tramp-repository-branch "")
+ (or tramp-repository-version "")))))
+ ;; Traces.
+ (when (>= tramp-verbose 11)
+ (dolist
+ (elt
+ (append
+ (mapcar
+ #'intern (all-completions "tramp-" obarray #'functionp))
+ tramp-trace-functions))
+ (unless (get elt 'tramp-suppress-trace)
+ (trace-function-background elt (tramp-trace-buffer-name vec)))))
+ ;; Delete debug file.
+ (when (and tramp-debug-to-file (tramp-get-debug-file-name vec))
+ (ignore-errors (delete-file (tramp-get-debug-file-name vec)))))
+ (unless (bolp)
+ (insert "\n"))
+ ;; Timestamp.
+ (insert (format-time-string "%T.%6N "))
+ ;; Threads. `current-thread' might not exist when Emacs is
+ ;; configured --without-threads.
+ ;; (unless (eq (tramp-compat-funcall 'current-thread) main-thread)
+ ;; (insert (format "%s " (tramp-compat-funcall 'current-thread))))
+ ;; Calling Tramp function. We suppress compat and trace
+ ;; functions from being displayed.
+ (let ((frames (backtrace-frames))
+ btf fn)
+ (while (not fn)
+ (setq btf (cadadr frames))
+ (if (not btf)
+ (setq fn "")
+ (and (symbolp btf) (setq fn (symbol-name btf))
+ (or (not (string-prefix-p "tramp" fn))
+ (get btf 'tramp-suppress-trace))
+ (setq fn nil))
+ (setq frames (cdr frames))))
+ ;; The following code inserts filename and line number.
+ ;; Should be inactive by default, because it is time consuming.
+ ;; (let ((ffn (find-function-noselect (intern fn))))
+ ;; (insert
+ ;; (format
+ ;; "%s:%d: "
+ ;; (file-name-nondirectory (buffer-file-name (car ffn)))
+ ;; (with-current-buffer (car ffn)
+ ;; (1+ (count-lines (point-min) (cdr ffn)))))))
+ (insert (format "%s " fn)))
+ ;; The message.
+ (insert (apply #'format-message fmt-string arguments))
+ (if tramp-debug-command-messages
+ ;; Add help function.
+ (tramp-debug-message-buttonize point)
+ ;; Write message to debug file.
+ (when tramp-debug-to-file
+ (ignore-errors
+ (write-region
+ point (point-max) (tramp-get-debug-file-name vec) 'append))))))))
+
+(put #'tramp-debug-message 'tramp-suppress-trace t)
+
+;;;###tramp-autoload
+(defun 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
+vector or a process. LEVEL says to be quiet if `tramp-verbose' is
+less than LEVEL. The message is emitted only if `tramp-verbose' is
+greater than or equal to LEVEL.
+
+The message is also logged into the debug buffer when `tramp-verbose'
+is greater than or equal 4.
+
+Calls functions `message' and `tramp-debug-message' with FMT-STRING as
+control string and the remaining ARGUMENTS to actually emit the message (if
+applicable)."
+ (ignore-errors
+ (when (<= level tramp-verbose)
+ ;; Display only when there is a minimum level, and the progress
+ ;; reporter doesn't suppress further messages.
+ (when (and (<= level 3) (null tramp-inhibit-progress-reporter))
+ (apply #'message
+ (concat
+ (cond
+ ((= level 0) "")
+ ((= level 1) "")
+ ((= level 2) "Warning: ")
+ (t "Tramp: "))
+ fmt-string)
+ arguments))
+ ;; Log only when there is a minimum level.
+ (when (>= tramp-verbose 4)
+ (let ((tramp-verbose 0))
+ ;; Append connection buffer for error messages, if exists.
+ (when (= level 1)
+ (ignore-errors
+ (setq fmt-string (concat fmt-string "\n%s")
+ arguments
+ (append
+ arguments
+ `(,(tramp-get-buffer-string
+ (if (processp vec-or-proc)
+ (process-buffer vec-or-proc)
+ (tramp-get-connection-buffer
+ vec-or-proc 'dont-create))))))))
+ ;; Translate proc to vec.
+ (when (processp vec-or-proc)
+ (setq vec-or-proc (process-get vec-or-proc 'tramp-vector))))
+ ;; Do it.
+ (when (and (tramp-file-name-p vec-or-proc)
+ (or (null tramp-debug-command-messages) (= level 6)))
+ (apply #'tramp-debug-message
+ vec-or-proc
+ (concat (format "(%d) # " level) fmt-string)
+ arguments))))))
+
+(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
+forces the backtrace even if `tramp-verbose' is less than 10.
+This function is meant for debugging purposes."
+ (let ((tramp-verbose (if force 10 tramp-verbose)))
+ (when (>= tramp-verbose 10)
+ (if vec-or-proc
+ (tramp-message
+ vec-or-proc 10 "\n%s" (with-output-to-string (backtrace)))
+ (with-output-to-temp-buffer "*debug tramp*" (backtrace))))))
+
+(defsubst tramp-error (vec-or-proc signal fmt-string &rest arguments)
+ "Emit an error.
+VEC-OR-PROC identifies the connection to use, SIGNAL is the
+signal identifier to be raised, remaining arguments passed to
+`tramp-message'. Finally, signal SIGNAL is raised with
+FMT-STRING and ARGUMENTS."
+ (let (signal-hook-function)
+ (tramp-backtrace vec-or-proc)
+ (unless arguments
+ ;; FMT-STRING could be just a file name, as in
+ ;; `file-already-exists' errors. It could contain the ?\%
+ ;; character, as in smb domain spec.
+ (setq arguments (list fmt-string)
+ fmt-string "%s"))
+ (when vec-or-proc
+ (tramp-message
+ vec-or-proc 1 "%s"
+ (error-message-string
+ (list signal
+ (get signal 'error-message)
+ (apply #'format-message fmt-string arguments)))))
+ (signal signal (list (substring-no-properties
+ (apply #'format-message fmt-string arguments))))))
+
+(defvar tramp-error-show-message-timeout 30
+ "Time to show the Tramp buffer in case of an error.
+If it is bound to nil, the buffer is not shown. This is used in
+tramp-tests.el.")
+
+(defsubst tramp-error-with-buffer
+ (buf vec-or-proc signal fmt-string &rest arguments)
+ "Emit an error, and show BUF.
+If BUF is nil, show the connection buf. Wait for 30\", or until
+an input event arrives. The other arguments are passed to `tramp-error'."
+ (save-window-excursion
+ (let* ((buf (or (and (bufferp buf) buf)
+ (and (processp vec-or-proc) (process-buffer vec-or-proc))
+ (and (tramp-file-name-p vec-or-proc)
+ (tramp-get-connection-buffer vec-or-proc))))
+ (vec (or (and (tramp-file-name-p vec-or-proc) vec-or-proc)
+ (and buf (tramp-dissect-file-name
+ (tramp-get-default-directory buf))))))
+ (unwind-protect
+ (apply #'tramp-error vec-or-proc signal fmt-string arguments)
+ ;; Save exit.
+ (when (and buf
+ (natnump tramp-error-show-message-timeout)
+ (not (zerop tramp-verbose))
+ ;; Do not show when flagged from outside.
+ (not non-essential)
+ ;; Show only when Emacs has started already.
+ (current-message))
+ (let ((enable-recursive-minibuffers t)
+ inhibit-message)
+ ;; `tramp-error' does not show messages. So we must do it
+ ;; ourselves.
+ (apply #'message fmt-string arguments)
+ ;; Show buffer.
+ (pop-to-buffer buf)
+ (discard-input)
+ (sit-for tramp-error-show-message-timeout)))
+ ;; Reset timestamp. It would be wrong after waiting for a while.
+ (when (tramp-file-name-equal-p vec (car tramp-current-connection))
+ (setcdr tramp-current-connection (current-time)))))))
+
+(defsubst tramp-user-error (vec-or-proc fmt-string &rest arguments)
+ "Signal a user error (or \"pilot error\")."
+ (unwind-protect
+ (apply #'tramp-error vec-or-proc 'user-error fmt-string arguments)
+ ;; Save exit.
+ (when (and (natnump tramp-error-show-message-timeout)
+ (not (zerop tramp-verbose))
+ ;; Do not show when flagged from outside.
+ (not non-essential)
+ ;; Show only when Emacs has started already.
+ (current-message))
+ (let ((enable-recursive-minibuffers t)
+ inhibit-message)
+ ;; `tramp-error' does not show messages. So we must do it ourselves.
+ (apply #'message fmt-string arguments)
+ (discard-input)
+ (sit-for tramp-error-show-message-timeout)
+ ;; Reset timestamp. It would be wrong after waiting for a while.
+ (when
+ (tramp-file-name-equal-p vec-or-proc (car tramp-current-connection))
+ (setcdr tramp-current-connection (current-time)))))))
+
+(defmacro tramp-with-demoted-errors (vec-or-proc format &rest body)
+ "Execute BODY while redirecting the error message to `tramp-message'.
+BODY is executed like wrapped by `with-demoted-errors'. FORMAT
+is a format-string containing a %-sequence meaning to substitute
+the resulting error message."
+ (declare (indent 2) (debug (symbolp form body)))
+ (let ((err (make-symbol "err")))
+ `(condition-case-unless-debug ,err
+ (progn ,@body)
+ (error (tramp-message ,vec-or-proc 3 ,format ,err) nil))))
+
+(defun tramp-debug-button-action (button)
+ "Goto the linked message in debug buffer at place."
+ (when (mouse-event-p last-input-event) (mouse-set-point last-input-event))
+ (when-let ((point (button-get button 'position)))
+ (goto-char point)))
+
+(put #'tramp-debug-button-action 'tramp-suppress-trace t)
+
+(define-button-type 'tramp-debug-button-type
+ 'follow-link t
+ 'mouse-face 'highlight
+ 'action #'tramp-debug-button-action)
+
+(defun tramp-debug-link-messages (pos1 pos2)
+ "Set links for two messages in current buffer.
+The link buttons are in the verbositiy level substrings."
+ (save-excursion
+ (let (beg1 end1 beg2 end2)
+ (goto-char pos1)
+ ;; Find positions.
+ (while (not (search-forward-regexp
+ tramp-debug-outline-regexp (line-end-position) t))
+ (forward-line))
+ (setq beg1 (1- (match-beginning 3)) end1 (1+ (match-end 3)))
+ (goto-char pos2)
+ (while (not (search-forward-regexp
+ tramp-debug-outline-regexp (line-end-position) t))
+ (forward-line))
+ (setq beg2 (1- (match-beginning 3)) end2 (1+ (match-end 3)))
+ ;; Create text buttons.
+ (make-text-button
+ beg1 end1 :type 'tramp-debug-button-type
+ 'position (set-marker (make-marker) beg2)
+ 'help-echo "mouse-2, RET: goto exit message")
+ (make-text-button
+ beg2 end2 :type 'tramp-debug-button-type
+ 'position (set-marker (make-marker) beg1)
+ 'help-echo "mouse-2, RET: goto entry message"))))
+
+(put #'tramp-debug-link-messages 'tramp-suppress-trace t)
+
+(defvar tramp-debug-nesting ""
+ "Indicator for debug messages nested level.
+This shouldn't be changed globally, but let-bind where needed.")
+
+(defvar tramp-debug-message-fnh-function nil
+ "The used file name handler operation.
+Bound in `tramp-*-file-name-handler' functions.")
+
+(defun tramp-debug-message-buttonize (position)
+ "Buttonize function in current buffer, at next line starting after POSTION."
+ (save-excursion
+ (goto-char position)
+ (while (not (search-forward-regexp
+ tramp-debug-outline-regexp (line-end-position) t))
+ (forward-line))
+ (let ((fun (intern (match-string 2))))
+ (make-text-button
+ (match-beginning 2) (match-end 2)
+ :type 'help-function-def
+ 'help-args (list fun (symbol-file fun))))))
+
+(put #'tramp-debug-message-buttonize 'tramp-suppress-trace t)
+
+;; This is used in `tramp-file-name-handler' and
`tramp-*-maybe-open-connection'.
+(defmacro with-tramp-debug-message (vec message &rest body)
+ "Execute BODY, embedded with MESSAGE in the debug buffer of VEC.
+If BODY does not raise a debug message, MESSAGE is ignored."
+ (declare (indent 2) (debug t))
+ (let ((result (make-symbol "result")))
+ `(if (and tramp-debug-command-messages (>= tramp-verbose 6))
+ (save-match-data
+ (let ((tramp-debug-nesting
+ (concat tramp-debug-nesting "#"))
+ (buf (tramp-get-debug-buffer ,vec))
+ beg end ,result)
+ ;; Insert entry message.
+ (with-current-buffer buf
+ (setq beg (point))
+ (tramp-debug-message
+ ,vec "(4) %s %s ..." tramp-debug-nesting ,message)
+ (setq end (point)))
+ (unwind-protect
+ ;; Run BODY.
+ (setq tramp-debug-message-fnh-function nil
+ ,result (progn ,@body))
+ (with-current-buffer buf
+ (if (= end (point-max))
+ (progn
+ (delete-region beg end)
+ (when (bobp) (kill-buffer)))
+ ;; Insert exit message.
+ (tramp-debug-message
+ ,vec "(5) %s %s ... %s" tramp-debug-nesting ,message
,result)
+ ;; Adapt file name handler function.
+ (dolist (pos (list (point-max) end))
+ (goto-char pos)
+ (when (and tramp-debug-message-fnh-function
+ (search-backward
+ "tramp-file-name-handler"
+ (line-beginning-position) t))
+ (replace-match
+ (symbol-name tramp-debug-message-fnh-function))
+ (tramp-debug-message-buttonize
+ (line-beginning-position))))
+ ;; Link related messages.
+ (goto-char (point-max))
+ (tramp-debug-link-messages beg
(line-beginning-position)))))))
+
+ ;; No special messages.
+ ,@body)))
+
+(add-hook 'tramp-unload-hook
+ (lambda ()
+ (unload-feature 'tramp-message 'force)))
+
+(provide 'tramp-message)
diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el
index df46bd5e20e..c2b84845f68 100644
--- a/lisp/net/tramp-rclone.el
+++ b/lisp/net/tramp-rclone.el
@@ -175,8 +175,10 @@ Operations not mentioned here will be handled by the
default Emacs primitives.")
First arg specifies the OPERATION, second arg is a list of
arguments to pass to the OPERATION."
(if-let ((fn (assoc operation tramp-rclone-file-name-handler-alist)))
- (save-match-data (apply (cdr fn) args))
- (tramp-run-real-handler operation args)))
+ (prog1 (save-match-data (apply (cdr fn) args))
+ (setq tramp-debug-message-fnh-function (cdr fn)))
+ (prog1 (tramp-run-real-handler operation args)
+ (setq tramp-debug-message-fnh-function operation))))
;;;###tramp-autoload
(tramp--with-startup
@@ -377,53 +379,55 @@ connection if a previous connection has died for some
reason."
(unless (tramp-connectable-p vec)
(throw 'non-essential 'non-essential))
- (let ((host (tramp-file-name-host vec)))
- (when (rassoc `(,host) (tramp-rclone-parse-device-names nil))
- (if (tramp-string-empty-or-nil-p host)
- (tramp-error vec 'file-error "Storage %s not connected" host))
- ;; We need a process bound to the connection buffer. Therefore,
- ;; we create a dummy process. Maybe there is a better solution?
- (unless (get-buffer-process (tramp-get-connection-buffer vec))
- (let ((p (make-network-process
- :name (tramp-get-connection-name vec)
- :buffer (tramp-get-connection-buffer vec)
- :server t :host 'local :service t :noquery t)))
- (tramp-post-process-creation p vec)
-
- ;; Set connection-local variables.
- (tramp-set-connection-local-variables vec)))
-
- ;; Create directory.
- (unless (file-directory-p (tramp-fuse-mount-point vec))
- (make-directory (tramp-fuse-mount-point vec) 'parents))
-
- ;; Mount. This command does not return, so we use 0 as
- ;; DESTINATION of `tramp-call-process'.
- (unless (tramp-fuse-mounted-p vec)
- (apply
- #'tramp-call-process
- vec tramp-rclone-program nil 0 nil
- "mount" (tramp-fuse-mount-spec vec)
- (tramp-fuse-mount-point vec)
- (tramp-get-method-parameter vec 'tramp-mount-args))
- (while (not (file-exists-p (tramp-make-tramp-file-name vec 'noloc)))
- (tramp-cleanup-connection vec 'keep-debug 'keep-password))
-
- ;; Mark it as connected.
- (add-to-list 'tramp-fuse-mount-points (tramp-file-name-unify vec))
- (tramp-set-connection-property
- (tramp-get-connection-process vec) "connected" t))))
-
- ;; In `tramp-check-cached-permissions', the connection properties
- ;; "{uid,gid}-{integer,string}" are used. We set them to proper values.
- (with-tramp-connection-property
- vec "uid-integer" (tramp-get-local-uid 'integer))
- (with-tramp-connection-property
- vec "gid-integer" (tramp-get-local-gid 'integer))
- (with-tramp-connection-property
- vec "uid-string" (tramp-get-local-uid 'string))
- (with-tramp-connection-property
- vec "gid-string" (tramp-get-local-gid 'string)))
+ (with-tramp-debug-message vec "Opening connection"
+ (let ((host (tramp-file-name-host vec)))
+ (when (rassoc `(,host) (tramp-rclone-parse-device-names nil))
+ (if (tramp-string-empty-or-nil-p host)
+ (tramp-error vec 'file-error "Storage %s not connected" host))
+ ;; We need a process bound to the connection buffer.
+ ;; Therefore, we create a dummy process. Maybe there is a
+ ;; better solution?
+ (unless (get-buffer-process (tramp-get-connection-buffer vec))
+ (let ((p (make-network-process
+ :name (tramp-get-connection-name vec)
+ :buffer (tramp-get-connection-buffer vec)
+ :server t :host 'local :service t :noquery t)))
+ (tramp-post-process-creation p vec)
+
+ ;; Set connection-local variables.
+ (tramp-set-connection-local-variables vec)))
+
+ ;; Create directory.
+ (unless (file-directory-p (tramp-fuse-mount-point vec))
+ (make-directory (tramp-fuse-mount-point vec) 'parents))
+
+ ;; Mount. This command does not return, so we use 0 as
+ ;; DESTINATION of `tramp-call-process'.
+ (unless (tramp-fuse-mounted-p vec)
+ (apply
+ #'tramp-call-process
+ vec tramp-rclone-program nil 0 nil
+ "mount" (tramp-fuse-mount-spec vec)
+ (tramp-fuse-mount-point vec)
+ (tramp-get-method-parameter vec 'tramp-mount-args))
+ (while (not (file-exists-p (tramp-make-tramp-file-name vec 'noloc)))
+ (tramp-cleanup-connection vec 'keep-debug 'keep-password))
+
+ ;; Mark it as connected.
+ (add-to-list 'tramp-fuse-mount-points (tramp-file-name-unify vec))
+ (tramp-set-connection-property
+ (tramp-get-connection-process vec) "connected" t))))
+
+ ;; In `tramp-check-cached-permissions', the connection properties
+ ;; "{uid,gid}-{integer,string}" are used. We set them to proper values.
+ (with-tramp-connection-property
+ vec "uid-integer" (tramp-get-local-uid 'integer))
+ (with-tramp-connection-property
+ vec "gid-integer" (tramp-get-local-gid 'integer))
+ (with-tramp-connection-property
+ vec "uid-string" (tramp-get-local-uid 'string))
+ (with-tramp-connection-property
+ vec "gid-string" (tramp-get-local-gid 'string))))
(defun tramp-rclone-send-command (vec &rest args)
"Send a command to connection VEC.
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 0cb953e2d80..e889cb2e86f 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -1571,7 +1571,7 @@ ID-FORMAT valid values are `string' and `integer'."
(tramp-shell-quote-argument localname))))
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
- (when (re-search-forward regexp (line-end-position) t)
+ (when (search-forward-regexp regexp (line-end-position) t)
(setq context (list (match-string 1) (match-string 2)
(match-string 3) (match-string 4))))))
;; Return the context.
@@ -2152,7 +2152,7 @@ the uid and gid from FILENAME."
(or
(and keep-date
;; Mask cp -f error.
- (re-search-forward
+ (search-forward-regexp
tramp-operation-not-permitted-regexp nil t))
cmd-result)
(tramp-error-with-buffer
@@ -2612,7 +2612,7 @@ The method used must be an out-of-band method."
(save-restriction
(narrow-to-region beg-marker end-marker)
;; Check for "--dired" output.
- (when (re-search-backward
+ (when (search-backward-regexp
(rx bol "//DIRED//" (+ blank) (group (+ nonl)) eol)
nil 'noerror)
(let ((beg (match-beginning 1))
@@ -2627,7 +2627,7 @@ The method used must be an out-of-band method."
(put-text-property start end 'dired-filename t))))))
;; Remove trailing lines.
(goto-char (point-max))
- (while (re-search-backward (rx bol "//") nil 'noerror)
+ (while (search-backward-regexp (rx bol "//") nil 'noerror)
(forward-line 1)
(delete-region (match-beginning 0) (point))))
;; Reset multibyte if needed.
@@ -2639,7 +2639,7 @@ The method used must be an out-of-band method."
(unless (tramp-compat-string-search
"color" (tramp-get-connection-property v "ls" ""))
(goto-char (point-min))
- (while (re-search-forward ansi-color-control-seq-regexp nil t)
+ (while (search-forward-regexp ansi-color-control-seq-regexp nil t)
(replace-match "")))
;; Now decode what read if necessary. Stolen from
`insert-directory'.
@@ -2686,7 +2686,8 @@ The method used must be an out-of-band method."
;; Try to insert the amount of free space.
(goto-char (point-min))
;; First find the line to put it on.
- (when (and (re-search-forward (rx bol (group (* blank) "total")) nil
t)
+ (when (and (search-forward-regexp
+ (rx bol (group (* blank) "total")) nil t)
;; Emacs 29.1 or later.
(not (fboundp 'dired--insert-disk-space)))
(when-let ((available (get-free-disk-space ".")))
@@ -3639,8 +3640,10 @@ implementation will be used."
"Invoke remote-shell Tramp file name handler.
Fall back to normal file name handler if no Tramp handler exists."
(if-let ((fn (assoc operation tramp-sh-file-name-handler-alist)))
- (save-match-data (apply (cdr fn) args))
- (tramp-run-real-handler operation args)))
+ (prog1 (save-match-data (apply (cdr fn) args))
+ (setq tramp-debug-message-fnh-function (cdr fn)))
+ (prog1 (tramp-run-real-handler operation args)
+ (setq tramp-debug-message-fnh-function operation))))
;;;###tramp-autoload
(defun tramp-sh-file-name-handler-p (vec)
@@ -5038,235 +5041,240 @@ connection if a previous connection has died for some
reason."
(unless (tramp-connectable-p vec)
(throw 'non-essential 'non-essential))
- (let ((p (tramp-get-connection-process vec))
- (process-name (tramp-get-connection-property vec "process-name"))
- (process-environment (copy-sequence process-environment))
- (pos (with-current-buffer (tramp-get-connection-buffer vec) (point))))
-
- ;; If Tramp opens the same connection within a short time frame,
- ;; there is a problem. We shall signal this.
- (unless (or (process-live-p p)
- (and (processp p) (not non-essential))
- (not (tramp-file-name-equal-p
- vec (car tramp-current-connection)))
- (time-less-p
- (time-since (cdr tramp-current-connection))
- (or tramp-connection-min-time-diff 0)))
- (throw 'suppress 'suppress))
-
- ;; If too much time has passed since last command was sent, look
- ;; whether process is still alive. If it isn't, kill it. When
- ;; using ssh, it can sometimes happen that the remote end has hung
- ;; up but the local ssh client doesn't recognize this until it
- ;; tries to send some data to the remote end. So that's why we
- ;; try to send a command from time to time, then look again
- ;; whether the process is really alive.
- (condition-case nil
- (when (and (time-less-p
- 60 (time-since
- (tramp-get-connection-property p "last-cmd-time" 0)))
- (process-live-p p))
- (tramp-send-command vec "echo are you awake" t t)
- (unless (and (process-live-p p)
- (tramp-wait-for-output p 10))
- ;; The error will be caught locally.
- (tramp-error vec 'file-error "Awake did fail")))
- (file-error
- (tramp-cleanup-connection vec t)
- (setq p nil)))
-
- ;; New connection must be opened.
- (condition-case err
- (unless (process-live-p p)
- (with-tramp-progress-reporter
- vec 3
- (if (tramp-string-empty-or-nil-p (tramp-file-name-user vec))
- (format "Opening connection %s for %s using %s"
+ (with-tramp-debug-message vec "Opening connection"
+ (let ((p (tramp-get-connection-process vec))
+ (process-name (tramp-get-connection-property vec "process-name"))
+ (process-environment (copy-sequence process-environment))
+ (pos (with-current-buffer (tramp-get-connection-buffer vec) (point))))
+
+ ;; If Tramp opens the same connection within a short time frame,
+ ;; there is a problem. We shall signal this.
+ (unless (or (process-live-p p)
+ (and (processp p) (not non-essential))
+ (not (tramp-file-name-equal-p
+ vec (car tramp-current-connection)))
+ (time-less-p
+ (time-since (cdr tramp-current-connection))
+ (or tramp-connection-min-time-diff 0)))
+ (throw 'suppress 'suppress))
+
+ ;; If too much time has passed since last command was sent, look
+ ;; whether process is still alive. If it isn't, kill it. When
+ ;; using ssh, it can sometimes happen that the remote end has
+ ;; hung up but the local ssh client doesn't recognize this until
+ ;; it tries to send some data to the remote end. So that's why
+ ;; we try to send a command from time to time, then look again
+ ;; whether the process is really alive.
+ (condition-case nil
+ (when (and (time-less-p
+ 60 (time-since
+ (tramp-get-connection-property p "last-cmd-time" 0)))
+ (process-live-p p))
+ (tramp-send-command vec "echo are you awake" t t)
+ (unless (and (process-live-p p)
+ (tramp-wait-for-output p 10))
+ ;; The error will be caught locally.
+ (tramp-error vec 'file-error "Awake did fail")))
+ (file-error
+ (tramp-cleanup-connection vec t)
+ (setq p nil)))
+
+ ;; New connection must be opened.
+ (condition-case err
+ (unless (process-live-p p)
+ (with-tramp-progress-reporter
+ vec 3
+ (if (tramp-string-empty-or-nil-p (tramp-file-name-user vec))
+ (format "Opening connection %s for %s using %s"
+ process-name
+ (tramp-file-name-host vec)
+ (tramp-file-name-method vec))
+ (format "Opening connection %s for %s@%s using %s"
process-name
+ (tramp-file-name-user vec)
(tramp-file-name-host vec)
- (tramp-file-name-method vec))
- (format "Opening connection %s for %s@%s using %s"
- process-name
- (tramp-file-name-user vec)
- (tramp-file-name-host vec)
- (tramp-file-name-method vec)))
-
- (catch 'uname-changed
- ;; Start new process.
- (when (and p (processp p))
- (delete-process p))
- (setenv "TERM" tramp-terminal-type)
- (setenv "LC_ALL" (tramp-get-local-locale vec))
- (if (stringp tramp-histfile-override)
- (setenv "HISTFILE" tramp-histfile-override)
- (if tramp-histfile-override
- (progn
- (setenv "HISTFILE")
- (setenv "HISTFILESIZE" "0")
- (setenv "HISTSIZE" "0"))))
- (setenv "PROMPT_COMMAND")
- (setenv "PS1" tramp-initial-end-of-output)
- (unless (stringp tramp-encoding-shell)
- (tramp-error vec 'file-error "`tramp-encoding-shell' not set"))
- (let* ((current-host tramp-system-name)
- (target-alist (tramp-compute-multi-hops vec))
- (previous-hop tramp-null-hop)
- ;; We will apply `tramp-ssh-controlmaster-options'
- ;; only for the first hop.
- (options (tramp-ssh-controlmaster-options vec))
- (process-connection-type tramp-process-connection-type)
- (process-adaptive-read-buffering nil)
- ;; There are unfortunate settings for "cmdproxy" on
- ;; W32 systems.
- (process-coding-system-alist nil)
- (coding-system-for-read nil)
- (extra-args (tramp-get-sh-extra-args tramp-encoding-shell))
- ;; This must be done in order to avoid our file
- ;; name handler.
- (p (let ((default-directory
- tramp-compat-temporary-file-directory))
- (apply
- #'start-process
- (tramp-get-connection-name vec)
- (tramp-get-connection-buffer vec)
- (append
- (list tramp-encoding-shell)
- (and extra-args (split-string extra-args))
- (and tramp-encoding-command-interactive
- (list tramp-encoding-command-interactive)))))))
-
- ;; This is neded for ssh or PuTTY based processes, and
- ;; only if the respective options are set. Perhaps,
- ;; the setting could be more fine-grained.
- ;; (process-put p 'tramp-shared-socket t)
- ;; Set sentinel. Initialize variables.
- (set-process-sentinel p #'tramp-process-sentinel)
- (tramp-post-process-creation p vec)
- (setq tramp-current-connection (cons vec (current-time)))
-
- ;; Set connection-local variables.
- (tramp-set-connection-local-variables vec)
-
- ;; Check whether process is alive.
- (tramp-barf-if-no-shell-prompt
- p 10
- "Couldn't find local shell prompt for %s" tramp-encoding-shell)
-
- ;; Now do all the connections as specified.
- (while target-alist
- (let* ((hop (car target-alist))
- (l-method (tramp-file-name-method hop))
- (l-user (tramp-file-name-user hop))
- (l-domain (tramp-file-name-domain hop))
- (l-host (tramp-file-name-host hop))
- (l-port (tramp-file-name-port hop))
- (remote-shell
- (tramp-get-method-parameter hop 'tramp-remote-shell))
- (extra-args (tramp-get-sh-extra-args remote-shell))
- (async-args
- (flatten-tree
- (tramp-get-method-parameter hop 'tramp-async-args)))
- (connection-timeout
- (tramp-get-method-parameter
- hop 'tramp-connection-timeout))
- (command
- (tramp-get-method-parameter hop 'tramp-login-program))
- ;; We don't create the temporary file. In
- ;; fact, it is just a prefix for the
- ;; ControlPath option of ssh; the real
- ;; temporary file has another name, and it is
- ;; created and protected by ssh. It is also
- ;; removed by ssh when the connection is
- ;; closed. The temporary file name is cached
- ;; in the main connection process, therefore
- ;; we cannot use `tramp-get-connection-process'.
- (tmpfile
- (with-tramp-connection-property
- (tramp-get-process vec) "temp-file"
- (tramp-compat-make-temp-name)))
- r-shell)
-
- ;; Check, whether there is a restricted shell.
- (dolist (elt tramp-restricted-shell-hosts-alist)
- (when (string-match-p elt current-host)
- (setq r-shell t)))
- (setq current-host l-host)
-
- ;; Set password prompt vector.
- (tramp-set-connection-property
- p "password-vector"
- (if (tramp-get-method-parameter
- hop 'tramp-password-previous-hop)
- (let ((pv (copy-tramp-file-name previous-hop)))
- (setf (tramp-file-name-method pv) l-method)
- pv)
- (make-tramp-file-name
- :method l-method :user l-user :domain l-domain
- :host l-host :port l-port)))
-
- ;; Set session timeout.
- (when (tramp-get-method-parameter
- hop 'tramp-session-timeout)
+ (tramp-file-name-method vec)))
+
+ (catch 'uname-changed
+ ;; Start new process.
+ (when (and p (processp p))
+ (delete-process p))
+ (setenv "TERM" tramp-terminal-type)
+ (setenv "LC_ALL" (tramp-get-local-locale vec))
+ (if (stringp tramp-histfile-override)
+ (setenv "HISTFILE" tramp-histfile-override)
+ (if tramp-histfile-override
+ (progn
+ (setenv "HISTFILE")
+ (setenv "HISTFILESIZE" "0")
+ (setenv "HISTSIZE" "0"))))
+ (setenv "PROMPT_COMMAND")
+ (setenv "PS1" tramp-initial-end-of-output)
+ (unless (stringp tramp-encoding-shell)
+ (tramp-error vec 'file-error "`tramp-encoding-shell' not
set"))
+ (let* ((current-host tramp-system-name)
+ (target-alist (tramp-compute-multi-hops vec))
+ (previous-hop tramp-null-hop)
+ ;; We will apply `tramp-ssh-controlmaster-options'
+ ;; only for the first hop.
+ (options (tramp-ssh-controlmaster-options vec))
+ (process-connection-type tramp-process-connection-type)
+ (process-adaptive-read-buffering nil)
+ ;; There are unfortunate settings for
+ ;; "cmdproxy" on W32 systems.
+ (process-coding-system-alist nil)
+ (coding-system-for-read nil)
+ (extra-args
+ (tramp-get-sh-extra-args tramp-encoding-shell))
+ ;; This must be done in order to avoid our file
+ ;; name handler.
+ (p (let ((default-directory
+ tramp-compat-temporary-file-directory))
+ (apply
+ #'start-process
+ (tramp-get-connection-name vec)
+ (tramp-get-connection-buffer vec)
+ (append
+ `(,tramp-encoding-shell)
+ (and extra-args (split-string extra-args))
+ (and tramp-encoding-command-interactive
+ `(,tramp-encoding-command-interactive)))))))
+
+ ;; This is neded for ssh or PuTTY based processes,
+ ;; and only if the respective options are set.
+ ;; Perhaps, the setting could be more fine-grained.
+ ;; (process-put p 'tramp-shared-socket t)
+ ;; Set sentinel. Initialize variables.
+ (set-process-sentinel p #'tramp-process-sentinel)
+ (tramp-post-process-creation p vec)
+ (setq tramp-current-connection (cons vec (current-time)))
+
+ ;; Set connection-local variables.
+ (tramp-set-connection-local-variables vec)
+
+ ;; Check whether process is alive.
+ (tramp-barf-if-no-shell-prompt
+ p 10
+ "Couldn't find local shell prompt for %s"
+ tramp-encoding-shell)
+
+ ;; Now do all the connections as specified.
+ (while target-alist
+ (let* ((hop (car target-alist))
+ (l-method (tramp-file-name-method hop))
+ (l-user (tramp-file-name-user hop))
+ (l-domain (tramp-file-name-domain hop))
+ (l-host (tramp-file-name-host hop))
+ (l-port (tramp-file-name-port hop))
+ (remote-shell
+ (tramp-get-method-parameter hop
'tramp-remote-shell))
+ (extra-args (tramp-get-sh-extra-args remote-shell))
+ (async-args
+ (flatten-tree
+ (tramp-get-method-parameter hop
'tramp-async-args)))
+ (connection-timeout
+ (tramp-get-method-parameter
+ hop 'tramp-connection-timeout))
+ (command
+ (tramp-get-method-parameter
+ hop 'tramp-login-program))
+ ;; We don't create the temporary file. In
+ ;; fact, it is just a prefix for the
+ ;; ControlPath option of ssh; the real
+ ;; temporary file has another name, and it
+ ;; is created and protected by ssh. It is
+ ;; also removed by ssh when the connection
+ ;; is closed. The temporary file name is
+ ;; cached in the main connection process,
+ ;; therefore we cannot use
+ ;; `tramp-get-connection-process'.
+ (tmpfile
+ (with-tramp-connection-property
+ (tramp-get-process vec) "temp-file"
+ (tramp-compat-make-temp-name)))
+ r-shell)
+
+ ;; Check, whether there is a restricted shell.
+ (dolist (elt tramp-restricted-shell-hosts-alist)
+ (when (string-match-p elt current-host)
+ (setq r-shell t)))
+ (setq current-host l-host)
+
+ ;; Set password prompt vector.
(tramp-set-connection-property
- p "session-timeout"
- (tramp-get-method-parameter
- hop 'tramp-session-timeout)))
-
- ;; Replace `login-args' place holders.
- (setq
- command
- (string-join
- (append
- ;; We do not want to see the trailing local
- ;; prompt in `start-file-process'.
- (unless r-shell '("exec"))
- `(,command)
- ;; Add arguments for asynchronous processes.
- (when process-name async-args)
- (tramp-expand-args
- hop 'tramp-login-args
- ?h (or l-host "") ?u (or l-user "") ?p (or l-port "")
- ?c (format-spec options (format-spec-make ?t tmpfile))
- ?n (concat
- "2>" (tramp-get-remote-null-device previous-hop))
- ?l (concat remote-shell " " extra-args " -i"))
- ;; A restricted shell does not allow "exec".
- (when r-shell '("&&" "exit" "||" "exit")))
- " "))
-
- ;; Send the command.
- (tramp-message vec 3 "Sending command `%s'" command)
- (tramp-send-command vec command t t)
- (tramp-process-actions
- p vec
- (min
- pos (with-current-buffer (process-buffer p) (point-max)))
- tramp-actions-before-shell
- (or connection-timeout tramp-connection-timeout))
- (tramp-message
- vec 3 "Found remote shell prompt on `%s'" l-host)
-
- ;; Next hop.
- (setq options ""
- target-alist (cdr target-alist)
- previous-hop hop)))
-
- ;; Activate session timeout.
- (when (tramp-get-connection-property p "session-timeout")
- (run-at-time
- (tramp-get-connection-property p "session-timeout") nil
- #'tramp-timeout-session vec))
-
- ;; Make initial shell settings.
- (tramp-open-connection-setup-interactive-shell p vec)
-
- ;; Mark it as connected.
- (tramp-set-connection-property p "connected" t)))))
-
- ;; Cleanup, and propagate the signal.
- ((error quit)
- (tramp-cleanup-connection vec t)
- (signal (car err) (cdr err))))))
+ p "password-vector"
+ (if (tramp-get-method-parameter
+ hop 'tramp-password-previous-hop)
+ (let ((pv (copy-tramp-file-name previous-hop)))
+ (setf (tramp-file-name-method pv) l-method)
+ pv)
+ (make-tramp-file-name
+ :method l-method :user l-user :domain l-domain
+ :host l-host :port l-port)))
+
+ ;; Set session timeout.
+ (when (tramp-get-method-parameter
+ hop 'tramp-session-timeout)
+ (tramp-set-connection-property
+ p "session-timeout"
+ (tramp-get-method-parameter
+ hop 'tramp-session-timeout)))
+
+ ;; Replace `login-args' place holders.
+ (setq
+ command
+ (string-join
+ (append
+ ;; We do not want to see the trailing local
+ ;; prompt in `start-file-process'.
+ (unless r-shell '("exec"))
+ `(,command)
+ ;; Add arguments for asynchronous processes.
+ (when process-name async-args)
+ (tramp-expand-args
+ hop 'tramp-login-args
+ ?h (or l-host "") ?u (or l-user "") ?p (or l-port "")
+ ?c (format-spec options (format-spec-make ?t tmpfile))
+ ?n (concat
+ "2>" (tramp-get-remote-null-device previous-hop))
+ ?l (concat remote-shell " " extra-args " -i"))
+ ;; A restricted shell does not allow "exec".
+ (when r-shell '("&&" "exit" "||" "exit")))
+ " "))
+
+ ;; Send the command.
+ (tramp-message vec 3 "Sending command `%s'" command)
+ (tramp-send-command vec command t t)
+ (tramp-process-actions
+ p vec
+ (min
+ pos (with-current-buffer (process-buffer p)
(point-max)))
+ tramp-actions-before-shell
+ (or connection-timeout tramp-connection-timeout))
+ (tramp-message
+ vec 3 "Found remote shell prompt on `%s'" l-host)
+
+ ;; Next hop.
+ (setq options ""
+ target-alist (cdr target-alist)
+ previous-hop hop)))
+
+ ;; Activate session timeout.
+ (when (tramp-get-connection-property p "session-timeout")
+ (run-at-time
+ (tramp-get-connection-property p "session-timeout") nil
+ #'tramp-timeout-session vec))
+
+ ;; Make initial shell settings.
+ (tramp-open-connection-setup-interactive-shell p vec)
+
+ ;; Mark it as connected.
+ (tramp-set-connection-property p "connected" t)))))
+
+ ;; Cleanup, and propagate the signal.
+ ((error quit)
+ (tramp-cleanup-connection vec t)
+ (signal (car err) (cdr err)))))))
(defun tramp-send-command (vec command &optional neveropen nooutput)
"Send the COMMAND to connection VEC.
@@ -5322,7 +5330,7 @@ function waits for output unless NOOUTPUT is set."
;; A simple-minded busybox has sent " ^H" sequences.
;; Delete them.
(goto-char (point-min))
- (when (re-search-forward
+ (when (search-forward-regexp
(rx bol (+ nonl "\b") eol) (line-end-position) t)
(forward-line 1)
(delete-region (point-min) (point)))
@@ -5404,7 +5412,7 @@ raises an error."
;; Read the marker.
(when (stringp marker)
(condition-case nil
- (re-search-forward marker)
+ (search-forward-regexp marker)
(error (unless noerror
(tramp-error
vec 'file-error
@@ -5417,7 +5425,7 @@ raises an error."
(unless noerror signal-hook-function)))
(read (current-buffer)))
;; Error handling.
- (when (re-search-forward (rx (not blank)) (line-end-position) t)
+ (when (search-forward-regexp (rx (not blank)) (line-end-position) t)
(error nil)))
(error (unless noerror
(tramp-error
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index dab85c5160e..60d40fef147 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -68,8 +68,8 @@
(defcustom tramp-smb-acl-program "smbcacls"
"Name of SMB acls to run."
:group 'tramp
- :type 'string
- :version "24.4")
+ :version "24.4"
+ :type 'string)
(defcustom tramp-smb-conf null-device
"Path of the \"smb.conf\" file.
@@ -85,8 +85,8 @@ They are added to the `tramp-smb-program' call via \"--option
'...'\".
For example, if the deprecated SMB1 protocol shall be used, add to
this variable \"client min protocol=NT1\"."
:group 'tramp
- :type '(repeat string)
- :version "28.1")
+ :version "28.1"
+ :type '(repeat string))
(defvar tramp-smb-version nil
"Version string of the SMB client.")
@@ -318,22 +318,22 @@ Operations not mentioned here will be handled by the
default Emacs primitives.")
If it isn't found in the local $PATH, the absolute path of winexe
shall be given. This is needed for remote processes."
:group 'tramp
- :type 'string
- :version "24.3")
+ :version "24.3"
+ :type 'string)
(defcustom tramp-smb-winexe-shell-command "powershell.exe"
"Shell to be used for processes on remote machines.
This must be Powershell V2 compatible."
:group 'tramp
- :type 'string
- :version "24.3")
+ :version "24.3"
+ :type 'string)
(defcustom tramp-smb-winexe-shell-command-switch "-file -"
"Command switch used together with `tramp-smb-winexe-shell-command'.
This can be used to disable echo etc."
:group 'tramp
- :type 'string
- :version "24.3")
+ :version "24.3"
+ :type 'string)
;; It must be a `defsubst' in order to push the whole code into
;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading.
@@ -349,8 +349,10 @@ This can be used to disable echo etc."
First arg specifies the OPERATION, second arg is a list of
arguments to pass to the OPERATION."
(if-let ((fn (assoc operation tramp-smb-file-name-handler-alist)))
- (save-match-data (apply (cdr fn) args))
- (tramp-run-real-handler operation args)))
+ (prog1 (save-match-data (apply (cdr fn) args))
+ (setq tramp-debug-message-fnh-function (cdr fn)))
+ (prog1 (tramp-run-real-handler operation args)
+ (setq tramp-debug-message-fnh-function operation))))
;;;###tramp-autoload
(unless (memq system-type '(cygwin windows-nt))
@@ -867,7 +869,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
;; Loop the listing.
(with-current-buffer (tramp-get-connection-buffer vec)
(goto-char (point-min))
- (unless (re-search-forward tramp-smb-errors nil t)
+ (unless (search-forward-regexp tramp-smb-errors nil t)
(while (not (eobp))
(cond
((looking-at
@@ -1618,7 +1620,7 @@ Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME
YEAR)."
;; Loop the listing.
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
- (if (re-search-forward tramp-smb-errors nil t)
+ (if (search-forward-regexp tramp-smb-errors nil t)
(tramp-error v 'file-error "%s `%s'" (match-string 0) directory)
(while (not (eobp))
(setq entry (tramp-smb-read-file-entry share))
@@ -1809,8 +1811,8 @@ are listed. Result is the list (LOCALNAME MODE SIZE
MTIME)."
(when (tramp-smb-send-command vec "posix")
(with-current-buffer (tramp-get-connection-buffer vec)
(goto-char (point-min))
- (when
- (re-search-forward "Server supports CIFS capabilities" nil t)
+ (when (search-forward-regexp
+ "Server supports CIFS capabilities" nil t)
(member
"pathnames"
(split-string
@@ -1846,153 +1848,152 @@ If ARGUMENT is non-nil, use it as argument for
(unless (tramp-connectable-p vec)
(throw 'non-essential 'non-essential))
- (let* ((share (tramp-smb-get-share vec))
- (buf (tramp-get-connection-buffer vec))
- (p (get-buffer-process buf)))
+ (with-tramp-debug-message vec "Opening connection"
+ (let* ((share (tramp-smb-get-share vec))
+ (buf (tramp-get-connection-buffer vec))
+ (p (get-buffer-process buf)))
+
+ ;; Check whether we still have the same smbclient version.
+ ;; Otherwise, we must delete the connection cache, because
+ ;; capabilities might have changed.
+ (unless (or argument (processp p))
+ (let ((default-directory tramp-compat-temporary-file-directory)
+ (command (concat tramp-smb-program " -V")))
+
+ (unless tramp-smb-version
+ (unless (executable-find tramp-smb-program)
+ (tramp-error
+ vec 'file-error
+ "Cannot find command %s in %s" tramp-smb-program exec-path))
+ (setq tramp-smb-version (shell-command-to-string command))
+ (tramp-message vec 6 command)
+ (tramp-message vec 6 "\n%s" tramp-smb-version)
+ (if (string-match (rx (+ (any " \t\r\n")) eos) tramp-smb-version)
+ (setq tramp-smb-version
+ (replace-match "" nil nil tramp-smb-version))))
+
+ (unless (string-equal
+ tramp-smb-version
+ (tramp-get-connection-property
+ vec "smbclient-version" tramp-smb-version))
+ (tramp-flush-directory-properties vec "/")
+ (tramp-flush-connection-properties vec))
+
+ (tramp-set-connection-property
+ vec "smbclient-version" tramp-smb-version)))
+
+ ;; If too much time has passed since last command was sent, look
+ ;; whether there has been an error message; maybe due to
+ ;; connection timeout.
+ (with-current-buffer buf
+ (goto-char (point-min))
+ (when (and (time-less-p
+ 60 (time-since
+ (tramp-get-connection-property p "last-cmd-time" 0)))
+ (process-live-p p)
+ (search-forward-regexp tramp-smb-errors nil t))
+ (delete-process p)
+ (setq p nil)))
+
+ ;; Check whether it is still the same share.
+ (unless (and (process-live-p p)
+ (or argument
+ (string-equal
+ share
+ (tramp-get-connection-property p "smb-share" ""))))
+ (save-match-data
+ ;; There might be unread output from checking for share names.
+ (when buf (with-current-buffer buf (erase-buffer)))
+ (when (and p (processp p)) (delete-process p))
- ;; Check whether we still have the same smbclient version.
- ;; Otherwise, we must delete the connection cache, because
- ;; capabilities might have changed.
- (unless (or argument (processp p))
- (let ((default-directory tramp-compat-temporary-file-directory)
- (command (concat tramp-smb-program " -V")))
+ (let* ((user (tramp-file-name-user vec))
+ (host (tramp-file-name-host vec))
+ (domain (tramp-file-name-domain vec))
+ (port (tramp-file-name-port vec))
+ (options tramp-smb-options)
+ args)
- (unless tramp-smb-version
- (unless (executable-find tramp-smb-program)
- (tramp-error
- vec 'file-error
- "Cannot find command %s in %s" tramp-smb-program exec-path))
- (setq tramp-smb-version (shell-command-to-string command))
- (tramp-message vec 6 command)
- (tramp-message vec 6 "\n%s" tramp-smb-version)
- (if (string-match (rx (+ (any " \t\r\n")) eos) tramp-smb-version)
- (setq tramp-smb-version
- (replace-match "" nil nil tramp-smb-version))))
-
- (unless (string-equal
- tramp-smb-version
- (tramp-get-connection-property
- vec "smbclient-version" tramp-smb-version))
- (tramp-flush-directory-properties vec "/")
- (tramp-flush-connection-properties vec))
-
- (tramp-set-connection-property
- vec "smbclient-version" tramp-smb-version)))
-
- ;; If too much time has passed since last command was sent, look
- ;; whether there has been an error message; maybe due to
- ;; connection timeout.
- (with-current-buffer buf
- (goto-char (point-min))
- (when (and (time-less-p
- 60 (time-since
- (tramp-get-connection-property p "last-cmd-time" 0)))
- (process-live-p p)
- (re-search-forward tramp-smb-errors nil t))
- (delete-process p)
- (setq p nil)))
-
- ;; Check whether it is still the same share.
- (unless (and (process-live-p p)
- (or argument
- (string-equal
- share
- (tramp-get-connection-property p "smb-share" ""))))
- (save-match-data
- ;; There might be unread output from checking for share names.
- (when buf (with-current-buffer buf (erase-buffer)))
- (when (and p (processp p)) (delete-process p))
-
- (let* ((user (tramp-file-name-user vec))
- (host (tramp-file-name-host vec))
- (domain (tramp-file-name-domain vec))
- (port (tramp-file-name-port vec))
- (options tramp-smb-options)
- args)
-
- (cond
- (argument
- (setq args (list (concat "//" host))))
- (share
- (setq args (list (concat "//" host "/" share))))
- (t
- (setq args (list "-g" "-L" host ))))
+ (cond
+ (argument (setq args (list (concat "//" host))))
+ (share (setq args (list (concat "//" host "/" share))))
+ (t (setq args (list "-g" "-L" host ))))
- (if (tramp-string-empty-or-nil-p user)
- (setq args (append args (list "-N")))
- (setq args (append args (list "-U" user))))
+ (if (tramp-string-empty-or-nil-p user)
+ (setq args (append args (list "-N")))
+ (setq args (append args (list "-U" user))))
- (when domain (setq args (append args (list "-W" domain))))
- (when port (setq args (append args (list "-p" port))))
- (when tramp-smb-conf
- (setq args (append args (list "-s" tramp-smb-conf))))
- (dolist (option options)
- (setq args (append args (list "--option" option))))
- (when argument
- (setq args (append args (list argument))))
-
- ;; OK, let's go.
- (with-tramp-progress-reporter
- vec 3
- (format "Opening connection for //%s%s/%s"
- (if (tramp-string-empty-or-nil-p user)
- "" (concat user "@"))
- host (or share ""))
-
- (let* (coding-system-for-read
- (process-connection-type tramp-process-connection-type)
- (p (let ((default-directory
- tramp-compat-temporary-file-directory)
- (process-environment
- (cons (concat "TERM=" tramp-terminal-type)
- process-environment)))
- (apply #'start-process
- (tramp-get-connection-name vec)
- (tramp-get-connection-buffer vec)
- (if argument
- tramp-smb-winexe-program tramp-smb-program)
- args))))
- (tramp-post-process-creation p vec)
-
- ;; Set connection-local variables.
- (tramp-set-connection-local-variables vec)
-
- (condition-case err
- (let ((inhibit-message t))
- ;; Play login scenario.
- (tramp-process-actions
- p vec nil
- (if (or argument share)
- tramp-smb-actions-with-share
- tramp-smb-actions-without-share))
-
- ;; Set chunksize to 1. smbclient reads its input
- ;; character by character; if we send the string
- ;; at once, it is read painfully slow.
- (tramp-set-connection-property p "smb-share" share)
- (tramp-set-connection-property p "chunksize" 1)
-
- ;; Mark it as connected.
- (tramp-set-connection-property p "connected" t))
-
- ;; Check for the error reason. If it was due to wrong
- ;; password, reestablish the connection. We cannot
- ;; handle this in `tramp-process-actions', because
- ;; smbclient does not ask for the password, again.
- (error
- (with-current-buffer (tramp-get-connection-buffer vec)
- (goto-char (point-min))
- (if (and (bound-and-true-p auth-sources)
- (search-forward-regexp
- tramp-smb-wrong-passwd-regexp nil t))
- ;; Disable `auth-source' and `password-cache'.
- (let (auth-sources)
- (tramp-message
- vec 3 "Retry connection with new password")
- (tramp-cleanup-connection vec t)
- (tramp-smb-maybe-open-connection vec argument))
- ;; Propagate the error.
- (signal (car err) (cdr err)))))))))))))
+ (when domain (setq args (append args (list "-W" domain))))
+ (when port (setq args (append args (list "-p" port))))
+ (when tramp-smb-conf
+ (setq args (append args (list "-s" tramp-smb-conf))))
+ (dolist (option options)
+ (setq args (append args (list "--option" option))))
+ (when argument
+ (setq args (append args (list argument))))
+
+ ;; OK, let's go.
+ (with-tramp-progress-reporter
+ vec 3
+ (format "Opening connection for //%s%s/%s"
+ (if (tramp-string-empty-or-nil-p user)
+ "" (concat user "@"))
+ host (or share ""))
+
+ (let* (coding-system-for-read
+ (process-connection-type tramp-process-connection-type)
+ (p (let ((default-directory
+ tramp-compat-temporary-file-directory)
+ (process-environment
+ (cons (concat "TERM=" tramp-terminal-type)
+ process-environment)))
+ (apply #'start-process
+ (tramp-get-connection-name vec)
+ (tramp-get-connection-buffer vec)
+ (if argument
+ tramp-smb-winexe-program tramp-smb-program)
+ args))))
+ (tramp-post-process-creation p vec)
+
+ ;; Set connection-local variables.
+ (tramp-set-connection-local-variables vec)
+
+ (condition-case err
+ (let ((inhibit-message t))
+ ;; Play login scenario.
+ (tramp-process-actions
+ p vec nil
+ (if (or argument share)
+ tramp-smb-actions-with-share
+ tramp-smb-actions-without-share))
+
+ ;; Set chunksize to 1. smbclient reads its
+ ;; input character by character; if we send the
+ ;; string at once, it is read painfully slow.
+ (tramp-set-connection-property p "smb-share" share)
+ (tramp-set-connection-property p "chunksize" 1)
+
+ ;; Mark it as connected.
+ (tramp-set-connection-property p "connected" t))
+
+ ;; Check for the error reason. If it was due to
+ ;; wrong password, reestablish the connection. We
+ ;; cannot handle this in `tramp-process-actions',
+ ;; because smbclient does not ask for the password,
+ ;; again.
+ (error
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (goto-char (point-min))
+ (if (and (bound-and-true-p auth-sources)
+ (search-forward-regexp
+ tramp-smb-wrong-passwd-regexp nil t))
+ ;; Disable `auth-source' and `password-cache'.
+ (let (auth-sources)
+ (tramp-message
+ vec 3 "Retry connection with new password")
+ (tramp-cleanup-connection vec t)
+ (tramp-smb-maybe-open-connection vec argument))
+ ;; Propagate the error.
+ (signal (car err) (cdr err))))))))))))))
;; We don't use timeouts. If needed, the caller shall wrap around.
(defun tramp-smb-wait-for-output (vec)
@@ -2003,21 +2004,21 @@ Removes smb prompt. Returns nil if an error message
has appeared."
(inhibit-read-only t))
;; Read pending output.
- (while (not (re-search-forward tramp-smb-prompt nil t))
+ (while (not (search-forward-regexp tramp-smb-prompt nil t))
(while (tramp-accept-process-output p))
(goto-char (point-min)))
(tramp-message vec 6 "\n%s" (buffer-string))
;; Remove prompt.
(goto-char (point-min))
- (when (re-search-forward tramp-smb-prompt nil t)
+ (when (search-forward-regexp tramp-smb-prompt nil t)
(goto-char (point-max))
- (re-search-backward tramp-smb-prompt nil t)
+ (search-backward-regexp tramp-smb-prompt nil t)
(delete-region (point) (point-max)))
;; Return value is whether no error message has appeared.
(goto-char (point-min))
- (not (re-search-forward tramp-smb-errors nil t)))))
+ (not (search-forward-regexp tramp-smb-errors nil t)))))
(defun tramp-smb-kill-winexe-function ()
"Send SIGKILL to the winexe process."
diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el
index e3c9e0b53b2..86cf63507c6 100644
--- a/lisp/net/tramp-sshfs.el
+++ b/lisp/net/tramp-sshfs.el
@@ -181,8 +181,10 @@ Operations not mentioned here will be handled by the
default Emacs primitives.")
First arg specifies the OPERATION, second arg is a list of
arguments to pass to the OPERATION."
(if-let ((fn (assoc operation tramp-sshfs-file-name-handler-alist)))
- (save-match-data (apply (cdr fn) args))
- (tramp-run-real-handler operation args)))
+ (prog1 (save-match-data (apply (cdr fn) args))
+ (setq tramp-debug-message-fnh-function (cdr fn)))
+ (prog1 (tramp-run-real-handler operation args)
+ (setq tramp-debug-message-fnh-function operation))))
;;;###tramp-autoload
(tramp--with-startup
@@ -393,52 +395,53 @@ connection if a previous connection has died for some
reason."
(unless (tramp-connectable-p vec)
(throw 'non-essential 'non-essential))
- ;; We need a process bound to the connection buffer. Therefore, we
- ;; create a dummy process. Maybe there is a better solution?
- (unless (get-buffer-process (tramp-get-connection-buffer vec))
- (let ((p (make-network-process
- :name (tramp-get-connection-name vec)
- :buffer (tramp-get-connection-buffer vec)
- :server t :host 'local :service t :noquery t)))
- (tramp-post-process-creation p vec)
-
- ;; Set connection-local variables.
- (tramp-set-connection-local-variables vec)))
-
- ;; Create directory.
- (unless (file-directory-p (tramp-fuse-mount-point vec))
- (make-directory (tramp-fuse-mount-point vec) 'parents))
-
- (unless
- (or (tramp-fuse-mounted-p vec)
- (with-temp-buffer
- (zerop
- (apply
- #'tramp-call-process
- vec tramp-sshfs-program nil t nil
- (tramp-fuse-mount-spec vec)
- (tramp-fuse-mount-point vec)
- (tramp-expand-args
- vec 'tramp-mount-args
- ?p (or (tramp-file-name-port vec) ""))))))
- (tramp-error
- vec 'file-error "Error mounting %s" (tramp-fuse-mount-spec vec)))
-
- ;; Mark it as connected.
- (add-to-list 'tramp-fuse-mount-points (tramp-file-name-unify vec))
- (tramp-set-connection-property
- (tramp-get-connection-process vec) "connected" t)
-
- ;; In `tramp-check-cached-permissions', the connection properties
- ;; "{uid,gid}-{integer,string}" are used. We set them to proper values.
- (with-tramp-connection-property
- vec "uid-integer" (tramp-get-local-uid 'integer))
- (with-tramp-connection-property
- vec "gid-integer" (tramp-get-local-gid 'integer))
- (with-tramp-connection-property
- vec "uid-string" (tramp-get-local-uid 'string))
- (with-tramp-connection-property
- vec "gid-string" (tramp-get-local-gid 'string)))
+ (with-tramp-debug-message vec "Opening connection"
+ ;; We need a process bound to the connection buffer. Therefore,
+ ;; we create a dummy process. Maybe there is a better solution?
+ (unless (get-buffer-process (tramp-get-connection-buffer vec))
+ (let ((p (make-network-process
+ :name (tramp-get-connection-name vec)
+ :buffer (tramp-get-connection-buffer vec)
+ :server t :host 'local :service t :noquery t)))
+ (tramp-post-process-creation p vec)
+
+ ;; Set connection-local variables.
+ (tramp-set-connection-local-variables vec)))
+
+ ;; Create directory.
+ (unless (file-directory-p (tramp-fuse-mount-point vec))
+ (make-directory (tramp-fuse-mount-point vec) 'parents))
+
+ (unless
+ (or (tramp-fuse-mounted-p vec)
+ (with-temp-buffer
+ (zerop
+ (apply
+ #'tramp-call-process
+ vec tramp-sshfs-program nil t nil
+ (tramp-fuse-mount-spec vec)
+ (tramp-fuse-mount-point vec)
+ (tramp-expand-args
+ vec 'tramp-mount-args
+ ?p (or (tramp-file-name-port vec) ""))))))
+ (tramp-error
+ vec 'file-error "Error mounting %s" (tramp-fuse-mount-spec vec)))
+
+ ;; Mark it as connected.
+ (add-to-list 'tramp-fuse-mount-points (tramp-file-name-unify vec))
+ (tramp-set-connection-property
+ (tramp-get-connection-process vec) "connected" t)
+
+ ;; In `tramp-check-cached-permissions', the connection properties
+ ;; "{uid,gid}-{integer,string}" are used. We set them to proper values.
+ (with-tramp-connection-property
+ vec "uid-integer" (tramp-get-local-uid 'integer))
+ (with-tramp-connection-property
+ vec "gid-integer" (tramp-get-local-gid 'integer))
+ (with-tramp-connection-property
+ vec "uid-string" (tramp-get-local-uid 'string))
+ (with-tramp-connection-property
+ vec "gid-string" (tramp-get-local-gid 'string))))
;; `shell-mode' tries to open remote files like "/sshfs:user@host:~/.history".
;; This fails, because the tilde cannot be expanded. Tell
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index e41a4a590e2..2bbe0945330 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -170,8 +170,10 @@ See `tramp-actions-before-shell' for more info.")
First arg specifies the OPERATION, second arg is a list of
arguments to pass to the OPERATION."
(if-let ((fn (assoc operation tramp-sudoedit-file-name-handler-alist)))
- (save-match-data (apply (cdr fn) args))
- (tramp-run-real-handler operation args)))
+ (prog1 (save-match-data (apply (cdr fn) args))
+ (setq tramp-debug-message-fnh-function (cdr fn)))
+ (prog1 (tramp-run-real-handler operation args)
+ (setq tramp-debug-message-fnh-function operation))))
;;;###tramp-autoload
(tramp--with-startup
@@ -524,7 +526,7 @@ the result will be a local, non-Tramp, file name."
v "ls" "-d" "-Z" (file-name-unquote localname)))
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
- (when (re-search-forward regexp (line-end-position) t)
+ (when (search-forward-regexp regexp (line-end-position) t)
(setq context (list (match-string 1) (match-string 2)
(match-string 3) (match-string 4))))))
;; Return the context.
@@ -714,20 +716,21 @@ connection if a previous connection has died for some
reason."
(unless (tramp-connectable-p vec)
(throw 'non-essential 'non-essential))
- ;; We need a process bound to the connection buffer. Therefore, we
- ;; create a dummy process. Maybe there is a better solution?
- (unless (tramp-get-connection-process vec)
- (let ((p (make-network-process
- :name (tramp-get-connection-name vec)
- :buffer (tramp-get-connection-buffer vec)
- :server t :host 'local :service t :noquery t)))
- (tramp-post-process-creation p vec)
+ (with-tramp-debug-message vec "Opening connection"
+ ;; We need a process bound to the connection buffer. Therefore,
+ ;; we create a dummy process. Maybe there is a better solution?
+ (unless (tramp-get-connection-process vec)
+ (let ((p (make-network-process
+ :name (tramp-get-connection-name vec)
+ :buffer (tramp-get-connection-buffer vec)
+ :server t :host 'local :service t :noquery t)))
+ (tramp-post-process-creation p vec)
- ;; Set connection-local variables.
- (tramp-set-connection-local-variables vec)
+ ;; Set connection-local variables.
+ (tramp-set-connection-local-variables vec)
- ;; Mark it as connected.
- (tramp-set-connection-property p "connected" t))))
+ ;; Mark it as connected.
+ (tramp-set-connection-property p "connected" t)))))
(defun tramp-sudoedit-send-command (vec &rest args)
"Send commands ARGS to connection VEC.
@@ -785,7 +788,7 @@ In case there is no valid Lisp expression, it raises an
error."
(condition-case nil
(prog1 (read (current-buffer))
;; Error handling.
- (when (re-search-forward (rx (not blank)) (line-end-position) t)
+ (when (search-forward-regexp (rx (not blank)) (line-end-position) t)
(error nil)))
(error (tramp-error
vec 'file-error
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 3df306910a9..4b1be4a4d11 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -55,6 +55,7 @@
;;; Code:
(require 'tramp-compat)
+(require 'tramp-message)
(require 'tramp-integration)
(require 'trampver)
@@ -92,8 +93,8 @@
"Edit remote files with a combination of ssh, scp, etc."
:group 'files
:group 'comm
- :link '(custom-manual "(tramp)Top")
- :version "22.1")
+ :version "22.1"
+ :link '(custom-manual "(tramp)Top"))
;;;###tramp-autoload
(progn
@@ -115,32 +116,6 @@
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
-
- 0 silent (no tramp messages at all)
- 1 errors
- 2 warnings
- 3 connection to remote hosts (default level)
- 4 activities
- 5 internal
- 6 sent and received strings
- 7 connection properties
- 8 file caching
- 9 test commands
-10 traces (huge)
-11 call traces (maintainer only)."
- :type 'integer)
-
-(defcustom tramp-debug-to-file nil
- "Whether Tramp debug messages shall be saved to file.
-The debug file has the same name as the debug buffer, written to
-`tramp-compat-temporary-file-directory'."
- :version "28.1"
- :type 'boolean)
-
(defcustom tramp-backup-directory-alist nil
"Alist of filename patterns and backup directory names.
Each element looks like (REGEXP . DIRECTORY), with the same meaning like
@@ -1272,7 +1247,7 @@ checked via the following code:
(process-send-eof proc)
(process-send-eof proc))
(while (not (progn (goto-char (point-min))
- (re-search-forward \"\\\\w+\" (point-max) t)))
+ (search-forward-regexp \"\\\\w+\" (point-max) t)))
(accept-process-output proc 1))
(when (process-live-p proc)
(setq received (string-to-number (match-string 0)))
@@ -1402,12 +1377,12 @@ The TERM environment variable should be set via
`tramp-terminal-type'.
The INSIDE_EMACS environment variable will automatically be set
based on the Tramp and Emacs versions, and should not be set here."
- :group 'tramp
:version "26.1"
:type '(repeat string))
;;; Internal Variables:
+;;;###tramp-autoload
(defvar tramp-current-connection nil
"Last connection timestamp.
It is a cons cell of the actual `tramp-file-name-structure', and
@@ -1478,6 +1453,7 @@ calling HANDLER.")
(make-tramp-file-name :user (user-login-name) :host tramp-system-name)
"Connection hop which identifies the virtual hop before the first one.")
+;;;###tramp-autoload
(defun tramp-file-name-user-domain (vec)
"Return user and domain components of VEC."
(when (or (tramp-file-name-user vec) (tramp-file-name-domain vec))
@@ -1488,6 +1464,7 @@ calling HANDLER.")
(put #'tramp-file-name-user-domain 'tramp-suppress-trace t)
+;;;###tramp-autoload
(defun tramp-file-name-host-port (vec)
"Return host and port components of VEC."
(when (or (tramp-file-name-host vec) (tramp-file-name-port vec))
@@ -1960,371 +1937,6 @@ of `current-buffer'."
buffer (current-buffer))
(substring-no-properties (buffer-string))))
-(defun tramp-debug-buffer-name (vec)
- "A name for the debug buffer for VEC."
- (let ((method (tramp-file-name-method vec))
- (user-domain (tramp-file-name-user-domain vec))
- (host-port (tramp-file-name-host-port vec)))
- (if (tramp-string-empty-or-nil-p user-domain)
- (format "*debug tramp/%s %s*" method host-port)
- (format "*debug tramp/%s %s@%s*" method user-domain host-port))))
-
-(put #'tramp-debug-buffer-name 'tramp-suppress-trace t)
-
-(defconst tramp-debug-outline-regexp
- (rx ;; Timestamp.
- (+ digit) ":" (+ digit) ":" (+ digit) "." (+ digit) blank
- ;; Thread.
- (? (group "#<thread " (+ nonl) ">") blank)
- ;; Function name, verbosity.
- (+ (any "-" alnum)) " (" (group (+ digit)) ") #")
- "Used for highlighting Tramp debug buffers in `outline-mode'.")
-
-(defconst tramp-debug-font-lock-keywords
- ;; FIXME: Make it a function instead of an ELisp expression, so you
- ;; can evaluate it with `funcall' rather than `eval'!
- ;; Also, in `font-lock-defaults' you can specify a function name for
- ;; the "KEYWORDS" part, so font-lock calls it to get the actual keywords!
- '(list
- (rx bol (regexp tramp-debug-outline-regexp) (+ nonl))
- '(1 font-lock-warning-face t t)
- '(0 (outline-font-lock-face) keep t))
- "Used for highlighting Tramp debug buffers in `outline-mode'.")
-
-(defun tramp-debug-outline-level ()
- "Return the depth to which a statement is nested in the outline.
-Point must be at the beginning of a header line.
-
-The outline level is equal to the verbosity of the Tramp message."
- (1+ (string-to-number (match-string 2))))
-
-(put #'tramp-debug-outline-level 'tramp-suppress-trace t)
-
-;; This function takes action since Emacs 28.1, when
-;; `read-extended-command-predicate' is set to
-;; `command-completion-default-include-p'.
-(defun tramp-debug-buffer-command-completion-p (_symbol buffer)
- "A predicate for Tramp interactive commands.
-They are completed by \"M-x TAB\" only in Tramp debug buffers."
- (with-current-buffer buffer
- (string-equal
- (buffer-substring (point-min) (min (+ (point-min) 10) (point-max)))
- ";; Emacs:")))
-
-(put #'tramp-debug-buffer-command-completion-p 'tramp-suppress-trace t)
-
-(defun tramp-setup-debug-buffer ()
- "Function to setup debug buffers."
- ;; (declare (completion tramp-debug-buffer-command-completion-p))
- (interactive)
- (set-buffer-file-coding-system 'utf-8)
- (setq buffer-undo-list t)
- ;; Activate `outline-mode'. This runs `text-mode-hook' and
- ;; `outline-mode-hook'. We must prevent that local processes die.
- ;; Yes: I've seen `flyspell-mode', which starts "ispell".
- ;; `(custom-declare-variable outline-minor-mode-prefix ...)' raises
- ;; on error in `(outline-mode)', we don't want to see it in the
- ;; traces.
- (let ((default-directory tramp-compat-temporary-file-directory))
- (outline-mode))
- (setq-local outline-level 'tramp-debug-outline-level)
- (setq-local font-lock-keywords
- ;; FIXME: This `(t FOO . BAR)' representation in
- ;; `font-lock-keywords' is supposed to be an internal
- ;; implementation "detail". Don't abuse it here!
- `(t (eval ,tramp-debug-font-lock-keywords t)
- ,(eval tramp-debug-font-lock-keywords t)))
- ;; Do not edit the debug buffer.
- (use-local-map special-mode-map)
- (set-buffer-modified-p nil)
- ;; For debugging purposes.
- (local-set-key "\M-n" 'clone-buffer)
- (add-hook 'clone-buffer-hook #'tramp-setup-debug-buffer nil 'local))
-
-(put #'tramp-setup-debug-buffer 'tramp-suppress-trace t)
-
-(function-put
- #'tramp-setup-debug-buffer 'completion-predicate
- #'tramp-debug-buffer-command-completion-p)
-
-(defun tramp-get-debug-buffer (vec)
- "Get the debug buffer for VEC."
- (with-current-buffer (get-buffer-create (tramp-debug-buffer-name vec))
- (when (bobp)
- (tramp-setup-debug-buffer))
- (current-buffer)))
-
-(put #'tramp-get-debug-buffer 'tramp-suppress-trace t)
-
-(defun tramp-get-debug-file-name (vec)
- "Get the debug file name for VEC."
- (expand-file-name
- (tramp-compat-string-replace "/" " " (tramp-debug-buffer-name vec))
- tramp-compat-temporary-file-directory))
-
-(put #'tramp-get-debug-file-name 'tramp-suppress-trace t)
-
-(defun tramp-trace-buffer-name (vec)
- "A name for the trace buffer for VEC."
- (tramp-compat-string-replace "debug" "trace" (tramp-debug-buffer-name vec)))
-
-(put #'tramp-trace-buffer-name 'tramp-suppress-trace t)
-
-(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
-ARGUMENTS to actually emit the message (if applicable)."
- (let ((inhibit-message t)
- create-lockfiles file-name-handler-alist message-log-max
- signal-hook-function)
- (with-current-buffer (tramp-get-debug-buffer vec)
- (goto-char (point-max))
- (let ((point (point)))
- (when (bobp)
- ;; Headline.
- (insert
- (format
- ";; Emacs: %s Tramp: %s -*- mode: outline; coding: utf-8; -*-"
- emacs-version tramp-version))
- (when (>= tramp-verbose 10)
- (let ((tramp-verbose 0))
- (insert
- (format
- "\n;; Location: %s Git: %s/%s"
- (locate-library "tramp")
- (or tramp-repository-branch "")
- (or tramp-repository-version "")))))
- ;; Traces.
- (when (>= tramp-verbose 11)
- (dolist
- (elt
- (append
- (mapcar
- #'intern (all-completions "tramp-" obarray #'functionp))
- tramp-trace-functions))
- (unless (get elt 'tramp-suppress-trace)
- (trace-function-background elt))))
- ;; Delete debug file.
- (when (and tramp-debug-to-file (tramp-get-debug-file-name vec))
- (ignore-errors (delete-file (tramp-get-debug-file-name vec)))))
- (unless (bolp)
- (insert "\n"))
- ;; Timestamp.
- (insert (format-time-string "%T.%6N "))
- ;; Threads. `current-thread' might not exist when Emacs is
- ;; configured --without-threads.
- ;; (unless (eq (tramp-compat-funcall 'current-thread) main-thread)
- ;; (insert (format "%s " (tramp-compat-funcall 'current-thread))))
- ;; Calling Tramp function. We suppress compat and trace
- ;; functions from being displayed.
- (let ((frames (backtrace-frames))
- btf fn)
- (while (not fn)
- (setq btf (cadadr frames))
- (if (not btf)
- (setq fn "")
- (and (symbolp btf) (setq fn (symbol-name btf))
- (or (not (string-prefix-p "tramp" fn))
- (get btf 'tramp-suppress-trace))
- (setq fn nil))
- (setq frames (cdr frames))))
- ;; The following code inserts filename and line number.
- ;; Should be inactive by default, because it is time consuming.
- ;; (let ((ffn (find-function-noselect (intern fn))))
- ;; (insert
- ;; (format
- ;; "%s:%d: "
- ;; (file-name-nondirectory (buffer-file-name (car ffn)))
- ;; (with-current-buffer (car ffn)
- ;; (1+ (count-lines (point-min) (cdr ffn)))))))
- (insert (format "%s " fn)))
- ;; The message.
- (insert (apply #'format-message fmt-string arguments))
- ;; Write message to debug file.
- (when tramp-debug-to-file
- (ignore-errors
- (write-region
- point (point-max) (tramp-get-debug-file-name vec) 'append)))))))
-
-(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
-vector or a process. LEVEL says to be quiet if `tramp-verbose' is
-less than LEVEL. The message is emitted only if `tramp-verbose' is
-greater than or equal to LEVEL.
-
-The message is also logged into the debug buffer when `tramp-verbose'
-is greater than or equal 4.
-
-Calls functions `message' and `tramp-debug-message' with FMT-STRING as
-control string and the remaining ARGUMENTS to actually emit the message (if
-applicable)."
- (ignore-errors
- (when (<= level tramp-verbose)
- ;; Display only when there is a minimum level, and the progress
- ;; reporter doesn't suppress further messages.
- (when (and (<= level 3) (null tramp-inhibit-progress-reporter))
- (apply #'message
- (concat
- (cond
- ((= level 0) "")
- ((= level 1) "")
- ((= level 2) "Warning: ")
- (t "Tramp: "))
- fmt-string)
- arguments))
- ;; Log only when there is a minimum level.
- (when (>= tramp-verbose 4)
- (let ((tramp-verbose 0))
- ;; Append connection buffer for error messages, if exists.
- (when (= level 1)
- (ignore-errors
- (setq fmt-string (concat fmt-string "\n%s")
- arguments
- (append
- arguments
- `(,(tramp-get-buffer-string
- (if (processp vec-or-proc)
- (process-buffer vec-or-proc)
- (tramp-get-connection-buffer
- vec-or-proc 'dont-create))))))))
- ;; Translate proc to vec.
- (when (processp vec-or-proc)
- (setq vec-or-proc (process-get vec-or-proc 'tramp-vector))))
- ;; Do it.
- (when (tramp-file-name-p vec-or-proc)
- (apply #'tramp-debug-message
- vec-or-proc
- (concat (format "(%d) # " level) fmt-string)
- arguments))))))
-
-(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
-forces the backtrace even if `tramp-verbose' is less than 10.
-This function is meant for debugging purposes."
- (let ((tramp-verbose (if force 10 tramp-verbose)))
- (when (>= tramp-verbose 10)
- (if vec-or-proc
- (tramp-message
- vec-or-proc 10 "\n%s" (with-output-to-string (backtrace)))
- (with-output-to-temp-buffer "*debug tramp*" (backtrace))))))
-
-(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
-signal identifier to be raised, remaining arguments passed to
-`tramp-message'. Finally, signal SIGNAL is raised with
-FMT-STRING and ARGUMENTS."
- (let (signal-hook-function)
- (tramp-backtrace vec-or-proc)
- (unless arguments
- ;; FMT-STRING could be just a file name, as in
- ;; `file-already-exists' errors. It could contain the ?\%
- ;; character, as in smb domain spec.
- (setq arguments (list fmt-string)
- fmt-string "%s"))
- (when vec-or-proc
- (tramp-message
- vec-or-proc 1 "%s"
- (error-message-string
- (list signal
- (get signal 'error-message)
- (apply #'format-message fmt-string arguments)))))
- (signal signal (list (substring-no-properties
- (apply #'format-message fmt-string arguments))))))
-
-(put #'tramp-error 'tramp-suppress-trace t)
-
-(defvar tramp-error-show-message-timeout 30
- "Time to show the Tramp buffer in case of an error.
-If it is bound to nil, the buffer is not shown. This is used in
-tramp-tests.el.")
-
-(defsubst tramp-error-with-buffer
- (buf vec-or-proc signal fmt-string &rest arguments)
- "Emit an error, and show BUF.
-If BUF is nil, show the connection buf. Wait for 30\", or until
-an input event arrives. The other arguments are passed to `tramp-error'."
- (save-window-excursion
- (let* ((buf (or (and (bufferp buf) buf)
- (and (processp vec-or-proc) (process-buffer vec-or-proc))
- (and (tramp-file-name-p vec-or-proc)
- (tramp-get-connection-buffer vec-or-proc))))
- (vec (or (and (tramp-file-name-p vec-or-proc) vec-or-proc)
- (and buf (tramp-dissect-file-name
- (tramp-get-default-directory buf))))))
- (unwind-protect
- (apply #'tramp-error vec-or-proc signal fmt-string arguments)
- ;; Save exit.
- (when (and buf
- (natnump tramp-error-show-message-timeout)
- (not (zerop tramp-verbose))
- ;; Do not show when flagged from outside.
- (not non-essential)
- ;; Show only when Emacs has started already.
- (current-message))
- (let ((enable-recursive-minibuffers t)
- inhibit-message)
- ;; `tramp-error' does not show messages. So we must do it
- ;; ourselves.
- (apply #'message fmt-string arguments)
- ;; Show buffer.
- (pop-to-buffer buf)
- (discard-input)
- (sit-for tramp-error-show-message-timeout)))
- ;; Reset timestamp. It would be wrong after waiting for a while.
- (when (tramp-file-name-equal-p vec (car tramp-current-connection))
- (setcdr tramp-current-connection (current-time)))))))
-
-;; 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\")."
- (unwind-protect
- (apply #'tramp-error vec-or-proc 'user-error fmt-string arguments)
- ;; Save exit.
- (when (and (natnump tramp-error-show-message-timeout)
- (not (zerop tramp-verbose))
- ;; Do not show when flagged from outside.
- (not non-essential)
- ;; Show only when Emacs has started already.
- (current-message))
- (let ((enable-recursive-minibuffers t)
- inhibit-message)
- ;; `tramp-error' does not show messages. So we must do it ourselves.
- (apply #'message fmt-string arguments)
- (discard-input)
- (sit-for tramp-error-show-message-timeout)
- ;; Reset timestamp. It would be wrong after waiting for a while.
- (when
- (tramp-file-name-equal-p vec-or-proc (car tramp-current-connection))
- (setcdr tramp-current-connection (current-time)))))))
-
-(put #'tramp-user-error 'tramp-suppress-trace t)
-
-(defmacro tramp-with-demoted-errors (vec-or-proc format &rest body)
- "Execute BODY while redirecting the error message to `tramp-message'.
-BODY is executed like wrapped by `with-demoted-errors'. FORMAT
-is a format-string containing a %-sequence meaning to substitute
-the resulting error message."
- (declare (indent 2) (debug (symbolp form body)))
- (let ((err (make-symbol "err")))
- `(condition-case-unless-debug ,err
- (progn ,@body)
- (error (tramp-message ,vec-or-proc 3 ,format ,err) nil))))
-
;; This macro shall optimize the cases where a `file-exists-p' call is
;; invoked first. Often, the file exists, so the remote command is
;; superfluous.
@@ -2407,6 +2019,11 @@ If VAR is nil, then we bind `v' to the structure and
`method', `user',
(when (tramp-compat-string-search message (or (current-message) ""))
(progress-reporter-update reporter value suffix))))
+;;;###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.")
+
(defmacro with-tramp-progress-reporter (vec level message &rest body)
"Execute BODY, spinning a progress reporter with MESSAGE in interactive mode.
If LEVEL does not fit for visible messages, there are only traces
@@ -2767,22 +2384,20 @@ Fall back to normal file name handler if no Tramp file
name handler exists."
tramp-compat-temporary-file-directory)
file-name-handler-alist)
(autoload-do-load sf foreign)))
- ;; (tramp-message
- ;; v 4 "Running `%s'..." (cons operation args))
- ;; If `non-essential' is non-nil, Tramp shall
- ;; not open a new connection.
- ;; If Tramp detects that it shouldn't continue
- ;; to work, it throws the `suppress' event.
- ;; This could happen for example, when Tramp
- ;; tries to open the same connection twice in
- ;; a short time frame.
- ;; In both cases, we try the default handler then.
- (setq result
- (catch 'non-essential
- (catch 'suppress
- (apply foreign operation args))))
- ;; (tramp-message
- ;; v 4 "Running `%s'...`%s'" (cons operation args)
result)
+ (with-tramp-debug-message
+ v (format "Running `%S'" (cons operation args))
+ ;; If `non-essential' is non-nil, Tramp shall
+ ;; not open a new connection.
+ ;; If Tramp detects that it shouldn't continue
+ ;; to work, it throws the `suppress' event.
+ ;; This could happen for example, when Tramp
+ ;; tries to open the same connection twice in
+ ;; a short time frame.
+ ;; In both cases, we try the default handler then.
+ (setq result
+ (catch 'non-essential
+ (catch 'suppress
+ (apply foreign operation args)))))
(cond
((eq result 'non-essential)
(tramp-message
@@ -3383,7 +2998,7 @@ for all methods. Resulting data are derived from default
settings."
"Return a (user host) tuple allowed to access.
User is always nil."
(let (result)
- (when (re-search-forward regexp (line-end-position) t)
+ (when (search-forward-regexp regexp (line-end-position) t)
(setq result (list nil (match-string match-level))))
(or
(> (skip-chars-forward skip-chars) 0)
@@ -3416,7 +3031,7 @@ Either user or host may be nil."
(rx
bol (group (regexp tramp-host-regexp))
(? (+ blank) (group (regexp tramp-user-regexp))))))
- (when (re-search-forward regexp (line-end-position) t)
+ (when (search-forward-regexp regexp (line-end-position) t)
(setq result (append (list (match-string 2) (match-string 1)))))
(forward-line 1)
result))
@@ -3504,7 +3119,7 @@ Host is always \"localhost\"."
Host is always \"localhost\"."
(let (result
(regexp (rx bol (group (regexp tramp-user-regexp)) ":")))
- (when (re-search-forward regexp (line-end-position) t)
+ (when (search-forward-regexp regexp (line-end-position) t)
(setq result (list (match-string 1) "localhost")))
(forward-line 1)
result))
@@ -3561,7 +3176,7 @@ User is always nil."
User is always nil."
(let (result
(regexp (rx (literal registry) "\\" (group (+ nonl)))))
- (when (re-search-forward regexp (line-end-position) t)
+ (when (search-forward-regexp regexp (line-end-position) t)
(setq result (list nil (match-string 1))))
(forward-line 1)
result))
@@ -5058,7 +4673,8 @@ a connection-local variable."
(process-put proc 'adjust-window-size-function #'ignore)
(set-process-query-on-exit-flag proc nil)
(tramp-taint-remote-process-buffer (process-buffer proc))
- (tramp-message vec 6 "%s" (string-join (process-command proc) " ")))
+ (when (process-command proc)
+ (tramp-message vec 6 "%s" (string-join (process-command proc) " "))))
(put #'tramp-post-process-creation 'tramp-suppress-trace t)
@@ -5245,25 +4861,25 @@ support symbolic links."
((zerop (process-file "cat" nil '(t) nil "/proc/meminfo"))
(goto-char (point-min))
(when
- (re-search-forward
+ (search-forward-regexp
(rx bol "MemTotal:" (* space) (group (+ digit)) (* space) "kB"
eol)
nil 'noerror)
(setcar (nthcdr 0 result) (string-to-number (match-string 1))))
(goto-char (point-min))
(when
- (re-search-forward
+ (search-forward-regexp
(rx bol "MemFree:" (* space) (group (+ digit)) (* space) "kB" eol)
nil 'noerror)
(setcar (nthcdr 1 result) (string-to-number (match-string 1))))
(goto-char (point-min))
(when
- (re-search-forward
+ (search-forward-regexp
(rx bol "SwapTotal:" (* space) (group (+ digit)) (* space) "kB"
eol)
nil 'noerror)
(setcar (nthcdr 2 result) (string-to-number (match-string 1))))
(goto-char (point-min))
(when
- (re-search-forward
+ (search-forward-regexp
(rx bol "SwapFree:" (* space) (group (+ digit)) (* space) "kB"
eol)
nil 'noerror)
(setcar (nthcdr 3 result) (string-to-number (match-string 1)))))
@@ -5273,13 +4889,13 @@ support symbolic links."
((zerop (process-file "sysctl" nil '(t) nil "-a"))
(goto-char (point-min))
(when
- (re-search-forward
+ (search-forward-regexp
(rx bol "hw.pagesize:" (* space) (group (+ digit)) eol)
nil 'noerror)
(let ((pagesize (string-to-number (match-string 1))))
(goto-char (point-min))
(when
- (re-search-forward
+ (search-forward-regexp
(rx bol "vm.stats.vm.v_page_count:" (* space)
(group (+ digit)) eol)
nil 'noerror)
@@ -5288,7 +4904,7 @@ support symbolic links."
(/ (* (string-to-number (match-string 1)) pagesize) 1024)))
(goto-char (point-min))
(when
- (re-search-forward
+ (search-forward-regexp
(rx bol "vm.stats.vm.v_free_count:" (* space)
(group (+ digit)) eol)
nil 'noerror)
@@ -5299,7 +4915,7 @@ support symbolic links."
(when (zerop (process-file "swapctl" nil '(t) nil "-sk"))
(goto-char (point-min))
(when
- (re-search-forward
+ (search-forward-regexp
(rx bol "Total:" (* space)
(group (+ digit)) (* space) (group (+ digit)) eol)
nil 'noerror)
@@ -5790,7 +5406,7 @@ Wait, until the connection buffer changes."
;; This can be ignored.
(with-current-buffer (process-buffer proc)
(goto-char (point-min))
- (if (re-search-forward tramp-operation-not-permitted-regexp nil t)
+ (if (search-forward-regexp tramp-operation-not-permitted-regexp nil
t)
(progn
(tramp-message vec 5 "'set mode' error ignored.")
(tramp-message vec 3 "Process has finished.")
@@ -5813,7 +5429,7 @@ See `tramp-process-actions' for the format of ACTIONS."
;; Remove ANSI control escape sequences.
(with-current-buffer (tramp-get-connection-buffer vec)
(goto-char (point-min))
- (while (re-search-forward ansi-color-control-seq-regexp nil t)
+ (while (search-forward-regexp ansi-color-control-seq-regexp nil t)
(replace-match "")))
(setq todo actions)
(while todo
@@ -5968,7 +5584,7 @@ Otherwise, return nil."
;; We restrict ourselves to the last 256 characters. There were
;; reports of a shell command "git ls-files -zco --exclude-standard"
;; with 85k files involved, which has blocked Tramp forever.
- (re-search-backward regexp (max (point-min) (- (point) 256)) 'noerror))
+ (search-backward-regexp regexp (max (point-min) (- (point) 256)) 'noerror))
(defun tramp-check-for-regexp (proc regexp)
"Check, whether REGEXP is contained in process buffer of PROC.
@@ -5980,12 +5596,12 @@ Erase echoed commands if exists."
;; the echo mark regexp is taken for search. We restrict the
;; search for the second echo mark to PIPE_BUF characters.
(when (and (tramp-get-connection-property proc "check-remote-echo")
- (re-search-forward
+ (search-forward-regexp
tramp-echoed-echo-mark-regexp
(+ (point) (* 5 tramp-echo-mark-marker-length)) t))
(let ((begin (match-beginning 0)))
(when
- (re-search-forward
+ (search-forward-regexp
tramp-echoed-echo-mark-regexp
(+ (point) (tramp-get-connection-property proc "pipe-buf" 4096)) t)
;; Discard echo from remote output.
@@ -6497,19 +6113,19 @@ Set connection properties
\"{uid,gid,groups}-{integer,string}\"."
groups-integer groups-string)
(goto-char (point-min))
;; Read uid.
- (when (re-search-forward
+ (when (search-forward-regexp
(rx "uid=" (group (+ digit)) "(" (group (+ (any "_" word))) ")")
nil 'noerror)
(setq uid-integer (string-to-number (match-string 1))
uid-string (match-string 2)))
;; Read gid.
- (when (re-search-forward
+ (when (search-forward-regexp
(rx "gid=" (group (+ digit)) "(" (group (+ (any "_" word))) ")")
nil 'noerror)
(setq gid-integer (string-to-number (match-string 1))
gid-string (match-string 2)))
;; Read groups.
- (when (re-search-forward (rx "groups=") nil 'noerror)
+ (when (search-forward-regexp (rx "groups=") nil 'noerror)
(while (looking-at
(rx (group (+ digit)) "(" (group (+ (any "_" word))) ")"))
(setq groups-integer (cons (string-to-number (match-string 1))
diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el
index ad7bf94cdcd..4d56cf367e3 100644
--- a/lisp/net/trampver.el
+++ b/lisp/net/trampver.el
@@ -47,6 +47,7 @@
(defconst tramp-bug-report-address "tramp-devel@gnu.org"
"Email address to send bug reports to.")
+;;;###tramp-autoload
(defconst tramp-repository-branch
(ignore-errors
;; Suppress message from `emacs-repository-get-branch'. We must
@@ -60,6 +61,7 @@
(emacs-repository-get-branch dir))))
"The repository branch of the Tramp sources.")
+;;;###tramp-autoload
(defconst tramp-repository-version
(ignore-errors
;; Suppress message from `emacs-repository-get-version'. We must
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 9bc8ad8ce39..ee9c09df9d8 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -263,7 +263,6 @@ is greater than 10.
`should-error' is not handled properly. BODY shall not contain a timeout."
(declare (indent 1) (debug (natnump body)))
`(let* ((tramp-verbose (max (or ,verbose 0) (or tramp-verbose 0)))
- (trace-buffer (tramp-trace-buffer-name tramp-test-vec))
(debug-ignored-errors
(append
'("^make-symbolic-link not supported$"
@@ -3502,14 +3501,14 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
"tramp-test*" ert-remote-temporary-file-directory)))
(goto-char (point-min))
(should
- (re-search-forward
+ (search-forward-regexp
(rx
(literal
(file-relative-name
tmp-name1 ert-remote-temporary-file-directory)))))
(goto-char (point-min))
(should
- (re-search-forward
+ (search-forward-regexp
(rx
(literal
(file-relative-name
@@ -3524,14 +3523,14 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
"tramp-test*/*" ert-remote-temporary-file-directory)))
(goto-char (point-min))
(should
- (re-search-forward
+ (search-forward-regexp
(rx
(literal
(file-relative-name
tmp-name3 ert-remote-temporary-file-directory)))))
(goto-char (point-min))
(should
- (re-search-forward
+ (search-forward-regexp
(rx
(literal
(file-relative-name
@@ -3554,14 +3553,14 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
"tramp-test*/*" ert-remote-temporary-file-directory)))
(goto-char (point-min))
(should
- (re-search-forward
+ (search-forward-regexp
(rx
(literal
(file-relative-name
tmp-name3 ert-remote-temporary-file-directory)))))
(goto-char (point-min))
(should
- (re-search-forward
+ (search-forward-regexp
(rx
(literal
(file-relative-name
@@ -4980,10 +4979,10 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
;; We must remove leading `default-directory'.
(goto-char (point-min))
(let ((inhibit-read-only t))
- (while (re-search-forward "//" nil 'noerror)
+ (while (search-forward-regexp "//" nil 'noerror)
(delete-region (line-beginning-position) (point))))
(goto-char (point-min))
- (re-search-forward
+ (search-forward-regexp
(rx bol (0+ nonl)
(any "Pp") "ossible completions"
(0+ nonl) eol))
@@ -5095,7 +5094,8 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(if (bufferp destination) destination (current-buffer))
;; "ls" could produce colorized output.
(goto-char (point-min))
- (while (re-search-forward ansi-color-control-seq-regexp nil t)
+ (while (search-forward-regexp
+ ansi-color-control-seq-regexp nil t)
(replace-match "" nil nil))
(should
(string-equal (if destination (format "%s\n" fnnd) "")
@@ -5109,7 +5109,8 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(if (bufferp destination) destination (current-buffer))
;; "ls" could produce colorized output.
(goto-char (point-min))
- (while (re-search-forward ansi-color-control-seq-regexp nil t)
+ (while (search-forward-regexp
+ ansi-color-control-seq-regexp nil t)
(replace-match "" nil nil))
(should
(string-equal
@@ -5823,7 +5824,7 @@ INPUT, if non-nil, is a string sent to the process."
(current-buffer))
;; "ls" could produce colorized output.
(goto-char (point-min))
- (while (re-search-forward ansi-color-control-seq-regexp nil t)
+ (while (search-forward-regexp ansi-color-control-seq-regexp nil t)
(replace-match "" nil nil))
(should
(string-equal
@@ -7374,7 +7375,7 @@ This requires restrictions of file name syntax."
(should (zerop (process-file "printenv" nil t nil)))
(goto-char (point-min))
(should
- (re-search-forward
+ (search-forward-regexp
(rx
bol (literal envvar)
"=" (literal (getenv envvar)) eol))))))))