From 338e98c8efcbdabbe00e1f9e64f409aa64f3581a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 18 Aug 2016 15:32:31 -0400 Subject: add support for multiple storage locattions also, server upload queues in ~/.keysafe --- keysafe.hs | 61 +++++++++++++++++++++++-------------------------------------- 1 file changed, 23 insertions(+), 38 deletions(-) (limited to 'keysafe.hs') diff --git a/keysafe.hs b/keysafe.hs index 2ac765f..c1ed35a 100644 --- a/keysafe.hs +++ b/keysafe.hs @@ -23,10 +23,7 @@ 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) @@ -42,29 +39,31 @@ main = do "Keysafe is running in test mode. This is not secure, and should not be used with real secret keys!" return (mkt testModeTunables, [mkt testModeTunables]) else return (mkt defaultTunables, map (mkt . snd) knownTunings) - dispatch cmdline ui tunables possibletunables + storagelocations <- if CmdLine.localstorage cmdline + then return localStorageLocations + else allStorageLocations + dispatch cmdline ui storagelocations tunables possibletunables -dispatch :: CmdLine.CmdLine -> UI -> Tunables -> [Tunables] -> IO () -dispatch cmdline ui tunables possibletunables = do +dispatch :: CmdLine.CmdLine -> UI -> StorageLocations -> Tunables -> [Tunables] -> IO () +dispatch cmdline ui storagelocations tunables possibletunables = do mode <- CmdLine.selectMode cmdline go mode (CmdLine.secretkeysource cmdline) where - storage = CmdLine.storage cmdline go CmdLine.Backup (Just secretkeysource) = - backup storage ui tunables secretkeysource + backup storagelocations ui tunables secretkeysource =<< getSecretKey secretkeysource go CmdLine.Restore (Just secretkeydest) = - restore storage ui possibletunables secretkeydest + restore storagelocations ui possibletunables secretkeydest go CmdLine.Backup Nothing = - backup storage ui tunables Gpg.anyKey + backup storagelocations ui tunables Gpg.anyKey =<< Gpg.getKeyToBackup ui go CmdLine.Restore Nothing = - restore storage ui possibletunables Gpg.anyKey + restore storagelocations ui possibletunables Gpg.anyKey go CmdLine.Benchmark _ = benchmarkTunables tunables -backup :: Storage -> UI -> Tunables -> SecretKeySource -> SecretKey -> IO () -backup storage ui tunables secretkeysource secretkey = do +backup :: StorageLocations -> UI -> Tunables -> SecretKeySource -> SecretKey -> IO () +backup storagelocations ui tunables secretkeysource secretkey = do username <- userName Name theirname <- fromMaybe (error "Aborting on no username") <$> promptName ui "Enter your name" @@ -84,7 +83,7 @@ backup storage ui tunables secretkeysource secretkey = do _ <- sis `deepseq` setpercent 50 let step = 50 `div` length shards let percentsteps = map setpercent [50+step, 50+step*2..100] - storeShards storage sis (zip percentsteps shards) + storeShards storagelocations sis (zip percentsteps shards) case r of StoreSuccess -> showInfo ui "Success" "Your secret key successfully encrypted and backed up." StoreFailure s -> showError ui ("There was a problem storing your encrypted secret key: " ++ s) @@ -93,7 +92,7 @@ backup storage ui tunables secretkeysource secretkey = do [ "Another secret key is already being stored under the name you entered." , "Please try again with a different name." ] - backup storage ui tunables secretkeysource secretkey + backup storagelocations ui tunables secretkeysource secretkey where promptkek name = do password <- fromMaybe (error "Aborting on no password") @@ -168,8 +167,8 @@ otherNameSuggestions = unlines $ map (" * " ++) , "Your college roomate." ] -restore :: Storage -> UI -> [Tunables] -> SecretKeySource -> IO () -restore storage ui possibletunables secretkeydest = do +restore :: StorageLocations -> UI -> [Tunables] -> SecretKeySource -> IO () +restore storagelocations ui possibletunables secretkeydest = do username <- userName Name theirname <- fromMaybe (error "Aborting on no username") <$> promptName ui "Enter your name" @@ -182,7 +181,7 @@ restore storage ui possibletunables secretkeydest = do <$> promptPassword ui True "Enter password" passworddesc let mksis tunables = shardIdents tunables name secretkeydest - (tunables, shards) <- downloadShards storage ui mksis possibletunables + (tunables, shards) <- downloadShards storagelocations ui mksis possibletunables let candidatekeys = candidateKeyEncryptionKeys tunables name password let cost = getCreationCost candidatekeys @@ -222,14 +221,11 @@ restore storage ui possibletunables secretkeydest = do , "Please wait..." ] -downloadShards :: Storage -> UI -> (Tunables -> ShardIdents) -> [Tunables] -> IO (Tunables, [Shard]) -downloadShards storage ui mksis possibletunables = - bracket_ setup cleanup download +downloadShards :: StorageLocations -> UI -> (Tunables -> ShardIdents) -> [Tunables] -> IO (Tunables, [Shard]) +downloadShards storagelocations ui mksis possibletunables = + withProgress ui "Downloading encrypted data" message $ + go possibletunables where - setup = return () - download = withProgress ui "Downloading encrypted data" message (go possibletunables) - cleanup = obscureShards storage - go [] _ = return (defaultTunables, []) go (tunables:othertunables) setpercent = do let sis = mksis tunables @@ -238,19 +234,8 @@ downloadShards storage ui mksis possibletunables = -- most of the time. _ <- l `deepseq` setpercent 50 let step = 50 `div` length l - let percentsteps = [50+step, 50+step*2..100] - - mshards <- forM (zip percentsteps l) $ \(pct, (n, i)) -> do - r <- retrieveShard storage n i - case r of - RetrieveSuccess s -> do - _ <- setpercent pct - return (Just s) - RetrieveFailure f -> do - hPutStrLn stderr $ - "warning: retrieval of shard " ++ show n ++ " failed: " ++ f - return Nothing - let shards = catMaybes mshards + let percentsteps = map setpercent [50+step, 50+step*2..100] + shards <- retrieveShards storagelocations (zip percentsteps l) if null shards then go othertunables setpercent else return (tunables, shards) -- cgit v1.2.3