From: Michael Albinus Date: Fri, 2 Dec 2011 19:23:19 +0000 (+0100) Subject: * net/tramp-sh.el (tramp-maybe-open-connection): Handle user X-Git-Tag: emacs-pretest-24.0.93~232^2~30 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=6bdac7360d522bc7a11b0ab867e3517ddacfaa35;p=emacs.git * net/tramp-sh.el (tramp-maybe-open-connection): Handle user interrupt. (Bug#10187) --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index ef99c31d1e8..4ab35890cae 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2011-12-02 Michael Albinus + + * net/tramp-sh.el (tramp-maybe-open-connection): Handle user + interrupt. (Bug#10187) + 2011-12-02 Stefan Monnier * pcmpl-gnu.el (pcomplete/tar): large-file-warn-threshold can be nil diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 941b788ae4d..ee4c8966626 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1042,9 +1042,9 @@ target of the symlink differ." (tramp-flush-file-property l (file-name-directory l-localname)) (tramp-flush-file-property l l-localname) - ;; Right, they are on the same host, regardless of user, method, etc. - ;; We now make the link on the remote machine. This will occur as the user - ;; that FILENAME belongs to. + ;; Right, they are on the same host, regardless of user, method, + ;; etc. We now make the link on the remote machine. This will + ;; occur as the user that FILENAME belongs to. (tramp-send-command-and-check l (format @@ -4224,148 +4224,166 @@ connection if a previous connection has died for some reason." (setq p nil))) ;; New connection must be opened. - (unless (and p (processp p) (memq (process-status p) '(run open))) - - ;; We call `tramp-get-buffer' in order to get a debug buffer for - ;; messages from the beginning. - (tramp-get-buffer vec) - (tramp-with-progress-reporter - vec 3 - (if (zerop (length (tramp-file-name-user vec))) - (format "Opening connection for %s using %s" - (tramp-file-name-host vec) - (tramp-file-name-method vec)) - (format "Opening connection for %s@%s using %s" - (tramp-file-name-user vec) - (tramp-file-name-host vec) - (tramp-file-name-method vec))) - - ;; Start new process. - (when (and p (processp p)) - (delete-process p)) - (setenv "TERM" tramp-terminal-type) - (setenv "LC_ALL" "C") - (setenv "PROMPT_COMMAND") - (setenv "PS1" tramp-initial-end-of-output) - (let* ((target-alist (tramp-compute-multi-hops vec)) - (process-connection-type tramp-process-connection-type) - (process-adaptive-read-buffering nil) - (coding-system-for-read nil) - ;; 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) - (if tramp-encoding-command-interactive - (list tramp-encoding-shell - tramp-encoding-command-interactive) - (list tramp-encoding-shell)))))) - - ;; Set sentinel and query flag. - (tramp-set-connection-property p "vector" vec) - (set-process-sentinel p 'tramp-process-sentinel) - (tramp-compat-set-process-query-on-exit-flag p nil) + (condition-case err + (unless (and p (processp p) (memq (process-status p) '(run open))) + + ;; We call `tramp-get-buffer' in order to get a debug + ;; buffer for messages from the beginning. + (tramp-get-buffer vec) + (tramp-with-progress-reporter + vec 3 + (if (zerop (length (tramp-file-name-user vec))) + (format "Opening connection for %s using %s" + (tramp-file-name-host vec) + (tramp-file-name-method vec)) + (format "Opening connection for %s@%s using %s" + (tramp-file-name-user vec) + (tramp-file-name-host vec) + (tramp-file-name-method vec))) + + ;; Start new process. + (when (and p (processp p)) + (delete-process p)) + (setenv "TERM" tramp-terminal-type) + (setenv "LC_ALL" "C") + (setenv "PROMPT_COMMAND") + (setenv "PS1" tramp-initial-end-of-output) + (let* ((target-alist (tramp-compute-multi-hops vec)) + (process-connection-type tramp-process-connection-type) + (process-adaptive-read-buffering nil) + (coding-system-for-read nil) + ;; 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) + (if tramp-encoding-command-interactive + (list tramp-encoding-shell + tramp-encoding-command-interactive) + (list tramp-encoding-shell)))))) + + ;; Set sentinel and query flag. + (tramp-set-connection-property p "vector" vec) + (set-process-sentinel p 'tramp-process-sentinel) + (tramp-compat-set-process-query-on-exit-flag p nil) - (tramp-message - vec 6 "%s" (mapconcat 'identity (process-command p) " ")) - - ;; Check whether process is alive. - (tramp-barf-if-no-shell-prompt - p 60 "Couldn't find local shell prompt %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-host (tramp-file-name-host hop)) - (l-port nil) - (login-program - (tramp-get-method-parameter - l-method 'tramp-login-program)) - (login-args - (tramp-get-method-parameter l-method 'tramp-login-args)) - (async-args - (tramp-get-method-parameter l-method 'tramp-async-args)) - (gw-args - (tramp-get-method-parameter l-method 'tramp-gw-args)) - (gw (tramp-get-file-property hop "" "gateway" nil)) - (g-method (and gw (tramp-file-name-method gw))) - (g-user (and gw (tramp-file-name-user gw))) - (g-host (and gw (tramp-file-name-real-host gw))) - (command 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. - (tmpfile - (tramp-set-connection-property - p "temp-file" - (make-temp-name - (expand-file-name - tramp-temp-name-prefix - (tramp-compat-temporary-file-directory))))) - spec) - - ;; Add arguments for asynchronous processes. - (when (and process-name async-args) - (setq login-args (append async-args login-args))) - - ;; Add gateway arguments if necessary. - (when (and gw gw-args) - (setq login-args (append gw-args login-args))) - - ;; Check for port number. Until now, there's no need - ;; for handling like method, user, host. - (when (string-match tramp-host-with-port-regexp l-host) - (setq l-port (match-string 2 l-host) - l-host (match-string 1 l-host))) - - ;; Set variables for computing the prompt for reading - ;; password. They can also be derived from a gateway. - (setq tramp-current-method (or g-method l-method) - tramp-current-user (or g-user l-user) - tramp-current-host (or g-host l-host)) - - ;; Replace login-args place holders. - (setq - l-host (or l-host "") - l-user (or l-user "") - l-port (or l-port "") - spec (format-spec-make - ?h l-host ?u l-user ?p l-port ?t tmpfile) - command - (concat - ;; We do not want to see the trailing local prompt in - ;; `start-file-process'. - (unless (memq system-type '(windows-nt)) "exec ") - command " " - (mapconcat - (lambda (x) - (setq x (mapcar (lambda (y) (format-spec y spec)) x)) - (unless (member "" x) (mapconcat 'identity x " "))) - login-args " ") - ;; Local shell could be a Windows COMSPEC. It - ;; doesn't know the ";" syntax, but we must exit - ;; always for `start-file-process'. "exec" does not - ;; work either. - (if (memq system-type '(windows-nt)) " && exit || exit"))) - - ;; Send the command. - (tramp-message vec 3 "Sending command `%s'" command) - (tramp-send-command vec command t t) - (tramp-process-actions p vec pos tramp-actions-before-shell 60) (tramp-message - vec 3 "Found remote shell prompt on `%s'" l-host)) - ;; Next hop. - (setq target-alist (cdr target-alist))) - - ;; Make initial shell settings. - (tramp-open-connection-setup-interactive-shell p vec))))))) + vec 6 "%s" (mapconcat 'identity (process-command p) " ")) + + ;; Check whether process is alive. + (tramp-barf-if-no-shell-prompt + p 60 + "Couldn't find local shell prompt %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-host (tramp-file-name-host hop)) + (l-port nil) + (login-program + (tramp-get-method-parameter + l-method 'tramp-login-program)) + (login-args + (tramp-get-method-parameter + l-method 'tramp-login-args)) + (async-args + (tramp-get-method-parameter + l-method 'tramp-async-args)) + (gw-args + (tramp-get-method-parameter l-method 'tramp-gw-args)) + (gw (tramp-get-file-property hop "" "gateway" nil)) + (g-method (and gw (tramp-file-name-method gw))) + (g-user (and gw (tramp-file-name-user gw))) + (g-host (and gw (tramp-file-name-real-host gw))) + (command 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. + (tmpfile + (tramp-set-connection-property + p "temp-file" + (make-temp-name + (expand-file-name + tramp-temp-name-prefix + (tramp-compat-temporary-file-directory))))) + spec) + + ;; Add arguments for asynchronous processes. + (when (and process-name async-args) + (setq login-args (append async-args login-args))) + + ;; Add gateway arguments if necessary. + (when (and gw gw-args) + (setq login-args (append gw-args login-args))) + + ;; Check for port number. Until now, there's no + ;; need for handling like method, user, host. + (when (string-match tramp-host-with-port-regexp l-host) + (setq l-port (match-string 2 l-host) + l-host (match-string 1 l-host))) + + ;; Set variables for computing the prompt for + ;; reading password. They can also be derived + ;; from a gateway. + (setq tramp-current-method (or g-method l-method) + tramp-current-user (or g-user l-user) + tramp-current-host (or g-host l-host)) + + ;; Replace login-args place holders. + (setq + l-host (or l-host "") + l-user (or l-user "") + l-port (or l-port "") + spec (format-spec-make + ?h l-host ?u l-user ?p l-port ?t tmpfile) + command + (concat + ;; We do not want to see the trailing local + ;; prompt in `start-file-process'. + (unless (memq system-type '(windows-nt)) "exec ") + command " " + (mapconcat + (lambda (x) + (setq x (mapcar (lambda (y) (format-spec y spec)) x)) + (unless (member "" x) (mapconcat 'identity x " "))) + login-args " ") + ;; Local shell could be a Windows COMSPEC. It + ;; doesn't know the ";" syntax, but we must exit + ;; always for `start-file-process'. "exec" does + ;; not work either. + (if (memq system-type '(windows-nt)) " && exit || exit"))) + + ;; Send the command. + (tramp-message vec 3 "Sending command `%s'" command) + (tramp-send-command vec command t t) + (tramp-process-actions + p vec pos tramp-actions-before-shell 60) + (tramp-message + vec 3 "Found remote shell prompt on `%s'" l-host)) + ;; Next hop. + (setq target-alist (cdr target-alist))) + + ;; Make initial shell settings. + (tramp-open-connection-setup-interactive-shell p vec)))) + + ;; When the user did interrupt, we must cleanup. + (quit + (let ((p (tramp-get-connection-process vec))) + (when (and p (processp p)) + (tramp-flush-connection-property vec) + (tramp-flush-connection-property p) + (delete-process p))) + ;; Propagate the quit signal. + (signal (car err) (cdr err))))))) (defun tramp-send-command (vec command &optional neveropen nooutput) "Send the COMMAND to connection VEC.