Add Tramp sshfs method

* doc/misc/tramp.texi (Top, Configuration): Insert sections 'FUSE-based
methods' and 'FUSE setup' in menu.
(Quick Start Guide): Fix @anchors.  Add doas.  Extend section
'Using @command{rclone}' to 'Using @acronym{FUSE}-based methods'.
(External methods): Remove rclone paragraph.
(FUSE-based methods, FUSE setup): New nodes.
(Predefined connection information): Mention "mount-point".

* etc/NEWS: Mention Tramp sshfs method.
Fix typos and other oddities.

* lisp/net/tramp-fuse.el: New file.

* lisp/net/tramp-rclone.el (tramp-fuse): Require.
(tramp-rclone-file-name-handler-alist): Replace `tramp-rclone-handle-*'
by `tramp-fuse-handle-*' where appropriate.
(tramp-rclone-handle-delete-directory)
(tramp-rclone-handle-delete-file)
(tramp-rclone-handle-directory-files)
(tramp-rclone-handle-file-attributes)
(tramp-rclone-handle-file-executable-p)
(tramp-rclone-handle-file-name-all-completions)
(tramp-rclone-handle-file-readable-p)
(tramp-rclone-handle-insert-directory)
(tramp-rclone-handle-insert-file-contents)
(tramp-rclone-handle-make-directory, tramp-rclone-mount-point)
(tramp-rclone-mounted-p, tramp-rclone-local-file-name):
Remove.  Functionality moved to tramp-fuse.el.
(tramp-rclone-remote-file-name)
(tramp-rclone-maybe-open-connection): Use `tramp-fuse-*' functions.

* lisp/net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band):
Simplify check.

* lisp/net/tramp-sshfs.el: New file.

* lisp/net/tramp.el: Remove TODO item.

* test/lisp/net/tramp-tests.el (tramp--test-sshfs-p): New defun.
(tramp-test14-delete-directory): Use it.

1 files changed, 318 insertions, 0 deletions

diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el
new file mode 100644
index 00000000000..feb64b82bc7
--- /dev/null
+++ b/lisp/net/tramp-sshfs.el
@@ -0,0 +1,318 @@
+;;; tramp-sshfs.el --- Tramp access functions via sshfs  -*- 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:
+
+;; sshfs is a program to mount a virtual file system, based on an sftp
+;; connection.  Tramp uses its mount utility to access files and
+;; directories there.
+
+;; A remote file under sshfs control has the form
+;; "/sshfs:user@host#port:/path/to/file".  User name and port number
+;; are optional.
+
+;;; Code:
+
+(require 'tramp)
+(require 'tramp-fuse)
+
+;;;###tramp-autoload
+(defconst tramp-sshfs-method "sshfs"
+  "Tramp method for sshfs mounts.")
+
+;;;###tramp-autoload
+(defcustom tramp-sshfs-program "sshfs"
+  "The sshfs mount command."
+  :group 'tramp
+  :version "28.1"
+  :type 'string)
+
+;;;###tramp-autoload
+(tramp--with-startup
+ (add-to-list 'tramp-methods
+	      `(,tramp-sshfs-method
+		(tramp-mount-args
+		 (("-p" "%p")
+		  ("-o" "idmap=user,reconnect")))))
+
+ (tramp-set-completion-function
+  tramp-sshfs-method tramp-completion-function-alist-ssh))
+
+
+;; New handlers should be added here.
+;;;###tramp-autoload
+(defconst tramp-sshfs-file-name-handler-alist
+  '((access-file . tramp-handle-access-file)
+    (add-name-to-file . tramp-handle-add-name-to-file)
+    ;; `byte-compiler-base-file-name' performed by default handler.
+    (copy-directory . tramp-handle-copy-directory)
+    (copy-file . tramp-sshfs-handle-copy-file)
+    (delete-directory . tramp-fuse-handle-delete-directory)
+    (delete-file . tramp-fuse-handle-delete-file)
+    ;; `diff-latest-backup-file' performed by default handler.
+    (directory-file-name . tramp-handle-directory-file-name)
+    (directory-files . tramp-fuse-handle-directory-files)
+    (directory-files-and-attributes
+     . tramp-handle-directory-files-and-attributes)
+    (dired-compress-file . ignore)
+    (dired-uncache . tramp-handle-dired-uncache)
+;;     (exec-path . ignore)
+    (expand-file-name . tramp-handle-expand-file-name)
+    (file-accessible-directory-p . tramp-handle-file-accessible-directory-p)
+    (file-acl . ignore)
+    (file-attributes . tramp-fuse-handle-file-attributes)
+    (file-directory-p . tramp-handle-file-directory-p)
+    (file-equal-p . tramp-handle-file-equal-p)
+    (file-executable-p . tramp-fuse-handle-file-executable-p)
+    (file-exists-p . tramp-handle-file-exists-p)
+    (file-in-directory-p . tramp-handle-file-in-directory-p)
+    (file-local-copy . tramp-handle-file-local-copy)
+    (file-modes . tramp-handle-file-modes)
+    (file-name-all-completions . tramp-fuse-handle-file-name-all-completions)
+    (file-name-as-directory . tramp-handle-file-name-as-directory)
+    (file-name-case-insensitive-p . tramp-handle-file-name-case-insensitive-p)
+    (file-name-completion . tramp-handle-file-name-completion)
+    (file-name-directory . tramp-handle-file-name-directory)
+    (file-name-nondirectory . tramp-handle-file-name-nondirectory)
+    ;; `file-name-sans-versions' performed by default handler.
+    (file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
+    (file-notify-add-watch . ignore)
+    (file-notify-rm-watch . ignore)
+    (file-notify-valid-p . ignore)
+    (file-ownership-preserved-p . ignore)
+    (file-readable-p . tramp-fuse-handle-file-readable-p)
+    (file-regular-p . tramp-handle-file-regular-p)
+    (file-remote-p . tramp-handle-file-remote-p)
+    (file-selinux-context . tramp-handle-file-selinux-context)
+    (file-symlink-p . tramp-handle-file-symlink-p)
+    (file-system-info . tramp-sshfs-handle-file-system-info)
+    (file-truename . tramp-handle-file-truename)
+    (file-writable-p . tramp-handle-file-writable-p)
+    (find-backup-file-name . tramp-handle-find-backup-file-name)
+    ;; `get-file-buffer' performed by default handler.
+    (insert-directory . tramp-handle-insert-directory)
+    (insert-file-contents . tramp-sshfs-handle-insert-file-contents)
+    (load . tramp-handle-load)
+    (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
+    (make-directory . tramp-fuse-handle-make-directory)
+    (make-directory-internal . ignore)
+    (make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
+;;     (make-process . ignore)
+    (make-symbolic-link . tramp-handle-make-symbolic-link)
+;;     (process-file . ignore)
+    (rename-file . tramp-sshfs-handle-rename-file)
+    (set-file-acl . ignore)
+    (set-file-modes . ignore)
+    (set-file-selinux-context . ignore)
+    (set-file-times . ignore)
+    (set-visited-file-modtime . tramp-handle-set-visited-file-modtime)
+;;     (shell-command . ignore)
+;;     (start-file-process . ignore)
+    (substitute-in-file-name . tramp-handle-substitute-in-file-name)
+    (temporary-file-directory . tramp-handle-temporary-file-directory)
+;;     (tramp-get-remote-gid . ignore)
+;;     (tramp-get-remote-uid . ignore)
+;;     (tramp-set-file-uid-gid . ignore)
+    (unhandled-file-name-directory . ignore)
+    (vc-registered . ignore)
+    (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
+    (write-region . tramp-sshfs-handle-write-region))
+"Alist of handler functions for Tramp SSHFS method.
+Operations not mentioned here will be handled by the default Emacs primitives.")
+
+;; It must be a `defsubst' in order to push the whole code into
+;; tramp-loaddefs.el.  Otherwise, there would be recursive autoloading.
+;;;###tramp-autoload
+(defsubst tramp-sshfs-file-name-p (filename)
+  "Check if it's a FILENAME for sshfs."
+  (and (tramp-tramp-file-p filename)
+       (string= (tramp-file-name-method (tramp-dissect-file-name filename))
+	        tramp-sshfs-method)))
+
+;;;###tramp-autoload
+(defun tramp-sshfs-file-name-handler (operation &rest args)
+  "Invoke the sshfs handler for OPERATION and ARGS.
+First arg specifies the OPERATION, second arg is a list of
+arguments to pass to the OPERATION."
+  (if-let ((fn (assoc operation tramp-sshfs-file-name-handler-alist)))
+      (save-match-data (apply (cdr fn) args))
+    (tramp-run-real-handler operation args)))
+
+;;;###tramp-autoload
+(tramp--with-startup
+ (tramp-register-foreign-file-name-handler
+  #'tramp-sshfs-file-name-p #'tramp-sshfs-file-name-handler))
+
+
+;; File name primitives.
+
+(defun tramp-sshfs-handle-copy-file
+    (filename newname &optional ok-if-already-exists keep-date
+     preserve-uid-gid preserve-extended-attributes)
+  "Like `copy-file' for Tramp files."
+  (setq filename (expand-file-name filename)
+	newname (expand-file-name newname))
+  (if (file-directory-p filename)
+      (copy-directory filename newname keep-date t)
+    (copy-file
+     (if (tramp-sshfs-file-name-p filename)
+	 (tramp-fuse-local-file-name filename) filename)
+     (if (tramp-sshfs-file-name-p newname)
+	 (tramp-fuse-local-file-name newname) newname)
+     ok-if-already-exists keep-date
+     preserve-uid-gid preserve-extended-attributes)
+    (when (tramp-sshfs-file-name-p newname)
+      (with-parsed-tramp-file-name newname nil
+	(tramp-flush-file-properties v localname)))))
+
+(defun tramp-sshfs-handle-file-system-info (filename)
+  "Like `file-system-info' for Tramp files."
+  ;;`file-system-info' exists since Emacs 27.1.
+  (tramp-compat-funcall 'file-system-info (tramp-fuse-local-file-name filename)))
+
+(defun tramp-sshfs-handle-insert-file-contents
+  (filename &optional visit beg end replace)
+  "Like `insert-file-contents' for Tramp files."
+  (let ((result
+	 (insert-file-contents
+	  (tramp-fuse-local-file-name filename) visit beg end replace)))
+    (when visit (setq buffer-file-name filename))
+    (cons (expand-file-name filename) (cdr result))))
+
+(defun tramp-sshfs-handle-rename-file
+    (filename newname &optional ok-if-already-exists)
+  "Like `rename-file' for Tramp files."
+  (setq filename (expand-file-name filename)
+	newname (expand-file-name newname))
+  (rename-file
+   (if (tramp-sshfs-file-name-p filename)
+       (tramp-fuse-local-file-name filename) filename)
+   (if (tramp-sshfs-file-name-p newname)
+       (tramp-fuse-local-file-name newname) newname)
+   ok-if-already-exists)
+  (when (tramp-sshfs-file-name-p filename)
+    (with-parsed-tramp-file-name filename nil
+      (tramp-flush-file-properties v localname)))
+  (when (tramp-sshfs-file-name-p newname)
+    (with-parsed-tramp-file-name newname nil
+      (tramp-flush-file-properties v localname))))
+
+(defun tramp-sshfs-handle-write-region
+  (start end filename &optional append visit lockname mustbenew)
+  "Like `write-region' for Tramp files."
+  (setq filename (expand-file-name filename))
+  (with-parsed-tramp-file-name filename nil
+    (when (and mustbenew (file-exists-p filename)
+	       (or (eq mustbenew 'excl)
+		   (not
+		    (y-or-n-p
+		     (format "File %s exists; overwrite anyway? " filename)))))
+      (tramp-error v 'file-already-exists filename))
+
+    (write-region
+     start end (tramp-fuse-local-file-name filename) append 'nomessage lockname)
+    (tramp-flush-file-properties v localname)
+
+    ;; The end.
+    (when (and (null noninteractive)
+	       (or (eq visit t) (null visit) (stringp visit)))
+      (tramp-message v 0 "Wrote %s" filename))
+    (run-hooks 'tramp-handle-write-region-hook)))
+
+
+;; File name conversions.
+
+(defun tramp-sshfs-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."
+  ;; During completion, don't reopen a new connection.
+  (unless (tramp-connectable-p vec)
+    (throw 'non-essential 'non-essential))
+
+  ;; 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-get-connection-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)
+
+      ;; Create directory.
+      (unless (file-directory-p (tramp-fuse-mount-point vec))
+	(make-directory (tramp-fuse-mount-point vec) 'parents))
+
+      (unless
+	  (or (tramp-fuse-mounted-p vec)
+	      (let* ((port (or (tramp-file-name-port vec) ""))
+		     (spec (format-spec-make ?p port))
+		     mount-args
+		     (mount-args
+		      (dolist
+			  (x
+			   (tramp-get-method-parameter vec 'tramp-mount-args)
+			   mount-args)
+			(setq mount-args
+			      (append
+			       mount-args
+			       (let ((y (mapcar
+					 (lambda (z) (format-spec z spec))
+					 x)))
+				 (unless (member "" y) y)))))))
+		(with-temp-buffer
+		  (zerop
+		   (apply
+		    #'tramp-call-process
+		    vec tramp-sshfs-program nil t nil
+		    (tramp-fuse-mount-spec vec)
+		    (tramp-fuse-mount-point vec) mount-args))))
+	  (tramp-error
+	   vec 'file-error "Error mounting %s" (tramp-fuse-mount-spec vec))))
+
+      ;; Mark it as connected.
+      (tramp-set-connection-property
+       (tramp-get-connection-process vec) "connected" t)))
+
+  ;; In `tramp-check-cached-permissions', the connection properties
+  ;; "{uid,gid}-{integer,string}" are used.  We set them to proper values.
+  (with-tramp-connection-property
+      vec "uid-integer" (tramp-get-local-uid 'integer))
+  (with-tramp-connection-property
+      vec "gid-integer" (tramp-get-local-gid 'integer))
+  (with-tramp-connection-property
+      vec "uid-string" (tramp-get-local-uid 'string))
+  (with-tramp-connection-property
+      vec "gid-string" (tramp-get-local-gid 'string)))
+
+(add-hook 'tramp-unload-hook
+	  (lambda ()
+	    (unload-feature 'tramp-sshfs 'force)))
+
+(provide 'tramp-sshfs)
+
+;;; tramp-sshfs.el ends here