ADD batch mode

This commit is contained in:
Nathan Dwarshuis 2021-03-19 23:23:45 -04:00
parent 836ed18943
commit f09f646e13
2 changed files with 238 additions and 80 deletions

View File

@ -1,4 +1,5 @@
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
@ -24,6 +25,7 @@ import Data.List.Split (splitOn)
import qualified Data.Map as M import qualified Data.Map as M
import qualified Data.Map.Ordered as O import qualified Data.Map.Ordered as O
import Data.Maybe import Data.Maybe
import qualified Data.Text as T
import qualified Data.Vector as V import qualified Data.Vector as V
import Data.Yaml import Data.Yaml
@ -48,18 +50,37 @@ main = getArgs >>= parse
parse :: [String] -> IO () parse :: [String] -> IO ()
parse args = case getOpt Permute options args of parse args = case getOpt Permute options args of
(o, n, []) -> initMountConf n >>= \i -> runMounts $ foldl (flip id) i o -- (o, n, []) -> initMountConf n >>= \i -> runMounts $ foldl (flip id) i o
(o, n, []) -> runMounts $ foldl (flip id) (defaultOpts n) o
(_, _, errs) -> ioError $ userError $ concat errs ++ usageInfo h options (_, _, errs) -> ioError $ userError $ concat errs ++ usageInfo h options
where where
h = "Usage: rofi-dev [OPTIONS] [-- ROFI-OPTIONS]" h = "Usage: rofi-dev [OPTIONS] [-- ROFI-OPTIONS]"
defaultOpts r = Opts
{ optsConfig = Nothing
, optsAlias = Nothing
, optsUnmount = False
, optsRofiArgs = r
}
options :: [OptDescr (MountConf -> MountConf)] options :: [OptDescr (Opts -> Opts)]
options = options =
[ Option ['c'] ["config"] [ Option ['c'] ["config"]
(ReqArg (\s m -> m { mConfig = Just s } ) "CONF") (ReqArg (\s m -> m { optsConfig = Just s } ) "CONF")
"The path to the config file" "The path to the config file"
, Option ['m'] ["mount"]
(ReqArg (\s m -> m { optsAlias = Just s } ) "ALIAS")
"Mount the device specified by ALIAS directly"
, Option ['u'] ["unmount"] (NoArg (\m -> m { optsUnmount = True } ))
"Unmount the device specified by ALIAS instead of mounting it."
] ]
data Opts = Opts
{ optsConfig :: Maybe FilePath
, optsAlias :: Maybe String
, optsUnmount :: Bool
, optsRofiArgs :: [String]
} deriving Show
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | Static configuration -- | Static configuration
-- --
@ -69,6 +90,9 @@ options =
defaultTries :: Integer defaultTries :: Integer
defaultTries = 2 defaultTries = 2
(.:&) :: FromJSON a => Object -> T.Text -> Parser (V.Vector a)
(.:&) o t = o .:? t .!= V.empty
data MountConfig = MountConfig data MountConfig = MountConfig
{ _mountMountPoint :: FilePath { _mountMountPoint :: FilePath
, _mountLabel :: Maybe String , _mountLabel :: Maybe String
@ -79,6 +103,18 @@ instance FromJSON MountConfig where
<$> o .: "mountpoint" <$> o .: "mountpoint"
<*> o .:? "label" <*> o .:? "label"
data DependsConfig = DependsConfig
{ _dependsVeracrypt :: V.Vector String
, _dependsSSHFS :: V.Vector String
, _dependsCIFS :: V.Vector String
} deriving Show
instance FromJSON DependsConfig where
parseJSON = withObject "depends" $ \o -> DependsConfig
<$> o .:& "veracrypt"
<*> o .:& "sshfs"
<*> o .:& "cifs"
data BitwardenConfig = BitwardenConfig data BitwardenConfig = BitwardenConfig
{ _bitwardenKey :: String { _bitwardenKey :: String
, _bitwardenTries :: Integer } , _bitwardenTries :: Integer }
@ -121,6 +157,7 @@ instance FromJSON PasswordConfig where
data VeracryptConfig = VeracryptConfig data VeracryptConfig = VeracryptConfig
{ _veracryptMount :: MountConfig { _veracryptMount :: MountConfig
, _veracryptVolume :: String , _veracryptVolume :: String
, _veracryptDepends :: Maybe DependsConfig
, _veracryptPassword :: Maybe PasswordConfig , _veracryptPassword :: Maybe PasswordConfig
} deriving Show } deriving Show
@ -128,21 +165,25 @@ instance FromJSON VeracryptConfig where
parseJSON = withObject "veracrypt" $ \o -> VeracryptConfig parseJSON = withObject "veracrypt" $ \o -> VeracryptConfig
<$> o .: "mount" <$> o .: "mount"
<*> o .: "volume" <*> o .: "volume"
<*> o .:? "depends"
<*> o .:? "password" <*> o .:? "password"
data SSHFSConfig = SSHFSConfig data SSHFSConfig = SSHFSConfig
{ _sshfsMount :: MountConfig { _sshfsMount :: MountConfig
, _sshfsRemote :: String , _sshfsRemote :: String
, _sshfsDepends :: Maybe DependsConfig
} deriving Show } deriving Show
instance FromJSON SSHFSConfig where instance FromJSON SSHFSConfig where
parseJSON = withObject "sshfs" $ \o -> SSHFSConfig parseJSON = withObject "sshfs" $ \o -> SSHFSConfig
<$> o .: "mount" <$> o .: "mount"
<*> o .: "remote" <*> o .: "remote"
<*> o .:? "depends"
data CIFSConfig = CIFSConfig data CIFSConfig = CIFSConfig
{ _cifsMount :: MountConfig { _cifsMount :: MountConfig
, _cifsRemote :: String , _cifsRemote :: String
, _cifsDepends :: Maybe DependsConfig
, _cifsPassword :: Maybe PasswordConfig , _cifsPassword :: Maybe PasswordConfig
} deriving Show } deriving Show
@ -150,12 +191,49 @@ instance FromJSON CIFSConfig where
parseJSON = withObject "cifs" $ \o -> CIFSConfig parseJSON = withObject "cifs" $ \o -> CIFSConfig
<$> o .: "mount" <$> o .: "mount"
<*> o .: "remote" <*> o .: "remote"
<*> o .: "password" <*> o .:? "depends"
<*> o .:? "password"
-- data DeviceConfig = VeracryptConfig
-- { _veracryptMount :: MountConfig
-- , _veracryptVolume :: String
-- , _veracryptDepends :: Maybe DependsConfig
-- , _veracryptPassword :: Maybe PasswordConfig
-- } | SSHFSConfig
-- { _sshfsMount :: MountConfig
-- , _sshfsRemote :: String
-- , _sshfsDepends :: Maybe DependsConfig
-- } | CIFSConfig
-- { _cifsMount :: MountConfig
-- , _cifsRemote :: String
-- , _cifsDepends :: Maybe DependsConfig
-- , _cifsPassword :: Maybe PasswordConfig
-- } deriving Show
-- instance FromJSON DeviceConfig where
-- parseJSON = withObject "devices" $ \o -> do
-- devType <- o .: "type"
-- case devType of
-- "cifs" -> CIFSConfig
-- <$> o .: "mount"
-- <*> o .: "remote"
-- <*> o .:? "depends"
-- <*> o .:? "password"
-- "sshfs" -> SSHFSConfig
-- <$> o .: "mount"
-- <*> o .: "remote"
-- <*> o .:? "depends"
-- "veracrypt" -> VeracryptConfig
-- <$> o .: "mount"
-- <*> o .: "volume"
-- <*> o .:? "depends"
-- <*> o .:? "password"
-- _ -> fail "unknown device type"
data DevicesConfig = DevicesConfig data DevicesConfig = DevicesConfig
{ _veracryptConfigs :: V.Vector VeracryptConfig { _veracryptConfigs :: M.Map String VeracryptConfig
, _sshfsConfigs :: V.Vector SSHFSConfig , _sshfsConfigs :: M.Map String SSHFSConfig
, _cifsConfigs :: V.Vector CIFSConfig , _cifsConfigs :: M.Map String CIFSConfig
} deriving Show } deriving Show
instance FromJSON DevicesConfig where instance FromJSON DevicesConfig where
@ -165,8 +243,9 @@ instance FromJSON DevicesConfig where
<*> o .: "cifs" <*> o .: "cifs"
data StaticConfig = StaticConfig data StaticConfig = StaticConfig
{ _tmpMountDir :: Maybe String { _staticconfigTmpPath :: Maybe String
, _devicesConfig :: Maybe DevicesConfig , _staticconfigDevices :: Maybe DevicesConfig
-- , _staticconfigDevices :: M.Map String DeviceConfig
} deriving Show } deriving Show
instance FromJSON StaticConfig where instance FromJSON StaticConfig where
@ -182,13 +261,15 @@ instance FromJSON StaticConfig where
-- from the parse tree. -- from the parse tree.
class Mountable m => StaticDevice m a where class Mountable m => StaticDevice m a where
-- | Mount the given type (or dismount if False is passed) fromConfig :: DevicesConfig -> (DevicesConfig -> M.Map String a) -> RofiIO MountConf [m]
fromConfig :: V.Vector a -> RofiIO MountConf [m] fromConfig s f = fromConfig' s (M.elems . f)
fromConfig s = do
v <- asks mountDir
return $ configToDev v <$> V.toList s
configToDev :: FilePath -> a -> m fromConfig' :: DevicesConfig -> (DevicesConfig -> [a]) -> RofiIO MountConf [m]
fromConfig' s f = do
v <- asks mountconfVolatilePath
mapM (configToDev v s) $ f s
configToDev :: FilePath -> DevicesConfig -> a -> RofiIO MountConf m
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | Global config used in the reader monad stack -- | Global config used in the reader monad stack
@ -201,24 +282,13 @@ class Mountable m => StaticDevice m a where
-- - any arguments to be passed to the rofi command -- - any arguments to be passed to the rofi command
data MountConf = MountConf data MountConf = MountConf
{ mountDir :: FilePath { mountconfVolatilePath :: FilePath
, rofiArgs :: [String] , mountconfRofiArgs :: [String]
, mConfig :: Maybe FilePath , mountconfStaticDevs :: Maybe DevicesConfig
, devConfig :: Maybe DevicesConfig
} }
instance RofiConf MountConf where instance RofiConf MountConf where
defArgs MountConf { rofiArgs = a } = a defArgs MountConf { mountconfRofiArgs = a } = a
initMountConf :: [String] -> IO MountConf
initMountConf a = conf <$> getEffectiveUserName
where
conf u = MountConf
{ mountDir = "/tmp/media" </> u
, rofiArgs = a
, mConfig = Nothing
, devConfig = Nothing
}
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | Password-getting functions -- | Password-getting functions
@ -268,19 +338,27 @@ configToPwd PasswordConfig{ _passwordBitwarden = b
-- mounts grouped by device type (eg removable, sshfs, cifs, etc). I like -- mounts grouped by device type (eg removable, sshfs, cifs, etc). I like
-- pretty things, so ensure the entries are aligned properly as well -- pretty things, so ensure the entries are aligned properly as well
runMounts :: MountConf -> IO () runMounts :: Opts -> IO ()
runMounts c = do runMounts opts = do
c' <- maybe (return c) parseConfig (mConfig c) static <- join <$> traverse parseStaticConfig (optsConfig opts)
runRofiIO c' $ runPrompt =<< getGroups defaultTmpPath <- ("/tmp/media" </>) <$> getEffectiveUserName
where let tmpPath = fromMaybe defaultTmpPath (_staticconfigTmpPath =<< static)
parseConfig m = do let staticDevs = _staticconfigDevices =<< static
res <- decodeFileEither m let mountconf = MountConf
{ mountconfVolatilePath = tmpPath
, mountconfRofiArgs = optsRofiArgs opts
, mountconfStaticDevs = staticDevs
}
let byAlias = mountByAlias $ optsUnmount opts
let byPrompt = runPrompt =<< getGroups
runRofiIO mountconf $ maybe byPrompt byAlias $ optsAlias opts
parseStaticConfig :: FilePath -> IO (Maybe StaticConfig)
parseStaticConfig p = do
res <- decodeFileEither p
case res of case res of
Left e -> print e >> return c Left e -> print e >> return Nothing
Right StaticConfig { _tmpMountDir = Just v, _devicesConfig = dc } -> Right c -> return $ Just c
return $ c { mountDir = v, devConfig = dc }
Right StaticConfig { _devicesConfig = dc } ->
return $ c { devConfig = dc }
runPrompt :: RofiConf c => [RofiGroup c] -> RofiIO c () runPrompt :: RofiConf c => [RofiGroup c] -> RofiIO c ()
runPrompt gs = selectAction $ emptyMenu runPrompt gs = selectAction $ emptyMenu
@ -291,14 +369,7 @@ runPrompt gs = selectAction $ emptyMenu
getGroups :: RofiIO MountConf [RofiGroup MountConf] getGroups :: RofiIO MountConf [RofiGroup MountConf]
getGroups = do getGroups = do
sysd <- io getSystemdDevices sysd <- io getSystemdDevices
devConf <- asks devConfig (cifsDevs, sshfsDevs, vcDevs) <- getStaticDevices
(cifsDevs, sshfsDevs, vcDevs) <- maybe
(return ( [] :: [CIFS], [] :: [SSHFS], [] :: [VeraCrypt]))
(\c -> liftM3 (,,)
(fromConfig $ _cifsConfigs c)
(fromConfig $ _sshfsConfigs c)
(fromConfig $ _veracryptConfigs c))
devConf
sequence sequence
[ mkGroup2 "SSHFS Devices" (filterSysd SystemdSSHFS sysd) sshfsDevs [ mkGroup2 "SSHFS Devices" (filterSysd SystemdSSHFS sysd) sshfsDevs
, mkGroup "CIFS Devices" cifsDevs , mkGroup "CIFS Devices" cifsDevs
@ -309,6 +380,34 @@ getGroups = do
where where
filterSysd t = filter (\s -> sysdType s == t) filterSysd t = filter (\s -> sysdType s == t)
mountByAlias :: Bool -> String -> RofiIO MountConf ()
mountByAlias unmountFlag alias = do
static <- asks mountconfStaticDevs
forM_ static $ \static' -> do
volatilePath <- asks mountconfVolatilePath
c <- toDev volatilePath static' _cifsConfigs alias
s <- toDev volatilePath static' _sshfsConfigs alias
v <- toDev volatilePath static' _veracryptConfigs alias
mountIfJust (c :: Maybe CIFS)
$ mountIfJust (s :: Maybe SSHFS)
$ mountIfJust (v :: Maybe VeraCrypt) (return ())
where
toDev v s f = mapM (configToDev v s) . aliasToDevice s f
mountIfJust a b = if isNothing a then b else forM_ a $ flip mount unmountFlag
aliasToDevice :: DevicesConfig -> (DevicesConfig -> M.Map String a) -> String -> Maybe a
aliasToDevice d f = flip M.lookup (f d)
getStaticDevices :: RofiIO MountConf ([CIFS], [SSHFS], [VeraCrypt])
getStaticDevices = do
static <- asks mountconfStaticDevs
maybe (return ( [] :: [CIFS], [] :: [SSHFS], [] :: [VeraCrypt]))
(\c -> liftM3 (,,)
(fromConfig c _cifsConfigs)
(fromConfig c _sshfsConfigs)
(fromConfig c _veracryptConfigs))
static
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
@ -391,10 +490,14 @@ getRemovableDevices = fromLines toDev . lines
-- This wraps the Removable device (since it is removable) and also adds its -- This wraps the Removable device (since it is removable) and also adds its
-- own mount options and passwords for authentication. -- own mount options and passwords for authentication.
data CIFS = CIFS Removable FilePath (Maybe PasswordGetter) data CIFS = CIFS Removable FilePath (Maybe PasswordGetter) Dependency
instance Show CIFS where
show (CIFS r f _ d) = unwords [show r, show f, "<Pwd>", show d]
instance Mountable CIFS where instance Mountable CIFS where
mount (CIFS Removable{ label = l } m getPwd) False = mount (CIFS Removable{ label = l } m getPwd deps) False = do
mountDependencies deps
bracketOnError_ bracketOnError_
(mkDirMaybe m) (mkDirMaybe m)
(rmDirMaybe m) (rmDirMaybe m)
@ -406,20 +509,22 @@ instance Mountable CIFS where
Nothing -> readCmdEither "mount" [m] "" Nothing -> readCmdEither "mount" [m] ""
notifyMounted (isRight res) False l notifyMounted (isRight res) False l
mount (CIFS Removable{ label = l } m _) True = umountNotify l m mount (CIFS Removable{ label = l } m _ _) True = umountNotify l m
allInstalled _ = io $ isJust <$> findExecutable "mount.cifs" allInstalled _ = io $ isJust <$> findExecutable "mount.cifs"
isMounted (CIFS _ dir _) = io $ isDirMounted dir isMounted (CIFS _ dir _ _) = io $ isDirMounted dir
fmtEntry (CIFS r _ _) = fmtEntry r fmtEntry (CIFS r _ _ _) = fmtEntry r
instance StaticDevice CIFS CIFSConfig where instance StaticDevice CIFS CIFSConfig where
configToDev v CIFSConfig { _cifsMount = MountConfig { _mountMountPoint = m } configToDev v s CIFSConfig { _cifsMount = MountConfig { _mountMountPoint = m }
, _cifsRemote = t , _cifsRemote = t
, _cifsPassword = p } = , _cifsDepends = d
, _cifsPassword = p } = do
let r = Removable { deviceSpec = smartSlashPrefix t, label = takeFileName m } let r = Removable { deviceSpec = smartSlashPrefix t, label = takeFileName m }
in CIFS r (appendRoot v m) $ configToPwd <$> p d' <- maybe (return initDependencies) (getDependencies s) d
return $ CIFS r (appendRoot v m) (configToPwd <$> p) d'
where where
smartSlashPrefix a = if "//" `isPrefixOf` a then a else "//" ++ a smartSlashPrefix a = if "//" `isPrefixOf` a then a else "//" ++ a
@ -431,37 +536,44 @@ instance StaticDevice CIFS CIFSConfig where
-- config that specifies the port, hostname, user, and identity file, these -- config that specifies the port, hostname, user, and identity file, these
-- need to be passed as mount options. -- need to be passed as mount options.
data SSHFS = SSHFS Removable FilePath data SSHFS = SSHFS Removable FilePath Dependency deriving Show
instance Mountable SSHFS where instance Mountable SSHFS where
mount (SSHFS Removable{ deviceSpec = d, label = l } m) False = do mount (SSHFS Removable{ deviceSpec = d, label = l } m deps) False = do
mountDependencies deps
bracketOnError_ bracketOnError_
(mkDirMaybe m) (mkDirMaybe m)
(rmDirMaybe m) (rmDirMaybe m)
(io $ runMountNotify "sshfs" [d, m] l False) (io $ runMountNotify "sshfs" [d, m] l False)
mount (SSHFS Removable{ label = l } m) True = umountNotify l m mount (SSHFS Removable{ label = l } m _) True = umountNotify l m
allInstalled _ = fmap isJust $ io $ findExecutable "sshfs" allInstalled _ = fmap isJust $ io $ findExecutable "sshfs"
isMounted (SSHFS _ dir) = io $ isDirMounted dir isMounted (SSHFS _ dir _) = io $ isDirMounted dir
fmtEntry (SSHFS r _) = fmtEntry r fmtEntry (SSHFS r _ _) = fmtEntry r
instance StaticDevice SSHFS SSHFSConfig where instance StaticDevice SSHFS SSHFSConfig where
configToDev v SSHFSConfig { _sshfsMount = MountConfig { _mountMountPoint = m } configToDev v s SSHFSConfig { _sshfsMount = MountConfig { _mountMountPoint = m }
, _sshfsRemote = t } = , _sshfsDepends = d
, _sshfsRemote = t } = do
let r = Removable { deviceSpec = t, label = takeFileName m } let r = Removable { deviceSpec = t, label = takeFileName m }
in SSHFS r (appendRoot v m) d' <- maybe (return initDependencies) (getDependencies s) d
return $ SSHFS r (appendRoot v m) d'
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | VeraCrypt Devices -- | VeraCrypt Devices
-- --
data VeraCrypt = VeraCrypt Removable FilePath (Maybe PasswordGetter) data VeraCrypt = VeraCrypt Removable FilePath (Maybe PasswordGetter) Dependency
instance Show VeraCrypt where
show (VeraCrypt r f _ d) = unwords [show r, show f, show d]
instance Mountable VeraCrypt where instance Mountable VeraCrypt where
mount (VeraCrypt Removable{ deviceSpec = s, label = l } m getPwd) False = mount (VeraCrypt Removable{ deviceSpec = s, label = l } m getPwd deps) False = do
mountDependencies deps
bracketOnError_ (mkDirMaybe m) (rmDirMaybe m) mountMaybe bracketOnError_ (mkDirMaybe m) (rmDirMaybe m) mountMaybe
where where
mountMaybe = io $ maybe (runVeraCryptWith "" []) (runVeraCryptWithPwd =<<) getPwd mountMaybe = io $ maybe (runVeraCryptWith "" []) (runVeraCryptWithPwd =<<) getPwd
@ -471,15 +583,15 @@ instance Mountable VeraCrypt where
notifyFail = notify "dialog-error-symbolic" $ notifyFail = notify "dialog-error-symbolic" $
printf "Failed to get volume password for %s" l printf "Failed to get volume password for %s" l
mount (VeraCrypt Removable{ label = l } m _) True = io $ do mount (VeraCrypt Removable{ label = l } m _ _) True = io $ do
res <- runVeraCrypt "" ["-d", m] res <- runVeraCrypt "" ["-d", m]
notifyMounted (isRight res) True l notifyMounted (isRight res) True l
allInstalled _ = io $ isJust <$> findExecutable "veracrypt" allInstalled _ = io $ isJust <$> findExecutable "veracrypt"
isMounted (VeraCrypt _ dir _) = io $ isDirMounted dir isMounted (VeraCrypt _ dir _ _) = io $ isDirMounted dir
fmtEntry (VeraCrypt r _ _) = fmtEntry r fmtEntry (VeraCrypt r _ _ _) = fmtEntry r
-- NOTE: the user is assumed to have added themselves to the sudoers file so -- NOTE: the user is assumed to have added themselves to the sudoers file so
-- that this command will work -- that this command will work
@ -490,11 +602,56 @@ runVeraCrypt stdin args = do
defaultArgs = ["/usr/bin/veracrypt", "--text", "--non-interactive"] defaultArgs = ["/usr/bin/veracrypt", "--text", "--non-interactive"]
instance StaticDevice VeraCrypt VeracryptConfig where instance StaticDevice VeraCrypt VeracryptConfig where
configToDev v VeracryptConfig { _veracryptMount = MountConfig { _mountMountPoint = m } configToDev v s VeracryptConfig { _veracryptMount = MountConfig { _mountMountPoint = m }
, _veracryptVolume = t , _veracryptVolume = t
, _veracryptPassword = p } = , _veracryptDepends = d
, _veracryptPassword = p } = do
let r = Removable { deviceSpec = t, label = takeFileName m } let r = Removable { deviceSpec = t, label = takeFileName m }
in VeraCrypt r (appendRoot v m) $ configToPwd <$> p d' <- maybe (return initDependencies) (getDependencies s) d
return $ VeraCrypt r (appendRoot v m) (configToPwd <$> p) d'
--------------------------------------------------------------------------------
-- | Dependencies
--
-- Define a data structure that allows one device to depend on another. Since
-- each device is different and has a different typeclass instance, need to
-- include slots for all possible devices. For now only deal with static
-- devices.
data Dependency = Dependency
{ dependencySSHFS :: [SSHFS]
, dependencyCIFS :: [CIFS]
, dependencyVeracrypt :: [VeraCrypt]
} deriving Show
initDependencies :: Dependency
initDependencies = Dependency [] [] []
getDependencies :: DevicesConfig -> DependsConfig -> RofiIO MountConf Dependency
getDependencies devConf DependsConfig { _dependsCIFS = c
, _dependsSSHFS = s
, _dependsVeracrypt = v} = do
c' <- getDepConfigs c _cifsConfigs
s' <- getDepConfigs s _sshfsConfigs
v' <- getDepConfigs v _veracryptConfigs
return Dependency
{ dependencyCIFS = c'
, dependencySSHFS = s'
, dependencyVeracrypt = v'
}
where
getDepConfigs aliases getConfig = fromConfig' devConf
$ M.elems . M.filterWithKey (\k _ -> k `elem` V.toList aliases) . getConfig
mountDependencies :: Dependency -> RofiIO MountConf ()
mountDependencies Dependency { dependencyCIFS = c
, dependencySSHFS = s
, dependencyVeracrypt = v
} =
mountAll c >> mountAll s >> mountAll v
where
mountAll :: Mountable a => [a] -> RofiIO MountConf ()
mountAll = mapM_ (\d -> isMounted d >>= (\r -> unless r $ mount d False))
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | MTP devices -- | MTP devices
@ -533,7 +690,7 @@ instance Mountable MTPFS where
-- | Return list of all available MTP devices -- | Return list of all available MTP devices
getMTPDevices :: RofiIO MountConf [MTPFS] getMTPDevices :: RofiIO MountConf [MTPFS]
getMTPDevices = do getMTPDevices = do
dir <- asks mountDir dir <- asks mountconfVolatilePath
res <- io $ readProcess "jmtpfs" ["-l"] "" res <- io $ readProcess "jmtpfs" ["-l"] ""
return $ fromLines (toDev dir) $ toDevList res return $ fromLines (toDev dir) $ toDevList res
where where
@ -669,7 +826,7 @@ mkDirMaybe fp = whenInMountDir fp $ io $ createDirectoryIfMissing True fp
rmDirMaybe :: FilePath -> RofiIO MountConf () rmDirMaybe :: FilePath -> RofiIO MountConf ()
rmDirMaybe fp = whenInMountDir fp $ unlessMountpoint fp rmDirMaybe fp = whenInMountDir fp $ unlessMountpoint fp
$ asks mountDir >>= io . rmUntil fp $ asks mountconfVolatilePath >>= io . rmUntil fp
where where
rmUntil cur target = unless (target == cur) $ do rmUntil cur target = unless (target == cur) $ do
removePathForcibly cur removePathForcibly cur
@ -677,7 +834,7 @@ rmDirMaybe fp = whenInMountDir fp $ unlessMountpoint fp
whenInMountDir :: FilePath -> RofiIO MountConf () -> RofiIO MountConf () whenInMountDir :: FilePath -> RofiIO MountConf () -> RofiIO MountConf ()
whenInMountDir fp f = do whenInMountDir fp f = do
mDir <- asks mountDir mDir <- asks mountconfVolatilePath
when (mDir `isPrefixOf` fp) f when (mDir `isPrefixOf` fp) f
unlessMountpoint :: FilePath -> RofiIO MountConf () -> RofiIO MountConf () unlessMountpoint :: FilePath -> RofiIO MountConf () -> RofiIO MountConf ()

View File

@ -33,6 +33,7 @@ dependencies:
- split >= 0.2.3.3 - split >= 0.2.3.3
- containers >= 0.6.0.1 - containers >= 0.6.0.1
- filepath >= 1.4.2.1 - filepath >= 1.4.2.1
- text >= 1.2.3.1
- unliftio >= 0.2.12 - unliftio >= 0.2.12
- unliftio-core >= 0.1.2.0 - unliftio-core >= 0.1.2.0
- X11 >= 1.9.1 - X11 >= 1.9.1