diff --git a/app/rofi-dev.hs b/app/rofi-dev.hs index e5f9a5d..cacfaed 100644 --- a/app/rofi-dev.hs +++ b/app/rofi-dev.hs @@ -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 -- @@ -394,8 +432,9 @@ class Mountable a where -- | Intermediate structure to hold fstab devices data FSTab = FSTab - { sshfsDevices :: [SSHFS] - , cifsDevices :: [CIFS] + { 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 =