[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master 7d33c77 3/3: Add missing handler to tramp-rclone.el
|
From: |
Michael Albinus |
|
Subject: |
[Emacs-diffs] master 7d33c77 3/3: Add missing handler to tramp-rclone.el, improve robustness |
|
Date: |
Thu, 6 Dec 2018 10:11:51 -0500 (EST) |
branch: master
commit 7d33c775b245dc011f56559a8a776728888d7246
Author: Michael Albinus <address@hidden>
Commit: Michael Albinus <address@hidden>
Add missing handler to tramp-rclone.el, improve robustness
* lisp/net/tramp-rclone.el (tramp-adb): Require.
(tramp-rclone-file-name-handler-alist):
Use `tramp-adb-handle-expand-file-name'.
(tramp-rclone-flush-directory-cache): New defun, derived from
`tramp-rclone-flush-mount'.
(tramp-rclone-do-copy-or-rename-file)
(tramp-rclone-handle-delete-directory)
(tramp-rclone-handle-delete-file)
(tramp-rclone-handle-make-directory): Use it.
(tramp-rclone-handle-directory-files)
(tramp-rclone-local-file-name):
Use `tramp-compat-file-name-quoted-p', `tramp-compat-file-name-quote'
and ´tramp-compat-file-name-unquote'.
(tramp-rclone-handle-file-executable-p)
(tramp-rclone-handle-file-readable-p): Cache result.
(tramp-rclone-handle-file-name-all-completions)
(tramp-rclone-mounted-p, tramp-rclone-remote-file-name)
(tramp-rclone-maybe-open-connection): Rewrite.
* test/lisp/net/tramp-tests.el (tramp--test-rclone-p): New defun.
(tramp-test05-expand-file-name-relative)
(tramp--test-special-characters): Use it.
---
lisp/net/tramp-rclone.el | 178 +++++++++++++++++++++++++++++--------------
test/lisp/net/tramp-tests.el | 15 +++-
2 files changed, 133 insertions(+), 60 deletions(-)
diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el
index 6c01d7d..3f3cac8 100644
--- a/lisp/net/tramp-rclone.el
+++ b/lisp/net/tramp-rclone.el
@@ -39,6 +39,7 @@
(require 'tramp)
;; TODDDDDDDDDO: REPLACE
+(require 'tramp-adb)
(require 'tramp-gvfs)
;;;###tramp-autoload
@@ -85,7 +86,7 @@
(dired-compress-file . ignore)
(dired-uncache . tramp-handle-dired-uncache)
(exec-path . ignore)
- ;; `expand-file-name' performed by default handler.
+ (expand-file-name . tramp-adb-handle-expand-file-name)
(file-accessible-directory-p . tramp-handle-file-accessible-directory-p)
(file-acl . ignore)
(file-attributes . tramp-rclone-handle-file-attributes)
@@ -258,7 +259,15 @@ file names."
(with-parsed-tramp-file-name filename v1
(tramp-flush-file-properties
v1 (file-name-directory v1-localname))
- (tramp-flush-file-properties v1 v1-localname)))
+ (tramp-flush-file-properties v1 v1-localname)
+ (when (tramp-rclone-file-name-p filename)
+ (tramp-rclone-flush-directory-cache v1)
+ ;; The mount point's directory cache might need time
+ ;; to flush.
+ (while (file-exists-p filename)
+ (tramp-flush-file-properties
+ v1 (file-name-directory v1-localname))
+ (tramp-flush-file-properties v1 v1-localname)))))
(when t2
(with-parsed-tramp-file-name newname v2
@@ -266,7 +275,13 @@ file names."
v2 (file-name-directory v2-localname))
(tramp-flush-file-properties v2 v2-localname)
(when (tramp-rclone-file-name-p newname)
- (tramp-rclone-flush-mount v2)))))))))
+ (tramp-rclone-flush-directory-cache v2)
+ ;; The mount point's directory cache might need time
+ ;; to flush.
+ (while (not (file-exists-p newname))
+ (tramp-flush-file-properties
+ v2 (file-name-directory v2-localname))
+ (tramp-flush-file-properties v2 v2-localname))))))))))
(defun tramp-rclone-handle-copy-file
(filename newname &optional ok-if-already-exists keep-date
@@ -289,17 +304,18 @@ file names."
(directory &optional recursive trash)
"Like `delete-directory' for Tramp files."
(with-parsed-tramp-file-name (expand-file-name directory) nil
+ (delete-directory (tramp-rclone-local-file-name directory) recursive trash)
(tramp-flush-file-properties v (file-name-directory localname))
(tramp-flush-directory-properties v localname)
- (delete-directory
- (tramp-rclone-local-file-name directory) recursive trash)))
+ (tramp-rclone-flush-directory-cache v)))
(defun tramp-rclone-handle-delete-file (filename &optional trash)
"Like `delete-file' for Tramp files."
(with-parsed-tramp-file-name (expand-file-name filename) nil
+ (delete-file (tramp-rclone-local-file-name filename) trash)
(tramp-flush-file-properties v (file-name-directory localname))
(tramp-flush-file-properties v localname)
- (delete-file (tramp-rclone-local-file-name filename) trash)))
+ (tramp-rclone-flush-directory-cache v)))
(defun tramp-rclone-handle-directory-files
(directory &optional full match nosort)
@@ -312,11 +328,11 @@ file names."
(tramp-rclone-local-file-name directory) full match)))
;; Massage the result.
(when full
- (let* ((quoted (file-name-quoted-p directory))
+ (let* ((quoted (tramp-compat-file-name-quoted-p directory))
(local
(concat "^" (regexp-quote (tramp-rclone-mount-point v))))
(remote
- (funcall (if quoted 'file-name-quote 'identity)
+ (funcall (if quoted 'tramp-compat-file-name-quote 'identity)
(file-remote-p directory))))
(setq result
(mapcar
@@ -341,15 +357,32 @@ file names."
(defun tramp-rclone-handle-file-executable-p (filename)
"Like `file-executable-p' for Tramp files."
- (file-executable-p (tramp-rclone-local-file-name filename)))
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (with-tramp-file-property v localname "file-executable-p"
+ (file-executable-p (tramp-rclone-local-file-name filename)))))
(defun tramp-rclone-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files."
- (file-name-all-completions filename (tramp-rclone-local-file-name
directory)))
+ (all-completions
+ filename
+ (delete-dups
+ (append
+ (file-name-all-completions
+ filename (tramp-rclone-local-file-name directory))
+ ;; Some storage systems do not return "." and "..".
+ (let (result)
+ (dolist (item '(".." ".") result)
+ (when (string-prefix-p filename item)
+ (catch 'match
+ (dolist (elt completion-regexp-list)
+ (unless (string-match-p elt item) (throw 'match nil)))
+ (setq result (cons (concat item "/") result))))))))))
(defun tramp-rclone-handle-file-readable-p (filename)
"Like `file-readable-p' for Tramp files."
- (file-readable-p (tramp-rclone-local-file-name filename)))
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (with-tramp-file-property v localname "file-readable-p"
+ (file-readable-p (tramp-rclone-local-file-name filename)))))
(defun tramp-rclone-handle-file-system-info (filename)
"Like `file-system-info' for Tramp files."
@@ -401,13 +434,14 @@ file names."
(defun tramp-rclone-handle-make-directory (dir &optional parents)
"Like `make-directory' for Tramp files."
(with-parsed-tramp-file-name (expand-file-name dir) nil
+ (make-directory (tramp-rclone-local-file-name dir) parents)
;; When PARENTS is non-nil, DIR could be a chain of non-existent
;; directories a/b/c/... Instead of checking, we simply flush the
- ;; whole cache.
+ ;; whole file cache.
(tramp-flush-file-properties v localname)
(tramp-flush-directory-properties
v (if parents "/" (file-name-directory localname)))
- (make-directory (tramp-rclone-local-file-name dir) parents)))
+ (tramp-rclone-flush-directory-cache v)))
(defun tramp-rclone-handle-rename-file
(filename newname &optional ok-if-already-exists)
@@ -436,24 +470,38 @@ file names."
(defun tramp-rclone-mounted-p (vec)
"Check, whether storage system determined by VEC is mounted."
- (with-tramp-file-property vec "/" "mounted"
- (string-match
- (format "^%s:" (regexp-quote (tramp-file-name-host vec)))
- (shell-command-to-string "mount"))))
-
-(defun tramp-rclone-flush-mount (vec)
+ (when (tramp-get-connection-process vec)
+ ;; We cannot use `with-connection-property', because we don't want
+ ;; to cache a nil result.
+ (or (tramp-get-connection-property
+ (tramp-get-connection-process vec) "mounted" nil)
+ (tramp-set-connection-property
+ (tramp-get-connection-process vec) "mounted"
+ (let* ((default-directory temporary-file-directory)
+ (mount (shell-command-to-string "mount -t fuse.rclone")))
+ (tramp-message vec 6 "%s" "mount -t fuse.rclone")
+ (tramp-message vec 6 "\n%s" mount)
+ (when (string-match
+ (format
+ "^\\(%s:\\S-*\\)" (regexp-quote (tramp-file-name-host vec)))
+ mount)
+ (match-string 1 mount)))))))
+
+(defun tramp-rclone-flush-directory-cache (vec)
"Flush directory cache of VEC mount."
(let ((rclone-pid
;; Identify rclone process.
- (with-tramp-file-property vec "/" "rclone-pid"
- (catch 'pid
- (dolist (pid (list-system-processes)) ;; "pidof rclone" ?
- (and (string-match
- (regexp-quote
- (format "rclone mount %s:" (tramp-file-name-host vec)))
- (or (cdr (assoc 'args (process-attributes pid))) ""))
- (throw 'pid pid)))))))
- ;; Send a SIGHUP in order to flush directory caches.
+ (when (tramp-get-connection-process vec)
+ (with-tramp-connection-property
+ (tramp-get-connection-process vec) "rclone-pid"
+ (catch 'pid
+ (dolist (pid (list-system-processes)) ;; "pidof rclone" ?
+ (and (string-match-p
+ (regexp-quote
+ (format "rclone mount %s:" (tramp-file-name-host vec)))
+ (or (cdr (assoc 'args (process-attributes pid))) ""))
+ (throw 'pid pid))))))))
+ ;; Send a SIGHUP in order to flush directory cache.
(when rclone-pid
(tramp-message
vec 6 "Send SIGHUP %d: %s"
@@ -462,15 +510,16 @@ file names."
(defun tramp-rclone-local-file-name (filename)
"Return local mount name of FILENAME."
- (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (setq filename (tramp-compat-file-name-unquote (expand-file-name filename)))
+ (with-parsed-tramp-file-name filename nil
;; As long as we call `tramp-rclone-maybe-open-connection' here,
;; we cache the result.
(with-tramp-file-property v localname "local-file-name"
(tramp-rclone-maybe-open-connection v)
- (let ((quoted (file-name-quoted-p localname))
- (localname (file-name-unquote localname)))
+ (let ((quoted (tramp-compat-file-name-quoted-p localname))
+ (localname (tramp-compat-file-name-unquote localname)))
(funcall
- (if quoted 'file-name-quote 'identity)
+ (if quoted 'tramp-compat-file-name-quote 'identity)
(expand-file-name
(if (file-name-absolute-p localname)
(substring localname 1) localname)
@@ -478,43 +527,59 @@ file names."
(defun tramp-rclone-remote-file-name (filename)
"Return FILENAME as used in the `rclone' command."
- (setq filename (file-name-unquote (expand-file-name filename)))
+ (setq filename (tramp-compat-file-name-unquote (expand-file-name filename)))
(if (tramp-rclone-file-name-p filename)
(with-parsed-tramp-file-name filename nil
- ;; TODO: This shall be handled by `expand-file-name'.
- (setq localname (replace-regexp-in-string "^\\." "" (or localname "")))
- (format "%s:%s" host localname))
+ ;; As long as we call `tramp-rclone-maybe-open-connection' here,
+ ;; we cache the result.
+ (with-tramp-file-property v localname "remote-file-name"
+ (tramp-rclone-maybe-open-connection v)
+ ;; TODO: This shall be handled by `expand-file-name'.
+ (setq localname
+ (replace-regexp-in-string "^\\." "" (or localname "")))
+ (format "%s%s" (tramp-rclone-mounted-p v) localname)))
+ ;; It is a local file name.
filename))
(defun tramp-rclone-maybe-open-connection (vec)
"Maybe open a connection VEC.
Does not do anything if a connection is already open, but re-opens the
connection if a previous connection has died for some reason."
- (unless (tramp-rclone-mounted-p vec)
- (let ((host (tramp-file-name-host vec)))
+ (let ((host (tramp-file-name-host vec)))
+ (when (rassoc `(,host) (tramp-rclone-parse-device-names nil))
(if (zerop (length host))
(tramp-error vec 'file-error "Storage %s not connected" host))
- (with-tramp-progress-reporter vec 3 "Mounting rclone storage"
- (unless (file-directory-p (tramp-rclone-mount-point vec))
- (make-directory (tramp-rclone-mount-point vec) 'parents))
- (let* ((buf (tramp-get-connection-buffer vec))
- (coding-system-for-read 'utf-8-dos) ;is this correct?
- (process-connection-type tramp-process-connection-type)
- (args `("mount" ,(concat host ":")
- ,(tramp-rclone-mount-point vec)
- ,(tramp-get-method-parameter vec 'tramp-mount-args)))
- (p (let ((default-directory
- (tramp-compat-temporary-file-directory)))
- (apply 'start-process (tramp-get-connection-name vec) buf
- tramp-rclone-program (delq nil args)))))
- (tramp-set-file-property vec "/" "mounted" t)
- (tramp-message
- vec 6 "%s" (mapconcat 'identity (process-command p) " "))
- (process-put p 'adjust-window-size-function 'ignore)
+
+ ;; We need a process bound to the connection buffer. Therefore,
+ ;; we create a dummy process. Maybe there is a better solution?
+ (unless (get-buffer-process (tramp-get-connection-buffer vec))
+ (let ((p (make-network-process
+ :name (tramp-buffer-name vec)
+ :buffer (tramp-get-connection-buffer vec)
+ :server t :host 'local :service t :noquery t)))
+ (process-put p 'vector vec)
(set-process-query-on-exit-flag p nil)
;; Set connection-local variables.
- (tramp-set-connection-local-variables vec)))))
+ (tramp-set-connection-local-variables vec)))
+
+ ;; Create directory.
+ (unless (file-directory-p (tramp-rclone-mount-point vec))
+ (make-directory (tramp-rclone-mount-point vec) 'parents))
+
+ ;; Mount. This command does not return, so we use 0 as
+ ;; DESTINATION of `tramp-call-process'.
+ (unless (tramp-rclone-mounted-p vec)
+ (apply
+ 'tramp-call-process
+ vec tramp-rclone-program nil 0 nil
+ (delq nil
+ `("mount" ,(concat host ":/")
+ ,(tramp-rclone-mount-point vec)
+ ;; This could be nil.
+ ,(tramp-get-method-parameter vec 'tramp-mount-args))))
+ (while (not (file-exists-p (tramp-make-tramp-file-name vec 'localname)))
+ (tramp-cleanup-connection vec 'keep-debug 'keep-password)))))
;; In `tramp-check-cached-permissions', the connection properties
;; {uig,gid}-{integer,string} are used. We set them to proper values.
@@ -529,7 +594,6 @@ connection if a previous connection has died for some
reason."
(defun tramp-rclone-send-command (vec &rest args)
"Send the COMMAND to connection VEC."
-; (tramp-rclone-maybe-open-connection vec)
(with-current-buffer (tramp-get-connection-buffer vec)
(erase-buffer)
(let ((flags (tramp-get-method-parameter
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 15a1207..1fcecb8 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -1997,7 +1997,7 @@ handled properly. BODY shall not contain a timeout."
(skip-unless (tramp--test-enabled))
;; These are the methods the test doesn't fail.
- (when (or (tramp--test-adb-p) (tramp--test-gvfs-p)
+ (when (or (tramp--test-adb-p) (tramp--test-gvfs-p) (tramp--test-rclone-p)
(tramp-smb-file-name-p tramp-test-temporary-file-directory))
(setf (ert-test-expected-result-type
(ert-get-test 'tramp-test05-expand-file-name-relative))
@@ -4551,6 +4551,11 @@ This does not support external Emacs calls."
(string-equal
"nextcloud" (file-remote-p tramp-test-temporary-file-directory 'method)))
+(defun tramp--test-rclone-p ()
+ "Check, whether the remote host is offered by rclone.
+This requires restrictions of file name syntax."
+ (tramp-rclone-file-name-p tramp-test-temporary-file-directory))
+
(defun tramp--test-rsync-p ()
"Check, whether the rsync method is used.
This does not support special file names."
@@ -4755,7 +4760,9 @@ This requires restrictions of file name syntax."
;; expanded to <TAB>.
(let ((files
(list
- (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
+ (if (or (tramp--test-gvfs-p)
+ (tramp--test-rclone-p)
+ (tramp--test-windows-nt-or-smb-p))
"foo bar baz"
(if (or (tramp--test-adb-p)
(tramp--test-docker-p)
@@ -4781,7 +4788,9 @@ This requires restrictions of file name syntax."
(if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
"!foo!bar!baz!"
"!foo|bar!baz|")
- (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
+ (if (or (tramp--test-gvfs-p)
+ (tramp--test-rclone-p)
+ (tramp--test-windows-nt-or-smb-p))
";foo;bar;baz;"
":foo;bar:baz;")
(unless (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))