From ecc967a33fbd4724f5782f6d6b858b3df103b134 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 12 Aug 2016 12:10:41 -0400 Subject: prompt for name --- CmdLine.hs | 6 ------ UI.hs | 4 ++-- UI/Readline.hs | 32 ++++++++++++++++++-------------- UI/Zenity.hs | 5 +++-- keysafe.hs | 50 +++++++++++++++++++++++++++++++++++++++++++------- 5 files changed, 66 insertions(+), 31 deletions(-) diff --git a/CmdLine.hs b/CmdLine.hs index 2b494db..b47d609 100644 --- a/CmdLine.hs +++ b/CmdLine.hs @@ -11,7 +11,6 @@ import qualified Data.ByteString.UTF8 as BU8 data CmdLine = CmdLine { mode :: Mode - , name :: Name , keytype :: KeyType , testMode :: Bool , gui :: Bool @@ -24,7 +23,6 @@ data Mode = Backup | Restore parse :: Parser CmdLine parse = CmdLine <$> (backup <|> restore) - <*> nameopt <*> keytypeopt <*> testmodeswitch <*> guiswitch @@ -37,10 +35,6 @@ parse = CmdLine ( long "restore" <> help "Retrieve a secret key from keysafe." ) - nameopt = Name . BU8.fromString <$> strOption - ( long "name" - <> help "Some name that is associated with the key. Should be something you can remember when restoring it." - ) keytypeopt = KeyType . BU8.fromString <$> strOption ( long "type" <> help "Type of key (eg, \"gpg\")." diff --git a/UI.hs b/UI.hs index a97f3c1..279f6b9 100644 --- a/UI.hs +++ b/UI.hs @@ -3,7 +3,7 @@ - Licensed under the GNU AGPL version 3 or higher. -} -module UI where +module UI (module UI, module Types.UI) where import Types.UI import Control.Monad @@ -11,7 +11,7 @@ import UI.Zenity import UI.Readline availableUIs :: IO [UI] -availableUIs = filterM isAvailable [zenityUI, readlineUI] +availableUIs = filterM isAvailable [readlineUI, zenityUI] selectUI :: Bool -> IO UI selectUI needgui diff --git a/UI/Readline.hs b/UI/Readline.hs index bcbe27e..50f2e99 100644 --- a/UI/Readline.hs +++ b/UI/Readline.hs @@ -10,7 +10,6 @@ import Types import System.Console.Readline import System.Posix.Terminal import System.Posix.IO -import Control.Monad import Control.Exception import System.IO import qualified Data.ByteString.UTF8 as BU8 @@ -23,15 +22,14 @@ readlineUI = UI , withProgress = progress } -name :: Title -> Desc -> (Name -> Maybe Problem) -> IO (Maybe Name) -name title desc checkproblem = go "" +name :: Title -> Desc -> Name -> (Name -> Maybe Problem) -> IO (Maybe Name) +name title desc (Name suggested) checkproblem = do + showTitle title + putStrLn desc + go where - go extradesc = do - putStrLn title - putStrLn "" - putStrLn desc - unless (null extradesc) $ - putStrLn extradesc + go = do + addHistory (BU8.toString suggested) mname <- readline "Name> " case mname of Just s -> do @@ -41,15 +39,16 @@ name title desc checkproblem = go "" Nothing -> do putStrLn "" return $ Just n - Just problem -> go problem + Just problem -> do + putStrLn problem + go Nothing -> return Nothing password :: Title -> Desc -> (Password -> Maybe Problem) -> IO (Maybe Password) password title desc checkproblem = bracket setup teardown (const go) where setup = do - putStrLn title - putStrLn "" + showTitle title putStrLn desc origattr <- getTerminalAttributes stdInput let newattr = origattr `withoutMode` EnableEcho @@ -83,10 +82,15 @@ progress :: Title -> Desc -> ((Percent -> IO ()) -> IO ()) -> IO () progress title desc a = bracket_ setup teardown (a sendpercent) where setup = do - putStrLn title - putStrLn "" + showTitle title putStrLn desc sendpercent p = do putStr (show p ++ "% ") hFlush stdout teardown = putStrLn "done" + +showTitle :: Title -> IO () +showTitle title = do + putStrLn title + putStrLn (replicate (length title) '-') + putStrLn "" diff --git a/UI/Zenity.hs b/UI/Zenity.hs index 3b8b028..f61bb44 100644 --- a/UI/Zenity.hs +++ b/UI/Zenity.hs @@ -27,14 +27,15 @@ zenityUI = UI , withProgress = progress } -name :: Title -> Desc -> (Name -> Maybe Problem) -> IO (Maybe Name) -name title desc checkproblem = go "" +name :: Title -> Desc -> Name -> (Name -> Maybe Problem) -> IO (Maybe Name) +name title desc (Name suggested) checkproblem = go "" where go extradesc = do h <- runZenity [ "--entry" , "--title", title , "--text", desc ++ "\n" ++ extradesc + , "--entry-text", BU8.toString suggested ] (ret, ok) <- waitZenity h if ok diff --git a/keysafe.hs b/keysafe.hs index 94a7b09..6306511 100644 --- a/keysafe.hs +++ b/keysafe.hs @@ -16,25 +16,32 @@ import Cost import Shard import Storage import Storage.LocalFiles +import Data.Maybe +import qualified Data.ByteString as B +import qualified Data.ByteString.UTF8 as BU8 +import System.Posix.User (userGecos, getUserEntryForID, getEffectiveUserID) main :: IO () main = do cmdline <- CmdLine.get ui <- selectUI (CmdLine.gui cmdline) - let name = CmdLine.name cmdline let keytype = CmdLine.keytype cmdline -- TODO determine gpg key id by examining secret key, -- or retrieving public key from keyserver and examining it. let keyid = KeyId keytype "dummy key id" case CmdLine.mode cmdline of - CmdLine.Backup -> storedemo name keyid $ + CmdLine.Backup -> storedemo ui keyid $ if CmdLine.testMode cmdline then testModeTunables else defaultTunables - CmdLine.Restore -> retrievedemo name keyid + CmdLine.Restore -> retrievedemo ui keyid -storedemo :: Name -> KeyId -> Tunables -> IO () -storedemo name keyid tunables = do +storedemo :: UI -> KeyId -> Tunables -> IO () +storedemo ui keyid tunables = do + username <- userName + name <- fromMaybe (error "Aborting on no name") + <$> promptName ui "Enter a name" + namedesc username validateName kek <- genKeyEncryptionKey tunables name password putStrLn "Very rough estimate of cost to brute-force the password:" print $ estimateAttack spotAWS $ estimateBruteforceOf kek @@ -47,9 +54,22 @@ storedemo name keyid tunables = do where password = Password "correct horse battery staple" secretkey = SecretKey "this is a gpg private key" + namedesc = unlines + [ "To back up your key, you will need to enter a name and a password." + , "" + , "Make sure to pick a name you will remember at some point in the future," + , "perhaps years from now, when you will need to enter it with the same" + , "spelling and capitalization in order to restore the key." + , "" + , "(Your own full name is a pretty good choice for the name to enter here.)" + ] -retrievedemo :: Name -> KeyId -> IO () -retrievedemo name keyid = do +retrievedemo :: UI -> KeyId -> IO () +retrievedemo ui keyid = do + username <- userName + name <- fromMaybe (error "Aborting on no name") + <$> promptName ui "Enter the name of the key to restore" + namedesc username validateName let sis = shardIdents tunables name keyid -- we drop 1 to simulate not getting all shards from the servers let l = drop 1 $ zip [1..] (getIdents sis) @@ -68,3 +88,19 @@ retrievedemo name keyid = do password = Password "correct horse battery staple" -- TODO: derive by probing to find objects tunables = testModeTunables -- defaultTunables + namedesc = unlines + [ "When you backed up the key, you entered a name and a password." + , "Now it's time to remember what you entered back then." + , "" + , "(If you can't remember the name you used, your own full name is the best guess.)" + ] + +validateName :: Name -> Maybe Problem +validateName (Name n) + | B.length n < 6 = Just "The name should be at least 6 letters long." + | otherwise = Nothing + +userName :: IO Name +userName = do + u <- getUserEntryForID =<< getEffectiveUserID + return $ Name $ BU8.fromString $ takeWhile (/= ',') (userGecos u) -- cgit v1.2.3