From f361c54e6abc5ba5fa5ce6cc9734b5283e0e6aa3 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 10 Jun 2017 10:57:19 +0200 Subject: [PATCH] Fix domain port and handling in tramp-gvfs.el * lisp/net/tramp-gvfs.el (tramp-gvfs-dbus-byte-array-to-string): Return nil if BYTE-ARRAY is nil. (tramp-gvfs-url-file-name, tramp-gvfs-handler-mounted-unmounted) (tramp-gvfs-connection-mounted-p, tramp-gvfs-mount-spec): Fix domain and port handling. * lisp/net/tramp.el (tramp-handle-file-name-case-insensitive-p): Ignore errors. --- lisp/net/tramp-gvfs.el | 37 +++++++++------------ lisp/net/tramp.el | 75 ++++++++++++++++++++++-------------------- 2 files changed, 54 insertions(+), 58 deletions(-) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index d031c73c3f7..119efa53f36 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -562,14 +562,16 @@ pass to the OPERATION." (concat string (string 0)) string))) (defun tramp-gvfs-dbus-byte-array-to-string (byte-array) - "Like `dbus-byte-array-to-string' but remove trailing \\0 if exists." + "Like `dbus-byte-array-to-string' but remove trailing \\0 if exists. +Return nil for null BYTE-ARRAY." ;; The byte array could be a variant. Take care. (let ((byte-array (if (and (consp byte-array) (atom (car byte-array))) byte-array (car byte-array)))) - (dbus-byte-array-to-string - (if (and (consp byte-array) (zerop (car (last byte-array)))) - (butlast byte-array) byte-array)))) + (and byte-array + (dbus-byte-array-to-string + (if (and (consp byte-array) (zerop (car (last byte-array)))) + (butlast byte-array) byte-array))))) (defun tramp-gvfs-stringify-dbus-message (message) "Convert a D-Bus message into readable UTF8 strings, used for traces." @@ -815,8 +817,7 @@ file names." ;; `expand-file-name' (this does "/./" and "/../"). (tramp-make-tramp-file-name method user domain host port - (tramp-run-real-handler - 'expand-file-name (list localname)))))) + (tramp-run-real-handler 'expand-file-name (list localname)))))) (defun tramp-gvfs-get-directory-attributes (directory) "Return GVFS attributes association list of all files in DIRECTORY." @@ -1227,12 +1228,11 @@ file-notify events." (with-parsed-tramp-file-name filename nil (when (string-equal "gdrive" method) (setq method "google-drive")) - (when (and user (string-match tramp-user-with-domain-regexp user)) - (setq user - (concat (match-string 2 user) ";" (match-string 1 user)))) + (when (and user domain) + (setq user (concat domain ";" user))) (url-parse-make-urlobj - method (and user (url-hexify-string user)) nil - (tramp-file-name-host v) (tramp-file-name-port v) + method (and user (url-hexify-string user)) nil host + (if (stringp port) (string-to-number port) port) (and localname (url-hexify-string localname)) nil nil t)) (url-parse-make-urlobj "file" nil nil nil nil @@ -1398,10 +1398,6 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"." (setq method "davs")) (when (string-equal "google-drive" method) (setq method "gdrive")) - (unless (zerop (length domain)) - (setq user (concat user tramp-prefix-domain-format domain))) - (unless (zerop (length port)) - (setq host (concat host tramp-prefix-port-format port))) (with-parsed-tramp-file-name (tramp-make-tramp-file-name method user domain host port "") nil (tramp-message @@ -1487,14 +1483,12 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"." (setq method "gdrive")) (when (and (string-equal "synce" method) (zerop (length user))) (setq user (or (tramp-file-name-user vec) ""))) - (unless (zerop (length domain)) - (setq user (concat user tramp-prefix-domain-format domain))) - (unless (zerop (length port)) - (setq host (concat host tramp-prefix-port-format port))) (when (and (string-equal method (tramp-file-name-method vec)) - (string-equal user (or (tramp-file-name-user vec) "")) + (string-equal user (tramp-file-name-user vec)) + (string-equal domain (tramp-file-name-domain vec)) (string-equal host (tramp-file-name-host vec)) + (string-equal port (tramp-file-name-port vec)) (string-match (concat "^" (regexp-quote prefix)) (tramp-file-name-unquote-localname vec))) ;; Set prefix, mountpoint and location. @@ -1554,8 +1548,7 @@ It was \"a(say)\", but has changed to \"a{sv})\"." ,@(when domain (list (tramp-gvfs-mount-spec-entry "domain" domain))) ,@(when port - (list (tramp-gvfs-mount-spec-entry - "port" (number-to-string port)))))) + (list (tramp-gvfs-mount-spec-entry "port" port))))) (mount-pref (if (and (string-match "\\`dav" method) (string-match "^/?[^/]+" localname)) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 05d197fce08..8758fb61e4a 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2878,42 +2878,45 @@ 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" - (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)))))))))) + (ignore-errors + (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) -- 2.39.2