Commit f361c54e authored by Michael Albinus's avatar Michael Albinus
Browse files

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.
parent 1a3feb8e
......@@ -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))
......
......@@ -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)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment