diff options
| -rw-r--r-- | doc/misc/tramp.texi | 20 | ||||
| -rw-r--r-- | doc/misc/trampver.texi | 2 | ||||
| -rw-r--r-- | etc/NEWS | 4 | ||||
| -rw-r--r-- | lisp/net/tramp-gvfs.el | 95 | ||||
| -rw-r--r-- | lisp/net/tramp.el | 14 | ||||
| -rw-r--r-- | lisp/net/trampver.el | 6 | ||||
| -rw-r--r-- | test/lisp/net/tramp-tests.el | 5 |
7 files changed, 92 insertions, 54 deletions
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 894ccbe9c9..dc3ef23c45 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -957,6 +957,22 @@ syntax requires a leading volume (share) name, for example: based on standard protocols, such as HTTP@. @option{davs} does the same but with SSL encryption. Both methods support the port numbers. +@item @option{gdrive} +@cindex method gdrive +@cindex gdrive method +@cindex Google Drive + +Via the @option{gdrive} method it is possible to access your Google +Drive online storage. User and host name of the remote file name are +your email address of the Google Drive credentials, like +@file{@trampfn{gdrive,john.doe@@gmail.com,/}}. These credentials must +be populated in your @command{Online Accounts} application outside Emacs. + +Since Google Drive uses cryptic blob file names internally, +@value{tramp} works with the @code{display-name} of the files. This +could produce unexpected behaviour in case two files in the same +directory have the same @code{display-name}, such a situation must be avoided. + @item @option{obex} @cindex method obex @cindex obex method @@ -986,8 +1002,8 @@ requires the SYNCE-GVFS plugin. @vindex tramp-gvfs-methods This custom option is a list of external methods for GVFS@. By default, this list includes @option{afp}, @option{dav}, @option{davs}, -@option{obex}, @option{sftp} and @option{synce}. Other methods to -include are: @option{ftp} and @option{smb}. +@option{gdrive}, @option{obex}, @option{sftp} and @option{synce}. +Other methods to include are: @option{ftp} and @option{smb}. @end defopt diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi index 6f67f35902..3101dc0de8 100644 --- a/doc/misc/trampver.texi +++ b/doc/misc/trampver.texi @@ -8,7 +8,7 @@ @c In the Tramp GIT, the version number is auto-frobbed from @c configure.ac, so you should edit that file and run @c "autoconf && ./configure" to change the version number. -@set trampver 2.3.0 +@set trampver 2.3.1-pre @c Other flags from configuration @set instprefix /usr/local @@ -318,6 +318,10 @@ different group ID. +++ *** New connection method "doas" for OpenBSD hosts. ++++ +*** New connection method "gdrive", which allows to access Google +Drive onsite repositories. + --- ** 'auto-revert-use-notify' is set back to t in 'global-auto-revert-mode'. diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 0e874d6c58..8e7ef0f407 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -49,10 +49,10 @@ ;; The custom option `tramp-gvfs-methods' contains the list of ;; supported connection methods. Per default, these are "afp", "dav", -;; "davs", "obex", "sftp" and "synce". Note that with "obex" it might -;; be necessary to pair with the other bluetooth device, if it hasn't -;; been done already. There might be also some few seconds delay in -;; discovering available bluetooth devices. +;; "davs", "gdrive", "obex", "sftp" and "synce". Note that with +;; "obex" it might be necessary to pair with the other bluetooth +;; device, if it hasn't been done already. There might be also some +;; few seconds delay in discovering available bluetooth devices. ;; Other possible connection methods are "ftp" and "smb". When one of ;; these methods is added to the list, the remote access for that @@ -110,21 +110,29 @@ (require 'custom)) ;;;###tramp-autoload -(defcustom tramp-gvfs-methods '("afp" "dav" "davs" "obex" "sftp" "synce") +(defcustom tramp-gvfs-methods + '("afp" "dav" "davs" "gdrive" "obex" "sftp" "synce") "List of methods for remote files, accessed with GVFS." :group 'tramp - :version "25.1" + :version "25.2" :type '(repeat (choice (const "afp") (const "dav") (const "davs") (const "ftp") + (const "gdrive") (const "obex") (const "sftp") (const "smb") (const "synce")))) -;; Add a default for `tramp-default-user-alist'. Rule: For the SYNCE -;; method, no user is chosen. +;; Add defaults for `tramp-default-user-alist' and `tramp-default-host-alist'. +;;;###tramp-autoload +(when (string-match "\\(.+\\)@\\(\\(?:gmail\\|googlemail\\)\\.com\\)" + user-mail-address) + (add-to-list 'tramp-default-user-alist + `("\\`gdrive\\'" nil ,(match-string 1 user-mail-address))) + (add-to-list 'tramp-default-host-alist + '("\\`gdrive\\'" nil ,(match-string 2 user-mail-address)))) ;;;###tramp-autoload (add-to-list 'tramp-default-user-alist '("\\`synce\\'" nil nil)) @@ -408,11 +416,9 @@ Every entry is a list (NAME ADDRESS).") "The device interface of the HAL daemon.") (defconst tramp-gvfs-file-attributes - '("type" + '("name" + "type" "standard::display-name" - ;; We don't need this one. It is used as delimiter in case the - ;; display name contains spaces, which is hard to parse. - "standard::icon" "standard::symlink-target" "unix::nlink" "unix::uid" @@ -432,9 +438,7 @@ Every entry is a list (NAME ADDRESS).") "GVFS file attributes.") (defconst tramp-gvfs-file-attributes-with-gvfs-ls-regexp - (concat "[[:blank:]]" - (regexp-opt tramp-gvfs-file-attributes t) - "=\\([^[:blank:]]+\\)") + (concat "[[:blank:]]" (regexp-opt tramp-gvfs-file-attributes t) "=\\(.+?\\)") "Regexp to parse GVFS file attributes with `gvfs-ls'.") (defconst tramp-gvfs-file-attributes-with-gvfs-info-regexp @@ -834,25 +838,31 @@ file names." v "gvfs-ls" "-h" "-n" "-a" (mapconcat 'identity tramp-gvfs-file-attributes ",") (tramp-gvfs-url-file-name directory)) - ;; Parse output ... + ;; Parse output. (with-current-buffer (tramp-get-connection-buffer v) (goto-char (point-min)) - (while (re-search-forward + (while (looking-at (concat "^\\(.+\\)[[:blank:]]" "\\([[:digit:]]+\\)[[:blank:]]" - "(\\(.+\\))[[:blank:]]" - "standard::display-name=\\(.+\\)[[:blank:]]" - "standard::icon=") - (point-at-eol) t) - (let ((item (list (cons "standard::display-name" (match-string 4)) - (cons "type" (match-string 3)) + "(\\(.+?\\))" + tramp-gvfs-file-attributes-with-gvfs-ls-regexp)) + (let ((item (list (cons "type" (match-string 3)) (cons "standard::size" (match-string 2)) - (match-string 1)))) - (while (re-search-forward - tramp-gvfs-file-attributes-with-gvfs-ls-regexp - (point-at-eol) t) - (push (cons (match-string 1) (match-string 2)) item)) - (push (nreverse item) result)) + (cons "name" (match-string 1))))) + (goto-char (1+ (match-end 3))) + (while (looking-at + (concat + tramp-gvfs-file-attributes-with-gvfs-ls-regexp + "\\(" tramp-gvfs-file-attributes-with-gvfs-ls-regexp + "\\|" "$" "\\)")) + (push (cons (match-string 1) (match-string 2)) item) + (goto-char (match-end 2))) + ;; Add display name as head. + (push + (cons (cdr (or (assoc "standard::display-name" item) + (assoc "name" item))) + (nreverse item)) + result)) (forward-line))) result))))) @@ -868,7 +878,7 @@ file names." ;; Send command. (tramp-gvfs-send-command v "gvfs-info" (tramp-gvfs-url-file-name filename)) - ;; Parse output ... + ;; Parse output. (with-current-buffer (tramp-get-connection-buffer v) (goto-char (point-min)) (while (re-search-forward @@ -1024,17 +1034,12 @@ file names." filename (with-parsed-tramp-file-name (expand-file-name directory) nil (with-tramp-file-property v localname "file-name-all-completions" - (let ((result '("./" "../")) - entry) + (let ((result '("./" "../"))) ;; Get a list of directories and files. (dolist (item (tramp-gvfs-get-directory-attributes directory) result) - (setq entry - (or ;; Use display-name if available (google-drive). - ;(cdr (assoc "standard::display-name" item)) - (car item))) (if (string-equal (cdr (assoc "type" item)) "directory") - (push (file-name-as-directory entry) result) - (push entry result))))))))) + (push (file-name-as-directory (car item)) result) + (push (car item) result))))))))) (defun tramp-gvfs-handle-file-notify-add-watch (file-name flags _callback) "Like `file-notify-add-watch' for Tramp files." @@ -1220,6 +1225,8 @@ file-notify events." (url-recreate-url (if (tramp-tramp-file-p filename) (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)))) @@ -1389,6 +1396,8 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"." (setq host (tramp-bluez-device host))) (when (and (string-equal "dav" method) (string-equal "true" ssl)) (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)) @@ -1474,6 +1483,8 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"." (setq host (tramp-bluez-device host))) (when (and (string-equal "dav" method) (string-equal "true" ssl)) (setq method "davs")) + (when (string-equal "google-drive" method) + (setq method "gdrive")) (when (and (string-equal "synce" method) (zerop (length user))) (setq user (or (tramp-file-name-user vec) ""))) (unless (zerop (length domain)) @@ -1531,6 +1542,9 @@ It was \"a(say)\", but has changed to \"a{sv})\"." (list (tramp-gvfs-mount-spec-entry "type" "afp-volume") (tramp-gvfs-mount-spec-entry "host" host) (tramp-gvfs-mount-spec-entry "volume" share))) + ((string-equal "gdrive" method) + (list (tramp-gvfs-mount-spec-entry "type" "google-drive") + (tramp-gvfs-mount-spec-entry "host" host))) (t (list (tramp-gvfs-mount-spec-entry "type" method) (tramp-gvfs-mount-spec-entry "host" host)))) @@ -1896,8 +1910,9 @@ They are retrieved from the hal daemon." ;;; TODO: -;; * Host name completion via afp-server, smb-server or smb-network. -;; * Check how two shares of the same SMB server can be mounted in +;; * Host name completion for existing mount points (afp-server, +;; smb-server) or via smb-network. +;; * Check, how two shares of the same SMB server can be mounted in ;; parallel. ;; * Apply SDP on bluetooth devices, in order to filter out obex ;; capability. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index b02760bff8..d80006abbc 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -4012,7 +4012,7 @@ are written with verbosity of 6." (vector tramp-current-method tramp-current-user tramp-current-host nil nil))) (destination (if (eq destination t) (current-buffer) destination)) - result) + output error result) (tramp-message v 6 "`%s %s' %s %s" program (mapconcat 'identity args " ") infile destination) @@ -4023,13 +4023,17 @@ are written with verbosity of 6." 'call-process program infile (or destination t) display args)) ;; `result' could also be an error string. (when (stringp result) - (signal 'file-error (list result))) + (setq error result + result 1)) (with-current-buffer (if (bufferp destination) destination (current-buffer)) - (tramp-message v 6 "%d\n%s" result (buffer-string)))) + (setq output (buffer-string)))) (error - (setq result 1) - (tramp-message v 6 "%d\n%s" result (error-message-string err)))) + (setq error (error-message-string err) + result 1))) + (if (zerop (length error)) + (tramp-message v 6 "%d\n%s" result output) + (tramp-message v 6 "%d\n%s\n%s" result output error)) result)) (defun tramp-call-process-region diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index aea260541e..fad7e7f77c 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -6,7 +6,7 @@ ;; Author: Kai Großjohann <kai.grossjohann@gmx.net> ;; Keywords: comm, processes ;; Package: tramp -;; Version: 2.3.0 +;; Version: 2.3.1-pre ;; This file is part of GNU Emacs. @@ -32,7 +32,7 @@ ;; should be changed only there. ;;;###tramp-autoload -(defconst tramp-version "2.3.0" +(defconst tramp-version "2.3.1-pre" "This version of Tramp.") ;;;###tramp-autoload @@ -54,7 +54,7 @@ ;; Check for Emacs version. (let ((x (if (>= emacs-major-version 23) "ok" - (format "Tramp 2.3.0 is not fit for %s" + (format "Tramp 2.3.1-pre is not fit for %s" (when (string-match "^.*$" (emacs-version)) (match-string 0 (emacs-version))))))) (unless (string-match "\\`ok\\'" x) (error "%s" x))) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index b9562c1bef..fe927bb25f 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -119,7 +119,6 @@ eval properly in `should', `should-not' or `should-error'. BODY shall not contain a timeout." (declare (indent 1) (debug (natnump body))) `(let ((tramp-verbose ,verbose) - (tramp-message-show-message t) (tramp-debug-on-error t) (debug-ignored-errors (cons "^make-symbolic-link not supported$" debug-ignored-errors))) @@ -932,7 +931,7 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (make-directory tmp-name1) (should (file-directory-p tmp-name1)) (should (file-accessible-directory-p tmp-name1)) - (should-error (make-directory tmp-name2) :type 'file-error) + (should-error (make-directory tmp-name2)) (make-directory tmp-name2 'parents) (should (file-directory-p tmp-name2)) (should (file-accessible-directory-p tmp-name2))) @@ -953,7 +952,7 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." ;; Delete non-empty directory. (make-directory tmp-name) (write-region "foo" nil (expand-file-name "bla" tmp-name)) - (should-error (delete-directory tmp-name) :type 'file-error) + (should-error (delete-directory tmp-name)) (delete-directory tmp-name 'recursive) (should-not (file-directory-p tmp-name)))) |