Mercurial > emacs
changeset 56460:9459300bf43b
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.
| author | Kai Großjohann <kgrossjo@eu.uu.net> |
|---|---|
| date | Sat, 17 Jul 2004 17:28:43 +0000 |
| parents | 718cf6b0289c |
| children | 04a216bfa931 |
| files | lisp/ChangeLog lisp/net/tramp-smb.el lisp/net/tramp-vc.el lisp/net/tramp.el man/trampver.texi |
| diffstat | 5 files changed, 173 insertions(+), 93 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Sat Jul 17 17:06:26 2004 +0000 +++ b/lisp/ChangeLog Sat Jul 17 17:28:43 2004 +0000 @@ -1,3 +1,42 @@ +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> * emacs-lisp/testcover.el: New category "potentially-1valued" for
--- a/lisp/net/tramp-smb.el Sat Jul 17 17:06:26 2004 +0000 +++ b/lisp/net/tramp-smb.el Sat Jul 17 17:28:43 2004 +0000 @@ -1012,7 +1012,7 @@ (when real-user (let ((pw-prompt "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) (tramp-clear-passwd user host)
--- a/lisp/net/tramp-vc.el Sat Jul 17 17:06:26 2004 +0000 +++ b/lisp/net/tramp-vc.el Sat Jul 17 17:28:43 2004 +0000 @@ -77,7 +77,7 @@ "Like `vc-do-command' but invoked for tramp files. See `vc-do-command' for more information." (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 vc-command-messages (message "Running `%s' on `%s'..." command file)) @@ -85,7 +85,7 @@ (squeezed nil) (olddir default-directory) 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)) (method (tramp-file-name-method v)) (user (tramp-file-name-user v)) @@ -130,7 +130,7 @@ (save-excursion (save-window-excursion ;; Actually execute remote command - (tramp-handle-shell-command + (shell-command (mapconcat 'tramp-shell-quote-argument (cons command squeezed) " ") t) ;;(tramp-wait-for-output) @@ -190,7 +190,7 @@ (let ((w32-quote-process-args t)) (when (eq okstatus 'async) (message "Tramp doesn't do async commands, running synchronously.")) - (setq status (tramp-handle-shell-command + (setq status (shell-command (mapconcat 'tramp-shell-quote-argument (cons command squeezed) " ") t)) (when (or (not (integerp status)) @@ -257,7 +257,7 @@ ;; Don't switch to the *vc-info* buffer before running the ;; command, because that would change its default directory (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)) (method (tramp-file-name-method v)) (user (tramp-file-name-user v)) @@ -284,7 +284,7 @@ (save-excursion (save-window-excursion ;; Actually execute remote command - (tramp-handle-shell-command + (shell-command (mapconcat 'tramp-shell-quote-argument (append (list command) args (list localname)) " ") (get-buffer-create"*vc-info*")) @@ -414,7 +414,7 @@ (nth 2 (file-attributes file))))) (if (and uid (/= uid remote-uid)) (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))) (cond ((stringp u) u) ((vectorp u) (elt u (1- (length u)))) @@ -445,8 +445,8 @@ (defun tramp-file-owner (filename) "Return who owns FILE (user name, as a string)." (let ((v (tramp-dissect-file-name - (tramp-handle-expand-file-name filename)))) - (if (not (tramp-handle-file-exists-p filename)) + (expand-file-name filename)))) + (if (not (file-exists-p filename)) nil ; file cannot be opened ;; file exists, find out stuff (save-excursion
--- a/lisp/net/tramp.el Sat Jul 17 17:06:26 2004 +0000 +++ b/lisp/net/tramp.el Sat Jul 17 17:28:43 2004 +0000 @@ -916,8 +916,8 @@ "Regular expression indicating a process has finished. In fact this expression is empty by intention, it will be used only to check regularly the status of the associated process. -The answer will be provided by `tramp-action-process-alive' and -`tramp-action-out-of-band', which see." +The answer will be provided by `tramp-action-process-alive', +`tramp-multi-action-process-alive' and`tramp-action-out-of-band', which see." :group 'tramp :type 'regexp) @@ -1321,7 +1321,7 @@ (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-process-alive-regexp tramp-action-process-alive)) + (tramp-process-alive-regexp tramp-multi-action-process-alive)) "List of pattern/action pairs. This list is used for each hop in multi-hop connections. See `tramp-actions-before-shell' for more info." @@ -2165,7 +2165,7 @@ (let ((nonnumeric (and id-format (equal id-format 'string))) result) (with-parsed-tramp-file-name filename nil - (when (tramp-handle-file-exists-p filename) + (when (file-exists-p filename) ;; file exists, find out stuff (save-excursion (if (tramp-get-remote-perl multi-method method user host) @@ -2509,19 +2509,19 @@ (defun tramp-handle-file-writable-p (filename) "Like `file-writable-p' for tramp files." (with-parsed-tramp-file-name filename nil - (if (tramp-handle-file-exists-p filename) + (if (file-exists-p filename) ;; Existing files must be writable. (zerop (tramp-run-test "-w" filename)) ;; If file doesn't exist, check if directory is writable. (and (zerop (tramp-run-test - "-d" (tramp-handle-file-name-directory filename))) + "-d" (file-name-directory filename))) (zerop (tramp-run-test - "-w" (tramp-handle-file-name-directory filename))))))) + "-w" (file-name-directory filename))))))) (defun tramp-handle-file-ownership-preserved-p (filename) "Like `file-ownership-preserved-p' for tramp files." (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. (zerop (tramp-run-test "-O" filename))))) @@ -3064,7 +3064,7 @@ (with-parsed-tramp-file-name filename nil ;; run a shell command 'rm -r <localname>' ;; Code shamelessly stolen for the dired implementation and, um, hacked :) - (or (tramp-handle-file-exists-p filename) + (or (file-exists-p filename) (signal 'file-error (list "Removing old file name" "no such directory" filename))) @@ -3075,7 +3075,7 @@ ;; This might take a while, allow it plenty of time. (tramp-wait-for-output 120) ;; Make sure that it worked... - (and (tramp-handle-file-exists-p filename) + (and (file-exists-p filename) (error "Failed to recusively delete %s" filename)))) (defun tramp-handle-dired-call-process (program discard &rest arguments) @@ -3607,45 +3607,47 @@ (defun tramp-handle-find-backup-file-name (filename) "Like `find-backup-file-name' for tramp files." - - (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)))))) + (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))))) + ;; CCC grok APPEND, LOCKNAME, CONFIRM (defun tramp-handle-write-region @@ -3689,6 +3691,9 @@ ;; use an encoding function, but currently we use it always ;; because this makes the logic simpler. (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 ;; modtime data to be clobbered from the temp file. We call ;; `set-visited-file-modtime' ourselves later on. @@ -3972,14 +3977,50 @@ (foreign (apply foreign 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) "Invoke remote-shell Tramp file name handler. Fall back to normal file name handler if no Tramp handler exists." - (save-match-data - (let ((fn (assoc operation tramp-file-name-handler-alist))) - (if fn - (apply (cdr fn) args) - (tramp-run-real-handler operation args))))) + (when (and tramp-locked (not tramp-locker)) + (signal 'file-error "Forbidden reentrant call of Tramp")) + (let ((tl tramp-locked)) + (unwind-protect + (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 (defun tramp-completion-file-name-handler (operation &rest args) @@ -4062,7 +4103,7 @@ (tramp-make-tramp-file-name multi-method method user host x))) (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. (eval-and-compile @@ -4073,7 +4114,7 @@ (symbol-function 'PC-expand-many-files)) (defun PC-expand-many-files (name) (if (tramp-tramp-file-p name) - (tramp-handle-expand-many-files name) + (expand-many-files name) (tramp-save-PC-expand-many-files name)))) ;; Why isn't eval-after-load sufficient? @@ -4824,17 +4865,17 @@ ;; `/usr/bin/test -e' In case `/bin/test' does not exist. (unless (or (and (setq tramp-file-exists-command "test -e %s") - (tramp-handle-file-exists-p existing) - (not (tramp-handle-file-exists-p nonexisting))) + (file-exists-p existing) + (not (file-exists-p nonexisting))) (and (setq tramp-file-exists-command "/bin/test -e %s") - (tramp-handle-file-exists-p existing) - (not (tramp-handle-file-exists-p nonexisting))) + (file-exists-p existing) + (not (file-exists-p nonexisting))) (and (setq tramp-file-exists-command "/usr/bin/test -e %s") - (tramp-handle-file-exists-p existing) - (not (tramp-handle-file-exists-p nonexisting))) + (file-exists-p existing) + (not (file-exists-p nonexisting))) (and (setq tramp-file-exists-command "ls -d %s") - (tramp-handle-file-exists-p existing) - (not (tramp-handle-file-exists-p nonexisting)))) + (file-exists-p existing) + (not (file-exists-p nonexisting)))) (error "Couldn't find command to check if file exists.")))) @@ -4896,9 +4937,8 @@ 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 otherwise." - (tramp-message 9 "Checking remote `%s' command for `-n' option" - cmd) - (when (tramp-handle-file-executable-p + (tramp-message 9 "Checking remote `%s' command for `-n' option" cmd) + (when (file-executable-p (tramp-make-tramp-file-name multi-method method user host cmd)) (let ((result nil)) (tramp-message 7 "Testing remote command `%s' for -n..." cmd) @@ -4956,7 +4996,7 @@ "Query the user for a password." (let ((pw-prompt (match-string 0))) (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) "Signal success in finding shell prompt." @@ -5034,7 +5074,7 @@ (defun tramp-multi-action-password (p method user host) "Query the user for a 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) "Signal success in finding shell prompt." @@ -5049,6 +5089,11 @@ (erase-buffer) (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. (defun tramp-process-one-action (p multi-method method user host actions) @@ -5246,12 +5291,13 @@ (login-args (tramp-get-method-parameter multi-method (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 ;; mechanism to parse extra host args. (when (string-match "\\([^#]*\\)#\\(.*\\)" host) (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) (let* ((default-directory (tramp-temporary-file-directory)) ;; If we omit the conditional, we would use @@ -5262,9 +5308,9 @@ tramp-dos-coding-system)) (p (if (and user (not (string= user ""))) (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 - host login-args))) + real-host login-args))) (found nil)) (tramp-set-process-query-on-exit-flag p nil) @@ -5547,10 +5593,10 @@ (pop-to-buffer (buffer-name)) (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. 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) (process-send-string p (concat pw @@ -6717,16 +6763,11 @@ "`temp-directory' is defined -- using /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). Invokes `password-read' if available, `read-passwd' else." (if (functionp 'password-read) - (let* ((user (or tramp-current-user (user-login-name))) - (host (or tramp-current-host (system-name))) - (key (if (and (stringp user) (stringp host)) - (concat user "@" host) - (concat "[" (mapconcat 'identity user "/") "]@[" - (mapconcat 'identity host "/") "]"))) + (let* ((key (concat (or user (user-login-name)) "@" host)) (password (apply #'password-read (list prompt key)))) (apply #'password-cache-add (list key password)) password)
--- a/man/trampver.texi Sat Jul 17 17:06:26 2004 +0000 +++ b/man/trampver.texi Sat Jul 17 17:28:43 2004 +0000 @@ -4,7 +4,7 @@ @c In the Tramp CVS, the version number is auto-frobbed from @c configure.ac, so you should edit that file and run @c "autoconf && ./configure" to change the version number. -@set trampver 2.0.42 +@set trampver 2.0.43 @c Other flags from configuration @set prefix /usr/local