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