From: Michael Albinus Date: Mon, 5 Nov 2018 13:40:25 +0000 (+0100) Subject: Merge remote-tracking branch 'origin/master' into feature/tramp-thread-safe X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=14880247131504e7e0894c79cd71a2744ace70d8;p=emacs.git Merge remote-tracking branch 'origin/master' into feature/tramp-thread-safe --- 14880247131504e7e0894c79cd71a2744ace70d8 diff --cc lisp/net/tramp.el index 755ca21b369,13c3b5f939c..4c23392639f --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@@ -1552,13 -1578,13 +1588,12 @@@ The outline level is equal to the verbo ;; Activate `outline-mode'. This runs `text-mode-hook' and ;; `outline-mode-hook'. We must prevent that local processes ;; die. Yes: I've seen `flyspell-mode', which starts "ispell". - ;; Furthermore, `outline-regexp' must have the correct value - ;; already, because it is used by `font-lock-compile-keywords'. - (let ((default-directory (tramp-compat-temporary-file-directory)) - (outline-regexp tramp-debug-outline-regexp)) + (let ((default-directory (tramp-compat-temporary-file-directory))) (outline-mode)) - (set (make-local-variable 'outline-regexp) tramp-debug-outline-regexp) (set (make-local-variable 'outline-level) 'tramp-debug-outline-level) + (set (make-local-variable 'font-lock-keywords) - `(t - (eval ,tramp-debug-font-lock-keywords) - ,(eval tramp-debug-font-lock-keywords))) ++ `(t (eval ,tramp-debug-font-lock-keywords) ++ ,(eval tramp-debug-font-lock-keywords))) ;; Do not edit the debug buffer. (set-keymap-parent (current-local-map) special-mode-map)) (current-buffer))) @@@ -2275,113 -2285,100 +2312,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)) - file-name-handler-alist) ++ 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 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.