mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-06 14:30:50 -08:00
Code Issues Projects Releases Wiki Activity
emacs/lisp/net/tramp-fuse.el
Michael Albinus 10991877c8 Sync with Tramp 2.7.3-pre 
* doc/misc/tramp.texi: Use @dots{} where appropriate.
(External methods): Precise remark on rsync speed.
(Customizing Methods): Add incus-tramp.
(Password handling): Mention expiration of cached passwords when a
session timeout happens.
(Predefined connection information): Mention also "androidsu" as
special case of "tmpdir".
(Ad-hoc multi-hops, Frequently Asked Questions):
Improve description how ad-hoc multi-hop file names can be made
persistent.  (Bug#65039, Bug#76457)
(Remote processes): Signals are not delivered to remote direct
async processes.  Say, that there are restrictions for transfer of
binary data to remote direct async processes.
(Bug Reports): Explain bisecting.
(Frequently Asked Questions): Improve index.  Speak about
fingerprint readers.  Recommend `small-temporary-file-directory'
for ssh sockets.
(External packages): Rename subsection "Timers, process filters,
process sentinels, redisplay".
(Extension packages): New node.
(Top, Files directories and localnames): Add it to @menu.

* doc/misc/trampver.texi:
* lisp/net/trampver.el (tramp-version): Adapt Tramp versions.
(tramp-repository-branch, tramp-repository-version):
Remove ;;;###tramp-autoload cookie.

* lisp/net/tramp-adb.el:
* lisp/net/tramp-androidsu.el:
* lisp/net/tramp-cache.el:
* lisp/net/tramp-cmds.el:
* lisp/net/tramp-compat.el:
* lisp/net/tramp-container.el:
* lisp/net/tramp-crypt.el:
* lisp/net/tramp-ftp.el:
* lisp/net/tramp-fuse.el:
* lisp/net/tramp-gvfs.el:
* lisp/net/tramp-integration.el:
* lisp/net/tramp-message.el:
* lisp/net/tramp-rclone.el:
* lisp/net/tramp-sh.el:
* lisp/net/tramp-smb.el:
* lisp/net/tramp-sshfs.el:
* lisp/net/tramp-sudoedit.el:
* lisp/net/tramp.el: Use `when-let*', `if-let*' and `and-let*'
consequently.  (Bug#73441)

* lisp/net/tramp-adb.el (tramp-adb-maybe-open-connection):
Move setting of sentinel up.

* lisp/net/tramp-archive.el (tramp-archive-file-name-p):
Add ;;;###tramp-autoload cookie.
(tramp-archive-local-file-name): New defun.

* lisp/net/tramp-cache.el (tramp-connection-properties): Add link
to the Tramp manual in the docstring.
(tramp-get-connection-property, tramp-set-connection-property):
Don't raise a debug message for the `tramp-cache-version' key.
(with-tramp-saved-connection-property)
(with-tramp-saved-connection-properties): Add traces.
(tramp-dump-connection-properties): Don't save connection property
"pw-spec".

* lisp/net/tramp-cmds.el (tramp-repository-branch)
(tramp-repository-version): Declare.

* lisp/net/tramp-gvfs.el (tramp-gvfs-do-copy-or-rename-file):
(tramp-gvfs-do-copy-or-rename-file): Don't use the truename.
Handle symlinks.
(tramp-gvfs-local-file-name): New defun.

* lisp/net/tramp-message.el (tramp-repository-branch)
(tramp-repository-version): Declare.
(tramp-error-with-buffer, tramp-user-error): Don't redisplay in
`sit-for'.  (Bug#73718)
(tramp-warning): Fix `lwarn' call.

* lisp/net/tramp.el (tramp-read-passwd):
* lisp/net/tramp-sh.el (tramp-maybe-open-connection):
* lisp/net/tramp-sudoedit.el (tramp-sudoedit-send-command):
Rename connection property "password-vector" to "pw-vector".

* lisp/net/tramp-sh.el (tramp-methods) <pscp, psftp>:
Adapt `tramp-copy-args' argument.
(tramp-get-remote-pipe-buf, tramp-actions-before-shell):
Use `tramp-fingerprint-prompt-regexp'.
(tramp-sh-handle-copy-directory):
Apply `tramp-do-copy-or-rename-file-directly' if possible.
(tramp-do-copy-or-rename-file): Refactor.  Handle symlinks.
(Bug#76678)
(tramp-plink-option-exists-p): New defun.
(tramp-ssh-or-plink-options): Rename from
`tramp-ssh-controlmaster-options'.  Adapt further plink options.
(tramp-do-copy-or-rename-file-out-of-band)
(tramp-maybe-open-connection): Adapt calls.
(tramp-sh-handle-make-process): Don't set connection property
"remote-pid", it's unused.
(tramp-sh-handle-process-file): Do proper quoting.
(tramp-vc-file-name-handler): Add `file-directory-p', which is
used in `vc-find-root'.  (Bug#74026)
(tramp-maybe-open-connection): Use connection property "hop-vector".
(tramp-get-remote-pipe-buf): Make it more robust.

* lisp/net/tramp-smb.el (tramp-smb-errors): Add string.
(tramp-smb-handle-copy-directory): Don't check existence of
DIRNAME, this is done in `tramp-skeleton-copy-directory' already.
(tramp-smb-handle-copy-file, tramp-smb-handle-rename-file): Refactor.

* lisp/net/tramp-sshfs.el (tramp-sshfs-handle-process-file):
STDERR is not implemented.

* lisp/net/tramp-sudoedit.el (tramp-sudoedit-do-copy-or-rename-file):
Don't use the truename.  Handle symlinks.

* lisp/net/tramp.el (tramp-mode): Set to nil on MS-DOS.
(tramp-otp-password-prompt-regexp): Add TACC HPC prompt.
(tramp-wrong-passwd-regexp): Add fingerprint messages.
(tramp-fingerprint-prompt-regexp, tramp-use-fingerprint):
New defcustoms.
(tramp-string-empty-or-nil-p):
Declare `tramp-suppress-trace' property.
(tramp-barf-if-file-missing): Accept also symlinks.
(tramp-skeleton-file-exists-p)
(tramp-handle-file-directory-p): Protect against cyclic symlinks.
(tramp-skeleton-make-symbolic-link): Drop volume letter when flushing.
(tramp-skeleton-process-file): Raise a warning if STDERR is not
implemented.
(tramp-skeleton-set-file-modes-times-uid-gid): Fix typo.
(tramp-compute-multi-hops): Check for
`tramp-sh-file-name-handler-p', it works only for this.
(tramp-handle-shell-command):
Respect `async-shell-command-display-buffer'.
(tramp-action-password, tramp-process-actions): Use connection
property "hop-vector".
(tramp-action-fingerprint, tramp-action-show-message): New defuns.
(tramp-action-show-and-confirm-message): Start check at (point-min).
(tramp-wait-for-regexp): Don't redisplay in `sit-for'.  (Bug#73718)
(tramp-convert-file-attributes): Don't cache
"file-attributes-ID-FORMAT".
(tramp-read-passwd, tramp-clear-passwd): Rewrite.  (Bug#74105)

* test/lisp/net/tramp-tests.el (auth-source-cache-expiry)
(ert-batch-backtrace-right-margin): Set them to nil.
(vc-handled-backends): Suppress if noninteractive.
(tramp--test-enabled): Cleanup also
`tramp-compat-temporary-file-directory'.
(tramp-test11-copy-file, tramp-test12-rename-file)
(tramp-test18-file-attributes, tramp--test-deftest-with-stat)
(tramp--test-deftest-with-perl, tramp--test-deftest-with-ls)
(tramp--test-deftest-without-file-attributes)
(tramp-test21-file-links, tramp-test28-process-file)
(tramp-test32-shell-command, tramp-test36-vc-registered)
(tramp-test39-make-lock-file-name, tramp--test-check-files)
(tramp-test42-utf8, tramp-test43-file-system-info)
(tramp-test44-file-user-group-ids, tramp-test47-read-password):
Adapt tests.
(tramp-test47-read-fingerprint): New test.
2025-03-30 15:53:47 +02:00

273 lines
9.9 KiB
EmacsLisp
Raw Permalink Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;;; tramp-fuse.el --- Tramp access functions for FUSE mounts -*- lexical-binding:t -*-
;; Copyright (C) 2021-2025 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
(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'.")
;;;###tramp-autoload
(defconst tramp-fuse-name-prefix "tramp-"
"Prefix to use for temporary FUSE mount points.")
(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-fuse-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 (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
:link '(info-link :tag "Tramp manual" "(tramp) FUSE setup"))
(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
Reference in a new issue View git blame Copy permalink