{-# LANGUAGE OverloadedStrings #-} {- Copyright 2016 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} module Main where import Types import Tunables import qualified CmdLine import UI import Encryption import Entropy import ExpensiveHash 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) main :: IO () main = do cmdline <- CmdLine.get ui <- selectUI (CmdLine.gui cmdline) let tunables = if CmdLine.testMode cmdline then testModeTunables else defaultTunables 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 getSecretKey :: SecretKeySource -> IO SecretKey getSecretKey (GpgKey kid) = Gpg.getSecretKey kid getSecretKey (KeyFile f) = SecretKey <$> B.readFile f -- | Pick gpg secret key to back up. -- -- 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 -- | 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 []) let esk = encrypt tunables kek secretkey let sis = shardIdents tunables name secretkeysource shards <- genShards esk tunables print =<< mapM (uncurry (storeShard localFiles)) (zip (getIdents sis) shards) print =<< obscureShards localFiles where namedesc = unlines [ "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 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 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 secretkeydest -- we drop 1 to simulate not getting all shards from the servers let l = drop 1 $ zip [1..] (getIdents sis) shards <- map (\(RetrieveSuccess s) -> s) <$> mapM (uncurry (retrieveShard localFiles)) l _ <- obscureShards localFiles let esk = combineShards tunables shards go esk (candidateKeyEncryptionKeys tunables name password) where go _ [] = error "decryption failed" go esk (kek:rest) = case decrypt kek esk of Just (SecretKey sk) -> print sk Nothing -> go esk rest 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 validatePassword :: Password -> Maybe Problem validatePassword _ = Nothing userName :: IO Name userName = do u <- getUserEntryForID =<< getEffectiveUserID return $ Name $ BU8.fromString $ takeWhile (/= ',') (userGecos u)