ADD password prompt to sshfs and FIX password prompt since it never actually worked
This commit is contained in:
parent
ded4f4a0b4
commit
e3ecbad62d
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue