ADD veracrypt support

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]
+    { sshfsDevices     :: [SSHFS]
-    , cifsDevices  :: [CIFS]
+    , 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' :: 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)
 
+umountNotify :: String -> FilePath -> RofiIO MountConf ()
+umountNotify = umountNotify' "umount"
+
 -- | Send a notification indicating the mount succeeded
 notifyMounted :: Bool -> Bool -> String -> IO ()
 notifyMounted succeeded mounted label =