ADD veracrypt support

This commit is contained in:
Nathan Dwarshuis 2020-08-15 13:54:33 -04:00
parent 537841b1b9
commit 73ee4f4cd2
1 changed files with 50 additions and 6 deletions

View File

@ -143,6 +143,7 @@ getGroups = do
sequence sequence
[ mkGroup "SSHFS Devices" $ sshfsDevices fstab [ mkGroup "SSHFS Devices" $ sshfsDevices fstab
, mkGroup "CIFS Devices" $ cifsDevices fstab , mkGroup "CIFS Devices" $ cifsDevices fstab
, mkGroup "Veracrypt Devices" $ veracryptDevices fstab
, mkGroup "Removable Devices" =<< getRemovableDevices , mkGroup "Removable Devices" =<< getRemovableDevices
, mkGroup "MTP Devices" =<< getMTPDevices , mkGroup "MTP Devices" =<< getMTPDevices
] ]
@ -290,6 +291,43 @@ fstabToSSHFS FSTabEntry{ fstabSpec = s, fstabDir = d } = return $ SSHFS r d
where where
r = Removable { deviceSpec = s, label = takeFileName d } 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 -- | MTP devices
-- --
@ -394,8 +432,9 @@ class Mountable a where
-- | Intermediate structure to hold fstab devices -- | Intermediate structure to hold fstab devices
data FSTab = FSTab data FSTab = FSTab
{ sshfsDevices :: [SSHFS] { sshfsDevices :: [SSHFS]
, cifsDevices :: [CIFS] , cifsDevices :: [CIFS]
, veracryptDevices :: [VeraCrypt]
} }
-- | Data structure representing an fstab device (or one line in the fstab file) -- | 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 -- | Return all user fstab devices from /etc/fstab
readFSTab :: RofiIO MountConf FSTab readFSTab :: RofiIO MountConf FSTab
readFSTab = do readFSTab = do
let i = FSTab { sshfsDevices = [], cifsDevices = [] } let i = FSTab { sshfsDevices = [], cifsDevices = [], veracryptDevices = []}
fstab <- io $ readFile "/etc/fstab" fstab <- io $ readFile "/etc/fstab"
foldM addFstabDevice i $ fromLines toEntry $ lines fstab foldM addFstabDevice i $ fromLines toEntry $ lines fstab
where where
@ -436,6 +475,8 @@ addFstabDevice f@FSTab{..} e@FSTabEntry{..}
(\d -> f { cifsDevices = append d cifsDevices }) <$> fstabToCIFS e (\d -> f { cifsDevices = append d cifsDevices }) <$> fstabToCIFS e
| fstabType == "fuse.sshfs" = | fstabType == "fuse.sshfs" =
(\d -> f { sshfsDevices = append d sshfsDevices }) <$> fstabToSSHFS e (\d -> f { sshfsDevices = append d sshfsDevices }) <$> fstabToSSHFS e
| fstabType == "veracrypt" =
(\d -> f { veracryptDevices = append d veracryptDevices }) <$> fstabToVeraCrypt e
| otherwise = return f | otherwise = return f
where where
append x xs = xs ++ [x] append x xs = xs ++ [x]
@ -483,11 +524,14 @@ runMountNotify cmd args msg mounted = do
res <- readCmdEither cmd args "" res <- readCmdEither cmd args ""
notifyMounted (isRight res) mounted msg notifyMounted (isRight res) mounted msg
umountNotify :: String -> FilePath -> RofiIO MountConf () umountNotify' :: String -> String -> FilePath -> RofiIO MountConf ()
umountNotify msg dir = finally umountNotify' cmd msg dir = finally
(io $ runMountNotify "umount" [dir] msg True) (io $ runMountNotify cmd [dir] msg True)
(rmDirMaybe dir) (rmDirMaybe dir)
umountNotify :: String -> FilePath -> RofiIO MountConf ()
umountNotify = umountNotify' "umount"
-- | Send a notification indicating the mount succeeded -- | Send a notification indicating the mount succeeded
notifyMounted :: Bool -> Bool -> String -> IO () notifyMounted :: Bool -> Bool -> String -> IO ()
notifyMounted succeeded mounted label = notifyMounted succeeded mounted label =