Merge remote-tracking branch 'origin/master' into feature/android
This commit is contained in:
Po Lu
commit
7ce7a004f6
17 changed files with 1437 additions and 1199 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
(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))
|
||||
;; 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!"))
|
||||
(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 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)
|
||||
;; 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))
|
||||
;; 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")
|
||||
;; 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"))
|
||||
;; 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)))
|
||||
;; 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)))
|
||||
;; 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)))))))
|
||||
;; Mark it as connected.
|
||||
(tramp-set-connection-property p "connected" t))))))))
|
||||
|
||||
;;; Default connection-local variables for Tramp.
|
||||
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
(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)
|
||||
;; 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)))))
|
||||
;; 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>")))
|
||||
;; 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)
|
||||
;; 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)))))))
|
||||
;; 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.
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
(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)
|
||||
;; 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)))
|
||||
;; 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))))
|
||||
(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-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-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 (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))))
|
||||
(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))
|
||||
(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)
|
||||
;; 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 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)
|
||||
;; 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)
|
||||
;; 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))
|
||||
: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))
|
||||
;; 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)))
|
||||
"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"))
|
||||
;; 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)))
|
||||
;; 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)))))
|
||||
;; 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."
|
||||
|
|
|
|||
572
lisp/net/tramp-message.el
Normal file
572
lisp/net/tramp-message.el
Normal file
|
|
@ -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)
|
||||
|
|
@ -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)
|
||||
(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)))
|
||||
;; 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))
|
||||
;; 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))
|
||||
;; 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))))
|
||||
;; 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)))
|
||||
;; 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.
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
(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 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)))
|
||||
;; 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"
|
||||
;; 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)))
|
||||
(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)))))))
|
||||
(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)))
|
||||
;; 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)
|
||||
;; 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)
|
||||
;; 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)
|
||||
;; 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)
|
||||
;; 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)
|
||||
;; Set password prompt vector.
|
||||
(tramp-set-connection-property
|
||||
p "session-timeout"
|
||||
(tramp-get-method-parameter
|
||||
hop 'tramp-session-timeout)))
|
||||
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)))
|
||||
|
||||
;; 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")))
|
||||
" "))
|
||||
;; 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)))
|
||||
|
||||
;; 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)
|
||||
;; 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")))
|
||||
" "))
|
||||
|
||||
;; Next hop.
|
||||
(setq options ""
|
||||
target-alist (cdr target-alist)
|
||||
previous-hop hop)))
|
||||
;; 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)
|
||||
|
||||
;; 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))
|
||||
;; Next hop.
|
||||
(setq options ""
|
||||
target-alist (cdr target-alist)
|
||||
previous-hop hop)))
|
||||
|
||||
;; Make initial shell settings.
|
||||
(tramp-open-connection-setup-interactive-shell p vec)
|
||||
;; 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))
|
||||
|
||||
;; Mark it as connected.
|
||||
(tramp-set-connection-property p "connected" t)))))
|
||||
;; Make initial shell settings.
|
||||
(tramp-open-connection-setup-interactive-shell p vec)
|
||||
|
||||
;; Cleanup, and propagate the signal.
|
||||
((error quit)
|
||||
(tramp-cleanup-connection vec t)
|
||||
(signal (car err) (cdr err))))))
|
||||
;; 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
|
||||
|
|
|
|||
|
|
@ -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")))
|
||||
;; 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 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))
|
||||
(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)))
|
||||
(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)))
|
||||
;; 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 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)
|
||||
(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))))
|
||||
(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 ""))
|
||||
;; 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)
|
||||
(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)
|
||||
;; 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))
|
||||
(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)
|
||||
;; 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))
|
||||
;; 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)))))))))))))
|
||||
;; 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."
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
(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)))
|
||||
;; 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))
|
||||
;; 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)))
|
||||
(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)
|
||||
;; 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)))
|
||||
;; 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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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))))))))
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue