ADD veracrypt support
This commit is contained in:
parent
537841b1b9
commit
73ee4f4cd2
|
@ -143,6 +143,7 @@ getGroups = do
|
|||
sequence
|
||||
[ mkGroup "SSHFS Devices" $ sshfsDevices fstab
|
||||
, mkGroup "CIFS Devices" $ cifsDevices fstab
|
||||
, mkGroup "Veracrypt Devices" $ veracryptDevices fstab
|
||||
, mkGroup "Removable Devices" =<< getRemovableDevices
|
||||
, mkGroup "MTP Devices" =<< getMTPDevices
|
||||
]
|
||||
|
@ -290,6 +291,43 @@ fstabToSSHFS FSTabEntry{ fstabSpec = s, fstabDir = d } = return $ SSHFS r d
|
|||
where
|
||||
r = Removable { deviceSpec = s, label = takeFileName d }
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | VeraCrypt Devices
|
||||
--
|
||||
|
||||
data VeraCrypt = VeraCrypt Removable FilePath (Maybe Password)
|
||||
|
||||
instance Mountable VeraCrypt where
|
||||
-- TODO this is just like the CIFS version...
|
||||
mount (VeraCrypt Removable{ label = l } m getPwd) False =
|
||||
bracketOnError_
|
||||
(mkDirMaybe m)
|
||||
(rmDirMaybe m)
|
||||
$ io $ do
|
||||
res <- case getPwd of
|
||||
Just pwd -> do
|
||||
p <- maybe [] (\p -> [("PASSWD", p)]) <$> pwd
|
||||
readCmdEither' "mount" [m] "" p
|
||||
Nothing -> readCmdEither "mount" [m] ""
|
||||
print res
|
||||
notifyMounted (isRight res) False l
|
||||
|
||||
mount (VeraCrypt Removable{ label = l } m _) True =
|
||||
umountNotify' "umount.veracrypt" l m
|
||||
|
||||
-- TODO also check for umount.veracrypt?
|
||||
allInstalled _ = io $ isJust <$> findExecutable "mount.veracrypt"
|
||||
|
||||
isMounted (VeraCrypt _ dir _) = io $ isDirMounted dir
|
||||
|
||||
fmtEntry (VeraCrypt r _ _) = fmtEntry r
|
||||
|
||||
fstabToVeraCrypt :: FSTabEntry -> RofiIO MountConf VeraCrypt
|
||||
fstabToVeraCrypt FSTabEntry{ fstabSpec = s, fstabDir = d } = do
|
||||
pwd <- Just . M.findWithDefault readPassword d <$> asks passwords
|
||||
let r = Removable { deviceSpec = s, label = takeFileName d }
|
||||
return $ VeraCrypt r d pwd
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | MTP devices
|
||||
--
|
||||
|
@ -396,6 +434,7 @@ class Mountable a where
|
|||
data FSTab = FSTab
|
||||
{ sshfsDevices :: [SSHFS]
|
||||
, cifsDevices :: [CIFS]
|
||||
, veracryptDevices :: [VeraCrypt]
|
||||
}
|
||||
|
||||
-- | Data structure representing an fstab device (or one line in the fstab file)
|
||||
|
@ -413,7 +452,7 @@ type MountOptions = M.Map String (Maybe String)
|
|||
-- | Return all user fstab devices from /etc/fstab
|
||||
readFSTab :: RofiIO MountConf FSTab
|
||||
readFSTab = do
|
||||
let i = FSTab { sshfsDevices = [], cifsDevices = [] }
|
||||
let i = FSTab { sshfsDevices = [], cifsDevices = [], veracryptDevices = []}
|
||||
fstab <- io $ readFile "/etc/fstab"
|
||||
foldM addFstabDevice i $ fromLines toEntry $ lines fstab
|
||||
where
|
||||
|
@ -436,6 +475,8 @@ addFstabDevice f@FSTab{..} e@FSTabEntry{..}
|
|||
(\d -> f { cifsDevices = append d cifsDevices }) <$> fstabToCIFS e
|
||||
| fstabType == "fuse.sshfs" =
|
||||
(\d -> f { sshfsDevices = append d sshfsDevices }) <$> fstabToSSHFS e
|
||||
| fstabType == "veracrypt" =
|
||||
(\d -> f { veracryptDevices = append d veracryptDevices }) <$> fstabToVeraCrypt e
|
||||
| otherwise = return f
|
||||
where
|
||||
append x xs = xs ++ [x]
|
||||
|
@ -483,11 +524,14 @@ runMountNotify cmd args msg mounted = do
|
|||
res <- readCmdEither cmd args ""
|
||||
notifyMounted (isRight res) mounted msg
|
||||
|
||||
umountNotify :: String -> FilePath -> RofiIO MountConf ()
|
||||
umountNotify msg dir = finally
|
||||
(io $ runMountNotify "umount" [dir] msg True)
|
||||
umountNotify' :: String -> String -> FilePath -> RofiIO MountConf ()
|
||||
umountNotify' cmd msg dir = finally
|
||||
(io $ runMountNotify cmd [dir] msg True)
|
||||
(rmDirMaybe dir)
|
||||
|
||||
umountNotify :: String -> FilePath -> RofiIO MountConf ()
|
||||
umountNotify = umountNotify' "umount"
|
||||
|
||||
-- | Send a notification indicating the mount succeeded
|
||||
notifyMounted :: Bool -> Bool -> String -> IO ()
|
||||
notifyMounted succeeded mounted label =
|
||||
|
|
Loading…
Reference in New Issue