From 44515414172aed08cdca302a0de62cfbe2031768 Mon Sep 17 00:00:00 2001 From: ndwarshuis Date: Fri, 22 Jul 2022 00:19:41 -0400 Subject: [PATCH] ADD support for partially mounted things --- app/rofi-dev.hs | 75 ++++++++++++++++++++++++++++++++++++++----------- package.yaml | 1 + 2 files changed, 60 insertions(+), 16 deletions(-) diff --git a/app/rofi-dev.hs b/app/rofi-dev.hs index 574244e..2a268a4 100644 --- a/app/rofi-dev.hs +++ b/app/rofi-dev.hs @@ -161,6 +161,12 @@ instance RofiConf MountConf where -- -- Class to provide common interface for anything that can be mounted. +data MountState = Unmounted | Mounted | Partial deriving (Show, Eq) + +mountedState :: MountState -> Bool +mountedState Mounted = True +mountedState _ = False + class Mountable a where -- | Mount the given type (or dismount if False is passed) mount :: a -> Bool -> RofiMountIO MountResult @@ -183,6 +189,9 @@ class Mountable a where -- | Determine if the given type is mounted or not isMounted :: a -> RofiMountIO Bool + isMounted dev = mountedState <$> mountState dev + + mountState :: a -> RofiMountIO MountState -------------------------------------------------------------------------------- -- | Actionable typeclass @@ -204,18 +213,19 @@ class Mountable a => Actionable a where -- Rofi prompt and an action to perform when it is selected) mkAction :: a -> RofiMountIO (Header, ProtoAction [String]) mkAction dev = do - m <- isMounted dev + m <- mountState dev i <- allInstalled dev let h = groupHeader dev - let action = when i $ mountMaybe dev m + let action = when i $ mountMaybe dev $ mountedState m let entry = case fmtEntry dev of (e:es) -> (mountedPrefix m i ++ e):es _ -> [] return (h, ProtoAction entry action) where - mountedPrefix False True = " " - mountedPrefix True True = "* " - mountedPrefix _ False = "! " + mountedPrefix _ False = "! " + mountedPrefix Unmounted True = " " + mountedPrefix Mounted True = "* " + mountedPrefix Partial True = "- " mountableToAction :: Actionable a => RofiMountIO [a] -> RofiMountIO [(Header, ProtoAction [String])] mountableToAction ms = mapM mkAction =<< ms @@ -402,7 +412,7 @@ instance Mountable a => Mountable (Tree a) where mount (Tree p cs) False = mapM_ (`mountMaybe` False) cs >> mount p False mount (Tree p _) True = mount p True - isMounted (Tree p _) = isMounted p + mountState (Tree p _) = mountState p allInstalled (Tree p cs) = do res <- and <$> mapM allInstalled cs @@ -472,8 +482,13 @@ instance Mountable DeviceConfig where exe CIFSConfig{} = "mount.cifs" exe VeracryptConfig{} = "veracrypt" - isMounted DeviceConfig{ deviceMount = m } = - (io . isDirMounted) =<< getAbsMountpoint m + mountState DeviceConfig{ deviceMount = m, deviceData = d } = do + -- mountState DeviceConfig{ deviceMount = m } = do + case d of + VeracryptConfig{} -> veracryptMountState m + _ -> do + b <- (io . isDirMounted) =<< getAbsMountpoint m + return $ if b then Mounted else Unmounted getLabel DeviceConfig { deviceMount = MountConfig { mountMountpoint = p, mountLabel = l } @@ -519,6 +534,23 @@ runVeraCrypt args = runMount "sudo" (defaultArgs ++ args) where defaultArgs = ["/usr/bin/veracrypt", "--text", "--non-interactive"] +veracryptMountState :: MountConfig -> RofiMountIO MountState +veracryptMountState mc = do + mp <- getAbsMountpoint mc + primary <- io $ lookupSpec mp + aux <- io $ fmap join $ mapM lookupSpec $ auxPath =<< primary + return $ case (primary, aux) of + (Just _, Just _) -> Mounted + (Nothing, Nothing) -> Unmounted + _ -> Partial + where + -- TODO don't hardcode the tmp directory + auxPath = fmap (\i -> "/tmp/.veracrypt_aux_mnt" ++ [i]) . vcIndex + vcIndex spec = case reverse spec of + -- TODO what if I have more than one digit? + (i:_) -> if i `elem` ['0'..'9'] then Just i else Nothing + _ -> Nothing + getAbsMountpoint :: MountConfig -> RofiMountIO FilePath getAbsMountpoint MountConfig{ mountMountpoint = m } = asks $ flip appendRoot m . mountconfVolatilePath @@ -596,7 +628,9 @@ instance Mountable Removable where allInstalled _ = fmap isJust $ io $ findExecutable "udisksctl" - isMounted Removable { removablePath = d } = elem d <$> io curDeviceSpecs + mountState Removable { removablePath = d } = do + s <- elem d <$> io curDeviceSpecs + return $ if s then Mounted else Unmounted getLabel Removable { removableLabel = l } = l @@ -649,7 +683,9 @@ instance Mountable MTPFS where -- | return True always since the list won't even show without jmtpfs allInstalled _ = return True - isMounted = io . isDirMounted <$> mtpfsMountpoint + mountState MTPFS { mtpfsMountpoint = m } = do + s <- io $ isDirMounted m + return $ if s then Mounted else Unmounted getLabel = mtpfsDescription @@ -748,16 +784,23 @@ eitherToMountResult (Left (_, _, e)) = MountError e -------------------------------------------------------------------------------- -- | Low-level mount functions --- ASSUME these will never fail because the format of /proc/mounts is fixed - -curMountField :: Int -> IO [String] -curMountField i = fmap ((!! i) . words) . lines <$> readFile "/proc/mounts" +mountMap :: IO (M.Map FilePath String) +mountMap = do + parseFile <$> readFile "/proc/mounts" + where + parseFile = M.fromList . mapMaybe (parseLine . words) . lines + -- none of these should fail since this file format will never change + parseLine [spec, mountpoint, _, _, _, _] = Just (mountpoint, spec) + parseLine _ = Nothing curDeviceSpecs :: IO [String] -curDeviceSpecs = curMountField 0 +curDeviceSpecs = M.elems <$> mountMap curMountpoints :: IO [String] -curMountpoints = curMountField 1 +curMountpoints = M.keys <$> mountMap + +lookupSpec :: FilePath -> IO (Maybe String) +lookupSpec mountpoint = M.lookup mountpoint <$> mountMap -- ASSUME the base mount path will always be created because -- 'createDirectoryIfMissing' will make parents if missing, and that removing diff --git a/package.yaml b/package.yaml index 541dad0..d8f7f16 100644 --- a/package.yaml +++ b/package.yaml @@ -39,6 +39,7 @@ dependencies: - X11 >= 1.9.1 - yaml >= 0.11.1.2 - vector >= 0.12.0.3 +- bimap >= 0.2.4 library: source-dirs: lib/