Commit 07dfe738 authored by Kai Großjohann's avatar Kai Großjohann
Browse files

Sync with Tramp 2.0.43.

(tramp-handle-verify-visited-file-modtime): Remove
outdated comment.
(tramp-locked, tramp-locker): New variables for implementing a
global lock.
(tramp-sh-file-name-handler): Use them to implement the global
lock.
parent 3e39672f
2004-07-17 Kai Grossjohann <kai.grossjohann@gmx.net>
Sync with Tramp 2.0.43.
* net/tramp.el (tramp-handle-verify-visited-file-modtime): Remove
outdated comment.
(tramp-locked, tramp-locker): New variables for implementing a
global lock.
(tramp-sh-file-name-handler): Use them to implement the global
lock.
2004-07-13 Michael Albinus <michael.albinus@gmx.de>
* net/tramp.el (all): Code cleanup. Change all `tramp-handle-xxx'
calls to respective `xxx` calls.
(tramp-process-alive-regexp): Precise doc string.
(tramp-multi-action-process-alive): New defun.
(tramp-multi-actions): Use it.
(tramp-handle-find-backup-file-name): `copy-tree' is available
since Emacs 21.4 only (XEmacs has it). Implementation rewritten
in order to avoid this function.
(tramp-handle-write-region): Set current buffer. If connection
wasn't open, `file-modes' has changed it accidently. Reported by
David Kastrup <dak@gnu.org>.
(tramp-enter-password, tramp-read-passwd): New arguments USER and
HOST.
(tramp-action-password, tramp-multi-action-password): Apply it.
(tramp-open-connection-rsh): If a port is given, the Tramp buffer
name must still contain the port number. Otherwise, we have two
Tramp buffers, with all the confusion. Reported by Myron Selby
<myron@xytech.com> and Rolf Dubitzky
<Dubitzky@physi.uni-heidelberg.de>.
* net/tramp-smb.el (tramp-smb-open-connection): Apply USER and
HOST to `tramp-enter-passwd'.
* net/tramp-vc.el (all): Code cleanup. Change all
`tramp-handle-xxx' calls to respective `xxx` calls.
2004-07-17 Jonathan Yavner <jyavner@member.fsf.org> 2004-07-17 Jonathan Yavner <jyavner@member.fsf.org>
* emacs-lisp/testcover.el: New category "potentially-1valued" for * emacs-lisp/testcover.el: New category "potentially-1valued" for
......
...@@ -1012,7 +1012,7 @@ Domain names in USER and port numbers in HOST are acknowledged." ...@@ -1012,7 +1012,7 @@ Domain names in USER and port numbers in HOST are acknowledged."
(when real-user (when real-user
(let ((pw-prompt "Password:")) (let ((pw-prompt "Password:"))
(tramp-message 9 "Sending password") (tramp-message 9 "Sending password")
(tramp-enter-password p pw-prompt))) (tramp-enter-password p pw-prompt user host)))
(unless (tramp-smb-wait-for-output user host) (unless (tramp-smb-wait-for-output user host)
(tramp-clear-passwd user host) (tramp-clear-passwd user host)
......
...@@ -77,7 +77,7 @@ ...@@ -77,7 +77,7 @@
"Like `vc-do-command' but invoked for tramp files. "Like `vc-do-command' but invoked for tramp files.
See `vc-do-command' for more information." See `vc-do-command' for more information."
(save-match-data (save-match-data
(and file (setq file (tramp-handle-expand-file-name file))) (and file (setq file (expand-file-name file)))
(if (not buffer) (setq buffer "*vc*")) (if (not buffer) (setq buffer "*vc*"))
(if vc-command-messages (if vc-command-messages
(message "Running `%s' on `%s'..." command file)) (message "Running `%s' on `%s'..." command file))
...@@ -85,7 +85,7 @@ See `vc-do-command' for more information." ...@@ -85,7 +85,7 @@ See `vc-do-command' for more information."
(squeezed nil) (squeezed nil)
(olddir default-directory) (olddir default-directory)
vc-file status) vc-file status)
(let* ((v (tramp-dissect-file-name (tramp-handle-expand-file-name file))) (let* ((v (tramp-dissect-file-name (expand-file-name file)))
(multi-method (tramp-file-name-multi-method v)) (multi-method (tramp-file-name-multi-method v))
(method (tramp-file-name-method v)) (method (tramp-file-name-method v))
(user (tramp-file-name-user v)) (user (tramp-file-name-user v))
...@@ -130,7 +130,7 @@ See `vc-do-command' for more information." ...@@ -130,7 +130,7 @@ See `vc-do-command' for more information."
(save-excursion (save-excursion
(save-window-excursion (save-window-excursion
;; Actually execute remote command ;; Actually execute remote command
(tramp-handle-shell-command (shell-command
(mapconcat 'tramp-shell-quote-argument (mapconcat 'tramp-shell-quote-argument
(cons command squeezed) " ") t) (cons command squeezed) " ") t)
;;(tramp-wait-for-output) ;;(tramp-wait-for-output)
...@@ -190,7 +190,7 @@ Since TRAMP doesn't do async commands yet, this function doesn't, either." ...@@ -190,7 +190,7 @@ Since TRAMP doesn't do async commands yet, this function doesn't, either."
(let ((w32-quote-process-args t)) (let ((w32-quote-process-args t))
(when (eq okstatus 'async) (when (eq okstatus 'async)
(message "Tramp doesn't do async commands, running synchronously.")) (message "Tramp doesn't do async commands, running synchronously."))
(setq status (tramp-handle-shell-command (setq status (shell-command
(mapconcat 'tramp-shell-quote-argument (mapconcat 'tramp-shell-quote-argument
(cons command squeezed) " ") t)) (cons command squeezed) " ") t))
(when (or (not (integerp status)) (when (or (not (integerp status))
...@@ -257,7 +257,7 @@ Since TRAMP doesn't do async commands yet, this function doesn't, either." ...@@ -257,7 +257,7 @@ Since TRAMP doesn't do async commands yet, this function doesn't, either."
;; Don't switch to the *vc-info* buffer before running the ;; Don't switch to the *vc-info* buffer before running the
;; command, because that would change its default directory ;; command, because that would change its default directory
(save-match-data (save-match-data
(let* ((v (tramp-dissect-file-name (tramp-handle-expand-file-name file))) (let* ((v (tramp-dissect-file-name (expand-file-name file)))
(multi-method (tramp-file-name-multi-method v)) (multi-method (tramp-file-name-multi-method v))
(method (tramp-file-name-method v)) (method (tramp-file-name-method v))
(user (tramp-file-name-user v)) (user (tramp-file-name-user v))
...@@ -284,7 +284,7 @@ Since TRAMP doesn't do async commands yet, this function doesn't, either." ...@@ -284,7 +284,7 @@ Since TRAMP doesn't do async commands yet, this function doesn't, either."
(save-excursion (save-excursion
(save-window-excursion (save-window-excursion
;; Actually execute remote command ;; Actually execute remote command
(tramp-handle-shell-command (shell-command
(mapconcat 'tramp-shell-quote-argument (mapconcat 'tramp-shell-quote-argument
(append (list command) args (list localname)) " ") (append (list command) args (list localname)) " ")
(get-buffer-create"*vc-info*")) (get-buffer-create"*vc-info*"))
...@@ -414,7 +414,7 @@ filename we are thinking about..." ...@@ -414,7 +414,7 @@ filename we are thinking about..."
(nth 2 (file-attributes file))))) (nth 2 (file-attributes file)))))
(if (and uid (/= uid remote-uid)) (if (and uid (/= uid remote-uid))
(error "tramp-handle-vc-user-login-name cannot map a uid to a name") (error "tramp-handle-vc-user-login-name cannot map a uid to a name")
(let* ((v (tramp-dissect-file-name (tramp-handle-expand-file-name file))) (let* ((v (tramp-dissect-file-name (expand-file-name file)))
(u (tramp-file-name-user v))) (u (tramp-file-name-user v)))
(cond ((stringp u) u) (cond ((stringp u) u)
((vectorp u) (elt u (1- (length u)))) ((vectorp u) (elt u (1- (length u))))
...@@ -445,8 +445,8 @@ filename we are thinking about..." ...@@ -445,8 +445,8 @@ filename we are thinking about..."
(defun tramp-file-owner (filename) (defun tramp-file-owner (filename)
"Return who owns FILE (user name, as a string)." "Return who owns FILE (user name, as a string)."
(let ((v (tramp-dissect-file-name (let ((v (tramp-dissect-file-name
(tramp-handle-expand-file-name filename)))) (expand-file-name filename))))
(if (not (tramp-handle-file-exists-p filename)) (if (not (file-exists-p filename))
nil ; file cannot be opened nil ; file cannot be opened
;; file exists, find out stuff ;; file exists, find out stuff
(save-excursion (save-excursion
......
...@@ -916,8 +916,8 @@ The answer will be provided by `tramp-action-terminal', which see." ...@@ -916,8 +916,8 @@ The answer will be provided by `tramp-action-terminal', which see."
"Regular expression indicating a process has finished. "Regular expression indicating a process has finished.
In fact this expression is empty by intention, it will be used only to In fact this expression is empty by intention, it will be used only to
check regularly the status of the associated process. check regularly the status of the associated process.
The answer will be provided by `tramp-action-process-alive' and The answer will be provided by `tramp-action-process-alive',
`tramp-action-out-of-band', which see." `tramp-multi-action-process-alive' and`tramp-action-out-of-band', which see."
:group 'tramp :group 'tramp
:type 'regexp) :type 'regexp)
...@@ -1321,7 +1321,7 @@ See `tramp-actions-before-shell' for more info." ...@@ -1321,7 +1321,7 @@ See `tramp-actions-before-shell' for more info."
(shell-prompt-pattern tramp-multi-action-succeed) (shell-prompt-pattern tramp-multi-action-succeed)
(tramp-shell-prompt-pattern tramp-multi-action-succeed) (tramp-shell-prompt-pattern tramp-multi-action-succeed)
(tramp-wrong-passwd-regexp tramp-multi-action-permission-denied) (tramp-wrong-passwd-regexp tramp-multi-action-permission-denied)
(tramp-process-alive-regexp tramp-action-process-alive)) (tramp-process-alive-regexp tramp-multi-action-process-alive))
"List of pattern/action pairs. "List of pattern/action pairs.
This list is used for each hop in multi-hop connections. This list is used for each hop in multi-hop connections.
See `tramp-actions-before-shell' for more info." See `tramp-actions-before-shell' for more info."
...@@ -2165,7 +2165,7 @@ target of the symlink differ." ...@@ -2165,7 +2165,7 @@ target of the symlink differ."
(let ((nonnumeric (and id-format (equal id-format 'string))) (let ((nonnumeric (and id-format (equal id-format 'string)))
result) result)
(with-parsed-tramp-file-name filename nil (with-parsed-tramp-file-name filename nil
(when (tramp-handle-file-exists-p filename) (when (file-exists-p filename)
;; file exists, find out stuff ;; file exists, find out stuff
(save-excursion (save-excursion
(if (tramp-get-remote-perl multi-method method user host) (if (tramp-get-remote-perl multi-method method user host)
...@@ -2509,19 +2509,19 @@ if the remote host can't provide the modtime." ...@@ -2509,19 +2509,19 @@ if the remote host can't provide the modtime."
(defun tramp-handle-file-writable-p (filename) (defun tramp-handle-file-writable-p (filename)
"Like `file-writable-p' for tramp files." "Like `file-writable-p' for tramp files."
(with-parsed-tramp-file-name filename nil (with-parsed-tramp-file-name filename nil
(if (tramp-handle-file-exists-p filename) (if (file-exists-p filename)
;; Existing files must be writable. ;; Existing files must be writable.
(zerop (tramp-run-test "-w" filename)) (zerop (tramp-run-test "-w" filename))
;; If file doesn't exist, check if directory is writable. ;; If file doesn't exist, check if directory is writable.
(and (zerop (tramp-run-test (and (zerop (tramp-run-test
"-d" (tramp-handle-file-name-directory filename))) "-d" (file-name-directory filename)))
(zerop (tramp-run-test (zerop (tramp-run-test
"-w" (tramp-handle-file-name-directory filename))))))) "-w" (file-name-directory filename)))))))
(defun tramp-handle-file-ownership-preserved-p (filename) (defun tramp-handle-file-ownership-preserved-p (filename)
"Like `file-ownership-preserved-p' for tramp files." "Like `file-ownership-preserved-p' for tramp files."
(with-parsed-tramp-file-name filename nil (with-parsed-tramp-file-name filename nil
(or (not (tramp-handle-file-exists-p filename)) (or (not (file-exists-p filename))
;; Existing files must be writable. ;; Existing files must be writable.
(zerop (tramp-run-test "-O" filename))))) (zerop (tramp-run-test "-O" filename)))))
...@@ -3064,7 +3064,7 @@ This is like `dired-recursive-delete-directory' for tramp files." ...@@ -3064,7 +3064,7 @@ This is like `dired-recursive-delete-directory' for tramp files."
(with-parsed-tramp-file-name filename nil (with-parsed-tramp-file-name filename nil
;; run a shell command 'rm -r <localname>' ;; run a shell command 'rm -r <localname>'
;; Code shamelessly stolen for the dired implementation and, um, hacked :) ;; Code shamelessly stolen for the dired implementation and, um, hacked :)
(or (tramp-handle-file-exists-p filename) (or (file-exists-p filename)
(signal (signal
'file-error 'file-error
(list "Removing old file name" "no such directory" filename))) (list "Removing old file name" "no such directory" filename)))
...@@ -3075,7 +3075,7 @@ This is like `dired-recursive-delete-directory' for tramp files." ...@@ -3075,7 +3075,7 @@ This is like `dired-recursive-delete-directory' for tramp files."
;; This might take a while, allow it plenty of time. ;; This might take a while, allow it plenty of time.
(tramp-wait-for-output 120) (tramp-wait-for-output 120)
;; Make sure that it worked... ;; Make sure that it worked...
(and (tramp-handle-file-exists-p filename) (and (file-exists-p filename)
(error "Failed to recusively delete %s" filename)))) (error "Failed to recusively delete %s" filename))))
(defun tramp-handle-dired-call-process (program discard &rest arguments) (defun tramp-handle-dired-call-process (program discard &rest arguments)
...@@ -3607,45 +3607,47 @@ This will break if COMMAND prints a newline, followed by the value of ...@@ -3607,45 +3607,47 @@ This will break if COMMAND prints a newline, followed by the value of
(defun tramp-handle-find-backup-file-name (filename) (defun tramp-handle-find-backup-file-name (filename)
"Like `find-backup-file-name' for tramp files." "Like `find-backup-file-name' for tramp files."
(with-parsed-tramp-file-name filename nil
;; We set both variables. It doesn't matter whether it is
;; Emacs or XEmacs
(let ((backup-directory-alist
;; Emacs case
(when (boundp 'backup-directory-alist)
(if (boundp 'tramp-backup-directory-alist)
(mapcar
'(lambda (x)
(cons
(car x)
(if (and (stringp (cdr x))
(file-name-absolute-p (cdr x))
(not (tramp-file-name-p (cdr x))))
(tramp-make-tramp-file-name
multi-method method user host (cdr x))
(cdr x))))
(symbol-value 'tramp-backup-directory-alist))
(symbol-value 'backup-directory-alist))))
(bkup-backup-directory-info
;; XEmacs case
(when (boundp 'bkup-backup-directory-info)
(if (boundp 'tramp-bkup-backup-directory-info)
(mapcar
'(lambda (x)
(nconc
(list (car x))
(list
(if (and (stringp (car (cdr x)))
(file-name-absolute-p (car (cdr x)))
(not (tramp-file-name-p (car (cdr x)))))
(tramp-make-tramp-file-name
multi-method method user host (car (cdr x)))
(car (cdr x))))
(cdr (cdr x))))
(symbol-value 'tramp-bkup-backup-directory-info))
(symbol-value 'bkup-backup-directory-info)))))
(tramp-run-real-handler 'find-backup-file-name (list filename)))))
(if (or (and (not (featurep 'xemacs))
(not (boundp 'tramp-backup-directory-alist)))
(and (featurep 'xemacs)
(not (boundp 'tramp-bkup-backup-directory-info))))
;; No tramp backup directory alist defined, or nil
(tramp-run-real-handler 'find-backup-file-name (list filename))
(with-parsed-tramp-file-name filename nil
(let* ((backup-var
(copy-tree
(if (featurep 'xemacs)
;; XEmacs case
(symbol-value 'tramp-bkup-backup-directory-info)
;; Emacs case
(symbol-value 'tramp-backup-directory-alist))))
;; We set both variables. It doesn't matter whether it is
;; Emacs or XEmacs
(backup-directory-alist backup-var)
(bkup-backup-directory-info backup-var))
(mapcar
'(lambda (x)
(let ((dir (if (consp (cdr x)) (car (cdr x)) (cdr x))))
(when (and (stringp dir)
(file-name-absolute-p dir)
(not (tramp-file-name-p dir)))
;; Prepend absolute directory names with tramp prefix
(if (consp (cdr x))
(setcar (cdr x)
(tramp-make-tramp-file-name
multi-method method user host dir))
(setcdr x (tramp-make-tramp-file-name
multi-method method user host dir))))))
backup-var)
(tramp-run-real-handler 'find-backup-file-name (list filename))))))
;; CCC grok APPEND, LOCKNAME, CONFIRM ;; CCC grok APPEND, LOCKNAME, CONFIRM
(defun tramp-handle-write-region (defun tramp-handle-write-region
...@@ -3689,6 +3691,9 @@ This will break if COMMAND prints a newline, followed by the value of ...@@ -3689,6 +3691,9 @@ This will break if COMMAND prints a newline, followed by the value of
;; use an encoding function, but currently we use it always ;; use an encoding function, but currently we use it always
;; because this makes the logic simpler. ;; because this makes the logic simpler.
(setq tmpfil (tramp-make-temp-file)) (setq tmpfil (tramp-make-temp-file))
;; Set current buffer. If connection wasn't open, `file-modes' has
;; changed it accidently.
(set-buffer curbuf)
;; We say `no-message' here because we don't want the visited file ;; We say `no-message' here because we don't want the visited file
;; modtime data to be clobbered from the temp file. We call ;; modtime data to be clobbered from the temp file. We call
;; `set-visited-file-modtime' ourselves later on. ;; `set-visited-file-modtime' ourselves later on.
...@@ -3972,14 +3977,50 @@ Falls back to normal file name handler if no tramp file name handler exists." ...@@ -3972,14 +3977,50 @@ Falls back to normal file name handler if no tramp file name handler exists."
(foreign (apply foreign operation args)) (foreign (apply foreign operation args))
(t (tramp-run-real-handler operation args)))))) (t (tramp-run-real-handler operation args))))))
;; In Emacs, there is some concurrency due to timers. If a timer
;; interrupts Tramp and wishes to use the same connection buffer as
;; the "main" Emacs, then garbage might occur in the connection
;; buffer. Therefore, we need to make sure that a timer does not use
;; the same connection buffer as the "main" Emacs. We implement a
;; cheap global lock, instead of locking each connection buffer
;; separately. The global lock is based on two variables,
;; `tramp-locked' and `tramp-locker'. `tramp-locked' is set to true
;; (with setq) to indicate a lock. But Tramp also calls itself during
;; processing of a single file operation, so we need to allow
;; recursive calls. That's where the `tramp-locker' variable comes in
;; -- it is let-bound to t during the execution of the current
;; handler. So if `tramp-locked' is t and `tramp-locker' is also t,
;; then we should just proceed because we have been called
;; recursively. But if `tramp-locker' is nil, then we are a timer
;; interrupting the "main" Emacs, and then we signal an error.
(defvar tramp-locked nil
"If non-nil, then Tramp is currently busy.
Together with `tramp-locker', this implements a locking mechanism
preventing reentrant calls of Tramp.")
(defvar tramp-locker nil
"If non-nil, then a caller has locked Tramp.
Together with `tramp-locked', this implements a locking mechanism
preventing reentrant calls of Tramp.")
(defun tramp-sh-file-name-handler (operation &rest args) (defun tramp-sh-file-name-handler (operation &rest args)
"Invoke remote-shell Tramp file name handler. "Invoke remote-shell Tramp file name handler.
Fall back to normal file name handler if no Tramp handler exists." Fall back to normal file name handler if no Tramp handler exists."
(save-match-data (when (and tramp-locked (not tramp-locker))
(let ((fn (assoc operation tramp-file-name-handler-alist))) (signal 'file-error "Forbidden reentrant call of Tramp"))
(if fn (let ((tl tramp-locked))
(apply (cdr fn) args) (unwind-protect
(tramp-run-real-handler operation args))))) (progn
(setq tramp-locked t)
(let ((tramp-locker t))
(save-match-data
(let ((fn (assoc operation tramp-file-name-handler-alist)))
(if fn
(apply (cdr fn) args)
(tramp-run-real-handler operation args))))))
(setq tramp-locked tl))))
;;;###autoload ;;;###autoload
(defun tramp-completion-file-name-handler (operation &rest args) (defun tramp-completion-file-name-handler (operation &rest args)
...@@ -4062,7 +4103,7 @@ necessary anymore." ...@@ -4062,7 +4103,7 @@ necessary anymore."
(tramp-make-tramp-file-name multi-method method (tramp-make-tramp-file-name multi-method method
user host x))) user host x)))
(read (current-buffer)))))) (read (current-buffer))))))
(list (tramp-handle-expand-file-name name)))))) (list (expand-file-name name))))))
;; Check for complete.el and override PC-expand-many-files if appropriate. ;; Check for complete.el and override PC-expand-many-files if appropriate.
(eval-and-compile (eval-and-compile
...@@ -4073,7 +4114,7 @@ necessary anymore." ...@@ -4073,7 +4114,7 @@ necessary anymore."
(symbol-function 'PC-expand-many-files)) (symbol-function 'PC-expand-many-files))
(defun PC-expand-many-files (name) (defun PC-expand-many-files (name)
(if (tramp-tramp-file-p name) (if (tramp-tramp-file-p name)
(tramp-handle-expand-many-files name) (expand-many-files name)
(tramp-save-PC-expand-many-files name)))) (tramp-save-PC-expand-many-files name))))
;; Why isn't eval-after-load sufficient? ;; Why isn't eval-after-load sufficient?
...@@ -4824,17 +4865,17 @@ file exists and nonzero exit status otherwise." ...@@ -4824,17 +4865,17 @@ file exists and nonzero exit status otherwise."
;; `/usr/bin/test -e' In case `/bin/test' does not exist. ;; `/usr/bin/test -e' In case `/bin/test' does not exist.
(unless (or (unless (or
(and (setq tramp-file-exists-command "test -e %s") (and (setq tramp-file-exists-command "test -e %s")
(tramp-handle-file-exists-p existing) (file-exists-p existing)
(not (tramp-handle-file-exists-p nonexisting))) (not (file-exists-p nonexisting)))
(and (setq tramp-file-exists-command "/bin/test -e %s") (and (setq tramp-file-exists-command "/bin/test -e %s")
(tramp-handle-file-exists-p existing) (file-exists-p existing)
(not (tramp-handle-file-exists-p nonexisting))) (not (file-exists-p nonexisting)))
(and (setq tramp-file-exists-command "/usr/bin/test -e %s") (and (setq tramp-file-exists-command "/usr/bin/test -e %s")
(tramp-handle-file-exists-p existing) (file-exists-p existing)
(not (tramp-handle-file-exists-p nonexisting))) (not (file-exists-p nonexisting)))
(and (setq tramp-file-exists-command "ls -d %s") (and (setq tramp-file-exists-command "ls -d %s")
(tramp-handle-file-exists-p existing) (file-exists-p existing)
(not (tramp-handle-file-exists-p nonexisting)))) (not (file-exists-p nonexisting))))
(error "Couldn't find command to check if file exists.")))) (error "Couldn't find command to check if file exists."))))
...@@ -4896,9 +4937,8 @@ file exists and nonzero exit status otherwise." ...@@ -4896,9 +4937,8 @@ file exists and nonzero exit status otherwise."
METHOD, USER and HOST specify the connection, CMD (the absolute file name of) METHOD, USER and HOST specify the connection, CMD (the absolute file name of)
the `ls' executable. Returns t if CMD supports the `-n' option, nil the `ls' executable. Returns t if CMD supports the `-n' option, nil
otherwise." otherwise."
(tramp-message 9 "Checking remote `%s' command for `-n' option" (tramp-message 9 "Checking remote `%s' command for `-n' option" cmd)
cmd) (when (file-executable-p
(when (tramp-handle-file-executable-p
(tramp-make-tramp-file-name multi-method method user host cmd)) (tramp-make-tramp-file-name multi-method method user host cmd))
(let ((result nil)) (let ((result nil))
(tramp-message 7 "Testing remote command `%s' for -n..." cmd) (tramp-message 7 "Testing remote command `%s' for -n..." cmd)
...@@ -4956,7 +4996,7 @@ Returns nil if none was found, else the command is returned." ...@@ -4956,7 +4996,7 @@ Returns nil if none was found, else the command is returned."
"Query the user for a password." "Query the user for a password."
(let ((pw-prompt (match-string 0))) (let ((pw-prompt (match-string 0)))
(tramp-message 9 "Sending password") (tramp-message 9 "Sending password")
(tramp-enter-password p pw-prompt))) (tramp-enter-password p pw-prompt user host)))
(defun tramp-action-succeed (p multi-method method user host) (defun tramp-action-succeed (p multi-method method user host)
"Signal success in finding shell prompt." "Signal success in finding shell prompt."
...@@ -5034,7 +5074,7 @@ The terminal type can be configured with `tramp-terminal-type'." ...@@ -5034,7 +5074,7 @@ The terminal type can be configured with `tramp-terminal-type'."
(defun tramp-multi-action-password (p method user host) (defun tramp-multi-action-password (p method user host)
"Query the user for a password." "Query the user for a password."
(tramp-message 9 "Sending password") (tramp-message 9 "Sending password")
(tramp-enter-password p (match-string 0))) (tramp-enter-password p (match-string 0) user host))
(defun tramp-multi-action-succeed (p method user host) (defun tramp-multi-action-succeed (p method user host)
"Signal success in finding shell prompt." "Signal success in finding shell prompt."
...@@ -5049,6 +5089,11 @@ The terminal type can be configured with `tramp-terminal-type'." ...@@ -5049,6 +5089,11 @@ The terminal type can be configured with `tramp-terminal-type'."
(erase-buffer) (erase-buffer)
(throw 'tramp-action 'permission-denied)) (throw 'tramp-action 'permission-denied))
(defun tramp-multi-action-process-alive (p method user host)
"Check whether a process has finished."
(unless (memq (process-status p) '(run open))
(throw 'tramp-action 'process-died)))
;; Functions for processing the actions. ;; Functions for processing the actions.
(defun tramp-process-one-action (p multi-method method user host actions) (defun tramp-process-one-action (p multi-method method user host actions)
...@@ -5246,12 +5291,13 @@ arguments, and xx will be used as the host name to connect to. ...@@ -5246,12 +5291,13 @@ arguments, and xx will be used as the host name to connect to.
(login-args (tramp-get-method-parameter (login-args (tramp-get-method-parameter
multi-method multi-method
(tramp-find-method multi-method method user host) (tramp-find-method multi-method method user host)
user host 'tramp-login-args))) user host 'tramp-login-args))
(real-host host))
;; The following should be changed. We need a more general ;; The following should be changed. We need a more general
;; mechanism to parse extra host args. ;; mechanism to parse extra host args.
(when (string-match "\\([^#]*\\)#\\(.*\\)" host) (when (string-match "\\([^#]*\\)#\\(.*\\)" host)
(setq login-args (cons "-p" (cons (match-string 2 host) login-args))) (setq login-args (cons "-p" (cons (match-string 2 host) login-args)))
(setq host (match-string 1 host))) (setq real-host (match-string 1 host)))
(setenv "TERM" tramp-terminal-type) (setenv "TERM" tramp-terminal-type)
(let* ((default-directory (tramp-temporary-file-directory)) (let* ((default-directory (tramp-temporary-file-directory))
;; If we omit the conditional, we would use ;; If we omit the conditional, we would use
...@@ -5262,9 +5308,9 @@ arguments, and xx will be used as the host name to connect to. ...@@ -5262,9 +5308,9 @@ arguments, and xx will be used as the host name to connect to.
tramp-dos-coding-system)) tramp-dos-coding-system))
(p (if (and user (not (string= user ""))) (p (if (and user (not (string= user "")))
(apply #'start-process bufnam buf login-program (apply #'start-process bufnam buf login-program
host "-l" user login-args) real-host "-l" user login-args)
(apply #'start-process bufnam buf login-program (apply #'start-process bufnam buf login-program
host login-args))) real-host login-args)))
(found nil)) (found nil))
(tramp-set-process-query-on-exit-flag p nil) (tramp-set-process-query-on-exit-flag p nil)
...@@ -5547,10 +5593,10 @@ seconds. If not, it produces an error message with the given ERROR-ARGS." ...@@ -5547,10 +5593,10 @@ seconds. If not, it produces an error message with the given ERROR-ARGS."
(pop-to-buffer (buffer-name)) (pop-to-buffer (buffer-name))
(apply 'error error-args))) (apply 'error error-args)))
(defun tramp-enter-password (p prompt) (defun tramp-enter-password (p prompt user host)
"Prompt for a password and send it to the remote end. "Prompt for a password and send it to the remote end.
Uses PROMPT as a prompt and sends the password to process P." Uses PROMPT as a prompt and sends the password to process P."
(let ((pw (tramp-read-passwd prompt))) (let ((pw (tramp-read-passwd user host prompt)))
(erase-buffer) (erase-buffer)
(process-send-string (process-send-string
p (concat pw p (concat pw
...@@ -6717,16 +6763,11 @@ this is the function `temp-directory'." ...@@ -6717,16 +6763,11 @@ this is the function `temp-directory'."
"`temp-directory' is defined -- using /tmp.")) "`temp-directory' is defined -- using /tmp."))
(file-name-as-directory "/tmp")))) (file-name-as-directory "/tmp"))))
(defun tramp-read-passwd (prompt) (defun tramp-read-passwd (user host prompt)
"Read a password from user (compat function). "Read a password from user (compat function).
Invokes `password-read' if available, `read-passwd' else." Invokes `password-read' if available, `read-passwd' else."
(if (functionp 'password-read) (if (functionp 'password-read)
(let* ((user (or tramp-current-user (user-login-name)))