procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Tramp cleanup from recent test campaign

Browse source 
* 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.
This commit is contained in:
Michael Albinus 2023-01-28 10:26:44 +01:00
parent cd42244fca
commit 0820a81ec7
7 changed files with 57 additions and 50 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
lisp/net/tramp-adb.el
View file

@ -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))))

31
lisp/net/tramp-archive.el
View file

@ -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)
(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)))
(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."

2
lisp/net/tramp-sh.el
View file

@ -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)))

2
lisp/net/tramp-smb.el
View file

@ -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))))

2
lisp/net/tramp-sudoedit.el
View file

@ -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

44
lisp/net/tramp.el
View file

@ -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,

8
test/lisp/net/tramp-tests.el
View file

@ -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"