[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/net/tramp.el [emacs-unicode-2]
|
From: |
Miles Bader |
|
Subject: |
[Emacs-diffs] Changes to emacs/lisp/net/tramp.el [emacs-unicode-2] |
|
Date: |
Fri, 23 Jul 2004 00:56:43 -0400 |
Index: emacs/lisp/net/tramp.el
diff -c emacs/lisp/net/tramp.el:1.39.2.4 emacs/lisp/net/tramp.el:1.39.2.5
*** emacs/lisp/net/tramp.el:1.39.2.4 Sat Jul 17 02:46:47 2004
--- emacs/lisp/net/tramp.el Fri Jul 23 04:30:38 2004
***************
*** 916,923 ****
"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."
:group 'tramp
:type 'regexp)
--- 916,923 ----
"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',
! `tramp-multi-action-process-alive' and`tramp-action-out-of-band', which see."
:group 'tramp
:type 'regexp)
***************
*** 1321,1327 ****
(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))
"List of pattern/action pairs.
This list is used for each hop in multi-hop connections.
See `tramp-actions-before-shell' for more info."
--- 1321,1327 ----
(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-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,2171 ****
(let ((nonnumeric (and id-format (equal id-format 'string)))
result)
(with-parsed-tramp-file-name filename nil
! (when (tramp-handle-file-exists-p filename)
;; file exists, find out stuff
(save-excursion
(if (tramp-get-remote-perl multi-method method user host)
--- 2165,2171 ----
(let ((nonnumeric (and id-format (equal id-format 'string)))
result)
(with-parsed-tramp-file-name filename nil
! (when (file-exists-p filename)
;; file exists, find out stuff
(save-excursion
(if (tramp-get-remote-perl multi-method method user host)
***************
*** 2331,2337 ****
;; This function makes the same assumption as
;; `tramp-handle-set-visited-file-modtime'.
(defun tramp-handle-verify-visited-file-modtime (buf)
! "Like `verify-visited-file-modtime' for tramp files."
(with-current-buffer buf
(let ((f (buffer-file-name)))
(with-parsed-tramp-file-name f nil
--- 2331,2342 ----
;; This function makes the same assumption as
;; `tramp-handle-set-visited-file-modtime'.
(defun tramp-handle-verify-visited-file-modtime (buf)
! "Like `verify-visited-file-modtime' for tramp files.
! At the time `verify-visited-file-modtime' calls this function, we
! already know that the buffer is visiting a file and that
! `visited-file-modtime' does not return 0. Do not call this
! function directly, unless those two cases are already taken care
! of."
(with-current-buffer buf
(let ((f (buffer-file-name)))
(with-parsed-tramp-file-name f nil
***************
*** 2509,2527 ****
(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)
;; 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)))
(zerop (tramp-run-test
! "-w" (tramp-handle-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))
;; Existing files must be writable.
(zerop (tramp-run-test "-O" filename)))))
--- 2514,2532 ----
(defun tramp-handle-file-writable-p (filename)
"Like `file-writable-p' for tramp files."
(with-parsed-tramp-file-name filename nil
! (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" (file-name-directory filename)))
(zerop (tramp-run-test
! "-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 (file-exists-p filename))
;; Existing files must be writable.
(zerop (tramp-run-test "-O" filename)))))
***************
*** 3064,3070 ****
(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)
(signal
'file-error
(list "Removing old file name" "no such directory" filename)))
--- 3069,3075 ----
(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 (file-exists-p filename)
(signal
'file-error
(list "Removing old file name" "no such directory" filename)))
***************
*** 3075,3081 ****
;; 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)
(error "Failed to recusively delete %s" filename))))
(defun tramp-handle-dired-call-process (program discard &rest arguments)
--- 3080,3086 ----
;; This might take a while, allow it plenty of time.
(tramp-wait-for-output 120)
;; Make sure that it worked...
! (and (file-exists-p filename)
(error "Failed to recusively delete %s" filename))))
(defun tramp-handle-dired-call-process (program discard &rest arguments)
***************
*** 3607,3651 ****
(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))))))
;; CCC grok APPEND, LOCKNAME, CONFIRM
(defun tramp-handle-write-region
--- 3612,3658 ----
(defun tramp-handle-find-backup-file-name (filename)
"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)))))
;; CCC grok APPEND, LOCKNAME, CONFIRM
(defun tramp-handle-write-region
***************
*** 3689,3694 ****
--- 3696,3704 ----
;; 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,3985 ****
(foreign (apply foreign operation args))
(t (tramp-run-real-handler operation args))))))
(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)))))
;;;###autoload
(defun tramp-completion-file-name-handler (operation &rest args)
--- 3982,4031 ----
(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."
! (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,4068 ****
(tramp-make-tramp-file-name multi-method method
user host x)))
(read (current-buffer))))))
! (list (tramp-handle-expand-file-name name))))))
;; Check for complete.el and override PC-expand-many-files if appropriate.
(eval-and-compile
--- 4108,4114 ----
(tramp-make-tramp-file-name multi-method method
user host x)))
(read (current-buffer))))))
! (list (expand-file-name name))))))
;; Check for complete.el and override PC-expand-many-files if appropriate.
(eval-and-compile
***************
*** 4073,4079 ****
(symbol-function 'PC-expand-many-files))
(defun PC-expand-many-files (name)
(if (tramp-tramp-file-p name)
! (tramp-handle-expand-many-files name)
(tramp-save-PC-expand-many-files name))))
;; Why isn't eval-after-load sufficient?
--- 4119,4125 ----
(symbol-function 'PC-expand-many-files))
(defun PC-expand-many-files (name)
(if (tramp-tramp-file-p name)
! (expand-many-files name)
(tramp-save-PC-expand-many-files name))))
;; Why isn't eval-after-load sufficient?
***************
*** 4824,4840 ****
;; `/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)))
(and (setq tramp-file-exists-command "/bin/test -e %s")
! (tramp-handle-file-exists-p existing)
! (not (tramp-handle-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)))
(and (setq tramp-file-exists-command "ls -d %s")
! (tramp-handle-file-exists-p existing)
! (not (tramp-handle-file-exists-p nonexisting))))
(error "Couldn't find command to check if file exists."))))
--- 4870,4886 ----
;; `/usr/bin/test -e' In case `/bin/test' does not exist.
(unless (or
(and (setq tramp-file-exists-command "test -e %s")
! (file-exists-p existing)
! (not (file-exists-p nonexisting)))
(and (setq tramp-file-exists-command "/bin/test -e %s")
! (file-exists-p existing)
! (not (file-exists-p nonexisting)))
(and (setq tramp-file-exists-command "/usr/bin/test -e %s")
! (file-exists-p existing)
! (not (file-exists-p nonexisting)))
(and (setq tramp-file-exists-command "ls -d %s")
! (file-exists-p existing)
! (not (file-exists-p nonexisting))))
(error "Couldn't find command to check if file exists."))))
***************
*** 4896,4904 ****
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-make-tramp-file-name multi-method method user host cmd))
(let ((result nil))
(tramp-message 7 "Testing remote command `%s' for -n..." cmd)
--- 4942,4949 ----
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 (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,4962 ****
"Query the user for a password."
(let ((pw-prompt (match-string 0)))
(tramp-message 9 "Sending password")
! (tramp-enter-password p pw-prompt)))
(defun tramp-action-succeed (p multi-method method user host)
"Signal success in finding shell prompt."
--- 5001,5007 ----
"Query the user for a password."
(let ((pw-prompt (match-string 0)))
(tramp-message 9 "Sending password")
! (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,5040 ****
(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)))
(defun tramp-multi-action-succeed (p method user host)
"Signal success in finding shell prompt."
--- 5079,5085 ----
(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) user host))
(defun tramp-multi-action-succeed (p method user host)
"Signal success in finding shell prompt."
***************
*** 5049,5054 ****
--- 5094,5104 ----
(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,5257 ****
(login-args (tramp-get-method-parameter
multi-method
(tramp-find-method multi-method method user host)
! user host 'tramp-login-args)))
;; 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)))
(setenv "TERM" tramp-terminal-type)
(let* ((default-directory (tramp-temporary-file-directory))
;; If we omit the conditional, we would use
--- 5296,5308 ----
(login-args (tramp-get-method-parameter
multi-method
(tramp-find-method multi-method method user host)
! 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 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,5270 ****
tramp-dos-coding-system))
(p (if (and user (not (string= user "")))
(apply #'start-process bufnam buf login-program
! host "-l" user login-args)
(apply #'start-process bufnam buf login-program
! host login-args)))
(found nil))
(tramp-set-process-query-on-exit-flag p nil)
--- 5313,5321 ----
tramp-dos-coding-system))
(p (if (and user (not (string= user "")))
(apply #'start-process bufnam buf login-program
! real-host "-l" user login-args)
(apply #'start-process bufnam buf login-program
! real-host login-args)))
(found nil))
(tramp-set-process-query-on-exit-flag p nil)
***************
*** 5547,5556 ****
(pop-to-buffer (buffer-name))
(apply 'error error-args)))
! (defun tramp-enter-password (p prompt)
"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)))
(erase-buffer)
(process-send-string
p (concat pw
--- 5598,5607 ----
(pop-to-buffer (buffer-name))
(apply 'error error-args)))
! (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 user host prompt)))
(erase-buffer)
(process-send-string
p (concat pw
***************
*** 6717,6732 ****
"`temp-directory' is defined -- using /tmp."))
(file-name-as-directory "/tmp"))))
! (defun tramp-read-passwd (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 "/") "address@hidden"
! (mapconcat 'identity host "/") "]")))
(password (apply #'password-read (list prompt key))))
(apply #'password-cache-add (list key password))
password)
--- 6768,6778 ----
"`temp-directory' is defined -- using /tmp."))
(file-name-as-directory "/tmp"))))
! (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* ((key (concat (or user (user-login-name)) "@" host))
(password (apply #'password-read (list prompt key))))
(apply #'password-cache-add (list key password))
password)