diff options
| author | Michael Albinus | 2018-11-24 14:01:36 +0100 |
|---|---|---|
| committer | Michael Albinus | 2018-11-24 14:01:36 +0100 |
| commit | a7d9c38da52f413410e17a65d1e90b89edb6cbc4 (patch) | |
| tree | cc5b65b86be9b631f416c1f1ae48eb7693d31e0b | |
| parent | 5f9b29673fa29d27b7c165ecd5bbc7c3c06b138b (diff) | |
| download | emacs-a7d9c38da52f413410e17a65d1e90b89edb6cbc4.tar.gz emacs-a7d9c38da52f413410e17a65d1e90b89edb6cbc4.zip | |
Add Tramp rclone method
* doc/misc/tramp.texi (Top): Remove "History".
(History): Remove node.
(Quick Start Guide): New section "Using rclone".
(External methods) <rclone>: Describe.
* etc/NEWS: Mention Tramp rclone method.
* lisp/net/tramp-rclone.el: New file.
| -rw-r--r-- | doc/misc/tramp.texi | 81 | ||||
| -rw-r--r-- | etc/NEWS | 4 | ||||
| -rw-r--r-- | lisp/net/tramp-rclone.el | 558 |
3 files changed, 616 insertions, 27 deletions
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 5a375b120de..d5a45ad27c6 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi | |||
| @@ -86,7 +86,6 @@ Archive}. | |||
| 86 | For the end user: | 86 | For the end user: |
| 87 | 87 | ||
| 88 | * Obtaining @value{tramp}:: How to obtain @value{tramp}. | 88 | * Obtaining @value{tramp}:: How to obtain @value{tramp}. |
| 89 | * History:: History of @value{tramp}. | ||
| 90 | @ifset installchapter | 89 | @ifset installchapter |
| 91 | * Installation:: Installing @value{tramp} with your Emacs. | 90 | * Installation:: Installing @value{tramp} with your Emacs. |
| 92 | @end ifset | 91 | @end ifset |
| @@ -379,32 +378,6 @@ $ autoconf | |||
| 379 | @end example | 378 | @end example |
| 380 | 379 | ||
| 381 | 380 | ||
| 382 | @node History | ||
| 383 | @chapter History of @value{tramp} | ||
| 384 | @cindex history | ||
| 385 | @cindex development history | ||
| 386 | |||
| 387 | @value{tramp} development started at the end of November 1998 as | ||
| 388 | @file{rssh.el}. It provided only one method of access. It used | ||
| 389 | @command{ssh} for login and @command{scp} to transfer file contents. | ||
| 390 | The name was changed to @file{rcp.el} before it got its present name | ||
| 391 | @value{tramp}. New methods of remote access were added, so was support | ||
| 392 | for version control. | ||
| 393 | |||
| 394 | April 2000 was the first time when multi-hop methods were added. In | ||
| 395 | July 2002, @value{tramp} unified file names with Ange FTP@. In July | ||
| 396 | 2004, proxy hosts replaced multi-hop methods. Running commands on | ||
| 397 | remote hosts was introduced in December 2005. Support for gateways | ||
| 398 | since April 2007 (and removed in December 2016). GVFS integration | ||
| 399 | started in February 2009. Remote commands on MS Windows hosts since | ||
| 400 | September 2011. Ad-hoc multi-hop methods (with a changed syntax) | ||
| 401 | re-enabled in November 2011. In November 2012, added Juergen | ||
| 402 | Hoetzel's @file{tramp-adb.el}. Archive file names are supported since | ||
| 403 | December 2017. | ||
| 404 | |||
| 405 | XEmacs support was stopped in January 2016. Since March 2017, | ||
| 406 | @value{tramp} syntax mandates a method. | ||
| 407 | |||
| 408 | @c Installation chapter is necessary only in case of standalone | 381 | @c Installation chapter is necessary only in case of standalone |
| 409 | @c installation. Text taken from trampinst.texi. | 382 | @c installation. Text taken from trampinst.texi. |
| 410 | @ifset installchapter | 383 | @ifset installchapter |
| @@ -562,6 +535,18 @@ be accessed via the @command{adb} command. No user or host name is | |||
| 562 | needed. The file name syntax is @file{@trampfn{adb,,/path/to/file}}. | 535 | needed. The file name syntax is @file{@trampfn{adb,,/path/to/file}}. |
| 563 | 536 | ||
| 564 | 537 | ||
| 538 | @anchor{Quick Start Guide: @option{rclone} method} | ||
| 539 | @section Using @command{rclone} | ||
| 540 | @cindex method @option{rclone} | ||
| 541 | @cindex @option{rclone} method | ||
| 542 | |||
| 543 | A convenient way to access system storages is the @command{rclone} | ||
| 544 | program. If you have configured a storage in @command{rclone} under a | ||
| 545 | name @samp{storage} (for example), you could access it via the remote | ||
| 546 | file name syntax @file{@trampfn{rclone,storage,/path/to/file}}. User | ||
| 547 | names are not needed. | ||
| 548 | |||
| 549 | |||
| 565 | @node Configuration | 550 | @node Configuration |
| 566 | @chapter Configuring @value{tramp} | 551 | @chapter Configuring @value{tramp} |
| 567 | @cindex configuration | 552 | @cindex configuration |
| @@ -1054,6 +1039,48 @@ specified using @file{device#42} host name syntax or @value{tramp} can | |||
| 1054 | use the default value as declared in @command{adb} command. Port | 1039 | use the default value as declared in @command{adb} command. Port |
| 1055 | numbers are not applicable to Android devices connected through USB@. | 1040 | numbers are not applicable to Android devices connected through USB@. |
| 1056 | 1041 | ||
| 1042 | |||
| 1043 | @item @option{rclone} | ||
| 1044 | @cindex method @option{rclone} | ||
| 1045 | @cindex @option{rclone} method | ||
| 1046 | |||
| 1047 | @vindex tramp-rclone-program | ||
| 1048 | The program @command{rclone} allows to access different system | ||
| 1049 | storages in the cloud, see @url{https://rclone.org/} for a list of | ||
| 1050 | supported systems. If the @command{rclone} program isn't found in | ||
| 1051 | your @env{PATH} environment variable, you can tell Tramp its absolute | ||
| 1052 | path via the user option @code{tramp-rclone-program}. | ||
| 1053 | |||
| 1054 | A system storage must be configured via the @command{rclone config} | ||
| 1055 | command, outside Emacs. If you have configured a storage in | ||
| 1056 | @command{rclone} under a name @samp{storage} (for example), you could | ||
| 1057 | access it via the remote file name | ||
| 1058 | |||
| 1059 | @example | ||
| 1060 | @trampfn{rclone,storage,/path/to/file} | ||
| 1061 | @end example | ||
| 1062 | |||
| 1063 | User names are part of the @command{rclone} configuration, and not | ||
| 1064 | needed in the remote file name. If a user name is contained in the | ||
| 1065 | remote file name, it is ignored. | ||
| 1066 | |||
| 1067 | Internally, Tramp mounts the remote system storage at location | ||
| 1068 | @file{/tmp/tramp.rclone.storage}, with @file{storage} being the name | ||
| 1069 | of the configured system storage. | ||
| 1070 | |||
| 1071 | Optional flags to the different @option{rclone} operations could be | ||
| 1072 | passed as connection property, @xref{Predefined connection | ||
| 1073 | information}. Supported properties are @samp{mount-args}, | ||
| 1074 | @samp{copyto-args} and @samp{moveto-args}. | ||
| 1075 | |||
| 1076 | Access via @option{rclone} is slow. If you have an alternative method | ||
| 1077 | for accessing the system storage, you shall prefer this. @ref{GVFS | ||
| 1078 | based methods} for example, methods @option{gdrive} and | ||
| 1079 | @option{nextcloud}. | ||
| 1080 | |||
| 1081 | @strong{Note}: The @option{rclone} method is experimental, don't use | ||
| 1082 | it in production systems! | ||
| 1083 | |||
| 1057 | @end table | 1084 | @end table |
| 1058 | 1085 | ||
| 1059 | 1086 | ||
| @@ -823,6 +823,10 @@ process. It now accepts signals specified either by name or by its number. | |||
| 823 | or NextCloud hosted files and directories. | 823 | or NextCloud hosted files and directories. |
| 824 | 824 | ||
| 825 | +++ | 825 | +++ |
| 826 | *** New connection method "rclone", which allows to access system | ||
| 827 | storages via the 'rclone' program. This feature is experimental. | ||
| 828 | |||
| 829 | +++ | ||
| 826 | *** Connection methods "obex" and "synce" are removed, because they | 830 | *** Connection methods "obex" and "synce" are removed, because they |
| 827 | are obsoleted in GVFS. | 831 | are obsoleted in GVFS. |
| 828 | 832 | ||
diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el new file mode 100644 index 00000000000..725a6f153ad --- /dev/null +++ b/lisp/net/tramp-rclone.el | |||
| @@ -0,0 +1,558 @@ | |||
| 1 | ;;; tramp-rclone.el --- Tramp access functions to cloud storages -*- lexical-binding:t -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 2018 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: Michael Albinus <michael.albinus@gmx.de> | ||
| 6 | ;; Keywords: comm, processes | ||
| 7 | ;; Package: tramp | ||
| 8 | |||
| 9 | ;; This file is part of GNU Emacs. | ||
| 10 | |||
| 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 12 | ;; it under the terms of the GNU General Public License as published by | ||
| 13 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 14 | ;; (at your option) any later version. | ||
| 15 | |||
| 16 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 19 | ;; GNU General Public License for more details. | ||
| 20 | |||
| 21 | ;; You should have received a copy of the GNU General Public License | ||
| 22 | ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. | ||
| 23 | |||
| 24 | ;;; Commentary: | ||
| 25 | |||
| 26 | ;; rclone is a command line program to sync files and directories to | ||
| 27 | ;; and from cloud storages. Tramp uses its mount utility to access | ||
| 28 | ;; files and directories there. The configuration of rclone for | ||
| 29 | ;; different storage systems is performed outside Tramp, see rclone(1). | ||
| 30 | |||
| 31 | ;; A remote file under rclone control has the form | ||
| 32 | ;; "/rclone:<remote>:/path/to/file". <remote> is the name of a | ||
| 33 | ;; storage system in rclone's configuration. Therefore, such a remote | ||
| 34 | ;; file name does not know any user or port specification. | ||
| 35 | |||
| 36 | ;;; Code: | ||
| 37 | |||
| 38 | (eval-when-compile (require 'cl-lib)) | ||
| 39 | (require 'tramp) | ||
| 40 | |||
| 41 | ;; TODDDDDDDDDO: REPLACE | ||
| 42 | (require 'tramp-gvfs) | ||
| 43 | |||
| 44 | ;;;###tramp-autoload | ||
| 45 | (defconst tramp-rclone-method "rclone" | ||
| 46 | "When this method name is used, forward all calls to rclone mounts.") | ||
| 47 | |||
| 48 | ;;;###tramp-autoload | ||
| 49 | (defcustom tramp-rclone-program "rclone" | ||
| 50 | "Name of the rclone program." | ||
| 51 | :group 'tramp | ||
| 52 | :version "27.1" | ||
| 53 | :type 'string) | ||
| 54 | |||
| 55 | ;;;###tramp-autoload | ||
| 56 | (add-to-list | ||
| 57 | 'tramp-methods | ||
| 58 | `(,tramp-rclone-method | ||
| 59 | (tramp-mount-args nil) | ||
| 60 | (tramp-copyto-args nil) | ||
| 61 | (tramp-moveto-args nil) | ||
| 62 | (tramp-about-args ("--full")))) | ||
| 63 | |||
| 64 | ;;;###tramp-autoload | ||
| 65 | (eval-after-load 'tramp | ||
| 66 | '(tramp-set-completion-function | ||
| 67 | tramp-rclone-method '((tramp-rclone-parse-device-names "")))) | ||
| 68 | |||
| 69 | |||
| 70 | ;; New handlers should be added here. | ||
| 71 | ;;;###tramp-autoload | ||
| 72 | (defconst tramp-rclone-file-name-handler-alist | ||
| 73 | '((access-file . ignore) | ||
| 74 | (add-name-to-file . tramp-handle-add-name-to-file) | ||
| 75 | ;; `byte-compiler-base-file-name' performed by default handler. | ||
| 76 | ;; `copy-directory' performed by default handler. | ||
| 77 | (copy-file . tramp-rclone-handle-copy-file) | ||
| 78 | (delete-directory . tramp-rclone-handle-delete-directory) | ||
| 79 | (delete-file . tramp-rclone-handle-delete-file) | ||
| 80 | ;; `diff-latest-backup-file' performed by default handler. | ||
| 81 | (directory-file-name . tramp-handle-directory-file-name) | ||
| 82 | (directory-files . tramp-rclone-handle-directory-files) | ||
| 83 | (directory-files-and-attributes | ||
| 84 | . tramp-handle-directory-files-and-attributes) | ||
| 85 | (dired-compress-file . ignore) | ||
| 86 | (dired-uncache . tramp-handle-dired-uncache) | ||
| 87 | (exec-path . ignore) | ||
| 88 | ;; `expand-file-name' performed by default handler. | ||
| 89 | (file-accessible-directory-p . tramp-handle-file-accessible-directory-p) | ||
| 90 | (file-acl . ignore) | ||
| 91 | (file-attributes . tramp-rclone-handle-file-attributes) | ||
| 92 | (file-directory-p . tramp-handle-file-directory-p) | ||
| 93 | (file-equal-p . tramp-handle-file-equal-p) | ||
| 94 | (file-executable-p . tramp-rclone-handle-file-executable-p) | ||
| 95 | (file-exists-p . tramp-handle-file-exists-p) | ||
| 96 | (file-in-directory-p . tramp-handle-file-in-directory-p) | ||
| 97 | (file-local-copy . tramp-gvfs-handle-file-local-copy) | ||
| 98 | (file-modes . tramp-handle-file-modes) | ||
| 99 | (file-name-all-completions . tramp-rclone-handle-file-name-all-completions) | ||
| 100 | (file-name-as-directory . tramp-handle-file-name-as-directory) | ||
| 101 | (file-name-case-insensitive-p . tramp-handle-file-name-case-insensitive-p) | ||
| 102 | (file-name-completion . tramp-handle-file-name-completion) | ||
| 103 | (file-name-directory . tramp-handle-file-name-directory) | ||
| 104 | (file-name-nondirectory . tramp-handle-file-name-nondirectory) | ||
| 105 | ;; `file-name-sans-versions' performed by default handler. | ||
| 106 | (file-newer-than-file-p . tramp-handle-file-newer-than-file-p) | ||
| 107 | (file-notify-add-watch . ignore) | ||
| 108 | (file-notify-rm-watch . ignore) | ||
| 109 | (file-notify-valid-p . ignore) | ||
| 110 | (file-ownership-preserved-p . ignore) | ||
| 111 | (file-readable-p . tramp-rclone-handle-file-readable-p) | ||
| 112 | (file-regular-p . tramp-handle-file-regular-p) | ||
| 113 | (file-remote-p . tramp-handle-file-remote-p) | ||
| 114 | (file-selinux-context . tramp-handle-file-selinux-context) | ||
| 115 | (file-symlink-p . tramp-handle-file-symlink-p) | ||
| 116 | (file-system-info . tramp-rclone-handle-file-system-info) | ||
| 117 | (file-truename . tramp-handle-file-truename) | ||
| 118 | (file-writable-p . tramp-gvfs-handle-file-writable-p) | ||
| 119 | (find-backup-file-name . tramp-handle-find-backup-file-name) | ||
| 120 | ;; `get-file-buffer' performed by default handler. | ||
| 121 | (insert-directory . tramp-handle-insert-directory) | ||
| 122 | (insert-file-contents . tramp-handle-insert-file-contents) | ||
| 123 | (load . tramp-handle-load) | ||
| 124 | (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) | ||
| 125 | (make-directory . tramp-rclone-handle-make-directory) | ||
| 126 | (make-directory-internal . ignore) | ||
| 127 | (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) | ||
| 128 | (make-symbolic-link . tramp-handle-make-symbolic-link) | ||
| 129 | (process-file . ignore) | ||
| 130 | (rename-file . tramp-rclone-handle-rename-file) | ||
| 131 | (set-file-acl . ignore) | ||
| 132 | (set-file-modes . ignore) | ||
| 133 | (set-file-selinux-context . ignore) | ||
| 134 | (set-file-times . ignore) | ||
| 135 | (set-visited-file-modtime . tramp-handle-set-visited-file-modtime) | ||
| 136 | (shell-command . ignore) | ||
| 137 | (start-file-process . ignore) | ||
| 138 | (substitute-in-file-name . tramp-handle-substitute-in-file-name) | ||
| 139 | (temporary-file-directory . tramp-handle-temporary-file-directory) | ||
| 140 | (unhandled-file-name-directory . ignore) | ||
| 141 | (vc-registered . ignore) | ||
| 142 | (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime) | ||
| 143 | (write-region . tramp-gvfs-handle-write-region)) | ||
| 144 | "Alist of handler functions for Tramp RCLONE method. | ||
| 145 | Operations not mentioned here will be handled by the default Emacs primitives.") | ||
| 146 | |||
| 147 | ;; It must be a `defsubst' in order to push the whole code into | ||
| 148 | ;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading. | ||
| 149 | ;;;###tramp-autoload | ||
| 150 | (defsubst tramp-rclone-file-name-p (filename) | ||
| 151 | "Check if it's a filename for rclone." | ||
| 152 | (and (tramp-tramp-file-p filename) | ||
| 153 | (string= (tramp-file-name-method (tramp-dissect-file-name filename)) | ||
| 154 | tramp-rclone-method))) | ||
| 155 | |||
| 156 | ;;;###tramp-autoload | ||
| 157 | (defun tramp-rclone-file-name-handler (operation &rest args) | ||
| 158 | "Invoke the rclone handler for OPERATION. | ||
| 159 | First arg specifies the OPERATION, second arg is a list of arguments to | ||
| 160 | pass to the OPERATION." | ||
| 161 | (let ((fn (assoc operation tramp-rclone-file-name-handler-alist))) | ||
| 162 | (if fn | ||
| 163 | (save-match-data (apply (cdr fn) args)) | ||
| 164 | (tramp-run-real-handler operation args)))) | ||
| 165 | |||
| 166 | ;;;###tramp-autoload | ||
| 167 | (tramp-register-foreign-file-name-handler | ||
| 168 | 'tramp-rclone-file-name-p 'tramp-rclone-file-name-handler) | ||
| 169 | |||
| 170 | ;;;###tramp-autoload | ||
| 171 | (defun tramp-rclone-parse-device-names (_ignore) | ||
| 172 | "Return a list of (nil host) tuples allowed to access." | ||
| 173 | (with-timeout (10) | ||
| 174 | (with-temp-buffer | ||
| 175 | ;; `call-process' does not react on timer under MS Windows. | ||
| 176 | ;; That's why we use `start-process'. | ||
| 177 | (let ((p (start-process | ||
| 178 | tramp-rclone-program (current-buffer) | ||
| 179 | tramp-rclone-program "listremotes")) | ||
| 180 | (v (make-tramp-file-name :method tramp-rclone-method)) | ||
| 181 | result) | ||
| 182 | (tramp-message v 6 "%s" (mapconcat 'identity (process-command p) " ")) | ||
| 183 | (process-put p 'adjust-window-size-function 'ignore) | ||
| 184 | (set-process-query-on-exit-flag p nil) | ||
| 185 | (while (process-live-p p) | ||
| 186 | (accept-process-output p 0.1)) | ||
| 187 | (accept-process-output p 0.1) | ||
| 188 | (tramp-message v 6 "\n%s" (buffer-string)) | ||
| 189 | (goto-char (point-min)) | ||
| 190 | (while (search-forward-regexp "^\\(\\S-+\\):$" nil t) | ||
| 191 | (push (list nil (match-string 1)) result)) | ||
| 192 | result)))) | ||
| 193 | |||
| 194 | |||
| 195 | ;; File name primitives. | ||
| 196 | |||
| 197 | (defun tramp-rclone-do-copy-or-rename-file | ||
| 198 | (op filename newname &optional ok-if-already-exists keep-date | ||
| 199 | preserve-uid-gid preserve-extended-attributes) | ||
| 200 | "Copy or rename a remote file. | ||
| 201 | OP must be `copy' or `rename' and indicates the operation to perform. | ||
| 202 | FILENAME specifies the file to copy or rename, NEWNAME is the name of | ||
| 203 | the new file (for copy) or the new name of the file (for rename). | ||
| 204 | OK-IF-ALREADY-EXISTS means don't barf if NEWNAME exists already. | ||
| 205 | KEEP-DATE means to make sure that NEWNAME has the same timestamp | ||
| 206 | as FILENAME. PRESERVE-UID-GID, when non-nil, instructs to keep | ||
| 207 | the uid and gid if both files are on the same host. | ||
| 208 | PRESERVE-EXTENDED-ATTRIBUTES is ignored. | ||
| 209 | |||
| 210 | This function is invoked by `tramp-rclone-handle-copy-file' and | ||
| 211 | `tramp-rclone-handle-rename-file'. It is an error if OP is neither | ||
| 212 | of `copy' and `rename'. FILENAME and NEWNAME must be absolute | ||
| 213 | file names." | ||
| 214 | (unless (memq op '(copy rename)) | ||
| 215 | (error "Unknown operation `%s', must be `copy' or `rename'" op)) | ||
| 216 | |||
| 217 | (setq filename (file-truename filename)) | ||
| 218 | (if (file-directory-p filename) | ||
| 219 | (progn | ||
| 220 | (copy-directory filename newname keep-date t) | ||
| 221 | (when (eq op 'rename) (delete-directory filename 'recursive))) | ||
| 222 | |||
| 223 | (let ((t1 (tramp-tramp-file-p filename)) | ||
| 224 | (t2 (tramp-tramp-file-p newname)) | ||
| 225 | (rclone-operation (if (eq op 'copy) "copyto" "moveto")) | ||
| 226 | (msg-operation (if (eq op 'copy) "Copying" "Renaming"))) | ||
| 227 | |||
| 228 | (with-parsed-tramp-file-name (if t1 filename newname) nil | ||
| 229 | (when (and (not ok-if-already-exists) (file-exists-p newname)) | ||
| 230 | (tramp-error v 'file-already-exists newname)) | ||
| 231 | |||
| 232 | (if (or (and t1 (not (tramp-rclone-file-name-p filename))) | ||
| 233 | (and t2 (not (tramp-rclone-file-name-p newname)))) | ||
| 234 | |||
| 235 | ;; We cannot copy or rename directly. | ||
| 236 | (let ((tmpfile (tramp-compat-make-temp-file filename))) | ||
| 237 | (if (eq op 'copy) | ||
| 238 | (copy-file | ||
| 239 | filename tmpfile t keep-date preserve-uid-gid | ||
| 240 | preserve-extended-attributes) | ||
| 241 | (rename-file filename tmpfile t)) | ||
| 242 | (rename-file tmpfile newname ok-if-already-exists)) | ||
| 243 | |||
| 244 | ;; Direct action. | ||
| 245 | (with-tramp-progress-reporter | ||
| 246 | v 0 (format "%s %s to %s" msg-operation filename newname) | ||
| 247 | (unless (zerop | ||
| 248 | (tramp-rclone-send-command | ||
| 249 | v rclone-operation | ||
| 250 | (tramp-rclone-remote-file-name filename) | ||
| 251 | (tramp-rclone-remote-file-name newname))) | ||
| 252 | (tramp-error | ||
| 253 | v 'file-error | ||
| 254 | "Error %s `%s' `%s'" msg-operation filename newname))) | ||
| 255 | |||
| 256 | (when (and t1 (eq op 'rename)) | ||
| 257 | (with-parsed-tramp-file-name filename v1 | ||
| 258 | (tramp-flush-file-properties | ||
| 259 | v1 (file-name-directory v1-localname)) | ||
| 260 | (tramp-flush-file-properties v1 v1-localname))) | ||
| 261 | |||
| 262 | (when t2 | ||
| 263 | (with-parsed-tramp-file-name newname v2 | ||
| 264 | (tramp-flush-file-properties | ||
| 265 | v2 (file-name-directory v2-localname)) | ||
| 266 | (tramp-flush-file-properties v2 v2-localname) | ||
| 267 | (when (tramp-rclone-file-name-p newname) | ||
| 268 | (tramp-rclone-flush-mount v2))))))))) | ||
| 269 | |||
| 270 | (defun tramp-rclone-handle-copy-file | ||
| 271 | (filename newname &optional ok-if-already-exists keep-date | ||
| 272 | preserve-uid-gid preserve-extended-attributes) | ||
| 273 | "Like `copy-file' for Tramp files." | ||
| 274 | (setq filename (expand-file-name filename)) | ||
| 275 | (setq newname (expand-file-name newname)) | ||
| 276 | ;; At least one file a Tramp file? | ||
| 277 | (if (or (tramp-tramp-file-p filename) | ||
| 278 | (tramp-tramp-file-p newname)) | ||
| 279 | (tramp-rclone-do-copy-or-rename-file | ||
| 280 | 'copy filename newname ok-if-already-exists keep-date | ||
| 281 | preserve-uid-gid preserve-extended-attributes) | ||
| 282 | (tramp-run-real-handler | ||
| 283 | 'copy-file | ||
| 284 | (list filename newname ok-if-already-exists keep-date | ||
| 285 | preserve-uid-gid preserve-extended-attributes)))) | ||
| 286 | |||
| 287 | (defun tramp-rclone-handle-delete-directory | ||
| 288 | (directory &optional recursive trash) | ||
| 289 | "Like `delete-directory' for Tramp files." | ||
| 290 | (with-parsed-tramp-file-name (expand-file-name directory) nil | ||
| 291 | (tramp-flush-file-properties v (file-name-directory localname)) | ||
| 292 | (tramp-flush-directory-properties v localname) | ||
| 293 | (delete-directory | ||
| 294 | (tramp-rclone-local-file-name directory) recursive trash))) | ||
| 295 | |||
| 296 | (defun tramp-rclone-handle-delete-file (filename &optional trash) | ||
| 297 | "Like `delete-file' for Tramp files." | ||
| 298 | (with-parsed-tramp-file-name (expand-file-name filename) nil | ||
| 299 | (tramp-flush-file-properties v (file-name-directory localname)) | ||
| 300 | (tramp-flush-file-properties v localname) | ||
| 301 | (delete-file (tramp-rclone-local-file-name filename) trash))) | ||
| 302 | |||
| 303 | (defun tramp-rclone-handle-directory-files | ||
| 304 | (directory &optional full match nosort) | ||
| 305 | "Like `directory-files' for Tramp files." | ||
| 306 | (when (file-directory-p directory) | ||
| 307 | (setq directory (file-name-as-directory (expand-file-name directory))) | ||
| 308 | (with-parsed-tramp-file-name directory nil | ||
| 309 | (let ((result | ||
| 310 | (directory-files | ||
| 311 | (tramp-rclone-local-file-name directory) full match))) | ||
| 312 | ;; Massage the result. | ||
| 313 | (when full | ||
| 314 | (let* ((quoted (file-name-quoted-p directory)) | ||
| 315 | (local | ||
| 316 | (concat "^" (regexp-quote (tramp-rclone-mount-point v)))) | ||
| 317 | (remote | ||
| 318 | (funcall (if quoted 'file-name-quote 'identity) | ||
| 319 | (file-remote-p directory)))) | ||
| 320 | (setq result | ||
| 321 | (mapcar | ||
| 322 | (lambda (x) (replace-regexp-in-string local remote x)) | ||
| 323 | result)))) | ||
| 324 | ;; Some storage systems do not return "." and "..". | ||
| 325 | (dolist (item '(".." ".")) | ||
| 326 | (when (and (string-match-p (or match (regexp-quote item)) item) | ||
| 327 | (not | ||
| 328 | (member (if full (setq item (concat directory item)) item) | ||
| 329 | result))) | ||
| 330 | (setq result (cons item result)))) | ||
| 331 | ;; Return result. | ||
| 332 | (if nosort result (sort result 'string<)))))) | ||
| 333 | |||
| 334 | (defun tramp-rclone-handle-file-attributes (filename &optional id-format) | ||
| 335 | "Like `file-attributes' for Tramp files." | ||
| 336 | (with-parsed-tramp-file-name (expand-file-name filename) nil | ||
| 337 | (with-tramp-file-property | ||
| 338 | v localname (format "file-attributes-%s" id-format) | ||
| 339 | (file-attributes (tramp-rclone-local-file-name filename) id-format)))) | ||
| 340 | |||
| 341 | (defun tramp-rclone-handle-file-executable-p (filename) | ||
| 342 | "Like `file-executable-p' for Tramp files." | ||
| 343 | (file-executable-p (tramp-rclone-local-file-name filename))) | ||
| 344 | |||
| 345 | (defun tramp-rclone-handle-file-name-all-completions (filename directory) | ||
| 346 | "Like `file-name-all-completions' for Tramp files." | ||
| 347 | (file-name-all-completions filename (tramp-rclone-local-file-name directory))) | ||
| 348 | |||
| 349 | (defun tramp-rclone-handle-file-readable-p (filename) | ||
| 350 | "Like `file-readable-p' for Tramp files." | ||
| 351 | (file-readable-p (tramp-rclone-local-file-name filename))) | ||
| 352 | |||
| 353 | (defun tramp-rclone-handle-file-system-info (filename) | ||
| 354 | "Like `file-system-info' for Tramp files." | ||
| 355 | (ignore-errors | ||
| 356 | (unless (file-directory-p filename) | ||
| 357 | (setq filename (file-name-directory filename))) | ||
| 358 | (with-parsed-tramp-file-name (expand-file-name filename) nil | ||
| 359 | (tramp-message v 5 "file system info: %s" localname) | ||
| 360 | (tramp-rclone-send-command v "about" (concat host ":")) | ||
| 361 | (with-current-buffer (tramp-get-connection-buffer v) | ||
| 362 | (let (total used free) | ||
| 363 | (goto-char (point-min)) | ||
| 364 | (while (not (eobp)) | ||
| 365 | (when (looking-at "Total: [[:space:]]+\\([[:digit:]]+\\)") | ||
| 366 | (setq total (string-to-number (match-string 1)))) | ||
| 367 | (when (looking-at "Used: [[:space:]]+\\([[:digit:]]+\\)") | ||
| 368 | (setq used (string-to-number (match-string 1)))) | ||
| 369 | (when (looking-at "Free: [[:space:]]+\\([[:digit:]]+\\)") | ||
| 370 | (setq free (string-to-number (match-string 1)))) | ||
| 371 | (forward-line)) | ||
| 372 | (when used | ||
| 373 | ;; The used number of bytes is not part of the result. As | ||
| 374 | ;; side effect, we store it as file property. | ||
| 375 | (tramp-set-file-property v localname "used-bytes" used)) | ||
| 376 | ;; Result. | ||
| 377 | (when (and total free) | ||
| 378 | (list total free (- total free)))))))) | ||
| 379 | |||
| 380 | (defun tramp-rclone-handle-insert-directory | ||
| 381 | (filename switches &optional wildcard full-directory-p) | ||
| 382 | "Like `insert-directory' for Tramp files." | ||
| 383 | (insert-directory | ||
| 384 | (tramp-rclone-local-file-name filename) switches wildcard full-directory-p) | ||
| 385 | (goto-char (point-min)) | ||
| 386 | (while (search-forward (tramp-rclone-local-file-name filename) nil 'noerror) | ||
| 387 | (replace-match filename))) | ||
| 388 | |||
| 389 | (defun tramp-rclone-handle-insert-file-contents | ||
| 390 | (filename &optional visit beg end replace) | ||
| 391 | "Like `insert-file-contents' for Tramp files." | ||
| 392 | (let ((result | ||
| 393 | (insert-file-contents | ||
| 394 | (tramp-rclone-local-file-name filename) visit beg end replace))) | ||
| 395 | (prog1 | ||
| 396 | (list (expand-file-name filename) | ||
| 397 | (cadr result)) | ||
| 398 | (when visit (setq buffer-file-name filename))))) | ||
| 399 | |||
| 400 | (defun tramp-rclone-handle-make-directory (dir &optional parents) | ||
| 401 | "Like `make-directory' for Tramp files." | ||
| 402 | (with-parsed-tramp-file-name (expand-file-name dir) nil | ||
| 403 | ;; When PARENTS is non-nil, DIR could be a chain of non-existent | ||
| 404 | ;; directories a/b/c/... Instead of checking, we simply flush the | ||
| 405 | ;; whole cache. | ||
| 406 | (tramp-flush-file-properties v localname) | ||
| 407 | (tramp-flush-directory-properties | ||
| 408 | v (if parents "/" (file-name-directory localname))) | ||
| 409 | (make-directory (tramp-rclone-local-file-name dir) parents))) | ||
| 410 | |||
| 411 | (defun tramp-rclone-handle-rename-file | ||
| 412 | (filename newname &optional ok-if-already-exists) | ||
| 413 | "Like `rename-file' for Tramp files." | ||
| 414 | (setq filename (expand-file-name filename)) | ||
| 415 | (setq newname (expand-file-name newname)) | ||
| 416 | ;; At least one file a Tramp file? | ||
| 417 | (if (or (tramp-tramp-file-p filename) | ||
| 418 | (tramp-tramp-file-p newname)) | ||
| 419 | (tramp-rclone-do-copy-or-rename-file | ||
| 420 | 'rename filename newname ok-if-already-exists | ||
| 421 | 'keep-date 'preserve-uid-gid) | ||
| 422 | (tramp-run-real-handler | ||
| 423 | 'rename-file (list filename newname ok-if-already-exists)))) | ||
| 424 | |||
| 425 | |||
| 426 | ;; File name conversions. | ||
| 427 | |||
| 428 | (defun tramp-rclone-mount-point (vec) | ||
| 429 | "Return local mount point of VEC." | ||
| 430 | (expand-file-name | ||
| 431 | (concat | ||
| 432 | tramp-temp-name-prefix (tramp-file-name-method vec) | ||
| 433 | "." (tramp-file-name-host vec)) | ||
| 434 | (tramp-compat-temporary-file-directory))) | ||
| 435 | |||
| 436 | (defun tramp-rclone-mounted-p (vec) | ||
| 437 | "Check, whether storage system determined by VEC is mounted." | ||
| 438 | (or | ||
| 439 | ;; We set this property at the end of | ||
| 440 | ;; `tramp-rclone-maybe-open-connection'. Let's use it as | ||
| 441 | ;; indicator. | ||
| 442 | (tramp-get-connection-property vec "uid-integer" nil) | ||
| 443 | ;; If it is mounted, "." is not shown. If the endpoint is not | ||
| 444 | ;; connected, `directory-files' returns an error. | ||
| 445 | (ignore-errors | ||
| 446 | (not (member "." (directory-files (tramp-rclone-mount-point vec))))))) | ||
| 447 | |||
| 448 | (defun tramp-rclone-flush-mount (vec) | ||
| 449 | "Flush directory cache of VEC mount." | ||
| 450 | (let ((rclone-pid | ||
| 451 | ;; Identify rclone process. | ||
| 452 | (with-tramp-file-property vec "/" "rclone-pid" | ||
| 453 | (catch 'pid | ||
| 454 | (dolist (pid (list-system-processes)) ;; "pidof rclone" ? | ||
| 455 | (and (string-match | ||
| 456 | (regexp-quote | ||
| 457 | (format "rclone mount %s:" (tramp-file-name-host vec))) | ||
| 458 | (or (cdr (assoc 'args (process-attributes pid))) "")) | ||
| 459 | (throw 'pid pid))))))) | ||
| 460 | ;; Send a SIGHUP in order to flush directory caches. | ||
| 461 | (when rclone-pid | ||
| 462 | (tramp-message | ||
| 463 | vec 6 "Send SIGHUP %d: %s" | ||
| 464 | rclone-pid (cdr (assoc 'args (process-attributes rclone-pid)))) | ||
| 465 | (signal-process rclone-pid 'SIGHUP)))) | ||
| 466 | |||
| 467 | (defun tramp-rclone-local-file-name (filename) | ||
| 468 | "Return local mount name of FILENAME." | ||
| 469 | (with-parsed-tramp-file-name (expand-file-name filename) nil | ||
| 470 | ;; As long as we call `tramp-rclone-maybe-open-connection' here, | ||
| 471 | ;; we cache the result. | ||
| 472 | (with-tramp-file-property v localname "local-file-name" | ||
| 473 | (tramp-rclone-maybe-open-connection v) | ||
| 474 | (let ((quoted (file-name-quoted-p localname)) | ||
| 475 | (localname (file-name-unquote localname))) | ||
| 476 | (funcall | ||
| 477 | (if quoted 'file-name-quote 'identity) | ||
| 478 | (expand-file-name | ||
| 479 | (if (file-name-absolute-p localname) | ||
| 480 | (substring localname 1) localname) | ||
| 481 | (tramp-rclone-mount-point v))))))) | ||
| 482 | |||
| 483 | (defun tramp-rclone-remote-file-name (filename) | ||
| 484 | "Return FILENAME as used in the `rclone' command." | ||
| 485 | (setq filename (file-name-unquote (expand-file-name filename))) | ||
| 486 | (if (tramp-rclone-file-name-p filename) | ||
| 487 | (with-parsed-tramp-file-name filename nil | ||
| 488 | ;; TODO: This shall be handled by `expand-file-name'. | ||
| 489 | (setq localname (replace-regexp-in-string "^\\." "" (or localname ""))) | ||
| 490 | (format "%s:%s" host localname)) | ||
| 491 | filename)) | ||
| 492 | |||
| 493 | (defun tramp-rclone-maybe-open-connection (vec) | ||
| 494 | "Maybe open a connection VEC. | ||
| 495 | Does not do anything if a connection is already open, but re-opens the | ||
| 496 | connection if a previous connection has died for some reason." | ||
| 497 | (unless (or (null non-essential) (tramp-rclone-mounted-p vec)) | ||
| 498 | (let ((host (tramp-file-name-host vec))) | ||
| 499 | (if (zerop (length host)) | ||
| 500 | (tramp-error vec 'file-error "Storage %s not connected" host)) | ||
| 501 | (with-tramp-progress-reporter vec 3 "Mounting rclone storage" | ||
| 502 | (unless (file-directory-p (tramp-rclone-mount-point vec)) | ||
| 503 | (make-directory (tramp-rclone-mount-point vec) 'parents)) | ||
| 504 | (let* ((buf (tramp-get-connection-buffer vec)) | ||
| 505 | (coding-system-for-read 'utf-8-dos) ;is this correct? | ||
| 506 | (process-connection-type tramp-process-connection-type) | ||
| 507 | (args `("mount" ,(concat host ":") | ||
| 508 | ,(tramp-rclone-mount-point vec) | ||
| 509 | ,(tramp-get-method-parameter vec 'tramp-mount-args))) | ||
| 510 | (p (let ((default-directory | ||
| 511 | (tramp-compat-temporary-file-directory))) | ||
| 512 | (apply 'start-process (tramp-get-connection-name vec) buf | ||
| 513 | tramp-rclone-program (delq nil args))))) | ||
| 514 | (tramp-message | ||
| 515 | vec 6 "%s" (mapconcat 'identity (process-command p) " ")) | ||
| 516 | (process-put p 'adjust-window-size-function 'ignore) | ||
| 517 | (set-process-query-on-exit-flag p nil) | ||
| 518 | |||
| 519 | ;; Set connection-local variables. | ||
| 520 | (tramp-set-connection-local-variables vec))))) | ||
| 521 | |||
| 522 | ;; In `tramp-check-cached-permissions', the connection properties | ||
| 523 | ;; {uig,gid}-{integer,string} are used. We set them to proper values. | ||
| 524 | (unless (tramp-get-connection-property vec "uid-integer" nil) | ||
| 525 | (tramp-set-connection-property | ||
| 526 | vec "uid-integer" (tramp-get-local-uid 'integer)) | ||
| 527 | (tramp-set-connection-property | ||
| 528 | vec "gid-integer" (tramp-get-local-gid 'integer)) | ||
| 529 | (tramp-set-connection-property | ||
| 530 | vec "uid-string" (tramp-get-local-uid 'string)) | ||
| 531 | (tramp-set-connection-property | ||
| 532 | vec "gid-string" (tramp-get-local-gid 'string)))) | ||
| 533 | |||
| 534 | (defun tramp-rclone-send-command (vec &rest args) | ||
| 535 | "Send the COMMAND to connection VEC." | ||
| 536 | ; (tramp-rclone-maybe-open-connection vec) | ||
| 537 | (with-current-buffer (tramp-get-connection-buffer vec) | ||
| 538 | (erase-buffer) | ||
| 539 | (let ((flags (tramp-get-method-parameter | ||
| 540 | vec (intern (format "tramp-%s-args" (car args)))))) | ||
| 541 | (apply 'tramp-call-process | ||
| 542 | vec tramp-rclone-program nil t nil (append args flags))))) | ||
| 543 | |||
| 544 | (add-hook 'tramp-unload-hook | ||
| 545 | (lambda () | ||
| 546 | (unload-feature 'tramp-rclone 'force))) | ||
| 547 | |||
| 548 | (provide 'tramp-rclone) | ||
| 549 | |||
| 550 | ;;; TODO: | ||
| 551 | |||
| 552 | ;; * Refactor tramp-gvfs.el in order to move used functions to | ||
| 553 | ;; tramp.el. | ||
| 554 | ;; | ||
| 555 | ;; * If possible, get rid of rclone mount. Maybe it is more | ||
| 556 | ;; performant then. | ||
| 557 | |||
| 558 | ;;; tramp-rclone.el ends here | ||