Some tweaks, almost all for Tramp adb method
* lisp/net/tramp-adb.el (tramp-adb-parse-device-names): Use `make-tramp-file-name'. (tramp-adb-get-device): Use `tramp-file-name-port-or-default'. (tramp-adb-maybe-open-connection): Set "prompt" property. (tramp-adb-wait-for-output): Use it. * lisp/net/tramp-cache.el (tramp-cache-print): Use `elt'. (tramp-dump-connection-properties): Check also that there are properties to be saved. Don't save "started" property of "ftp" method. * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-expand-file-name): Use `make-tramp-file-name'. * lisp/net/tramp.el (tramp-remote-file-name-spec-regexp): Host could be empty. (tramp-file-name-port-or-default): New defun. (tramp-dissect-file-name): Simplify `make-tramp-file-name' call. (tramp-handle-file-name-case-insensitive-p): Use a progress reporter. (tramp-call-process, tramp-call-process-region): Use `make-tramp-file-name'. * test/lisp/net/tramp-tests.el (tramp-test03-file-name-defaults): Revert change from 2017-05-24. (tramp-test05-expand-file-name-relative): Let it also pass for "adb" method.
This commit is contained in:
parent
288b3ca2e5
commit
e7bb7cc29b
5 changed files with 95 additions and 69 deletions
|
@ -200,9 +200,9 @@ pass to the OPERATION."
|
|||
;; That's why we use `start-process'.
|
||||
(let ((p (start-process
|
||||
tramp-adb-program (current-buffer) tramp-adb-program "devices"))
|
||||
(v (tramp-make-tramp-file-name
|
||||
tramp-adb-method tramp-current-user nil
|
||||
tramp-current-host nil nil nil))
|
||||
(v (make-tramp-file-name
|
||||
:method tramp-adb-method :user tramp-current-user
|
||||
:host tramp-current-host))
|
||||
result)
|
||||
(tramp-message v 6 "%s" (mapconcat 'identity (process-command p) " "))
|
||||
(process-put p 'adjust-window-size-function 'ignore)
|
||||
|
@ -1069,7 +1069,7 @@ E.g. a host name \"192.168.1.1#5555\" returns \"192.168.1.1:5555\"
|
|||
(tramp-flush-connection-property nil)
|
||||
(with-tramp-connection-property (tramp-get-connection-process vec) "device"
|
||||
(let* ((host (tramp-file-name-host vec))
|
||||
(port (tramp-file-name-port vec))
|
||||
(port (tramp-file-name-port-or-default vec))
|
||||
(devices (mapcar 'cadr (tramp-adb-parse-device-names nil))))
|
||||
(replace-regexp-in-string
|
||||
tramp-prefix-port-format ":"
|
||||
|
@ -1170,7 +1170,9 @@ FMT and ARGS are passed to `error'."
|
|||
(delete-process proc)
|
||||
(tramp-error proc 'file-error "Process `%s' not available, try again" proc))
|
||||
(with-current-buffer (process-buffer proc)
|
||||
(if (tramp-wait-for-regexp proc timeout tramp-adb-prompt)
|
||||
(if (tramp-wait-for-regexp
|
||||
proc timeout
|
||||
(tramp-get-connection-property proc "prompt" tramp-adb-prompt))
|
||||
(let (buffer-read-only)
|
||||
(goto-char (point-min))
|
||||
;; ADB terminal sends "^H" sequences.
|
||||
|
@ -1179,20 +1181,25 @@ FMT and ARGS are passed to `error'."
|
|||
(delete-region (point-min) (point)))
|
||||
;; Delete the prompt.
|
||||
(goto-char (point-min))
|
||||
(when (re-search-forward tramp-adb-prompt (point-at-eol) t)
|
||||
(when (re-search-forward
|
||||
(tramp-get-connection-property proc "prompt" tramp-adb-prompt)
|
||||
(point-at-eol) t)
|
||||
(forward-line 1)
|
||||
(delete-region (point-min) (point)))
|
||||
(goto-char (point-max))
|
||||
(re-search-backward tramp-adb-prompt nil t)
|
||||
(re-search-backward
|
||||
(tramp-get-connection-property proc "prompt" tramp-adb-prompt) nil t)
|
||||
(delete-region (point) (point-max)))
|
||||
(if timeout
|
||||
(tramp-error
|
||||
proc 'file-error
|
||||
"[[Remote adb prompt `%s' not found in %d secs]]"
|
||||
tramp-adb-prompt timeout)
|
||||
(tramp-get-connection-property proc "prompt" tramp-adb-prompt)
|
||||
timeout)
|
||||
(tramp-error
|
||||
proc 'file-error
|
||||
"[[Remote prompt `%s' not found]]" tramp-adb-prompt)))))
|
||||
"[[Remote prompt `%s' not found]]"
|
||||
(tramp-get-connection-property proc "prompt" tramp-adb-prompt))))))
|
||||
|
||||
(defun tramp-adb-maybe-open-connection (vec)
|
||||
"Maybe open a connection VEC.
|
||||
|
@ -1228,7 +1235,9 @@ connection if a previous connection has died for some reason."
|
|||
(p (let ((default-directory
|
||||
(tramp-compat-temporary-file-directory)))
|
||||
(apply 'start-process (tramp-get-connection-name vec) buf
|
||||
tramp-adb-program args))))
|
||||
tramp-adb-program args)))
|
||||
(prompt (md5 (concat (prin1-to-string process-environment)
|
||||
(current-time-string)))))
|
||||
(tramp-message
|
||||
vec 6 "%s" (mapconcat 'identity (process-command p) " "))
|
||||
;; Wait for initial prompt.
|
||||
|
@ -1239,6 +1248,12 @@ connection if a previous connection has died for some reason."
|
|||
(process-put p 'adjust-window-size-function 'ignore)
|
||||
(set-process-query-on-exit-flag p nil)
|
||||
|
||||
;; Change prompt.
|
||||
(tramp-set-connection-property
|
||||
p "prompt" (regexp-quote (format "///%s#$" prompt)))
|
||||
(tramp-adb-send-command
|
||||
vec (format "PS1=\"///\"\"%s\"\"#$\"" prompt))
|
||||
|
||||
;; Check whether the properties have been changed. If
|
||||
;; yes, this is a strong indication that we must expire all
|
||||
;; connection properties. We start again.
|
||||
|
|
|
@ -326,8 +326,8 @@ used to cache connection properties of the local machine."
|
|||
;; (substring-no-properties
|
||||
;; (cl-struct-slot-value 'tramp-file-name slot key))))))
|
||||
(dotimes (i (length key))
|
||||
(when (stringp (aref key i))
|
||||
(aset key i (substring-no-properties (aref key i))))))
|
||||
(when (stringp (elt key i))
|
||||
(setf (elt key i) (substring-no-properties (elt key i))))))
|
||||
(when (stringp key)
|
||||
(setq key (substring-no-properties key)))
|
||||
(when (stringp value)
|
||||
|
@ -373,12 +373,15 @@ used to cache connection properties of the local machine."
|
|||
;; Remove temporary data. If there is the key "login-as", we
|
||||
;; don't save either, because all other properties might
|
||||
;; depend on the login name, and we want to give the
|
||||
;; possibility to use another login name later on.
|
||||
;; possibility to use another login name later on. Key
|
||||
;; "started" exists for the "ftp" method only, which must be
|
||||
;; be kept persistent.
|
||||
(maphash
|
||||
(lambda (key value)
|
||||
(if (and (tramp-file-name-p key)
|
||||
(if (and (tramp-file-name-p key) value
|
||||
(not (tramp-file-name-localname key))
|
||||
(not (gethash "login-as" value)))
|
||||
(not (gethash "login-as" value))
|
||||
(not (gethash "started" value)))
|
||||
(progn
|
||||
(remhash "process-name" value)
|
||||
(remhash "process-buffer" value)
|
||||
|
|
|
@ -788,7 +788,9 @@ file names."
|
|||
(when (string-match "\\`\\(~\\)\\(/\\|\\'\\)" localname)
|
||||
(save-match-data
|
||||
(tramp-gvfs-maybe-open-connection
|
||||
(tramp-make-tramp-file-name method user domain host port "/" hop)))
|
||||
(make-tramp-file-name
|
||||
:method method :user user :domain domain
|
||||
:host host :port port :localname "/" :hop hop)))
|
||||
(setq localname
|
||||
(replace-match
|
||||
(tramp-get-connection-property v "default-location" "~")
|
||||
|
|
|
@ -857,8 +857,9 @@ Derived from `tramp-postfix-host-format'."
|
|||
"\\(" (tramp-method-regexp) "\\)" (tramp-postfix-method-regexp)
|
||||
"\\(?:" "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp "\\)?"
|
||||
"\\(" "\\(?:" tramp-host-regexp "\\|"
|
||||
(tramp-prefix-ipv6-regexp) "\\(?:" tramp-ipv6-regexp "\\)?"
|
||||
(tramp-postfix-ipv6-regexp) "\\)"
|
||||
(tramp-prefix-ipv6-regexp)
|
||||
"\\(?:" tramp-ipv6-regexp "\\)?"
|
||||
(tramp-postfix-ipv6-regexp) "\\)?"
|
||||
"\\(?:" tramp-prefix-port-regexp tramp-port-regexp "\\)?" "\\)?"))
|
||||
|
||||
(defun tramp-file-name-structure ()
|
||||
|
@ -1135,7 +1136,7 @@ calling HANDLER.")
|
|||
;; data structure.
|
||||
|
||||
;; The basic structure for remote file names. We use a list :type,
|
||||
;; otherwise the persistent data are not read in tramp-cache.el.
|
||||
;; in order to be compatible with Emacs 24 and 25.
|
||||
(cl-defstruct (tramp-file-name (:type list) :named)
|
||||
method user domain host port localname hop)
|
||||
|
||||
|
@ -1155,6 +1156,12 @@ calling HANDLER.")
|
|||
tramp-prefix-port-format)
|
||||
(tramp-file-name-port vec))))
|
||||
|
||||
(defun tramp-file-name-port-or-default (vec)
|
||||
"Return port component of VEC.
|
||||
If nil, return `tramp-default-port'."
|
||||
(or (tramp-file-name-port vec)
|
||||
(tramp-get-method-parameter vec 'tramp-default-port)))
|
||||
|
||||
(defun tramp-file-name-equal-p (vec1 vec2)
|
||||
"Check, whether VEC1 and VEC2 denote the same `tramp-file-name'."
|
||||
(and (tramp-file-name-p vec1) (tramp-file-name-p vec2)
|
||||
|
@ -1294,16 +1301,9 @@ values."
|
|||
user (tramp-find-user method user host)
|
||||
host (tramp-find-host method user host)))
|
||||
|
||||
(apply
|
||||
'make-tramp-file-name
|
||||
(append
|
||||
(unless (zerop (length method)) `(:method ,method))
|
||||
(unless (zerop (length user)) `(:user ,user))
|
||||
(unless (zerop (length domain)) `(:domain ,domain))
|
||||
(unless (zerop (length host)) `(:host ,host))
|
||||
(unless (zerop (length port)) `(:port ,port))
|
||||
`(:localname ,(or localname ""))
|
||||
(unless (zerop (length hop)) `(:hop ,hop))))))))
|
||||
(make-tramp-file-name
|
||||
:method method :user user :domain domain :host host :port port
|
||||
:localname (or localname "") :hop hop)))))
|
||||
|
||||
(defun tramp-buffer-name (vec)
|
||||
"A name for the connection buffer VEC."
|
||||
|
@ -2878,38 +2878,42 @@ User is always nil."
|
|||
;; There isn't. So we must check, in case there's a connection already.
|
||||
(and (tramp-connectable-p filename)
|
||||
(with-tramp-connection-property v "case-insensitive"
|
||||
;; The idea is to compare a file with lower case letters
|
||||
;; with the same file with upper case letters.
|
||||
(let ((candidate
|
||||
(tramp-compat-file-name-unquote
|
||||
(directory-file-name filename)))
|
||||
tmpfile)
|
||||
;; Check, whether we find an existing file with lower case
|
||||
;; letters. This avoids us to create a temporary file.
|
||||
(while (and (string-match
|
||||
"[a-z]" (file-remote-p candidate 'localname))
|
||||
(not (file-exists-p candidate)))
|
||||
(setq candidate
|
||||
(directory-file-name (file-name-directory candidate))))
|
||||
;; Nothing found, so we must use a temporary file for
|
||||
;; comparison. `make-nearby-temp-file' is added to
|
||||
;; Emacs 26+ like `file-name-case-insensitive-p', so
|
||||
;; there is no compatibility problem calling it.
|
||||
(unless
|
||||
(string-match "[a-z]" (file-remote-p candidate 'localname))
|
||||
(setq tmpfile
|
||||
(let ((default-directory (file-name-directory filename)))
|
||||
(tramp-compat-funcall 'make-nearby-temp-file "tramp."))
|
||||
candidate tmpfile))
|
||||
;; Check for the existence of the same file with upper
|
||||
;; case letters.
|
||||
(unwind-protect
|
||||
(file-exists-p
|
||||
(concat
|
||||
(file-remote-p candidate)
|
||||
(upcase (file-remote-p candidate 'localname))))
|
||||
;; Cleanup.
|
||||
(when tmpfile (delete-file tmpfile)))))))))
|
||||
(with-tramp-progress-reporter v 5 "Checking case-insensitive"
|
||||
;; The idea is to compare a file with lower case letters
|
||||
;; with the same file with upper case letters.
|
||||
(let ((candidate
|
||||
(tramp-compat-file-name-unquote
|
||||
(directory-file-name filename)))
|
||||
tmpfile)
|
||||
;; Check, whether we find an existing file with lower
|
||||
;; case letters. This avoids us to create a temporary
|
||||
;; file.
|
||||
(while (and (string-match
|
||||
"[a-z]" (file-remote-p candidate 'localname))
|
||||
(not (file-exists-p candidate)))
|
||||
(setq candidate
|
||||
(directory-file-name (file-name-directory candidate))))
|
||||
;; Nothing found, so we must use a temporary file for
|
||||
;; comparison. `make-nearby-temp-file' is added to
|
||||
;; Emacs 26+ like `file-name-case-insensitive-p', so
|
||||
;; there is no compatibility problem calling it.
|
||||
(unless
|
||||
(string-match "[a-z]" (file-remote-p candidate 'localname))
|
||||
(setq tmpfile
|
||||
(let ((default-directory
|
||||
(file-name-directory filename)))
|
||||
(tramp-compat-funcall
|
||||
'make-nearby-temp-file "tramp."))
|
||||
candidate tmpfile))
|
||||
;; Check for the existence of the same file with upper
|
||||
;; case letters.
|
||||
(unwind-protect
|
||||
(file-exists-p
|
||||
(concat
|
||||
(file-remote-p candidate)
|
||||
(upcase (file-remote-p candidate 'localname))))
|
||||
;; Cleanup.
|
||||
(when tmpfile (delete-file tmpfile))))))))))
|
||||
|
||||
(defun tramp-handle-file-name-completion
|
||||
(filename directory &optional predicate)
|
||||
|
@ -4131,9 +4135,10 @@ PROGRAM is nil is trapped also, returning 1. Furthermore, traces
|
|||
are written with verbosity of 6."
|
||||
(let ((default-directory (tramp-compat-temporary-file-directory))
|
||||
(v (or vec
|
||||
(tramp-make-tramp-file-name
|
||||
tramp-current-method tramp-current-user tramp-current-domain
|
||||
tramp-current-host tramp-current-port nil nil)))
|
||||
(make-tramp-file-name
|
||||
:method tramp-current-method :user tramp-current-user
|
||||
:domain tramp-current-domain :host tramp-current-host
|
||||
:port tramp-current-port)))
|
||||
(destination (if (eq destination t) (current-buffer) destination))
|
||||
output error result)
|
||||
(tramp-message
|
||||
|
@ -4167,9 +4172,10 @@ PROGRAM is nil is trapped also, returning 1. Furthermore, traces
|
|||
are written with verbosity of 6."
|
||||
(let ((default-directory (tramp-compat-temporary-file-directory))
|
||||
(v (or vec
|
||||
(tramp-make-tramp-file-name
|
||||
tramp-current-method tramp-current-user tramp-current-domain
|
||||
tramp-current-host tramp-current-port nil nil)))
|
||||
(make-tramp-file-name
|
||||
:method tramp-current-method :user tramp-current-user
|
||||
:domain tramp-current-domain :host tramp-current-host
|
||||
:port tramp-current-port)))
|
||||
(buffer (if (eq buffer t) (current-buffer) buffer))
|
||||
result)
|
||||
(tramp-message
|
||||
|
|
|
@ -1510,7 +1510,7 @@ handled properly. BODY shall not contain a timeout."
|
|||
(ert-deftest tramp-test03-file-name-defaults ()
|
||||
"Check default values for some methods."
|
||||
;; Default values in tramp-adb.el.
|
||||
(should (string-equal (file-remote-p "/adb::" 'host) nil))
|
||||
(should (string-equal (file-remote-p "/adb::" 'host) ""))
|
||||
;; Default values in tramp-ftp.el.
|
||||
(should (string-equal (file-remote-p "/-:ftp.host:" 'method) "ftp"))
|
||||
(dolist (u '("ftp" "anonymous"))
|
||||
|
@ -1626,7 +1626,7 @@ handled properly. BODY shall not contain a timeout."
|
|||
:expected-result :failed
|
||||
(skip-unless (tramp--test-enabled))
|
||||
;; File names with a share behave differently.
|
||||
(when (tramp--test-afp-or-smb-p)
|
||||
(when (or (tramp--test-adb-p) (tramp--test-afp-or-smb-p))
|
||||
(setf (ert-test-expected-result-type
|
||||
(ert-get-test 'tramp-test05-expand-file-name-relative))
|
||||
:passed))
|
||||
|
|
Loading…
Add table
Reference in a new issue