ENH remove weird systemd devices

This commit is contained in:
Nathan Dwarshuis 2021-03-20 15:03:13 -04:00
parent 79d8b0194a
commit a033b673e0
1 changed files with 2 additions and 65 deletions

View File

@ -1,6 +1,5 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | rofi-dev - a rofi prompt for mountable devices -- | rofi-dev - a rofi prompt for mountable devices
@ -33,7 +32,6 @@ import Text.Printf
import System.Console.GetOpt import System.Console.GetOpt
import System.Directory import System.Directory
import System.Environment import System.Environment
import System.Exit (ExitCode(..))
import System.FilePath.Posix import System.FilePath.Posix
import System.Posix.User (getEffectiveUserName) import System.Posix.User (getEffectiveUserName)
import System.Process import System.Process
@ -281,18 +279,15 @@ runPrompt gs = selectAction $ emptyMenu
getGroups :: RofiIO MountConf [RofiGroup MountConf] getGroups :: RofiIO MountConf [RofiGroup MountConf]
getGroups = do getGroups = do
sysd <- io getSystemdDevices
(cifsDevs, sshfsDevs, vcDevs) <- groupTriples (cifsDevs, sshfsDevs, vcDevs) <- groupTriples
<$> (fromConfig =<< asks mountconfStaticDevs) <$> (fromConfig =<< asks mountconfStaticDevs)
sequence sequence
[ mkGroup2 "SSHFS Devices" (filterSysd SystemdSSHFS sysd) sshfsDevs [ mkGroup "SSHFS Devices" sshfsDevs
, mkGroup "CIFS Devices" cifsDevs , mkGroup "CIFS Devices" cifsDevs
, mkGroup2 "Veracrypt Devices" (filterSysd SystemdVeracrypt sysd) vcDevs , mkGroup "Veracrypt Devices" vcDevs
, mkGroup "Removable Devices" =<< getRemovableDevices , mkGroup "Removable Devices" =<< getRemovableDevices
, mkGroup "MTP Devices" =<< getMTPDevices , mkGroup "MTP Devices" =<< getMTPDevices
] ]
where
filterSysd t = filter (\s -> sysdType s == t)
mountByAlias :: Bool -> String -> RofiIO MountConf () mountByAlias :: Bool -> String -> RofiIO MountConf ()
mountByAlias unmountFlag alias = do mountByAlias unmountFlag alias = do
@ -311,13 +306,6 @@ mountByAlias unmountFlag alias = do
mkGroup :: Mountable d => String -> [d] -> RofiIO MountConf (RofiGroup MountConf) mkGroup :: Mountable d => String -> [d] -> RofiIO MountConf (RofiGroup MountConf)
mkGroup header devs = sortGroup header <$> mapM mkAction devs mkGroup header devs = sortGroup header <$> mapM mkAction devs
mkGroup2 :: (Mountable d, Mountable e) => String
-> [d] -> [e] -> RofiIO MountConf (RofiGroup MountConf)
mkGroup2 header devs1 devs2 = do
r1 <- mapM mkAction devs1
r2 <- mapM mkAction devs2
return $ sortGroup header (r1 ++ r2)
sortGroup :: String -> [(String, RofiIO MountConf ())] -> RofiGroup MountConf sortGroup :: String -> [(String, RofiIO MountConf ())] -> RofiGroup MountConf
sortGroup header = titledGroup header . alignEntries . toRofiActions sortGroup header = titledGroup header . alignEntries . toRofiActions
@ -542,57 +530,6 @@ getMTPDevices = do
| c == ' ' = Just '-' | c == ' ' = Just '-'
| otherwise = Just c | otherwise = Just c
--------------------------------------------------------------------------------
-- | Systemd typeclass
data SystemdMountType = SystemdVeracrypt | SystemdSSHFS deriving (Eq, Show)
data Systemd = Systemd
{ sysdType :: SystemdMountType
, sysdInstance :: String
}
deriving (Eq, Show)
instance Mountable Systemd where
mount s@Systemd { sysdInstance = i } m = let
unit = fmtSysdInstanceName s
operation = if m then "stop" else "start" in
io $ runMountNotify "systemctl" ["--user", operation, unit] i m
allInstalled Systemd { sysdType = SystemdVeracrypt } =
io $ isJust <$> findExecutable "veracrypt"
allInstalled Systemd { sysdType = SystemdSSHFS } =
io $ isJust <$> findExecutable "sshfs"
isMounted s = let
unit = fmtSysdInstanceName s
args = ["--user", "is-active", "--quiet", unit] in
io $ (\(ec, _, _) -> ec == ExitSuccess)
<$> readProcessWithExitCode "systemctl" args ""
fmtEntry Systemd { sysdInstance = i } = i ++ alignSepPre ++ "Systemd"
fmtSysdInstanceName :: Systemd -> String
fmtSysdInstanceName Systemd { sysdType = SystemdVeracrypt, sysdInstance = i } =
"mount-veracrypt@" ++ i ++ ".service"
fmtSysdInstanceName Systemd { sysdType = SystemdSSHFS, sysdInstance = i } =
"mount-sshfs@" ++ i ++ ".service"
getSystemdDevices :: IO [Systemd]
getSystemdDevices = do
systemdHome <- io $ getXdgDirectory XdgConfig "systemd/user"
io $ mapMaybe toDev
<$> (filterM (doesDirectoryExist . (systemdHome </>))
=<< listDirectory systemdHome)
where
toDev (splitInstance "mount-veracrypt@" -> Just s) =
Just $ Systemd { sysdType = SystemdVeracrypt , sysdInstance = s }
toDev (splitInstance "mount-sshfs@" -> Just s) =
Just $ Systemd { sysdType = SystemdSSHFS , sysdInstance = s }
toDev _ = Nothing
splitInstance p = fmap (takeWhile (not . (==) '.')) . stripPrefix p
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | Static Device Wrapper -- | Static Device Wrapper
-- --