From 3eb522469e641e31d02fa060a1b48b93edbf7d84 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 22 Sep 2016 14:08:36 -0400 Subject: record already-existing backup in log after restoring a secret key This will prevent --autostart from prompting to get the newly restored key backed up again. This commit was sponsored by Remy van Elst on Patreon. --- keysafe.hs | 46 ++++++++++++++++++++++++++++++---------------- 1 file changed, 30 insertions(+), 16 deletions(-) (limited to 'keysafe.hs') diff --git a/keysafe.hs b/keysafe.hs index 7fe27cf..a6db8ca 100644 --- a/keysafe.hs +++ b/keysafe.hs @@ -19,6 +19,7 @@ import Cost import SecretKey import Share import Storage +import Types.Server import BackupLog import AutoStart import HTTP.Server @@ -28,6 +29,7 @@ import Data.Maybe import Data.Time.Clock import Data.Time.Calendar import Data.Monoid +import Data.List import Control.DeepSeq import qualified Data.ByteString as B import qualified Data.ByteString.UTF8 as BU8 @@ -135,9 +137,7 @@ backup cmdline storagelocations ui tunables secretkeysource secretkey = do password <- fromMaybe (error "Aborting on no password") <$> promptPassword ui True "Enter password" passworddesc kek <- genKeyEncryptionKey tunables name password - username <- userName - let badwords = concatMap namewords [name, username] - let passwordentropy = calcPasswordEntropy password badwords + passwordentropy <- getPasswordEntropy password name let crackcost = estimateAttackCost spotAWS $ estimateBruteforceOf kek passwordentropy let mincost = Dollars 100000 @@ -154,7 +154,6 @@ backup cmdline storagelocations ui tunables secretkeysource secretkey = do if ok then return (kek, passwordentropy) else promptpassword name - namewords (Name nb) = words (BU8.toString nb) keydesc = case secretkeysource of GpgKey _ -> "gpg secret key" KeyFile _ -> "secret key" @@ -229,7 +228,7 @@ restore cmdline storagelocations ui possibletunables secretkeydest = do r <- downloadInitialShares storagelocations ui mksis possibletunables case r of Nothing -> showError ui "No shares could be downloaded. Perhaps you entered the wrong name?" - Just (tunables, shares, sis) -> do + Just (tunables, shares, sis, usedservers) -> do let candidatekeys = candidateKeyEncryptionKeys tunables name password let cost = getCreationCost candidatekeys <> castCost (getDecryptionCost candidatekeys) @@ -238,26 +237,33 @@ restore cmdline storagelocations ui possibletunables secretkeydest = do Right esk -> do final <- withProgress ui "Decrypting" (decryptdesc cost cores) $ \setpercent -> - go tunables [shares] sis setpercent $ + go tunables [shares] usedservers sis setpercent $ tryDecrypt candidatekeys esk - final + final =<< getPasswordEntropy password name where - go tunables firstshares sis setpercent r = case r of - DecryptFailed -> return $ + go tunables firstshares firstusedservers sis setpercent r = case r of + DecryptFailed -> return $ \_ -> showError ui "Decryption failed! Probably you entered the wrong password." DecryptSuccess secretkey -> do _ <- setpercent 100 writeSecretKey secretkeydest secretkey - return $ + return $ \passwordentropy -> do showInfo ui "Success" "Your secret key was successfully restored!" + -- Since the key was restored, we know it's + -- backed up; log that. + backuplog <- mkBackupLog $ + backupMade firstusedservers secretkeydest passwordentropy + storeBackupLog backuplog DecryptIncomplete kek -> do -- Download shares for another chunk. - (nextshares, sis') <- retrieveShares storagelocations sis (return ()) + (nextshares, sis', nextusedservers) + <- retrieveShares storagelocations sis (return ()) let shares = firstshares ++ [nextshares] + let usedservers = nub (firstusedservers ++ nextusedservers) case combineShares tunables shares of - Left e -> return $ showError ui e + Left e -> return $ \_ -> showError ui e Right esk -> - go tunables shares sis' setpercent $ + go tunables shares usedservers sis' setpercent $ decrypt kek esk namedesc = unlines [ "When you backed up your secret key, you entered some information." @@ -291,7 +297,7 @@ downloadInitialShares -> UI -> (Tunables -> ShareIdents) -> [Tunables] - -> IO (Maybe (Tunables, S.Set Share, ShareIdents)) + -> IO (Maybe (Tunables, S.Set Share, ShareIdents, [Server])) downloadInitialShares storagelocations ui mksis possibletunables = do cores <- fromMaybe 1 <$> getNumCores withProgressIncremental ui "Downloading encrypted data" (message cores) $ \addpercent -> do @@ -305,10 +311,10 @@ downloadInitialShares storagelocations ui mksis possibletunables = do addpercent 50 let m = totalObjects (shareParams tunables) let step = 50 `div` m - (shares, sis') <- retrieveShares storagelocations sis (addpercent step) + (shares, sis', usedservers) <- retrieveShares storagelocations sis (addpercent step) if S.null shares then go othertunables addpercent - else return $ Just (tunables, shares, sis') + else return $ Just (tunables, shares, sis', usedservers) possiblesis = map mksis possibletunables message cores = unlines @@ -331,6 +337,14 @@ userName = do u <- getUserEntryForID =<< getEffectiveUserID return $ Name $ BU8.fromString $ takeWhile (/= ',') (userGecos u) +getPasswordEntropy :: Password -> Name -> IO (Entropy UnknownPassword) +getPasswordEntropy password name = do + username <- userName + let badwords = concatMap namewords [name, username] + return $ calcPasswordEntropy password badwords + where + namewords (Name nb) = words (BU8.toString nb) + uploadQueued :: UI -> Maybe LocalStorageDirectory -> IO () uploadQueued ui d = do problems <- tryUploadQueued d -- cgit v1.2.3