diff options
Diffstat (limited to 'lisp/net/tramp-fuse.el')
| -rw-r--r-- | lisp/net/tramp-fuse.el | 214 |
1 files changed, 214 insertions, 0 deletions
diff --git a/lisp/net/tramp-fuse.el b/lisp/net/tramp-fuse.el new file mode 100644 index 00000000000..93b184a36c2 --- /dev/null +++ b/lisp/net/tramp-fuse.el @@ -0,0 +1,214 @@ +;;; tramp-fuse.el --- Tramp access functions for FUSE mounts -*- lexical-binding:t -*- + +;; Copyright (C) 2021 Free Software Foundation, Inc. + +;; Author: Michael Albinus <michael.albinus@gmx.de> +;; Keywords: comm, processes +;; Package: tramp + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; These are helper functions for FUSE file systems. + +;;; Code: + +(require 'tramp) + +;; File name primitives. + +(defun tramp-fuse-handle-delete-directory + (directory &optional recursive trash) + "Like `delete-directory' for Tramp files." + (with-parsed-tramp-file-name (expand-file-name directory) nil + (tramp-flush-directory-properties v localname) + (delete-directory (tramp-fuse-local-file-name directory) recursive trash))) + +(defun tramp-fuse-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-fuse-local-file-name filename) trash) + (tramp-flush-file-properties v localname))) + +(defun tramp-fuse-handle-directory-files + (directory &optional full match nosort count) + "Like `directory-files' for Tramp files." + (unless (file-exists-p directory) + (tramp-compat-file-missing (tramp-dissect-file-name directory) directory)) + (when (file-directory-p directory) + (setq directory (file-name-as-directory (expand-file-name directory))) + (with-parsed-tramp-file-name directory nil + (let ((result + (tramp-compat-directory-files + (tramp-fuse-local-file-name directory) full match nosort count))) + ;; Massage the result. + (when full + (let ((local (concat "^" (regexp-quote (tramp-fuse-mount-point v)))) + (remote (directory-file-name + (funcall + (if (tramp-compat-file-name-quoted-p directory) + #'tramp-compat-file-name-quote #'identity) + (file-remote-p directory))))) + (setq result + (mapcar + (lambda (x) (replace-regexp-in-string local remote x)) + result)))) + ;; Some storage systems do not return "." and "..". + (dolist (item '(".." ".")) + (when (and (string-match-p (or match (regexp-quote item)) item) + (not + (member (if full (setq item (concat directory item)) item) + result))) + (setq result (cons item result)))) + ;; Return result. + (if nosort result (sort result #'string<)))))) + +(defun tramp-fuse-handle-file-attributes (filename &optional id-format) + "Like `file-attributes' for Tramp files." + (with-parsed-tramp-file-name (expand-file-name filename) nil + (with-tramp-file-property + v localname (format "file-attributes-%s" id-format) + (file-attributes (tramp-fuse-local-file-name filename) id-format)))) + +(defun tramp-fuse-handle-file-executable-p (filename) + "Like `file-executable-p' for Tramp files." + (with-parsed-tramp-file-name (expand-file-name filename) nil + (with-tramp-file-property v localname "file-executable-p" + (file-executable-p (tramp-fuse-local-file-name filename))))) + +(defun tramp-fuse-handle-file-name-all-completions (filename directory) + "Like `file-name-all-completions' for Tramp files." + (all-completions + filename + (delete-dups + (append + (file-name-all-completions + filename (tramp-fuse-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-fuse-handle-file-readable-p (filename) + "Like `file-readable-p' for Tramp files." + (with-parsed-tramp-file-name (expand-file-name filename) nil + (with-tramp-file-property v localname "file-readable-p" + (file-readable-p (tramp-fuse-local-file-name filename))))) + +;; This function isn't used. +(defun tramp-fuse-handle-insert-directory + (filename switches &optional wildcard full-directory-p) + "Like `insert-directory' for Tramp files." + (insert-directory + (tramp-fuse-local-file-name filename) switches wildcard full-directory-p) + (goto-char (point-min)) + (while (search-forward (tramp-fuse-local-file-name filename) nil 'noerror) + (replace-match filename))) + +(defun tramp-fuse-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-fuse-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 file cache. + (tramp-flush-file-properties v localname) + (tramp-flush-directory-properties + v (if parents "/" (file-name-directory localname))))) + + +;; File name helper functions. + +(defun tramp-fuse-mount-spec (vec) + "Return local mount spec of VEC." + (if-let ((host (tramp-file-name-host vec)) + (user (tramp-file-name-user vec))) + (format "%s@%s:/" user host) + (format "%s:/" host))) + +(defun tramp-fuse-mount-point (vec) + "Return local mount point of VEC." + (or (tramp-get-connection-property vec "mount-point" nil) + (expand-file-name + (concat + tramp-temp-name-prefix + (tramp-file-name-method vec) "." + (when (tramp-file-name-user vec) + (concat (tramp-file-name-user-domain vec) "@")) + (tramp-file-name-host-port vec)) + (tramp-compat-temporary-file-directory)))) + +(defun tramp-fuse-mounted-p (vec) + "Check, whether fuse volume determined by VEC is mounted." + (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) + (let* ((default-directory (tramp-compat-temporary-file-directory)) + (command (format "mount -t fuse.%s" (tramp-file-name-method vec))) + (mount (shell-command-to-string command))) + (tramp-message vec 6 "%s\n%s" command mount) + (tramp-set-connection-property + (tramp-get-connection-process vec) "mounted" + (when (string-match + (format + "^\\(%s\\)\\s-" (regexp-quote (tramp-fuse-mount-spec vec))) + mount) + (match-string 1 mount))))))) + +(defun tramp-fuse-unmount (vec) + "Unmount fuse volume determined by VEC." + (let ((default-directory (tramp-compat-temporary-file-directory)) + (command (format "fusermount3 -u %s" (tramp-fuse-mount-point vec)))) + (tramp-message vec 6 "%s\n%s" command (shell-command-to-string command)) + (tramp-flush-connection-property + (tramp-get-connection-process vec) "mounted") + ;; Give the caches a chance to expire. + (sleep-for 1))) + +(defun tramp-fuse-local-file-name (filename) + "Return local mount name of FILENAME." + (setq filename (tramp-compat-file-name-unquote (expand-file-name filename))) + (with-parsed-tramp-file-name filename nil + ;; As long as we call `tramp-*-maybe-open-connection' here, + ;; we cache the result. + (with-tramp-file-property v localname "local-file-name" + (funcall + (intern + (format "tramp-%s-maybe-open-connection" (tramp-file-name-method v))) + v) + (let ((quoted (tramp-compat-file-name-quoted-p localname)) + (localname (tramp-compat-file-name-unquote localname))) + (funcall + (if quoted #'tramp-compat-file-name-quote #'identity) + (expand-file-name + (if (file-name-absolute-p localname) + (substring localname 1) localname) + (tramp-fuse-mount-point v))))))) + +(add-hook 'tramp-unload-hook + (lambda () + (unload-feature 'tramp-fuse 'force))) + +(provide 'tramp-fuse) + +;;; tramp-fuse.el ends here |