From 87958db425812ec7cacf9ad3f8db22a91e3db4e4 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sun, 11 Jun 2017 23:16:13 +0200 Subject: [PATCH] Some further improvements for tramp-gvfs.el * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-expand-file-name) (tramp-gvfs-get-file-attributes) (tramp-gvfs-maybe-open-connection): Handle davs? properly. (tramp-gvfs-handler-askquestion): Improve `yes-or-no-p' prompt. Show question also in batch mode. Cache result. * test/lisp/net/tramp-tests.el (tramp-test24-file-name-completion): Support completion for host names and ports. --- lisp/net/tramp-gvfs.el | 85 +++++++++++++++++++++--------------- test/lisp/net/tramp-tests.el | 2 + 2 files changed, 53 insertions(+), 34 deletions(-) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 119efa53f36..7aac7c66e37 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -805,7 +805,7 @@ file names." (unless (tramp-run-real-handler 'file-name-absolute-p (list localname)) (setq localname (concat "/" localname))) ;; We do not pass "/..". - (if (string-match "^\\(afp\\|smb\\)$" method) + (if (string-match "^\\(afp\\|davs?\\|smb\\)$" method) (when (string-match "^/[^/]+\\(/\\.\\./?\\)" localname) (setq localname (replace-match "/" t t localname 1))) (when (string-match "^/\\.\\./?" localname) @@ -886,10 +886,9 @@ file names." (setq filename (directory-file-name (expand-file-name filename))) (with-parsed-tramp-file-name filename nil (setq localname (tramp-compat-file-name-unquote localname)) - (if (or - (and (string-match "^\\(afp\\|smb\\)$" method) - (string-match "^/?\\([^/]+\\)$" localname)) - (string-equal localname "/")) + (if (or (and (string-match "^\\(afp\\|davs?\\|smb\\)$" method) + (string-match "^/?\\([^/]+\\)$" localname)) + (string-equal localname "/")) (tramp-gvfs-get-root-attributes filename) (assoc (file-name-nondirectory filename) @@ -1326,36 +1325,50 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"." "Implementation for the \"org.gtk.vfs.MountOperation.askQuestion\" method." (save-window-excursion (let ((enable-recursive-minibuffers t) - choice) + (use-dialog-box (and use-dialog-box (null noninteractive))) + result) - (condition-case nil - (with-parsed-tramp-file-name - (tramp-gvfs-file-name (dbus-event-path-name last-input-event)) nil - (tramp-message v 6 "%S %S" message choices) - - ;; In theory, there can be several choices. Until now, - ;; there is only the question whether to accept an unknown - ;; host signature. - (with-temp-buffer - ;; Preserve message for `progress-reporter'. - (with-temp-message "" - (insert message) - (pop-to-buffer (current-buffer)) - (setq choice (if (yes-or-no-p (concat (car choices) " ")) 0 1)) - (tramp-message v 6 "%d" choice))) - - ;; When the choice is "no", we set a dummy fuse-mountpoint - ;; in order to leave the timeout. - (unless (zerop choice) - (tramp-set-file-property v "/" "fuse-mountpoint" "/")) - - (list - t ;; handled. - nil ;; no abort of D-Bus. - choice)) - - ;; When QUIT is raised, we shall return this information to D-Bus. - (quit (list nil t 0)))))) + (with-parsed-tramp-file-name + (tramp-gvfs-file-name (dbus-event-path-name last-input-event)) nil + (tramp-message v 6 "%S %S" message choices) + + (setq result + (condition-case nil + (list + t ;; handled. + nil ;; no abort of D-Bus. + (with-tramp-connection-property + (tramp-get-connection-process v) message + ;; In theory, there can be several choices. + ;; Until now, there is only the question whether + ;; to accept an unknown host signature. + (with-temp-buffer + ;; Preserve message for `progress-reporter'. + (with-temp-message "" + (insert message) + (goto-char (point-max)) + (if noninteractive + (message "%s" message) + (pop-to-buffer (current-buffer))) + (if (yes-or-no-p + (concat + (buffer-substring + (line-beginning-position) (point)) + " ")) + 0 1))))) + + ;; When QUIT is raised, we shall return this + ;; information to D-Bus. + (quit (list nil t 1)))) + + (tramp-message v 6 "%s" result) + + ;; When the choice is "no", we set a dummy fuse-mountpoint in + ;; order to leave the timeout. + (unless (zerop (cl-caddr result)) + (tramp-set-file-property v "/" "fuse-mountpoint" "/")) + + result)))) (defun tramp-gvfs-handler-mounted-unmounted (mount-info) "Signal handler for the \"org.gtk.vfs.MountTracker.mounted\" and @@ -1638,6 +1651,10 @@ connection if a previous connection has died for some reason." (string-equal localname "/")) (tramp-error vec 'file-error "Filename must contain an AFP volume")) + (when (and (string-match method "davs?") + (string-equal localname "/")) + (tramp-error vec 'file-error "Filename must contain a WebDAV share")) + (when (and (string-equal method "smb") (string-equal localname "/")) (tramp-error vec 'file-error "Filename must contain a Windows share")) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 6876f20d41c..28147c48d6c 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2501,6 +2501,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (let ((method (file-remote-p tramp-test-temporary-file-directory 'method)) (host (file-remote-p tramp-test-temporary-file-directory 'host)) (orig-syntax tramp-syntax)) + (when (and (stringp host) (string-match tramp-host-with-port-regexp host)) + (setq host (match-string 1 host))) (unwind-protect (dolist -- 2.39.2