ADD password prompt to sshfs and FIX password prompt since it never actually worked

This commit is contained in:
Nathan Dwarshuis 2022-02-03 00:32:52 -05:00
parent ded4f4a0b4
commit e3ecbad62d
1 changed files with 68 additions and 57 deletions

View File

@ -1,5 +1,5 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | rofi-dev - a rofi prompt for mountable devices -- | rofi-dev - a rofi prompt for mountable devices
@ -290,21 +290,21 @@ newtype PromptConfig = PromptConfig
deriving Show deriving Show
instance FromJSON PromptConfig where instance FromJSON PromptConfig where
parseJSON = withObject "libsecret" $ \o -> PromptConfig parseJSON = withObject "prompt" $ \o -> PromptConfig
<$> o .: "tries" .!= defaultTries <$> o .:? "tries" .!= defaultTries
data PasswordConfig = PasswordConfig data PasswordConfig = PwdBW BitwardenConfig
{ passwordBitwarden :: Maybe BitwardenConfig | PwdLS LibSecretConfig
, passwordLibSecret :: Maybe LibSecretConfig | PwdPr PromptConfig
, passwordPrompt :: Maybe PromptConfig
}
deriving Show deriving Show
instance FromJSON PasswordConfig where instance FromJSON PasswordConfig where
parseJSON = withObject "password" $ \o -> PasswordConfig parseJSON = withObject "password" $ \o -> do
<$> o .:? "bitwarden" br <- fmap PwdBW <$> o .:? "bitwarden"
<*> o .:? "libsecret" ls <- maybe (fmap PwdLS <$> o .:? "libsecret") (return . Just) br
<*> o .:? "prompt" -- TODO this is silly because I need to pass 'prompt: {}' instead of
-- just 'prompt:' if I just want the defaults
maybe (PwdPr <$> o .: "prompt") return ls
data CIFSOptsConfig = CIFSOptsConfig data CIFSOptsConfig = CIFSOptsConfig
{ cifsoptsUsername :: Maybe String { cifsoptsUsername :: Maybe String
@ -327,6 +327,7 @@ data DataConfig = VeracryptConfig
, veracryptPassword :: Maybe PasswordConfig , veracryptPassword :: Maybe PasswordConfig
} | SSHFSConfig } | SSHFSConfig
{ sshfsRemote :: String { sshfsRemote :: String
, sshfsPassword :: Maybe PasswordConfig
} | CIFSConfig } | CIFSConfig
{ cifsRemote :: String { cifsRemote :: String
, cifsSudo :: Bool , cifsSudo :: Bool
@ -357,6 +358,7 @@ instance FromJSON TreeConfig where
<*> o .:? "options" <*> o .:? "options"
"sshfs" -> SSHFSConfig "sshfs" -> SSHFSConfig
<$> o .: "remote" <$> o .: "remote"
<*> o .:? "password"
"veracrypt" -> VeracryptConfig "veracrypt" -> VeracryptConfig
<$> o .: "volume" <$> o .: "volume"
<*> o .:? "password" <*> o .:? "password"
@ -446,7 +448,7 @@ instance Mountable DeviceConfig where
withTmpMountDir m' withTmpMountDir m'
$ io $ io
$ case devData of $ case devData of
SSHFSConfig{ sshfsRemote = r } -> mountSSHFS m' r SSHFSConfig{ sshfsRemote = r, sshfsPassword = p } -> mountSSHFS m' p r
CIFSConfig CIFSConfig
{ cifsRemote = r { cifsRemote = r
, cifsSudo = s , cifsSudo = s
@ -477,8 +479,11 @@ instance Mountable DeviceConfig where
{ deviceMount = MountConfig { mountMountpoint = p, mountLabel = l } { deviceMount = MountConfig { mountMountpoint = p, mountLabel = l }
} = fromMaybe (takeFileName p) l } = fromMaybe (takeFileName p) l
mountSSHFS :: FilePath -> String -> IO MountResult mountSSHFS :: FilePath -> Maybe PasswordConfig -> String -> IO MountResult
mountSSHFS mountpoint remote = runMount "sshfs" [remote, mountpoint] "" mountSSHFS mountpoint pwdConfig remote =
withPasswordGetter pwdConfig (run ["-o", "password_stdin"]) $ run [] ""
where
run other = runMount "sshfs" (other ++ [remote, mountpoint])
mountCIFS :: Bool -> String -> FilePath -> Maybe CIFSOptsConfig mountCIFS :: Bool -> String -> FilePath -> Maybe CIFSOptsConfig
-> Maybe PasswordConfig -> IO MountResult -> Maybe PasswordConfig -> IO MountResult
@ -542,20 +547,26 @@ runPromptLoop n pwd = do
if n <= 0 then return Nothing else runPromptLoop (n-1) pwd if n <= 0 then return Nothing else runPromptLoop (n-1) pwd
else return res else return res
-- configToPwd :: PasswordConfig -> PasswordGetter
-- configToPwd PasswordConfig
-- { passwordBitwarden = b
-- , passwordLibSecret = s
-- , passwordPrompt = p
-- } =
-- getBW b `runMaybe` getLS s `runMaybe` getPrompt p
-- where
-- getBW (Just BitwardenConfig{ bitwardenKey = k, bitwardenTries = n }) =
-- runPromptLoop n $ runBitwarden k
-- getBW _ = return Nothing
-- getLS = maybe (return Nothing) (runSecret . libsecretAttributes)
-- getPrompt = maybe (return Nothing) (flip runPromptLoop readPassword . promptTries)
-- runMaybe x y = (\r -> if isNothing r then y else return r) =<< x
configToPwd :: PasswordConfig -> PasswordGetter configToPwd :: PasswordConfig -> PasswordGetter
configToPwd PasswordConfig configToPwd (PwdBW (BitwardenConfig { bitwardenKey = k, bitwardenTries = n })) =
{ passwordBitwarden = b
, passwordLibSecret = s
, passwordPrompt = p
} =
getBW b `runMaybe` getLS s `runMaybe` getPrompt p
where
getBW (Just BitwardenConfig{ bitwardenKey = k, bitwardenTries = n }) =
runPromptLoop n $ runBitwarden k runPromptLoop n $ runBitwarden k
getBW _ = return Nothing configToPwd (PwdLS s) = runSecret $ libsecretAttributes s
getLS = maybe (return Nothing) (runSecret . libsecretAttributes) configToPwd (PwdPr p) = flip runPromptLoop readPassword $ promptTries p
getPrompt = maybe (return Nothing) (flip runPromptLoop readPassword . promptTries)
runMaybe x y = (\r -> if isNothing r then y else return r) =<< x
withPasswordGetter :: Maybe PasswordConfig -> (String -> IO MountResult) withPasswordGetter :: Maybe PasswordConfig -> (String -> IO MountResult)
-> IO MountResult -> IO MountResult -> IO MountResult -> IO MountResult