From 0820a81ec7a1dcd421b3eec345a38d8405ee00a0 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 28 Jan 2023 10:26:44 +0100 Subject: [PATCH] Tramp cleanup from recent test campaign * lisp/net/tramp.el (tramp-barf-if-file-missing): Fix docstring. (tramp-handle-file-directory-p): Don't suppress errors. (tramp-handle-shell-command): * lisp/net/tramp-adb.el (tramp-adb-handle-make-process): Make insertion of a stderr file more robust. * lisp/net/tramp-archive.el (tramp-archive-handle-directory-files): Use `tramp-barf-if-file-missing'. * lisp/net/tramp-sudoedit.el (tramp-sudoedit-handle-file-name-all-completions): Protect against errors from `file-directory-p'. * lisp/net/tramp.el (tramp-wrong-passwd-regexp): * lisp/net/tramp-adb.el (tramp-adb-prompt): * lisp/net/tramp-sh.el (tramp-sh-inotifywait-process-filter): * lisp/net/tramp-smb.el (tramp-smb-maybe-open-connection): Unify regexps. * test/lisp/net/tramp-tests.el (tramp-test48-auto-load) (tramp-test48-delay-load): Unify regexps. --- lisp/net/tramp-adb.el | 18 ++++++++------- lisp/net/tramp-archive.el | 33 +++++++++++++-------------- lisp/net/tramp-sh.el | 2 +- lisp/net/tramp-smb.el | 2 +- lisp/net/tramp-sudoedit.el | 2 +- lisp/net/tramp.el | 44 ++++++++++++++++++++---------------- test/lisp/net/tramp-tests.el | 8 +++---- 7 files changed, 58 insertions(+), 51 deletions(-) diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 10f33e5f929..38fd8a4e258 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -55,7 +55,7 @@ It is used for TCP/IP devices." (defconst tramp-adb-method "adb" "When this method name is used, forward all calls to Android Debug Bridge.") -(defcustom tramp-adb-prompt (rx bol (* (not (any "#$\n\r"))) (any "#$") blank) +(defcustom tramp-adb-prompt (rx bol (* (not (any "#$\r\n"))) (any "#$") blank) "Regexp used as prompt in almquist shell." :type 'regexp :version "28.1" @@ -1005,17 +1005,19 @@ implementation will be used." ;; file will exist until the process is ;; deleted. (when (bufferp stderr) - (with-current-buffer stderr - (insert-file-contents-literally - remote-tmpstderr 'visit)) + (ignore-errors + (with-current-buffer stderr + (insert-file-contents-literally + remote-tmpstderr 'visit))) ;; Delete tmpstderr file. (add-function :after (process-sentinel p) (lambda (_proc _msg) - (with-current-buffer stderr - (insert-file-contents-literally - remote-tmpstderr 'visit nil nil 'replace)) - (delete-file remote-tmpstderr)))) + (ignore-errors + (with-current-buffer stderr + (insert-file-contents-literally + remote-tmpstderr 'visit nil nil 'replace)) + (delete-file remote-tmpstderr))))) ;; Return process. p)))) diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index 7c1f578d085..97adb36c4af 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -611,23 +611,22 @@ offered." (defun tramp-archive-handle-directory-files (directory &optional full match nosort count) "Like `directory-files' for Tramp files." - (unless (file-exists-p directory) - (tramp-error (tramp-dissect-file-name directory) 'file-missing directory)) - (when (file-directory-p directory) - (setq directory (file-name-as-directory (expand-file-name directory))) - (let ((temp (nreverse (file-name-all-completions "" directory))) - result item) - - (while temp - (setq item (directory-file-name (pop temp))) - (when (or (null match) (string-match-p match item)) - (push (if full (concat directory item) item) - result))) - (unless nosort - (setq result (sort result #'string<))) - (when (and (natnump count) (> count 0)) - (setq result (tramp-compat-ntake count result))) - result))) + (tramp-barf-if-file-missing (tramp-dissect-file-name directory) directory + (when (file-directory-p directory) + (setq directory (file-name-as-directory (expand-file-name directory))) + (let ((temp (nreverse (file-name-all-completions "" directory))) + result item) + + (while temp + (setq item (directory-file-name (pop temp))) + (when (or (null match) (string-match-p match item)) + (push (if full (concat directory item) item) + result))) + (unless nosort + (setq result (sort result #'string<))) + (when (and (natnump count) (> count 0)) + (setq result (tramp-compat-ntake count result))) + result)))) (defun tramp-archive-handle-dired-uncache (dir) "Like `dired-uncache' for file archives." diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 25bc59eb4ff..48d91bd733e 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -3877,7 +3877,7 @@ Fall back to normal file name handler if no Tramp handler exists." "Read output from \"inotifywait\" and add corresponding `file-notify' events." (let ((events (process-get proc 'events))) (tramp-message proc 6 "%S\n%s" proc string) - (dolist (line (split-string string "[\n\r]+" 'omit)) + (dolist (line (split-string string (rx (+ (any "\r\n"))) 'omit)) ;; Check, whether there is a problem. (unless (string-match (rx bol (+ (not blank)) (+ blank) (group (+ (not blank))) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index a9cec17f536..b2272f804e0 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -1878,7 +1878,7 @@ If ARGUMENT is non-nil, use it as argument for (setq tramp-smb-version (shell-command-to-string command)) (tramp-message vec 6 command) (tramp-message vec 6 "\n%s" tramp-smb-version) - (if (string-match (rx (+ (any " \t\n\r")) eos) tramp-smb-version) + (if (string-match (rx (+ (any " \t\r\n")) eos) tramp-smb-version) (setq tramp-smb-version (replace-match "" nil nil tramp-smb-version)))) diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index 486a22a60e1..1f646253579 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -477,7 +477,7 @@ the result will be a local, non-Tramp, file name." "" (file-name-unquote localname))) (mapcar (lambda (f) - (if (file-directory-p (expand-file-name f directory)) + (if (ignore-errors (file-directory-p (expand-file-name f directory))) (file-name-as-directory f) f)) (delq diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index f38e570700e..50e1e2479d5 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -82,6 +82,7 @@ (progn (defvar tramp--startup-hook nil "Forms to be executed at the end of tramp.el.") + (put 'tramp--startup-hook 'tramp-suppress-trace t) (defmacro tramp--with-startup (&rest body) @@ -657,14 +658,13 @@ The `sudo' program appears to insert a `^@' character into the prompt." (defcustom tramp-wrong-passwd-regexp (rx bol (* nonl) (| "Permission denied" - (: "Login " (| "Incorrect" "incorrect")) - "Connection refused" - "Connection closed" "Timeout, server not responding." "Sorry, try again." "Name or service not known" "Host key verification failed." "No supported authentication methods left to try!" + (: "Login " (| "Incorrect" "incorrect")) + (: "Connection " (| "refused" "closed")) (: "Received signal " (+ digit))) (* nonl)) "Regexp matching a `login failed' message. @@ -787,6 +787,7 @@ It shall be used in combination with `generate-new-buffer-name'.") (defvar tramp-temp-buffer-file-name nil "File name of a persistent local temporary file. Useful for \"rsync\" like methods.") + (make-variable-buffer-local 'tramp-temp-buffer-file-name) (put 'tramp-temp-buffer-file-name 'permanent-local t) @@ -1404,6 +1405,7 @@ the (optional) timestamp of last activity on this connection.") "Password save function. Will be called once the password has been verified by successful authentication.") + (put 'tramp-password-save-function 'tramp-suppress-trace t) (defvar tramp-password-prompt-not-unique nil @@ -2299,12 +2301,12 @@ the resulting error message." (progn ,@body) (error (tramp-message ,vec-or-proc 3 ,format ,err) nil)))) -;; This macro shall optimize the cases where an `file-exists-p' call -;; is invoked first. Often, the file exists, so the remote command is +;; This macro shall optimize the cases where a `file-exists-p' call is +;; invoked first. Often, the file exists, so the remote command is ;; superfluous. (defmacro tramp-barf-if-file-missing (vec filename &rest body) "Execute BODY and return the result. -In case if an error, raise a `file-missing' error if FILENAME +In case of an error, raise a `file-missing' error if FILENAME does not exist, otherwise propagate the error." (declare (indent 2) (debug (symbolp form body))) (let ((err (make-symbol "err"))) @@ -3935,9 +3937,10 @@ Let-bind it when necessary.") (defun tramp-handle-file-directory-p (filename) "Like `file-directory-p' for Tramp files." ;; `file-truename' could raise an error, for example due to a cyclic - ;; symlink. - (ignore-errors - (eq (file-attribute-type (file-attributes (file-truename filename))) t))) + ;; symlink. We don't protect this despite it, because other errors + ;; might be worth to be visible, for example impossibility to mount + ;; in tramp-gvfs.el. + (eq (file-attribute-type (file-attributes (file-truename filename))) t)) (defun tramp-handle-file-equal-p (filename1 filename2) "Like `file-equalp-p' for Tramp files." @@ -5152,17 +5155,19 @@ support symbolic links." (add-function :after (process-sentinel p) (lambda (_proc _string) - (with-current-buffer error-buffer - (insert-file-contents-literally - error-file nil nil nil 'replace)) - (delete-file error-file)))) + (ignore-errors + (with-current-buffer error-buffer + (insert-file-contents-literally + error-file nil nil nil 'replace)) + (delete-file error-file))))) (display-buffer output-buffer '(nil (allow-no-window . t))))) ;; Insert error messages if they were separated. (when (and error-file (not (process-live-p p))) - (with-current-buffer error-buffer - (insert-file-contents-literally error-file)) - (delete-file error-file)))) + (ignore-errors + (with-current-buffer error-buffer + (insert-file-contents-literally error-file)) + (delete-file error-file))))) ;; Synchronous case. (prog1 @@ -5170,9 +5175,10 @@ support symbolic links." (process-file-shell-command command nil buffer) ;; Insert error messages if they were separated. (when error-file - (with-current-buffer error-buffer - (insert-file-contents-literally error-file)) - (delete-file error-file)) + (ignore-errors + (with-current-buffer error-buffer + (insert-file-contents-literally error-file)) + (delete-file error-file))) (if current-buffer-p ;; This is like exchange-point-and-mark, but doesn't ;; activate the mark. It is cleaner to avoid activation, diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 59e160c9d71..338482d2b61 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -7488,7 +7488,7 @@ process sentinels. They shall not disturb each other." ert-remote-temporary-file-directory))) (should (string-match-p - (rx "Tramp loaded: t" (+ (any "\n\r"))) + (rx "Tramp loaded: t" (+ (any "\r\n"))) (shell-command-to-string (format "%s -batch -Q -L %s --eval %s" @@ -7516,9 +7516,9 @@ process sentinels. They shall not disturb each other." (should (string-match-p (rx - "Tramp loaded: nil" (+ (any "\n\r")) - "Tramp loaded: nil" (+ (any "\n\r")) - "Tramp loaded: " (literal (symbol-name tm)) (+ (any "\n\r"))) + "Tramp loaded: nil" (+ (any "\r\n")) + "Tramp loaded: nil" (+ (any "\r\n")) + "Tramp loaded: " (literal (symbol-name tm)) (+ (any "\r\n"))) (shell-command-to-string (format "%s -batch -Q -L %s --eval %s" -- 2.39.5