From 758965d177d75f529bb88e24564a0bdb5e406fc6 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 27 Sep 2016 20:22:53 -0400 Subject: Filter out escape sequences and any other unusual characters when writing all messages to the console. This should protect against all attacks where the server sends back a malicious message. --- UI/NonInteractive.hs | 16 +++++------- UI/Readline.hs | 73 ++++++++++++++++++++++++---------------------------- 2 files changed, 41 insertions(+), 48 deletions(-) (limited to 'UI') diff --git a/UI/NonInteractive.hs b/UI/NonInteractive.hs index f0010eb..cd96254 100644 --- a/UI/NonInteractive.hs +++ b/UI/NonInteractive.hs @@ -6,7 +6,7 @@ module UI.NonInteractive (noninteractiveUI) where import Types.UI -import System.IO +import Output import Control.Exception noninteractiveUI :: UI @@ -22,21 +22,19 @@ noninteractiveUI = UI } myShowError :: Desc -> IO () -myShowError desc = hPutStrLn stderr $ "Error: " ++ desc +myShowError desc = warn $ "Error: " ++ desc myShowInfo :: Title -> Desc -> IO () -myShowInfo _title desc = putStrLn desc +myShowInfo _title desc = say desc myPrompt :: Title -> Desc -> x -> IO a myPrompt _title desc _ = do - putStrLn desc + say desc error "Not running at a terminal and zenity is not installed; cannot interact with user." myWithProgress :: Title -> Desc -> ((Percent -> IO ()) -> IO a) -> IO a myWithProgress _title desc a = bracket_ setup cleanup (a sendpercent) where - setup = putStrLn desc - sendpercent p = do - putStr (show p ++ "% ") - hFlush stdout - cleanup = putStrLn "done" + setup = say desc + sendpercent p = progress (show p ++ "% ") + cleanup = say "done" diff --git a/UI/Readline.hs b/UI/Readline.hs index 7f19f67..16e4923 100644 --- a/UI/Readline.hs +++ b/UI/Readline.hs @@ -7,11 +7,11 @@ module UI.Readline (readlineUI) where import Types.UI import Types +import Output import System.Console.Readline import System.Posix.Terminal import System.Posix.IO import Control.Exception -import System.IO import Data.List import Data.Char import Text.Read @@ -33,23 +33,23 @@ readlineUI = UI myShowError :: Desc -> IO () myShowError desc = do - hPutStrLn stderr $ "Error: " ++ desc + warn $ "Error: " ++ desc _ <- readline "[Press Enter]" - putStrLn "" + say "" myShowInfo :: Title -> Desc -> IO () myShowInfo title desc = do showTitle title - putStrLn desc - putStrLn "" + say desc + say "" myPromptQuestion :: Title -> Desc -> Question -> IO Bool myPromptQuestion title desc question = bracket_ setup cleanup go where setup = do showTitle title - putStrLn desc - cleanup = putStrLn "" + say desc + cleanup = say "" go = do mresp <- readline $ question ++ " [y/n] " case mresp of @@ -59,7 +59,7 @@ myPromptQuestion title desc question = bracket_ setup cleanup go | "n" `isPrefixOf` (map toLower s) -> return False _ -> do - putStrLn "Please enter 'y' or 'n'" + say "Please enter 'y' or 'n'" go myPromptName :: Title -> Desc -> Maybe Name -> (Name -> Maybe Problem) -> IO (Maybe Name) @@ -68,8 +68,8 @@ myPromptName title desc suggested checkproblem = where setup = do showTitle title - putStrLn desc - cleanup = putStrLn "" + say desc + cleanup = say "" go = do case suggested of Nothing -> return () @@ -81,10 +81,10 @@ myPromptName title desc suggested checkproblem = let n = Name $ BU8.fromString s case checkproblem n of Nothing -> do - putStrLn "" + say "" return $ Just n Just problem -> do - putStrLn problem + say problem go Nothing -> return Nothing @@ -93,33 +93,31 @@ myPromptPassword confirm title desc = bracket setup cleanup (const prompt) where setup = do showTitle title - putStrLn desc + say desc origattr <- getTerminalAttributes stdInput let newattr = origattr `withoutMode` EnableEcho setTerminalAttributes stdInput newattr Immediately return origattr cleanup origattr = do setTerminalAttributes stdInput origattr Immediately - putStrLn "" + say "" prompt = do - putStr "Enter password> " - hFlush stdout + ask "Enter password> " p1 <- getLine - putStrLn "" + say "" if confirm then promptconfirm p1 else return $ mkpassword p1 promptconfirm p1 = do - putStr "Confirm password> " - hFlush stdout + ask "Confirm password> " p2 <- getLine - putStrLn "" + say "" if p1 /= p2 then do - putStrLn "Passwords didn't match, try again..." + say "Passwords didn't match, try again..." prompt else do - putStrLn "" + say "" return $ mkpassword p1 mkpassword = Just . Password . BU8.fromString @@ -127,25 +125,24 @@ myPromptKeyId :: Title -> Desc -> [(Name, KeyId)] -> IO (Maybe KeyId) myPromptKeyId _ _ [] = return Nothing myPromptKeyId title desc l = do showTitle title - putStrLn desc - putStrLn "" + say desc + say "" forM_ nl $ \(n, ((Name name), (KeyId kid))) -> - putStrLn $ show n ++ ".\t" ++ BU8.toString name ++ " (keyid " ++ T.unpack kid ++ ")" + say $ show n ++ ".\t" ++ BU8.toString name ++ " (keyid " ++ T.unpack kid ++ ")" prompt where nl = zip [1 :: Integer ..] l prompt = do - putStr "Enter number> " - hFlush stdout + ask "Enter number> " r <- getLine - putStrLn "" + say "" case readMaybe r of Just n | n > 0 && n <= length l -> do - putStrLn "" + say "" return $ Just $ snd (l !! pred n) _ -> do - putStrLn $ "Enter a number from 1 to " ++ show (length l) + say $ "Enter a number from 1 to " ++ show (length l) prompt myWithProgress :: Title -> Desc -> ((Percent -> IO ()) -> IO a) -> IO a @@ -153,16 +150,14 @@ myWithProgress title desc a = bracket_ setup cleanup (a sendpercent) where setup = do showTitle title - putStrLn desc - sendpercent p = do - putStr (show p ++ "% ") - hFlush stdout + say desc + sendpercent p = ask (show p ++ "% ") cleanup = do - putStrLn "done" - putStrLn "" + say "done" + say "" showTitle :: Title -> IO () showTitle title = do - putStrLn title - putStrLn (replicate (length title) '-') - putStrLn "" + say title + say (replicate (length title) '-') + say "" -- cgit v1.2.3