diff options
Diffstat (limited to 'keysafe.hs')
| -rw-r--r-- | keysafe.hs | 75 |
1 files changed, 60 insertions, 15 deletions
@@ -22,7 +22,11 @@ import qualified Gpg import Data.Maybe import Data.Time.Clock import Data.Time.Calendar +import Data.Monoid import Control.Monad +import Control.DeepSeq +import Control.Exception +import System.IO import qualified Data.ByteString as B import qualified Data.ByteString.UTF8 as BU8 import System.Posix.User (userGecos, getUserEntryForID, getEffectiveUserID) @@ -40,7 +44,7 @@ main = do 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" + showError ui "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 = @@ -146,21 +150,21 @@ restore ui secretkeydest = do <$> promptPassword ui True "Enter password" passworddesc 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) + shards <- catMaybes <$> downloadShards ui sis + let candidatekeys = candidateKeyEncryptionKeys tunables name password + let cost = getCreationCost candidatekeys + <> castCost (getDecryptionCost candidatekeys) + case combineShards tunables shards of + Left e -> showError ui e + Right esk -> withProgress ui "Decrypting" + (decryptdesc cost) $ \setpercent -> do + case decrypt candidatekeys esk of + Nothing -> showError ui "Decryption failed! Unknown why it would fail at this point." + Just (SecretKey secretkey) -> do + setpercent 100 + -- TODO save + print secretkey where - go _ [] = error "decryption failed" - go esk (kek:rest) = case decrypt kek esk of - Just (SecretKey sk) -> print sk - Nothing -> go esk rest - -- TODO: derive by probing to find objects tunables = testModeTunables -- defaultTunables namedesc = unlines @@ -172,6 +176,47 @@ restore ui secretkeydest = do passworddesc = unlines [ "Enter the password to unlock your secret key." ] + decryptdesc cost = unlines + [ "This will probably take around " ++ showCostMinutes cost + , "" + , "(It's a feature that this takes so long;" + , "it prevents cracking your password.)" + , "" + , "Please wait..." + ] + +downloadShards :: UI -> ShardIdents -> IO [Maybe Shard] +downloadShards ui sis = bracket_ (return ()) cleanup + (withProgress ui "Downloading encrypted data" message go) + where + go setpercent = do + let l = zip [1..] (getIdents sis) + -- Just calculating the idents probably takes + -- most of the time. + _ <- l `deepseq` setpercent 50 + let step = 50 `div` length l + let percentsteps = [50+step, 50+step*2..100] + + forM (zip percentsteps l) $ \(pct, (n, i)) -> do + r <- retrieveShard localFiles n i + _ <- setpercent pct + case r of + RetrieveSuccess s -> do + return (Just s) + RetrieveFailure f -> do + hPutStrLn stderr $ + "warning: retrieval of shard " ++ show n ++ " failed: " ++ f + return Nothing + cleanup = obscureShards localFiles + message = unlines + [ "This will probably take around " + ++ showCostMinutes (getCreationCost sis) + , "" + , "(It's a feature that this takes a while; it makes it hard" + , "for anyone else to find your data.)" + , "" + , "Please wait..." + ] validateName :: Name -> Maybe Problem validateName (Name n) |