mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-12 17:10:43 -08:00
ecf08f0621
dc4e6b1329; Update copyright years in more files64b3777631; Run set-copyright from admin.el8e1c56ae46; Add 2024 to copyright years # Conflicts: # doc/misc/modus-themes.org # doc/misc/texinfo.tex # etc/NEWS # etc/refcards/ru-refcard.tex # etc/themes/modus-operandi-theme.el # etc/themes/modus-themes.el # etc/themes/modus-vivendi-theme.el # lib/alloca.in.h # lib/binary-io.h # lib/c-ctype.h # lib/c-strcasecmp.c # lib/c-strncasecmp.c # lib/careadlinkat.c # lib/cloexec.c # lib/close-stream.c # lib/diffseq.h # lib/dup2.c # lib/filemode.h # lib/fpending.c # lib/fpending.h # lib/fsusage.c # lib/getgroups.c # lib/getloadavg.c # lib/gettext.h # lib/gettime.c # lib/gettimeofday.c # lib/group-member.c # lib/malloc.c # lib/md5-stream.c # lib/md5.c # lib/md5.h # lib/memmem.c # lib/memrchr.c # lib/nanosleep.c # lib/save-cwd.h # lib/sha1.c # lib/sig2str.c # lib/stdlib.in.h # lib/strtoimax.c # lib/strtol.c # lib/strtoll.c # lib/time_r.c # lib/xalloc-oversized.h # lisp/auth-source-pass.el # lisp/emacs-lisp/lisp-mnt.el # lisp/emacs-lisp/timer.el # lisp/info-look.el # lisp/jit-lock.el # lisp/loadhist.el # lisp/mail/rmail.el # lisp/net/ntlm.el # lisp/net/webjump.el # lisp/progmodes/asm-mode.el # lisp/progmodes/project.el # lisp/progmodes/sh-script.el # lisp/textmodes/flyspell.el # lisp/textmodes/reftex-toc.el # lisp/textmodes/reftex.el # lisp/textmodes/tex-mode.el # lisp/url/url-gw.el # m4/alloca.m4 # m4/clock_time.m4 # m4/d-type.m4 # m4/dirent_h.m4 # m4/dup2.m4 # m4/euidaccess.m4 # m4/fchmodat.m4 # m4/filemode.m4 # m4/fsusage.m4 # m4/getgroups.m4 # m4/getloadavg.m4 # m4/getrandom.m4 # m4/gettime.m4 # m4/gettimeofday.m4 # m4/gnulib-common.m4 # m4/group-member.m4 # m4/inttypes.m4 # m4/malloc.m4 # m4/manywarnings.m4 # m4/mempcpy.m4 # m4/memrchr.m4 # m4/mkostemp.m4 # m4/mktime.m4 # m4/nproc.m4 # m4/nstrftime.m4 # m4/pathmax.m4 # m4/pipe2.m4 # m4/pselect.m4 # m4/pthread_sigmask.m4 # m4/readlink.m4 # m4/realloc.m4 # m4/sig2str.m4 # m4/ssize_t.m4 # m4/stat-time.m4 # m4/stddef_h.m4 # m4/stdint.m4 # m4/stdio_h.m4 # m4/stdlib_h.m4 # m4/stpcpy.m4 # m4/strnlen.m4 # m4/strtoimax.m4 # m4/strtoll.m4 # m4/time_h.m4 # m4/timegm.m4 # m4/timer_time.m4 # m4/timespec.m4 # m4/unistd_h.m4 # m4/warnings.m4 # nt/configure.bat # nt/preprep.c # test/lisp/register-tests.el
269 lines
9.8 KiB
EmacsLisp
269 lines
9.8 KiB
EmacsLisp
;;; tramp-fuse.el --- Tramp access functions for FUSE mounts -*- lexical-binding:t -*-
|
||
|
||
;; Copyright (C) 2021-2024 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."
|
||
(tramp-skeleton-delete-directory directory recursive trash
|
||
(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."
|
||
(tramp-skeleton-delete-file filename trash
|
||
(delete-file (tramp-fuse-local-file-name filename) trash)))
|
||
|
||
(defvar tramp-fuse-remove-hidden-files nil
|
||
"Remove hidden files from directory listings.")
|
||
|
||
(defsubst tramp-fuse-remove-hidden-files (files)
|
||
"Remove hidden files from FILES."
|
||
(if tramp-fuse-remove-hidden-files
|
||
(cl-remove-if
|
||
(lambda (x) (and (stringp x) (string-match-p (rx ".fuse_hidden") x)))
|
||
files)
|
||
files))
|
||
|
||
(defun tramp-fuse-handle-directory-files
|
||
(directory &optional full match nosort count)
|
||
"Like `directory-files' for Tramp files."
|
||
(let ((result
|
||
(tramp-skeleton-directory-files directory full match nosort count
|
||
;; Some storage systems do not return "." and "..".
|
||
(delete-dups
|
||
(append
|
||
'("." "..")
|
||
(tramp-fuse-remove-hidden-files
|
||
(tramp-compat-directory-files
|
||
(tramp-fuse-local-file-name directory))))))))
|
||
(if full
|
||
;; Massage the result.
|
||
(let ((local (rx
|
||
bol
|
||
(literal
|
||
(tramp-fuse-mount-point
|
||
(tramp-dissect-file-name directory)))))
|
||
(remote (directory-file-name
|
||
(funcall
|
||
(if (file-name-quoted-p directory)
|
||
#'file-name-quote #'identity)
|
||
(file-remote-p directory)))))
|
||
(mapcar
|
||
(lambda (x) (replace-regexp-in-string local remote x))
|
||
result))
|
||
result)))
|
||
|
||
(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-exists-p (filename)
|
||
"Like `file-exists-p' for Tramp files."
|
||
(tramp-skeleton-file-exists-p filename
|
||
(file-exists-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."
|
||
(tramp-skeleton-file-name-all-completions filename directory
|
||
(tramp-fuse-remove-hidden-files
|
||
(all-completions
|
||
filename
|
||
(file-name-all-completions
|
||
filename (tramp-fuse-local-file-name directory))))))
|
||
|
||
;; 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."
|
||
(tramp-skeleton-make-directory dir parents
|
||
(make-directory (tramp-fuse-local-file-name dir) parents)))
|
||
|
||
|
||
;; 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)))
|
||
|
||
(defconst tramp-fuse-mount-timeout
|
||
(eval (car (get 'remote-file-name-inhibit-cache 'standard-value)) t)
|
||
"Time period to check whether the mount point still exists.
|
||
It has the same meaning as `remote-file-name-inhibit-cache'.")
|
||
|
||
(defun tramp-fuse-mount-point (vec)
|
||
"Return local mount point of VEC."
|
||
(let ((remote-file-name-inhibit-cache tramp-fuse-mount-timeout))
|
||
(or (tramp-get-file-property vec "/" "mount-point")
|
||
(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."
|
||
;; Remember the mount status by using a file property on "/",
|
||
;; instead of using a connection property, because a file property
|
||
;; has a timeout. Having a timeout lets us regularly recheck the
|
||
;; mount status, as requested by `tramp-fuse-mount-timeout'. We
|
||
;; cannot use `with-tramp-file-property', because we don't want to
|
||
;; cache a nil result.
|
||
(let ((remote-file-name-inhibit-cache tramp-fuse-mount-timeout))
|
||
(or (tramp-get-file-property vec "/" "mounted")
|
||
(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))
|
||
(mount-spec (split-string (tramp-fuse-mount-spec vec) ":" 'omit)))
|
||
(tramp-message vec 6 "%s\n%s" command mount)
|
||
;; The mount-spec contains a trailing local file name part,
|
||
;; which might not be visible, for example with rclone
|
||
;; mounts of type "memory" or "gdrive". Make it optional.
|
||
(setq mount-spec
|
||
(if (cdr mount-spec)
|
||
(rx (literal (car mount-spec))
|
||
":" (? (literal (cadr mount-spec))))
|
||
(car mount-spec)))
|
||
(tramp-set-file-property
|
||
vec "/" "mounted"
|
||
(when (string-match
|
||
(rx bol (group (regexp mount-spec))
|
||
" on " (group (+ (not blank))) blank)
|
||
mount)
|
||
(tramp-set-file-property
|
||
vec "/" "mount-point" (match-string 2 mount))
|
||
(match-string 1 mount)))))))
|
||
|
||
(defun tramp-fuse-get-fusermount ()
|
||
"Determine the local `fusermount' command."
|
||
;; We use key nil for local connection properties.
|
||
(with-tramp-connection-property nil "fusermount"
|
||
(or (executable-find "fusermount3")
|
||
(executable-find "fusermount"))))
|
||
|
||
(defvar tramp-fuse-mount-points nil
|
||
"List of fuse volume determined by a VEC.")
|
||
|
||
(defun tramp-fuse-unmount (vec)
|
||
"Unmount fuse volume determined by VEC."
|
||
(let* ((default-directory tramp-compat-temporary-file-directory)
|
||
(mount-point (tramp-fuse-mount-point vec))
|
||
(command (format "%s -u %s" (tramp-fuse-get-fusermount) mount-point)))
|
||
(tramp-message vec 6 "%s\n%s" command (shell-command-to-string command))
|
||
(tramp-flush-file-property vec "/" "mounted")
|
||
(tramp-flush-file-property vec "/" "mount-point")
|
||
(setq tramp-fuse-mount-points
|
||
(delete (tramp-file-name-unify vec) tramp-fuse-mount-points))
|
||
;; Give the caches a chance to expire.
|
||
(sleep-for 1)
|
||
(when (tramp-compat-directory-empty-p mount-point)
|
||
(delete-directory mount-point))))
|
||
|
||
(defun tramp-fuse-local-file-name (filename)
|
||
"Return local mount name of FILENAME."
|
||
(setq filename (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 (file-name-quoted-p localname))
|
||
(localname (file-name-unquote localname)))
|
||
(funcall
|
||
(if quoted #'file-name-quote #'identity)
|
||
(expand-file-name
|
||
(if (file-name-absolute-p localname)
|
||
(substring localname 1) localname)
|
||
(tramp-fuse-mount-point v)))))))
|
||
|
||
(defcustom tramp-fuse-unmount-on-cleanup nil
|
||
"Whether fuse volumes shall be unmounted on cleanup."
|
||
:group 'tramp
|
||
:version "28.1"
|
||
:type 'boolean)
|
||
|
||
(defun tramp-fuse-cleanup (vec)
|
||
"Cleanup fuse volume determined by VEC."
|
||
(and tramp-fuse-unmount-on-cleanup
|
||
(member (tramp-file-name-unify vec) tramp-fuse-mount-points)
|
||
(tramp-fuse-unmount vec)))
|
||
|
||
(defun tramp-fuse-cleanup-all ()
|
||
"Unmount all fuse volumes used by Tramp."
|
||
(and tramp-fuse-unmount-on-cleanup
|
||
(mapc #'tramp-fuse-unmount tramp-fuse-mount-points)))
|
||
|
||
;; Add cleanup hooks.
|
||
(add-hook 'tramp-cleanup-connection-hook #'tramp-fuse-cleanup)
|
||
(add-hook 'tramp-cleanup-all-connections-hook #'tramp-fuse-cleanup-all)
|
||
(add-hook 'kill-emacs-hook #'tramp-fuse-cleanup-all)
|
||
(add-hook 'tramp-fuse-unload-hook
|
||
(lambda ()
|
||
(remove-hook 'tramp-cleanup-connection-hook
|
||
#'tramp-fuse-cleanup)
|
||
(remove-hook 'tramp-cleanup-all-connections-hook
|
||
#'tramp-fuse-cleanup-all)
|
||
(remove-hook 'kill-emacs-hook
|
||
#'tramp-fuse-cleanup-all)))
|
||
|
||
(add-hook 'tramp-unload-hook
|
||
(lambda ()
|
||
(unload-feature 'tramp-fuse 'force)))
|
||
|
||
(provide 'tramp-fuse)
|
||
|
||
;;; tramp-fuse.el ends here
|