From e7bb7cc29bc27b368a066c088943c93b1c689b23 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sun, 28 May 2017 23:44:10 +0200 Subject: [PATCH] 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. --- lisp/net/tramp-adb.el | 35 ++++++++---- lisp/net/tramp-cache.el | 13 +++-- lisp/net/tramp-gvfs.el | 4 +- lisp/net/tramp.el | 108 ++++++++++++++++++----------------- test/lisp/net/tramp-tests.el | 4 +- 5 files changed, 95 insertions(+), 69 deletions(-) diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index e9a3d001341..23aa90186a6 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -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. diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index a863860abf1..415cde2fc8a 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -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) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index c016c7e0274..d031c73c3f7 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -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" "~") diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index e75305b637f..05d197fce08 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -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 diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 7a12aae1bf2..8c97fafa3e6 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -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)) -- 2.39.2