lkn
/
syscfg
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

generic remotefs mount/umount

This commit is contained in:
Levi 2024-09-19 09:17:08 +02:00
parent 0e2a1dc1b4
commit 1a34ad1681
3 changed files with 66 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
emacs/feature/feature-base.el
View File

@ -11,7 +11,7 @@
(require 'module-detached)
(require 'module-dired)
(require 'module-async)
(require 'module-alioth)
(require 'module-remotefs)
(require 'module-which-key)
(require 'module-multi-cursor)
(require 'module-eshell)

41
emacs/module/module-alioth.el
View File

@ -1,41 +0,0 @@
;;; module-alioth.el --- alioth automount -*- lexical-binding: t; -*-
;;;
;;; Commentary:
;;;
;;; Automount alioth on demand.
;;;
;;; Code:
(defun ensure-alioth-mounted ()
"Check if ~/alioth is mounted, and if not, mount it."
(unless (file-exists-p "~/alioth/.exists")
(mount-alioth-sshfs)))
(defun umount-alioth-sshfs ()
"Unmount Alioth Uberspace using SSHFS."
(interactive)
(let ((default-directory "~"))
(shell-command "umount ~/alioth")))
(defun mount-alioth-sshfs ()
"Mount Alioth Uberspace using SSHFS."
(interactive)
(let ((default-directory "~"))
(shell-command "sshfs lkn@alioth.uberspace.de:/home/lkn/ ~/alioth")))
(add-hook 'find-file-hook
(lambda ()
(when (string-prefix-p (expand-file-name "~/alioth/")
(expand-file-name (buffer-file-name)))
(ensure-alioth-mounted))))
(add-hook 'dired-mode-hook
(lambda ()
(when (string-prefix-p (expand-file-name "~/alioth/")
(expand-file-name default-directory))
(ensure-alioth-mounted))))
(provide 'module-alioth)
;;; module-alioth.el ends here.

65
emacs/module/module-remotefs.el Normal file
View File

@ -0,0 +1,65 @@
;;; module-remotefs.el --- remotefs automount -*- lexical-binding: t; -*-
;;;
;;; Commentary:
;;;
;;; Automount remotefs on demand.
;;;
;;; Code:
(defvar remote-mounts nil
"Alist of remote mounts. Each entry is (name . (remote-path local-mountpoint)).")
(add-to-list 'remote-mounts '("alioth" . ("lkn@alioth.uberspace.de:/home/lkn/" "~/alioth")))
(add-to-list 'remote-mounts '("eris" . ("lkn@eris.fritz.box:/home/lkn/" "~/eris")))
(defun ensure-remote-mounted (name)
"Check if the remote mount NAME is mounted, and if not, mount it."
(let* ((mount-info (assoc name remote-mounts))
(local-path (cadr (cdr mount-info))))
(unless (file-exists-p (expand-file-name ".exists" local-path))
(mount-remote-sshfs name))))
(defun umount-remote-sshfs (name)
"Unmount the remote mount NAME using SSHFS."
(interactive
(list (completing-read "Unmount remote: " remote-mounts nil t)))
(let* ((mount-info (assoc name remote-mounts))
(local-path (cadr (cdr mount-info)))
(default-directory "~"))
(shell-command (format "umount %s" local-path))))
(defun mount-remote-sshfs (name)
"Mount the remote mount NAME using SSHFS."
(interactive
(list (completing-read "Mount remote: " remote-mounts nil t)))
(let* ((mount-info (assoc name remote-mounts))
(remote-path (cadr mount-info))
(local-path (cadr (cdr mount-info)))
(default-directory "~"))
(shell-command (format "sshfs %s %s" remote-path local-path))))
(defun check-and-mount-remote (path)
"Check if PATH is under a remote mount, and ensure it's mounted if so."
(let ((matching-mount
(cl-find-if
(lambda (mount)
(string-prefix-p
(expand-file-name (cadr (cdr mount)))
(expand-file-name path)))
remote-mounts)))
(when matching-mount
(ensure-remote-mounted (car matching-mount)))))
(add-hook 'find-file-hook
(lambda ()
(when buffer-file-name
(check-and-mount-remote buffer-file-name))))
(add-hook 'dired-mode-hook
(lambda ()
(check-and-mount-remote default-directory)))
(provide 'module-remotefs)
;;; module-alioth.el ends here.