diff options
| -rw-r--r-- | CHANGELOG | 3 | ||||
| -rw-r--r-- | Storage.hs | 37 | ||||
| -rw-r--r-- | keysafe.hs | 27 |
3 files changed, 61 insertions, 6 deletions
@@ -5,6 +5,9 @@ keysafe (0.20160923) UNRELEASED; urgency=medium * Fix embedded copy of Argon2 to not use Word64, fixing build on 32 bit systems. * Randomize the server list. + * Don't upload more than neededshares-1 shares to Alternate servers + without asking the user if they want to do this potentially dangerous + action. -- Joey Hess <id@joeyh.name> Fri, 23 Sep 2016 10:40:55 -0400 @@ -40,6 +40,43 @@ localStorageLocations d = StorageLocations $ type UpdateProgress = IO () +data StorageProblem + = FatalProblem String + | OverridableProblem String + deriving (Show) + +-- | Check if there is a problem with storing shares amoung the provided +-- storage locations, assuming that some random set of the storage +-- locations will be used. +-- +-- It's always a problem to store anything on an Untrusted server. +-- +-- It should not be possible to reconstruct the encrypted +-- secret key using only objects from Alternate servers, so +-- fewer than neededObjects Alternate servers can be used. +problemStoringIn :: StorageLocations -> Tunables -> Maybe StorageProblem +problemStoringIn (StorageLocations locs) tunables + | not (null (getlevel Untrusted)) || length locs < totalObjects ps = + Just $ FatalProblem + "Not enough servers are available to store your encrypted secret key." + | length alternates >= neededObjects ps = Just $ OverridableProblem $ unlines $ + [ "Not enough keysafe servers are available that can store" + , "your encrypted secret key with a recommended level of" + , "security." + , "" + , "If you continue, some of the following less secure" + , "servers will be used:" + , "" + ] ++ map descserver alternates + | otherwise = Nothing + where + ps = shareParams tunables + getlevel sl = filter (\s -> serverLevel s == sl) $ + mapMaybe getServer locs + alternates = getlevel Alternate + descserver (Server { serverName = ServerName n, serverDesc = d}) = + "* " ++ n ++ " -- " ++ d + -- | Stores the shares amoung the storage locations. Each location -- gets at most one share from each set. -- @@ -88,15 +88,31 @@ dispatch cmdline ui tunables possibletunables = do backup :: CmdLine.CmdLine -> UI -> Tunables -> SecretKeySource -> SecretKey -> IO () backup cmdline ui tunables secretkeysource secretkey = do installAutoStartFile + + let m = totalObjects (shareParams tunables) + StorageLocations allocs <- cmdLineStorageLocations cmdline + let locs = StorageLocations (take m allocs) + case problemStoringIn locs tunables of + Nothing -> return () + Just (FatalProblem p) -> do + showError ui p + error "aborting" + Just (OverridableProblem p) -> do + ok <- promptQuestion ui "Server problem" + p "Continue anyway?" + if ok + then return () + else error "aborting" + username <- userName Name theirname <- case CmdLine.name cmdline of Just n -> pure n Nothing -> fromMaybe (error "Aborting on no username") <$> promptName ui "Enter your name" usernamedesc (Just username) validateName - go theirname + go theirname locs where - go theirname = do + go theirname locs = do cores <- fromMaybe 1 <$> getNumCores Name othername <- case CmdLine.name cmdline of Just n -> pure n @@ -107,16 +123,15 @@ backup cmdline ui tunables secretkeysource secretkey = do (kek, passwordentropy) <- promptpassword name let sis = shareIdents tunables name secretkeysource let cost = getCreationCost kek <> getCreationCost sis - (r, queued, locs) <- withProgressIncremental ui "Encrypting and storing data" + (r, queued, usedlocs) <- withProgressIncremental ui "Encrypting and storing data" (encryptdesc cost cores) $ \addpercent -> do let esk = encrypt tunables kek secretkey shares <- genShares esk tunables _ <- esk `deepseq` addpercent 25 _ <- sis `seq` addpercent 25 let step = 50 `div` sum (map S.size shares) - locs <- cmdLineStorageLocations cmdline storeShares locs sis shares (addpercent step) - backuplog <- mkBackupLog $ backupMade (mapMaybe getServer locs) secretkeysource passwordentropy + backuplog <- mkBackupLog $ backupMade (mapMaybe getServer usedlocs) secretkeysource passwordentropy case r of StoreSuccess -> do storeBackupLog backuplog @@ -132,7 +147,7 @@ backup cmdline ui tunables secretkeysource secretkey = do [ "Another secret key is already being stored under the name you entered." , "Please try again with a different name." ] - go theirname + go theirname locs promptpassword name = do password <- fromMaybe (error "Aborting on no password") <$> promptPassword ui True "Enter password" passworddesc |