From c3f0ddc9f833ca55f04122bf083cf6e50942e195 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 19 Feb 2025 19:38:25 +0100 Subject: [PATCH] Simplify Tramp's find-executable * lisp/net/tramp-cache.el (with-tramp-saved-connection-property): Fix typo. * lisp/net/tramp-compat.el: Add TODO. * lisp/net/tramp-sh.el (tramp-find-executable): Simplify, using "type -P ...". (tramp-set-remote-path): Better handling of superlong $PATH. (tramp-get-remote-path): Adapt/use connection properties. * test/lisp/net/tramp-tests.el (tramp--test-enabled) (tramp-test03-file-name-host-rules): Don't wrap `tramp-cleanup-connection' with `ignore-errors'. (cherry picked from commit ec34bccfee68a521e7a98ce8dce9325a146d095b) --- lisp/net/tramp-cache.el | 4 +- lisp/net/tramp-compat.el | 2 + lisp/net/tramp-sh.el | 153 ++++++++++++++++------------------- test/lisp/net/tramp-tests.el | 6 +- 4 files changed, 74 insertions(+), 91 deletions(-) diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index ba4c786451a..7fc285c8358 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -482,10 +482,10 @@ used to cache connection properties of the local machine." (hash (tramp-get-hash-table key)) (cached (and (hash-table-p hash) (gethash ,property hash tramp-cache-undefined)))) - (tramp-message key 7 "Saved %s %s" property cached) + (tramp-message key 7 "Saved %s %s" ,property cached) (unwind-protect (progn ,@body) ;; Reset PROPERTY. Recompute hash, it could have been flushed. - (tramp-message key 7 "Restored %s %s" property cached) + (tramp-message key 7 "Restored %s %s" ,property cached) (setq hash (tramp-get-hash-table key)) (if (not (eq cached tramp-cache-undefined)) (puthash ,property cached hash) diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index d30c9b8cca0..7ed9e0d6fca 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -245,6 +245,8 @@ value is the default binding of the variable." ;; ;; * Use `with-environment-variables'. ;; +;; * Use `ensure-list'. +;; ;; * Starting with Emacs 29.1, use `buffer-match-p'. ;; ;; * Starting with Emacs 29.1, use `string-split'. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index e4df1499467..3ced60eb0dd 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -4099,44 +4099,23 @@ Returns the absolute file name of PROGNAME, if found, and nil otherwise. This function expects to be in the right *tramp* buffer." (with-current-buffer (tramp-get-connection-buffer vec) - (let (result) - ;; Check whether the executable is in $PATH. "which(1)" does not - ;; report always a correct error code; therefore we check the - ;; number of words it returns. "SunOS 5.10" (and maybe "SunOS - ;; 5.11") have problems with this command, we disable the call - ;; therefore. - (unless (or ignore-path (tramp-check-remote-uname vec tramp-sunos-unames)) - (tramp-send-command vec (format "which \\%s | wc -w" progname)) - (goto-char (point-min)) - (if (looking-at-p (rx bol (* blank) "1" eol)) - (setq result (concat "\\" progname)))) - (unless result - (when ignore-tilde - ;; Remove all ~/foo directories from dirlist. - (let (newdl d) - (while dirlist - (setq d (car dirlist) - dirlist (cdr dirlist)) - (unless (char-equal ?~ (aref d 0)) - (setq newdl (cons d newdl)))) - (setq dirlist (nreverse newdl)))) - (tramp-send-command - vec - (format (concat "while read d; " - "do if test -x $d/%s && test -f $d/%s; " - "then echo tramp_executable $d/%s; " - "break; fi; done <<'%s'\n" - "%s\n%s") - progname progname progname - tramp-end-of-heredoc - (string-join dirlist "\n") - tramp-end-of-heredoc)) - (goto-char (point-max)) - (when (search-backward "tramp_executable " nil t) - (skip-chars-forward "^ ") - (skip-chars-forward " ") - (setq result (buffer-substring (point) (line-end-position))))) - result))) + (unless ignore-path + (setq dirlist (cons "$PATH" dirlist))) + (when ignore-tilde + ;; Remove all ~/foo directories from dirlist. + (let (newdl d) + (while dirlist + (setq d (car dirlist) + dirlist (cdr dirlist)) + (unless (char-equal ?~ (aref d 0)) + (setq newdl (cons d newdl)))) + (setq dirlist (nreverse newdl)))) + (tramp-send-command + vec (format "%s type -P %s 2>%s" + (if dirlist (concat "PATH=" (string-join dirlist ":")) "") + progname (tramp-get-remote-null-device vec))) + (unless (zerop (buffer-size)) + (string-trim (buffer-string))))) ;; On hydra.nixos.org, the $PATH environment variable is too long to ;; send it. This is likely not due to PATH_MAX, but PIPE_BUF. We @@ -4158,18 +4137,24 @@ variable PATH." ;; Use a temporary file. We cannot use `write-region' because ;; setting the remote path happens in the early connection ;; handshake, and not all external tools are determined yet. - (setq command (concat command "\n") - tmpfile (tramp-make-tramp-temp-file vec)) - (while (not (string-empty-p command)) - (setq chunksize (min (length command) (/ pipe-buf 2)) - chunk (substring command 0 chunksize) - command (substring command chunksize)) - (tramp-send-command vec (format - "printf \"%%b\" \"$*\" %s >>%s" - (tramp-shell-quote-argument chunk) - (tramp-shell-quote-argument tmpfile)))) - (tramp-send-command vec (format ". %s" tmpfile)) - (tramp-send-command vec (format "rm -f %s" tmpfile))))) + ;; Furthermore, we know that the COMMAND is too long, due to a + ;; very long remote-path. Set it temporarily to something + ;; short. + (with-tramp-saved-connection-property (tramp-get-process vec) "remote-path" + (tramp-set-connection-property + (tramp-get-process vec) "remote-path" '("/bin" "/usr/bin")) + (setq command (concat command "\n") + tmpfile (tramp-make-tramp-temp-file vec)) + (while (not (string-empty-p command)) + (setq chunksize (min (length command) (/ pipe-buf 2)) + chunk (substring command 0 chunksize) + command (substring command chunksize)) + (tramp-send-command vec (format + "printf \"%%b\" \"$*\" %s >>%s" + (tramp-shell-quote-argument chunk) + (tramp-shell-quote-argument tmpfile)))) + (tramp-send-command vec (format ". %s" tmpfile)) + (tramp-send-command vec (format "rm -f %s" tmpfile)))))) ;; ------------------------------------------------------------ ;; -- Communication with external shell -- @@ -5576,50 +5561,48 @@ Nonexistent directories are removed from spec." (with-current-buffer (tramp-get-connection-buffer vec) ;; Expand connection-local variables. (tramp-set-connection-local-variables vec) - (with-tramp-connection-property - ;; When `tramp-own-remote-path' is in `tramp-remote-path', we - ;; cache the result for the session only. Otherwise, the - ;; result is cached persistently. - (if (memq 'tramp-own-remote-path tramp-remote-path) - (tramp-get-process vec) vec) - "remote-path" + (with-tramp-connection-property (tramp-get-process vec) "remote-path" (let* ((remote-path (copy-tree tramp-remote-path)) (elt1 (memq 'tramp-default-remote-path remote-path)) (elt2 (memq 'tramp-own-remote-path remote-path)) (default-remote-path - (when elt1 - (or - (tramp-send-command-and-read - vec - (format - "echo \\\"`getconf PATH 2>%s`\\\"" - (tramp-get-remote-null-device vec)) - 'noerror) - ;; Default if "getconf" is not available. - (progn - (tramp-message - vec 3 - "`getconf PATH' not successful, using default value \"%s\"." - "/bin:/usr/bin") - "/bin:/usr/bin")))) + (when elt1 + (or + (with-tramp-connection-property + (tramp-get-process vec) "default-remote-path" + (tramp-send-command-and-read + vec + (format + "echo \\\"`getconf PATH 2>%s`\\\"" + (tramp-get-remote-null-device vec)) + 'noerror)) + ;; Default if "getconf" is not available. + (progn + (tramp-message + vec 3 + "`getconf PATH' not successful, using default value \"%s\"." + "/bin:/usr/bin") + "/bin:/usr/bin")))) (own-remote-path ;; The login shell could return more than just the $PATH ;; string. So we use `tramp-end-of-heredoc' as marker. (when elt2 (or - (tramp-send-command-and-read - vec - (format - "%s %s %s 'echo %s \\\"$PATH\\\"'" - (tramp-get-method-parameter vec 'tramp-remote-shell) - (string-join - (tramp-get-method-parameter vec 'tramp-remote-shell-login) - " ") - (string-join - (tramp-get-method-parameter vec 'tramp-remote-shell-args) - " ") - (tramp-shell-quote-argument tramp-end-of-heredoc)) - 'noerror (rx (literal tramp-end-of-heredoc))) + (with-tramp-connection-property + (tramp-get-process vec) "own-remote-path" + (tramp-send-command-and-read + vec + (format + "%s %s %s 'echo %s \\\"$PATH\\\"'" + (tramp-get-method-parameter vec 'tramp-remote-shell) + (string-join + (tramp-get-method-parameter vec 'tramp-remote-shell-login) + " ") + (string-join + (tramp-get-method-parameter vec 'tramp-remote-shell-args) + " ") + (tramp-shell-quote-argument tramp-end-of-heredoc)) + 'noerror (rx (literal tramp-end-of-heredoc)))) (progn (tramp-warning vec "Could not retrieve `tramp-own-remote-path'") diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 44ccd552850..606e051d448 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -282,8 +282,7 @@ being the result.") (delete-directory file 'recursive) (delete-file file)))))) ;; Cleanup connection. - (ignore-errors - (tramp-cleanup-connection tramp-test-vec nil 'keep-password))) + (tramp-cleanup-connection tramp-test-vec nil 'keep-password)) ;; Return result. (cdr tramp--test-enabled-checked)) @@ -2175,8 +2174,7 @@ being the result.") (dolist (m '("su" "sg" "sudo" "doas" "ksu")) (when (assoc m tramp-methods) (let (tramp-connection-properties tramp-default-proxies-alist) - (ignore-errors - (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)) + (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) ;; Single hop. The host name must match `tramp-local-host-regexp'. (should-error (find-file (format "/%s:foo:" m)) -- 2.39.5