From: Michael Albinus Date: Fri, 12 Oct 2018 13:09:03 +0000 (+0200) Subject: Merge remote-tracking branch 'origin/master' into feature/tramp-thread-safe X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=25f77f90855dd1add341ef58e044d375b7d8dfab;p=emacs.git Merge remote-tracking branch 'origin/master' into feature/tramp-thread-safe --- 25f77f90855dd1add341ef58e044d375b7d8dfab diff --cc lisp/net/tramp.el index 962549a7f12,e629ce17315..755ca21b369 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@@ -2269,112 -2247,100 +2275,113 @@@ If Emacs is compiled --with-threads, th (save-match-data (setq filename (tramp-replace-environment-variables filename)) (with-parsed-tramp-file-name filename nil - (let ((completion (tramp-completion-mode-p)) - (foreign - (tramp-find-foreign-file-name-handler filename operation)) - result) - ;; Call the backend function. - (if foreign - (tramp-condition-case-unless-debug err - (let ((sf (symbol-function foreign))) - ;; Some packages set the default directory to a - ;; remote path, before respective Tramp packages - ;; are already loaded. This results in - ;; recursive loading. Therefore, we load the - ;; Tramp packages locally. - (when (autoloadp sf) - (let ((default-directory - (tramp-compat-temporary-file-directory)) - file-name-handler-alist) - (load (cadr sf) 'noerror 'nomessage))) -;; (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 - (when (and tramp-locked (not tramp-locker)) - (setq tramp-locked nil) - (tramp-error - (car-safe tramp-current-connection) - 'file-error - "Forbidden reentrant call of Tramp")) - (let ((tl tramp-locked)) - (setq tramp-locked t) - (unwind-protect - (let ((tramp-locker t)) - (apply foreign operation args)) - (setq tramp-locked tl)))))) -;; (tramp-message -;; v 4 "Running `%s'...`%s'" (cons operation args) result) - (cond - ((eq result 'non-essential) - (tramp-message - v 5 "Non-essential received in operation %s" - (cons operation args)) - (tramp-run-real-handler operation args)) - ((eq result 'suppress) - (let (tramp-message-show-message) + ;; Give other threads a chance. + (tramp-compat-thread-yield) + ;; The mutex allows concurrent run of operations. It + ;; guarantees, that the threads are not mixed. + (tramp-compat-with-mutex (tramp-get-mutex v) + (let ((completion (tramp-completion-mode-p)) + (foreign + (tramp-find-foreign-file-name-handler filename operation)) + result) + ;; Call the backend function. + (if foreign + (tramp-condition-case-unless-debug err + (let ((sf (symbol-function foreign)) + p) + ;; Some packages set the default directory to + ;; a remote path, before respective Tramp + ;; packages are already loaded. This results + ;; in recursive loading. Therefore, we load + ;; the Tramp packages locally. + (when (autoloadp sf) + (let ((default-directory - (tramp-compat-temporary-file-directory))) ++ (tramp-compat-temporary-file-directory)) ++ file-name-handler-alist) + (load (cadr sf) 'noerror 'nomessage))) + ;; (tramp-message + ;; v 4 "Running `%s'..." (cons operation args)) + ;; Switch process thread. + (when (and tramp-mutex + (setq p (tramp-get-connection-process v))) + (tramp-compat-funcall + 'set-process-thread p (tramp-compat-current-thread))) + ;; 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 + (when (and tramp-locked (not tramp-locker)) + (setq tramp-locked nil) + (tramp-error + (car-safe tramp-current-connection) + 'file-error + "Forbidden reentrant call of Tramp")) + (let ((tl tramp-locked)) + (setq tramp-locked t) + (unwind-protect + (let ((tramp-locker t)) + (apply foreign operation args)) + (setq tramp-locked tl)))))) + ;; (tramp-message + ;; v 4 "Running `%s'...`%s'" (cons operation args) result) + (cond + ((eq result 'non-essential) (tramp-message - v 1 "Suppress received in operation %s" + v 5 "Non-essential received in operation %s" (cons operation args)) - (tramp-cleanup-connection v t) - (tramp-run-real-handler operation args))) - (t result))) - - ;; Trace that somebody has interrupted the operation. - ((debug quit) - (let (tramp-message-show-message) - (tramp-message - v 1 "Interrupt received in operation %s" - (cons operation args))) - ;; Propagate the quit signal. - (signal (car err) (cdr err))) - - ;; When we are in completion mode, some failed - ;; operations shall return at least a default - ;; value in order to give the user a chance to - ;; correct the file name in the minibuffer. - ;; In order to get a full backtrace, one could apply - ;; (setq tramp-debug-on-error t) - (error - (cond - ((and completion (zerop (length localname)) - (memq operation '(file-exists-p file-directory-p))) - t) - ((and completion (zerop (length localname)) - (memq operation - '(expand-file-name file-name-as-directory))) - filename) - ;; Propagate the error. - (t (signal (car err) (cdr err)))))) - - ;; Nothing to do for us. However, since we are in - ;; `tramp-mode', we must suppress the volume letter on - ;; MS Windows. - (setq result (tramp-run-real-handler operation args)) - (if (stringp result) - (tramp-drop-volume-letter result) - result))))) + (tramp-run-real-handler operation args)) + ((eq result 'suppress) + (let (tramp-message-show-message) + (tramp-message + v 1 "Suppress received in operation %s" + (cons operation args)) + (tramp-cleanup-connection v t) + (tramp-run-real-handler operation args))) + (t result))) + + ;; Trace that somebody has interrupted the operation. + ((debug quit) + (let (tramp-message-show-message) + (tramp-message + v 1 "Interrupt received in operation %s" + (cons operation args))) + ;; Propagate the signal. + (signal (car err) (cdr err))) + + ;; When we are in completion mode, some failed + ;; operations shall return at least a default + ;; value in order to give the user a chance to + ;; correct the file name in the minibuffer. In + ;; order to get a full backtrace, one could + ;; apply (setq tramp-debug-on-error t) + (error + (cond + ((and completion (zerop (length localname)) + (memq operation + '(file-exists-p file-directory-p))) + t) + ((and completion (zerop (length localname)) + (memq operation + '(expand-file-name file-name-as-directory))) + filename) + ;; Propagate the error. + (t (signal (car err) (cdr err)))))) + + ;; Nothing to do for us. However, since we are in + ;; `tramp-mode', we must suppress the volume letter + ;; on MS Windows. + (setq result (tramp-run-real-handler operation args)) + (if (stringp result) + (tramp-drop-volume-letter result) + result)))))) ;; When `tramp-mode' is not enabled, or the file name is quoted, ;; we don't do anything.