mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-26 15:21:51 -08:00
10991877c8
* 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.
413 lines
16 KiB
EmacsLisp
413 lines
16 KiB
EmacsLisp
;;; tramp-sshfs.el --- Tramp access functions via sshfs -*- 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:
|
||
|
||
;; 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.")
|
||
|
||
(defcustom tramp-sshfs-program "sshfs"
|
||
"The sshfs mount command."
|
||
:group 'tramp
|
||
:version "28.1"
|
||
:type 'string)
|
||
|
||
;;;###tramp-autoload
|
||
(defvar tramp-default-remote-shell) ;; Silence byte compiler.
|
||
|
||
;;;###tramp-autoload
|
||
(tramp--with-startup
|
||
(add-to-list 'tramp-methods
|
||
`(,tramp-sshfs-method
|
||
(tramp-mount-args (("-C") ("-p" "%p")
|
||
("-o" "dir_cache=no")
|
||
("-o" "transform_symlinks")
|
||
("-o" "idmap=user,reconnect")))
|
||
;; These are for remote processes.
|
||
(tramp-login-program "ssh")
|
||
(tramp-login-args (("-q") ("-l" "%u") ("-p" "%p")
|
||
("-e" "none") ("%a" "%a")
|
||
("%h") ("%l")))
|
||
(tramp-direct-async t)
|
||
(tramp-remote-shell ,tramp-default-remote-shell)
|
||
(tramp-remote-shell-login ("-l"))
|
||
(tramp-remote-shell-args ("-c"))))
|
||
|
||
(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
|
||
'(;; `abbreviate-file-name' performed by default handler.
|
||
(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 . tramp-sshfs-handle-exec-path)
|
||
(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-fuse-handle-file-exists-p)
|
||
(file-group-gid . tramp-handle-file-group-gid)
|
||
(file-in-directory-p . tramp-handle-file-in-directory-p)
|
||
(file-local-copy . tramp-handle-file-local-copy)
|
||
(file-locked-p . tramp-handle-file-locked-p)
|
||
(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 . tramp-handle-file-notify-add-watch)
|
||
(file-notify-rm-watch . tramp-handle-file-notify-rm-watch)
|
||
(file-notify-valid-p . tramp-handle-file-notify-valid-p)
|
||
(file-ownership-preserved-p . ignore)
|
||
(file-readable-p . tramp-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-user-uid . tramp-handle-file-user-uid)
|
||
(file-writable-p . tramp-sshfs-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)
|
||
(list-system-processes . tramp-handle-list-system-processes)
|
||
(load . tramp-handle-load)
|
||
(lock-file . tramp-handle-lock-file)
|
||
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
|
||
(make-directory . tramp-fuse-handle-make-directory)
|
||
(make-directory-internal . ignore)
|
||
(make-lock-file-name . tramp-handle-make-lock-file-name)
|
||
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
|
||
(make-process . tramp-handle-make-process)
|
||
(make-symbolic-link . tramp-handle-make-symbolic-link)
|
||
(memory-info . tramp-handle-memory-info)
|
||
(process-attributes . tramp-handle-process-attributes)
|
||
(process-file . tramp-sshfs-handle-process-file)
|
||
(rename-file . tramp-sshfs-handle-rename-file)
|
||
(set-file-acl . ignore)
|
||
(set-file-modes . tramp-sshfs-handle-set-file-modes)
|
||
(set-file-selinux-context . ignore)
|
||
(set-file-times . tramp-sshfs-handle-set-file-times)
|
||
(set-visited-file-modtime . tramp-handle-set-visited-file-modtime)
|
||
(shell-command . tramp-handle-shell-command)
|
||
(start-file-process . tramp-handle-start-file-process)
|
||
(substitute-in-file-name . tramp-handle-substitute-in-file-name)
|
||
(temporary-file-directory . tramp-handle-temporary-file-directory)
|
||
(tramp-get-home-directory . ignore)
|
||
(tramp-get-remote-gid . ignore)
|
||
(tramp-get-remote-groups . ignore)
|
||
(tramp-get-remote-uid . ignore)
|
||
(tramp-set-file-uid-gid . ignore)
|
||
(unhandled-file-name-directory . ignore)
|
||
(unlock-file . tramp-handle-unlock-file)
|
||
(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 (vec-or-filename)
|
||
"Check if it's a VEC-OR-FILENAME for sshfs."
|
||
(and-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename))
|
||
((string= (tramp-file-name-method vec) 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)))
|
||
(prog1 (save-match-data (apply (cdr fn) args))
|
||
(setq tramp-debug-message-fnh-function (cdr fn)))
|
||
(prog1 (tramp-run-real-handler operation args)
|
||
(setq tramp-debug-message-fnh-function operation))))
|
||
|
||
;;;###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-exec-path ()
|
||
"Like `exec-path' for Tramp files."
|
||
(append
|
||
(with-parsed-tramp-file-name default-directory nil
|
||
(with-tramp-connection-property (tramp-get-process v) "remote-path"
|
||
(with-temp-buffer
|
||
(let (process-file-side-effects)
|
||
(process-file "getconf" nil t nil "PATH"))
|
||
(split-string
|
||
(progn
|
||
;; Read the expression.
|
||
(goto-char (point-min))
|
||
(buffer-substring (point) (line-end-position)))
|
||
":" 'omit))))
|
||
;; The equivalent to `exec-directory'.
|
||
`(,(tramp-file-local-name (expand-file-name default-directory)))))
|
||
|
||
(defun tramp-sshfs-handle-file-system-info (filename)
|
||
"Like `file-system-info' for Tramp files."
|
||
(file-system-info (tramp-fuse-local-file-name filename)))
|
||
|
||
(defun tramp-sshfs-handle-file-writable-p (filename)
|
||
"Like `file-writable-p' for Tramp files."
|
||
(file-writable-p (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."
|
||
(setq filename (expand-file-name filename))
|
||
(let (signal-hook-function result)
|
||
(unwind-protect
|
||
(setq result
|
||
(insert-file-contents
|
||
(tramp-fuse-local-file-name filename) visit beg end replace))
|
||
(when visit (setq buffer-file-name filename)))
|
||
(cons filename (cdr result))))
|
||
|
||
(defun tramp-sshfs-handle-process-file
|
||
(program &optional infile destination display &rest args)
|
||
"Like `process-file' for Tramp files."
|
||
;; STDERR is not impelmemted.
|
||
(when (consp destination)
|
||
(setcdr destination `(,tramp-cache-undefined)))
|
||
(tramp-skeleton-process-file program infile destination display args
|
||
(let ((coding-system-for-read 'utf-8-dos)) ; Is this correct?
|
||
|
||
(setq command
|
||
(format
|
||
"cd %s && exec %s"
|
||
(tramp-unquote-shell-quote-argument localname)
|
||
(mapconcat #'tramp-shell-quote-argument (cons program args) " ")))
|
||
(when input (setq command (format "%s <%s" command input)))
|
||
|
||
(setq ret
|
||
(apply
|
||
#'tramp-call-process
|
||
v (tramp-get-method-parameter v 'tramp-login-program)
|
||
nil outbuf display
|
||
(tramp-expand-args
|
||
v 'tramp-login-args nil
|
||
?h (or (tramp-file-name-host v) "")
|
||
?u (or (tramp-file-name-user v) "")
|
||
?p (or (tramp-file-name-port v) "")
|
||
?a "-t" ?l command))))))
|
||
|
||
(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-set-file-modes (filename mode &optional flag)
|
||
"Like `set-file-modes' for Tramp files."
|
||
(unless (and (eq flag 'nofollow) (file-symlink-p filename))
|
||
(tramp-skeleton-set-file-modes-times-uid-gid filename
|
||
(tramp-compat-set-file-modes
|
||
(tramp-fuse-local-file-name filename) mode flag))))
|
||
|
||
(defun tramp-sshfs-handle-set-file-times (filename &optional timestamp flag)
|
||
"Like `set-file-times' for Tramp files."
|
||
(unless (and (eq flag 'nofollow) (file-symlink-p filename))
|
||
(tramp-skeleton-set-file-modes-times-uid-gid filename
|
||
(tramp-compat-set-file-times
|
||
(tramp-fuse-local-file-name filename) timestamp flag))))
|
||
|
||
(defun tramp-sshfs-handle-write-region
|
||
(start end filename &optional append visit lockname mustbenew)
|
||
"Like `write-region' for Tramp files."
|
||
(tramp-skeleton-write-region start end filename append visit lockname mustbenew
|
||
(let (create-lockfiles)
|
||
(write-region
|
||
start end (tramp-fuse-local-file-name filename) append 'nomessage))
|
||
;; Now, `last-coding-system-used' has the right value. Remember it.
|
||
(setq coding-system-used last-coding-system-used)))
|
||
|
||
|
||
;; 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))
|
||
|
||
(with-tramp-debug-message vec "Opening connection"
|
||
;; 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)))
|
||
(tramp-post-process-creation p vec)
|
||
|
||
;; 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)
|
||
(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)
|
||
(tramp-expand-args
|
||
vec 'tramp-mount-args nil
|
||
?p (or (tramp-file-name-port vec) ""))))))
|
||
(tramp-error
|
||
vec 'file-error "Error mounting %s" (tramp-fuse-mount-spec vec)))
|
||
|
||
;; Mark it as connected.
|
||
(add-to-list 'tramp-fuse-mount-points (tramp-file-name-unify vec))
|
||
(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))))
|
||
|
||
;; Default connection-local variables for Tramp.
|
||
|
||
(connection-local-set-profile-variables
|
||
'tramp-sshfs-connection-local-default-profile
|
||
'((tramp-direct-async-process t)))
|
||
|
||
(connection-local-set-profiles
|
||
`(:application tramp :protocol ,tramp-sshfs-method)
|
||
'tramp-sshfs-connection-local-default-profile)
|
||
|
||
;; `shell-mode' tries to open remote files like "/sshfs:user@host:~/.history".
|
||
;; This fails, because the tilde cannot be expanded. Tell
|
||
;; `tramp-handle-expand-file-name' to tolerate this.
|
||
(defun tramp-sshfs-tolerate-tilde (orig-fun)
|
||
"Advice for `shell-mode' to tolerate tilde in remote file names."
|
||
(let ((tramp-tolerate-tilde
|
||
(or tramp-tolerate-tilde
|
||
(equal (file-remote-p default-directory 'method)
|
||
tramp-sshfs-method))))
|
||
(funcall orig-fun)))
|
||
|
||
(add-function
|
||
:around (symbol-function #'shell-mode) #'tramp-sshfs-tolerate-tilde)
|
||
(add-hook 'tramp-sshfs-unload-hook
|
||
(lambda ()
|
||
(remove-function
|
||
(symbol-function #'shell-mode) #'tramp-sshfs-tolerate-tilde)))
|
||
|
||
(add-hook 'tramp-unload-hook
|
||
(lambda ()
|
||
(unload-feature 'tramp-sshfs 'force)))
|
||
|
||
(provide 'tramp-sshfs)
|
||
|
||
;;; tramp-sshfs.el ends here
|