From d3ec68f5e433e5792c1c63672c7b437bb29c5759 Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Thu, 4 May 2023 09:22:40 -0700 Subject: [PATCH 1/3] ; Fix post-commit and pre-push hooks in worktrees again * build-aux/git-hooks/post-commit: * build-aux/git-hooks/pre-push: Use "$(dirname $0)" to get the hooks directory. --- build-aux/git-hooks/post-commit | 4 +++- build-aux/git-hooks/pre-push | 4 +++- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/build-aux/git-hooks/post-commit b/build-aux/git-hooks/post-commit index 05f2d778b5c..10f43b539ac 100755 --- a/build-aux/git-hooks/post-commit +++ b/build-aux/git-hooks/post-commit @@ -34,6 +34,8 @@ ### Code: +HOOKS_DIR=$(dirname $0) + # Prefer gawk if available, as it handles NUL bytes properly. if type gawk >/dev/null 2>&1; then awk="gawk" @@ -42,4 +44,4 @@ else fi git rev-parse HEAD | $awk -v reason=post-commit \ - -f ${GIT_DIR:-.git}/hooks/commit-msg-files.awk + -f $HOOKS_DIR/commit-msg-files.awk diff --git a/build-aux/git-hooks/pre-push b/build-aux/git-hooks/pre-push index 6ff59102fd7..8d5dde2bbaf 100755 --- a/build-aux/git-hooks/pre-push +++ b/build-aux/git-hooks/pre-push @@ -31,6 +31,8 @@ ### Code: +HOOKS_DIR=$(dirname $0) + # Prefer gawk if available, as it handles NUL bytes properly. if type gawk >/dev/null 2>&1; then awk="gawk" @@ -83,4 +85,4 @@ $awk -v origin_name="$1" ' # Print every SHA after oldref, up to (and including) newref. system("git rev-list --first-parent --reverse " oldref ".." newref) } -' | $awk -v reason=pre-push -f ${GIT_DIR:-.git}/hooks/commit-msg-files.awk +' | $awk -v reason=pre-push -f $HOOKS_DIR/commit-msg-files.awk From 5f79d821a0651b74268cc1a27a8396a7e524a8c8 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Thu, 4 May 2023 20:42:24 +0200 Subject: [PATCH 2/3] Suspend timers when reading Tramp process output * lisp/net/tramp-compat.el (xdg): Require. (tramp-compat-temporary-file-directory): Set it to $XDG_CACHE_HOME/emacs if possible. * lisp/net/tramp.el (tramp-debug-to-file): Fix docstring. (tramp-wrong-passwd-regexp): Add "Authentication failed" string (from doas). (tramp-debug-message): Simplify backtrace check. (with-tramp-locked-connection): Suppress timers. (Bug#49954, Bug60534) * test/lisp/net/tramp-tests.el (tramp-test09-insert-file-contents): Adapt test. (tramp-test45-asynchronous-requests): Remove :unstable tag. Adapt test. --- lisp/net/tramp-cache.el | 12 +++++----- lisp/net/tramp-compat.el | 12 ++++++++-- lisp/net/tramp.el | 45 +++++++++++++++++++++--------------- test/lisp/net/tramp-tests.el | 39 +++++++++++++++---------------- 4 files changed, 61 insertions(+), 47 deletions(-) diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index c5864e7fa5e..e0d38853956 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -496,12 +496,12 @@ PROPERTIES is a list of file properties (strings)." (cons property (gethash property hash tramp-cache-undefined))) ,properties))) (unwind-protect (progn ,@body) - ;; Reset PROPERTIES. Recompute hash, it could have been flushed. - (setq hash (tramp-get-hash-table ,key)) - (dolist (value values) - (if (not (eq (cdr value) tramp-cache-undefined)) - (puthash (car value) (cdr value) hash) - (remhash (car value) hash))))))) + ;; Reset PROPERTIES. Recompute hash, it could have been flushed. + (setq hash (tramp-get-hash-table ,key)) + (dolist (value values) + (if (not (eq (cdr value) tramp-cache-undefined)) + (puthash (car value) (cdr value) hash) + (remhash (car value) hash))))))) ;;;###tramp-autoload (defun tramp-cache-print (table) diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 150c3fbf187..43544ae327e 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -35,6 +35,7 @@ (require 'parse-time) (require 'shell) (require 'subr-x) +(require 'xdg) (declare-function tramp-error "tramp") (declare-function tramp-tramp-file-p "tramp") @@ -64,9 +65,16 @@ (with-no-warnings (funcall ,function ,@arguments)))) ;; We must use a local directory. If it is remote, we could run into -;; an infloop. +;; an infloop. We try to follow the XDG specification, for security reasons. (defconst tramp-compat-temporary-file-directory - (eval (car (get 'temporary-file-directory 'standard-value)) t) + (file-name-as-directory + (if-let ((xdg (xdg-cache-home)) + ((file-directory-p xdg)) + ((file-writable-p xdg))) + ;; We can use `file-name-concat' starting with Emacs 28.1. + (prog1 (setq xdg (concat (file-name-as-directory xdg) "emacs")) + (make-directory xdg t)) + (eval (car (get 'temporary-file-directory 'standard-value)) t))) "The default value of `temporary-file-directory'.") (defsubst tramp-compat-make-temp-name () diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 7ce984d9144..3eb2dd13cbc 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -120,7 +120,7 @@ Any level x includes messages for all levels 1 .. x-1. The levels are (defcustom tramp-debug-to-file nil "Whether Tramp debug messages shall be saved to file. The debug file has the same name as the debug buffer, written to -`temporary-file-directory'." +`tramp-compat-temporary-file-directory'." :version "28.1" :type 'boolean) @@ -665,6 +665,7 @@ The `sudo' program appears to insert a `^@' character into the prompt." "Sorry, try again." "Name or service not known" "Host key verification failed." + "Authentication failed" "No supported authentication methods left to try!" (: "Login " (| "Incorrect" "incorrect")) (: "Connection " (| "refused" "closed")) @@ -1970,7 +1971,7 @@ of `current-buffer'." (+ digit) ":" (+ digit) ":" (+ digit) "." (+ digit) blank ;; Thread. (? (group "#") blank) - ;; Function name, verbosity. + ;; Function name, verbosity. (+ (any "-" alnum)) " (" (group (+ digit)) ") #") "Used for highlighting Tramp debug buffers in `outline-mode'.") @@ -2109,18 +2110,23 @@ ARGUMENTS to actually emit the message (if applicable)." (insert "\n")) ;; Timestamp. (insert (format-time-string "%T.%6N ")) + ;; Threads. `current-thread' might not exist when Emacs is + ;; configured --without-threads. + ;; (unless (eq (tramp-compat-funcall 'current-thread) main-thread) + ;; (insert (format "%s " (tramp-compat-funcall 'current-thread)))) ;; Calling Tramp function. We suppress compat and trace ;; functions from being displayed. - (let ((btn 1) btf fn) + (let ((frames (backtrace-frames)) + btf fn) (while (not fn) - (setq btf (nth 1 (backtrace-frame btn))) + (setq btf (cadadr frames)) (if (not btf) (setq fn "") (and (symbolp btf) (setq fn (symbol-name btf)) (or (not (string-prefix-p "tramp" fn)) (get btf 'tramp-suppress-trace)) (setq fn nil)) - (setq btn (1+ btn)))) + (setq frames (cdr frames)))) ;; The following code inserts filename and line number. ;; Should be inactive by default, because it is time consuming. ;; (let ((ffn (find-function-noselect (intern fn)))) @@ -3790,14 +3796,14 @@ BODY is the backend specific code." ;; VISIT, for example `jka-compr-handler'. We must respect this. ;; See Bug#55166. `(let* ((filename (expand-file-name ,filename)) - (lockname (file-truename (or ,lockname filename))) - (handler (and (stringp ,visit) - (let ((inhibit-file-name-handlers - `(tramp-file-name-handler - tramp-crypt-file-name-handler - . inhibit-file-name-handlers)) - (inhibit-file-name-operation 'write-region)) - (find-file-name-handler ,visit 'write-region))))) + (lockname (file-truename (or ,lockname filename))) + (handler (and (stringp ,visit) + (let ((inhibit-file-name-handlers + `(tramp-file-name-handler + tramp-crypt-file-name-handler + . inhibit-file-name-handlers)) + (inhibit-file-name-operation 'write-region)) + (find-file-name-handler ,visit 'write-region))))) (with-parsed-tramp-file-name filename nil (if handler (progn @@ -5821,11 +5827,14 @@ Mostly useful to protect BODY from being interrupted by timers." (throw 'non-essential 'non-essential) (tramp-error ,proc 'remote-file-error "Forbidden reentrant call of Tramp")) - (unwind-protect - (progn - (tramp-set-connection-property ,proc "locked" t) - ,@body) - (tramp-flush-connection-property ,proc "locked")))) + (let ((stimers (with-timeout-suspend)) + timer-list timer-idle-list) + (unwind-protect + (progn + (tramp-set-connection-property ,proc "locked" t) + ,@body) + (tramp-flush-connection-property ,proc "locked") + (with-timeout-unsuspend stimers))))) (defun tramp-accept-process-output (proc &optional _timeout) "Like `accept-process-output' for Tramp processes. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 8e4e7122a27..840decbf5d5 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2440,15 +2440,19 @@ This checks also `file-name-as-directory', `file-name-directory', `(,(expand-file-name tmp-name) 0))) (should (string-equal (buffer-string) "foo")) (should (= point (point)))) - (let ((point (point))) - (replace-string-in-region "foo" "bar" (point-min) (point-max)) - (goto-char point) - (should - (equal - (insert-file-contents tmp-name nil nil nil 'replace) - `(,(expand-file-name tmp-name) 3))) - (should (string-equal (buffer-string) "foo")) - (should (= point (point)))) + ;; Insert another string. + ;; `replace-string-in-region' was introduced in Emacs 28.1. + (when (tramp--test-emacs28-p) + (let ((point (point))) + (with-no-warnings + (replace-string-in-region "foo" "bar" (point-min) (point-max))) + (goto-char point) + (should + (equal + (insert-file-contents tmp-name nil nil nil 'replace) + `(,(expand-file-name tmp-name) 3))) + (should (string-equal (buffer-string) "foo")) + (should (= point (point))))) ;; Error case. (delete-file tmp-name) (should-error @@ -7444,12 +7448,7 @@ This is needed in timer functions as well as process filters and sentinels." "Check parallel asynchronous requests. Such requests could arrive from timers, process filters and process sentinels. They shall not disturb each other." - ;; :tags (append '(:expensive-test :tramp-asynchronous-processes) - ;; (and (or (getenv "EMACS_HYDRA_CI") - ;; (getenv "EMACS_EMBA_CI")) - ;; '(:unstable))) - ;; It doesn't work sufficiently. - :tags '(:expensive-test :tramp-asynchronous-processes :unstable) + :tags '(:expensive-test :tramp-asynchronous-processes) (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-supports-processes-p)) (skip-unless (not (tramp--test-container-p))) @@ -7517,14 +7516,12 @@ process sentinels. They shall not disturb each other." (when buffers (let ((time (float-time)) (default-directory tmp-name) - (file (buffer-name (seq-random-elt buffers))) - ;; A remote operation in a timer could - ;; confuse Tramp heavily. So we ignore this - ;; error here. - (debug-ignored-errors - (cons 'remote-file-error debug-ignored-errors))) + (file (buffer-name (seq-random-elt buffers)))) (tramp--test-message "Start timer %s %s" file (current-time-string)) + (dired-uncache file) + (tramp--test-message + "Continue timer %s %s" file (file-attributes file)) (vc-registered file) (tramp--test-message "Stop timer %s %s" file (current-time-string)) From 34ac7d908762663e4f91b678d3456286c494c237 Mon Sep 17 00:00:00 2001 From: Spencer Baugh Date: Thu, 27 Apr 2023 12:11:45 -0400 Subject: [PATCH 3/3] Make vc-hg-annotate-command async There's no benefit in this running the process synchrounously, and it's annoying for it to block the Emacs UI. * lisp/vc/vc-hg.el (vc-hg-annotate-command): Run asynchronously (bug#63123). --- lisp/vc/vc-hg.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 5bab9aa529e..78480fd8062 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -578,7 +578,7 @@ This requires hg 4.4 or later, for the \"-L\" option of \"hg log\"." (defun vc-hg-annotate-command (file buffer &optional revision) "Execute \"hg annotate\" on FILE, inserting the contents in BUFFER. Optional arg REVISION is a revision to annotate from." - (apply #'vc-hg-command buffer 0 file "annotate" "-dq" "-n" + (apply #'vc-hg-command buffer 'async file "annotate" "-dq" "-n" (append (vc-switches 'hg 'annotate) (if revision (list (concat "-r" revision))))))