From fccf788a5ce9788d7c073321a3d19941bc1269b1 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 16 Aug 2016 14:58:16 -0400 Subject: more command line interface improvements --- CmdLine.hs | 20 ++++++++++-- Gpg.hs | 9 ++++-- Types.hs | 3 +- Types/UI.hs | 2 ++ UI/Readline.hs | 23 ++++++++------ UI/Zenity.hs | 31 +++++++++++++------ keysafe.cabal | 1 + keysafe.hs | 96 +++++++++++++++++++++++++++++++++++++--------------------- 8 files changed, 124 insertions(+), 61 deletions(-) diff --git a/CmdLine.hs b/CmdLine.hs index ca574bb..6413cf7 100644 --- a/CmdLine.hs +++ b/CmdLine.hs @@ -3,14 +3,16 @@ - Licensed under the GNU AGPL version 3 or higher. -} -module CmdLine (CmdLine(..), Mode(..), get, parse) where +module CmdLine (CmdLine(..), Mode(..), get, parse, selectMode) where import Types +import qualified Gpg import Options.Applicative import qualified Data.ByteString.UTF8 as BU8 +import System.Directory data CmdLine = CmdLine - { mode :: Mode + { mode :: Maybe Mode , secretkeysource :: Maybe SecretKeySource , testMode :: Bool , gui :: Bool @@ -22,7 +24,7 @@ data Mode = Backup | Restore | Benchmark parse :: Parser CmdLine parse = CmdLine - <$> (backup <|> restore <|> benchmark) + <$> optional (backup <|> restore <|> benchmark) <*> optional (gpgswitch <|> fileswitch) <*> testmodeswitch <*> guiswitch @@ -63,3 +65,15 @@ get = execParser opts ( fullDesc <> header "keysafe - securely back up secret keys" ) + +-- | When a mode is not specified on the command line, +-- default to backing up if a secret key exists, and otherwise restoring. +selectMode :: CmdLine -> IO Mode +selectMode cmdline = case mode cmdline of + Just m -> return m + Nothing -> case secretkeysource cmdline of + Just (KeyFile f) -> present <$> doesFileExist f + _ -> present . not . null <$> Gpg.listSecretKeys + where + present True = Backup + present False = Restore diff --git a/Gpg.hs b/Gpg.hs index bf4cbe6..9794395 100644 --- a/Gpg.hs +++ b/Gpg.hs @@ -8,14 +8,17 @@ module Gpg where import Types import System.Process --- | Converts an input KeyId, which can be short, or even a name or email, --- to a long-form gpg KeyId of a secret key. -getFullKeyId :: KeyId -> IO (Maybe KeyId) +listSecretKeys :: IO [(Name, KeyId)] +listSecretKeys = undefined -- gpg --batch --with-colons --list-secret-keys -- extract from eg, sec::4096:1:C910D9222512E3C7:... +getSecretKey :: KeyId -> IO SecretKey +getSecretKey = undefined + -- | Check if a given gpg key is present on the keyserver. -- (Without downloading the key.) knownByKeyServer :: KeyId -> IO Bool +knownByKeyServer kid = undefined -- gpg --batch --with-colons --search-keys 2>/dev/null -- check if output includes pub: line diff --git a/Types.hs b/Types.hs index d3eeccb..5e06a74 100644 --- a/Types.hs +++ b/Types.hs @@ -52,8 +52,7 @@ data SecretKeySource = GpgKey KeyId | KeyFile FilePath -- | The keyid is any value that is unique to a private key, and can be -- looked up somehow without knowing the private key. -- --- A gpg keyid is the obvious example. But, if a gpg key is not --- stored on the key servers, keysafe will instead use "". +-- A gpg keyid is the obvious example. data KeyId = KeyId B.ByteString deriving (Show) diff --git a/Types/UI.hs b/Types/UI.hs index bba3d38..561aa65 100644 --- a/Types/UI.hs +++ b/Types/UI.hs @@ -9,8 +9,10 @@ import Types data UI = UI { isAvailable :: IO Bool + , showError :: Desc -> IO () , promptName :: Title -> Desc -> Name -> (Name -> Maybe Problem) -> IO (Maybe Name) , promptPassword :: Title -> Desc -> (Password -> Maybe Problem) -> IO (Maybe Password) + , promptKeyId :: Title -> Desc -> [(Name, KeyId)] -> IO (Maybe KeyId) , withProgress :: Title -> Desc -> ((Percent -> IO ()) -> IO ()) -> IO () } diff --git a/UI/Readline.hs b/UI/Readline.hs index 50f2e99..086da1e 100644 --- a/UI/Readline.hs +++ b/UI/Readline.hs @@ -17,13 +17,18 @@ import qualified Data.ByteString.UTF8 as BU8 readlineUI :: UI readlineUI = UI { isAvailable = queryTerminal stdInput - , promptName = name - , promptPassword = password - , withProgress = progress + , showError = myShowError + , promptName = myPromptName + , promptPassword = myPromptPassword + , withProgress = myWithProgress } -name :: Title -> Desc -> Name -> (Name -> Maybe Problem) -> IO (Maybe Name) -name title desc (Name suggested) checkproblem = do +myShowError :: Desc -> IO () +myShowError desc = do + hPutStrLn stderr $ "Error: " ++ desc + +myPromptName :: Title -> Desc -> Name -> (Name -> Maybe Problem) -> IO (Maybe Name) +myPromptName title desc (Name suggested) checkproblem = do showTitle title putStrLn desc go @@ -44,8 +49,8 @@ name title desc (Name suggested) checkproblem = do go Nothing -> return Nothing -password :: Title -> Desc -> (Password -> Maybe Problem) -> IO (Maybe Password) -password title desc checkproblem = bracket setup teardown (const go) +myPromptPassword :: Title -> Desc -> (Password -> Maybe Problem) -> IO (Maybe Password) +myPromptPassword title desc checkproblem = bracket setup teardown (const go) where setup = do showTitle title @@ -78,8 +83,8 @@ password title desc checkproblem = bracket setup teardown (const go) putStrLn problem go -progress :: Title -> Desc -> ((Percent -> IO ()) -> IO ()) -> IO () -progress title desc a = bracket_ setup teardown (a sendpercent) +myWithProgress :: Title -> Desc -> ((Percent -> IO ()) -> IO ()) -> IO () +myWithProgress title desc a = bracket_ setup teardown (a sendpercent) where setup = do showTitle title diff --git a/UI/Zenity.hs b/UI/Zenity.hs index f61bb44..c8fca2d 100644 --- a/UI/Zenity.hs +++ b/UI/Zenity.hs @@ -22,13 +22,26 @@ zenityUI = UI ps <- getSearchPath loc <- filterM (\p -> doesFileExist (p "zenity")) ps return (not (null loc)) - , promptName = name - , promptPassword = password - , withProgress = progress + , showError = myShowError + , promptName = myPromptName + , promptPassword = myPromptPassword + , withProgress = myWithProgress } -name :: Title -> Desc -> Name -> (Name -> Maybe Problem) -> IO (Maybe Name) -name title desc (Name suggested) checkproblem = go "" +myShowError :: Desc -> IO () +myShowError desc = bracket go cleanup (\_ -> return ()) + where + go = runZenity + [ "--error" + , "--title", "keysafe" + , "--text", "Error: " ++ desc + ] + cleanup h = do + _ <- waitZenity h + return () + +myPromptName :: Title -> Desc -> Name -> (Name -> Maybe Problem) -> IO (Maybe Name) +myPromptName title desc (Name suggested) checkproblem = go "" where go extradesc = do h <- runZenity @@ -46,8 +59,8 @@ name title desc (Name suggested) checkproblem = go "" Just problem -> go problem else return Nothing -password :: Title -> Desc -> (Password -> Maybe Problem) -> IO (Maybe Password) -password title desc checkproblem = go "" +myPromptPassword :: Title -> Desc -> (Password -> Maybe Problem) -> IO (Maybe Password) +myPromptPassword title desc checkproblem = go "" where go extradesc = do h <- runZenity @@ -71,8 +84,8 @@ password title desc checkproblem = go "" Just problem -> go problem else return Nothing -progress :: Title -> Desc -> ((Percent -> IO ()) -> IO ()) -> IO () -progress title desc a = bracket setup teardown (a . sendpercent) +myWithProgress :: Title -> Desc -> ((Percent -> IO ()) -> IO ()) -> IO () +myWithProgress title desc a = bracket setup teardown (a . sendpercent) where setup = do h <- runZenity diff --git a/keysafe.cabal b/keysafe.cabal index 175bb9f..f92656a 100644 --- a/keysafe.cabal +++ b/keysafe.cabal @@ -57,6 +57,7 @@ Executable keysafe Encryption Entropy ExpensiveHash + Gpg Serialization Shard Storage diff --git a/keysafe.hs b/keysafe.hs index 7f89004..056003a 100644 --- a/keysafe.hs +++ b/keysafe.hs @@ -18,7 +18,9 @@ import Cost import Shard import Storage import Storage.LocalFiles +import qualified Gpg import Data.Maybe +import Control.Monad import qualified Data.ByteString as B import qualified Data.ByteString.UTF8 as BU8 import System.Posix.User (userGecos, getUserEntryForID, getEffectiveUserID) @@ -27,49 +29,64 @@ main :: IO () main = do cmdline <- CmdLine.get ui <- selectUI (CmdLine.gui cmdline) - -- TODO determine gpg key id by examining secret key, - -- or retrieving public key from keyserver and examining it. let tunables = if CmdLine.testMode cmdline then testModeTunables else defaultTunables - case (CmdLine.mode cmdline, CmdLine.secretkeysource cmdline) of - (CmdLine.Backup, Just secretkeysource) -> - backup ui tunables =<< normalize secretkeysource - (CmdLine.Backup, Nothing) -> do - backup ui tunables =<< normalize =<< pickGpgKey CmdLine.Backup ui - (CmdLine.Restore, Just secretkeydest) -> - restore ui =<< normalize secretkeydest - (CmdLine.Restore, Nothing) -> do - restore ui =<< normalize =<< pickGpgKey CmdLine.Backup ui - (CmdLine.Benchmark, _) -> benchmarkTunables tunables + mode <- CmdLine.selectMode cmdline + go mode (CmdLine.secretkeysource cmdline) tunables ui + where + go CmdLine.Backup (Just secretkeysource@(GpgKey kid)) tunables ui = do + ok <- Gpg.knownByKeyServer kid + unless ok $ + error "Your gpg public key has to be stored on the keyservers before you can back it up by keyid. Either use gpg --send-key to store the public key on the keyservers, or omit the --gpgkeyid option" + backup ui tunables secretkeysource + =<< getSecretKey secretkeysource + go CmdLine.Backup (Just secretkeysource) tunables ui = + backup ui tunables secretkeysource + =<< getSecretKey secretkeysource + go CmdLine.Backup Nothing tunables ui = + backup ui tunables anyGpgKey =<< pickGpgKeyToBackup ui + go CmdLine.Restore (Just secretkeydest) _ ui = + restore ui secretkeydest + go CmdLine.Restore Nothing _ ui = + restore ui anyGpgKey + go CmdLine.Benchmark _ tunables _ = + benchmarkTunables tunables --- | Normalize gpg keyids, by querying the gpg keyserver for the key. --- If the keyserver knows of the key, the long keyid is used. --- But, if the keyserver does not know of the key, a null keyid is used. -normalize :: SecretKeySource -> IO SecretKeySource -normalize = return -- TODO +getSecretKey :: SecretKeySource -> IO SecretKey +getSecretKey (GpgKey kid) = Gpg.getSecretKey kid +getSecretKey (KeyFile f) = SecretKey <$> B.readFile f --- | Pick gpg secret key to back up or restore. --- --- When backing up, if there is only one secret --- key, the choice is obvious. Otherwise prompt the user with a list. +-- | Pick gpg secret key to back up. -- --- When restoring, prompt the user for the name of the key, --- query the keyserver, and let the user pick from a list. --- The "other" option uses a null keyid, to handle the case where a key is --- not stored in the keyserver. -pickGpgKey :: CmdLine.Mode -> UI -> IO SecretKeySource -pickGpgKey CmdLine.Backup ui = error "TODO" -pickGpgKey CmdLine.Restore ui = error "TODO" -pickGpgKey _ ui = error "internal error in pickGpgKey" +-- If there is only one gpg secret key, +-- the choice is obvious. Otherwise prompt the user with a list. +pickGpgKeyToBackup :: UI -> IO SecretKey +pickGpgKeyToBackup ui = go =<< Gpg.listSecretKeys + where + go [] = do + showError ui "You have no gpg secret keys to back up." + error "Aborting on no gpg secret keys." + go [(_, kid)] = Gpg.getSecretKey kid + go l = maybe (error "Canceled") Gpg.getSecretKey + =<< promptKeyId ui "Pick gpg secret key" + "Pick gpg secret key to back up:" l -backup :: UI -> Tunables -> SecretKeySource -> IO () -backup ui tunables secretkeysource = do +-- | Use when the gpg keyid will not be known at restore time. +anyGpgKey :: SecretKeySource +anyGpgKey = GpgKey (KeyId "") + +backup :: UI -> Tunables -> SecretKeySource -> SecretKey -> IO () +backup ui tunables secretkeysource secretkey = do username <- userName name <- fromMaybe (error "Aborting on no name") <$> promptName ui "Enter a name" namedesc username validateName + password <- fromMaybe (error "Aborting on no password") + <$> promptPassword ui "Enter a password" + passworddesc validatePassword kek <- genKeyEncryptionKey tunables name password + -- TODO: show password strength estimate, and verify password. putStrLn "Very rough estimate of cost to brute-force the password:" print $ estimateAttack spotAWS $ estimateBruteforceOf kek (passwordEntropy password []) @@ -79,17 +96,23 @@ backup ui tunables secretkeysource = do print =<< mapM (uncurry (storeShard localFiles)) (zip (getIdents sis) shards) print =<< obscureShards localFiles 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." + [ "To back up your secret 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." + , "spelling and capitalization in order to restore your secret key." , "" , "(Your own full name is a pretty good choice for the name to enter here.)" ] + passworddesc = unlines + [ "Pick a password that will be used to protect your secret key." + , "" + , "It's very important that this password be hard to guess." + , "" + , "And, it needs to be one that you will be able to remember years from now" + , "in order to restore your secret key." + ] restore :: UI -> SecretKeySource -> IO () restore ui secretkeydest = do @@ -126,6 +149,9 @@ validateName (Name n) | B.length n < 6 = Just "The name should be at least 6 letters long." | otherwise = Nothing +validatePassword :: Password -> Maybe Problem +validatePassword _ = Nothing + userName :: IO Name userName = do u <- getUserEntryForID =<< getEffectiveUserID -- cgit v1.2.3