diff options
| -rw-r--r-- | CHANGELOG | 1 | ||||
| -rw-r--r-- | Cost.hs | 40 | ||||
| -rw-r--r-- | ExpensiveHash.hs | 19 | ||||
| -rw-r--r-- | Tunables.hs | 18 | ||||
| -rw-r--r-- | Types/Cost.hs | 18 | ||||
| -rw-r--r-- | keysafe.hs | 23 |
6 files changed, 70 insertions, 49 deletions
@@ -7,6 +7,7 @@ keysafe (0.20160820) UNRELEASED; urgency=medium * Reduced object size to 32kb due to share size doubling. * Fix gpg secret key list parser to support gpg 2. * Tuned argon2 hash parameters on better hardware than my fanless laptop. + * Improve time estimates, taking into account the number of cores. -- Joey Hess <id@joeyh.name> Mon, 22 Aug 2016 13:56:16 -0400 @@ -11,29 +11,36 @@ module Cost ( ) where import Types.Cost +import Data.List +import Data.Maybe +import Text.Read -- | Cost in seconds, with the type of hardware needed. totalCost :: Cost op -> (Seconds, [UsingHardware]) -totalCost (CPUCost s) = (s, [UsingCPU]) +totalCost (CPUCost s _) = (s, [UsingCPU]) raiseCostPower :: Cost c -> Entropy e -> Cost c raiseCostPower c (Entropy e) = mapCost (* 2^e) c mapCost :: (Integer -> Integer) -> Cost op -> Cost op -mapCost f (CPUCost (Seconds n)) = CPUCost (Seconds (f n)) +mapCost f (CPUCost (Seconds n) d) = CPUCost (Seconds (f n)) d -showCostMinutes :: Cost op -> String -showCostMinutes (CPUCost (Seconds n)) - | n < 61 = "1 minute" - | otherwise = show (n `div` 60) ++ " minutes" +type NumCores = Integer + +showCostMinutes :: NumCores -> Cost op -> String +showCostMinutes numcores (CPUCost (Seconds n) (Divisibility d)) + | n' < 61 = "1 minute" + | otherwise = show (n' `div` 60) ++ " minutes" + where + n' = n `div` min numcores d -- If an operation took n seconds on a number of cores, --- multiple to get the CPUCost, which is for a single core. -coreCost :: Integer -> Seconds -> Cost op -coreCost cores (Seconds n) = CPUCost (Seconds (cores * n)) +-- multiply to get the CPUCost, which is for a single core. +coreCost :: NumCores -> Seconds -> Divisibility -> Cost op +coreCost cores (Seconds n) d = CPUCost (Seconds (cores * n)) d castCost :: Cost a -> Cost b -castCost (CPUCost s) = CPUCost s +castCost (CPUCost s d) = CPUCost s d -- | CostCalc for a brute force linear search through an entropy space -- in which each step entails paying a cost. @@ -127,3 +134,16 @@ costOverTimeTable cost thisyear = go [] thisyear $ costOverTime cost thisyear in if yprev < y - 1 then go (s:" ...":t) y ys else go (s:t) y ys + +-- Number of physical cores. This is not the same as +-- getNumProcessors, which includes hyper-threading. +getNumCores :: IO (Maybe NumCores) +getNumCores = getmax . mapMaybe parse . lines <$> readFile "/proc/cpuinfo" + where + getmax [] = Nothing + getmax l = Just $ + maximum l + 1 -- add 1 because /proc/cpuinfo counts from 0 + parse l + | "core id" `isPrefixOf` l = + readMaybe $ drop 1 $ dropWhile (/= ':') l + | otherwise = Nothing diff --git a/ExpensiveHash.hs b/ExpensiveHash.hs index 8c473d3..ff9c51c 100644 --- a/ExpensiveHash.hs +++ b/ExpensiveHash.hs @@ -50,7 +50,8 @@ expensiveHash (UseArgon2 cost opts) (Salt s) b = ExpensiveHash cost $ benchmarkExpensiveHash :: Int -> ExpensiveHashTunable -> Cost op -> IO (BenchmarkResult (Cost op)) benchmarkExpensiveHash rounds tunables@(UseArgon2 _ hashopts) expected = do - numcores <- fromIntegral <$> getNumCores + numcores <- fromIntegral . fromMaybe (error "Unknown number of physical cores.") + <$> getNumCores start <- getCurrentTime forM_ [1..rounds] $ \_ -> do let ExpensiveHash _ t = expensiveHash tunables @@ -59,11 +60,11 @@ benchmarkExpensiveHash rounds tunables@(UseArgon2 _ hashopts) expected = do t `deepseq` return () end <- getCurrentTime let diff = floor $ end `diffUTCTime` start - let actual = CPUCost $ Seconds diff + let maxthreads = Argon2.hashParallelism hashopts + let actual = CPUCost (Seconds diff) (Divisibility $ fromIntegral maxthreads) -- The expected cost is for a single core, so adjust it -- based on the number of cores, up to a maximum of the number -- of threads that the hash is configred to use. - let maxthreads = Argon2.hashParallelism hashopts let usedcores = min maxthreads numcores let adjustedexpected = mapCost (`div` fromIntegral usedcores) expected return $ BenchmarkResult @@ -71,18 +72,6 @@ benchmarkExpensiveHash rounds tunables@(UseArgon2 _ hashopts) expected = do , actualBenchmark = actual } --- Number of physical cores. This is not the same as --- getNumProcessors, which includes hyper-threading. -getNumCores :: IO Integer -getNumCores = getmax . mapMaybe parse . lines <$> readFile "/proc/cpuinfo" - where - getmax [] = error "Unknown number of physical cores." - getmax l = maximum l + 1 -- add 1 because /proc/cpuinfo counts from 0 - parse l - | "core id" `isPrefixOf` l = - readMaybe $ drop 1 $ dropWhile (/= ':') l - | otherwise = Nothing - benchmarkTunables :: Tunables -> IO () benchmarkTunables tunables = do putStrLn "/proc/cpuinfo:" diff --git a/Tunables.hs b/Tunables.hs index 8d95ad5..3356516 100644 --- a/Tunables.hs +++ b/Tunables.hs @@ -89,16 +89,16 @@ defaultTunables = Tunables -- The nameGenerationHash was benchmarked at 600 seconds -- on a 2 core Intel(R) Core(TM) i5-5200U CPU @ 2.20GHz. , nameGenerationTunable = NameGenerationTunable - { nameGenerationHash = argon2 10000 (coreCost 2 (Seconds 600)) + { nameGenerationHash = argon2 10000 (coreCost 2 (Seconds 600) d) } , keyEncryptionKeyTunable = KeyEncryptionKeyTunable - { keyEncryptionKeyHash = argon2 2700 (CPUCost (Seconds 12)) + { keyEncryptionKeyHash = argon2 2700 (CPUCost (Seconds 12) d) , randomSaltBytes = 1 -- The keyEncryptionKeyHash is run 256 times per -- random salt byte to brute-force, and its parameters -- were chosen so the total brute forcing time is 50 minutes, -- on a 2 core Intel(R) Core(TM) i5-5200U CPU @ 2.20GHz. - , randomSaltBytesBruteForceCost = coreCost 2 (Seconds (50*60)) + , randomSaltBytesBruteForceCost = coreCost 2 (Seconds (50*60)) d } , encryptionTunable = UseAES256 } @@ -106,9 +106,12 @@ defaultTunables = Tunables argon2 i c = UseArgon2 c $ Argon2.HashOptions { Argon2.hashIterations = i , Argon2.hashMemory = 131072 -- 128 mebibtyes per thread - , Argon2.hashParallelism = 4 -- 4 threads + , Argon2.hashParallelism = + let Divisibility n = d + in fromIntegral n , Argon2.hashVariant = Argon2.Argon2i } + d = Divisibility 4 -- argon2 uses 4 threads -- | Dials back hash difficulty, lies about costs. -- Not for production use! @@ -118,17 +121,18 @@ testModeTunables = Tunables , objectSize = 1024*32 , shareOverhead = 2 , nameGenerationTunable = NameGenerationTunable - { nameGenerationHash = weakargon2 (coreCost 2 (Seconds 600)) + { nameGenerationHash = weakargon2 (coreCost 2 (Seconds 600) d) } , keyEncryptionKeyTunable = KeyEncryptionKeyTunable - { keyEncryptionKeyHash = weakargon2 (CPUCost (Seconds 12)) + { keyEncryptionKeyHash = weakargon2 (CPUCost (Seconds 12) d) , randomSaltBytes = 1 - , randomSaltBytesBruteForceCost = coreCost 2 (Seconds (50*60)) + , randomSaltBytesBruteForceCost = coreCost 2 (Seconds (50*60)) d } , encryptionTunable = UseAES256 } where weakargon2 c = UseArgon2 c Argon2.defaultHashOptions + d = Divisibility 4 knownObjectSizes :: [Int] knownObjectSizes = map (calc . snd) knownTunings diff --git a/Types/Cost.hs b/Types/Cost.hs index 0e017bb..372c43d 100644 --- a/Types/Cost.hs +++ b/Types/Cost.hs @@ -9,22 +9,26 @@ module Types.Cost where -- | An estimated cost to perform an operation. data Cost op - = CPUCost Seconds -- ^ using 1 physical CPU core + = CPUCost Seconds Divisibility + -- ^ cost in Seconds, using 1 physical CPU core deriving (Show, Eq, Ord) -unknownCost :: Cost op -unknownCost = CPUCost (Seconds 0) - newtype Seconds = Seconds Integer deriving (Num, Eq, Ord, Show) +-- | How many CPU cores a single run of an operation can be divided amoung. +newtype Divisibility = Divisibility Integer + deriving (Show, Eq, Ord) + data UsingHardware = UsingCPU | UsingGPU | UsingASIC deriving (Show) instance Monoid (Cost t) where - mempty = CPUCost (Seconds 0) - CPUCost (Seconds a) `mappend` CPUCost (Seconds b) = - CPUCost (Seconds (a+b)) + mempty = CPUCost (Seconds 0) (Divisibility 1) + CPUCost (Seconds a) (Divisibility x) `mappend` CPUCost (Seconds b) (Divisibility y) = + -- Take maximum divisibility, to avoid over-estimating + -- the total cost. + CPUCost (Seconds (a+b)) (Divisibility $ max x y) -- | Operations whose cost can be measured. data DecryptionOp @@ -79,6 +79,7 @@ backup storagelocations ui tunables secretkeysource secretkey = do go theirname where go theirname = do + cores <- fromMaybe 1 <$> getNumCores Name othername <- fromMaybe (error "aborting on no othername") <$> promptName ui "Enter other name" othernamedesc Nothing validateName @@ -87,7 +88,7 @@ backup storagelocations ui tunables secretkeysource secretkey = do let sis = shareIdents tunables name secretkeysource let cost = getCreationCost kek <> getCreationCost sis r <- withProgressIncremental ui "Encrypting and storing data" - (encryptdesc cost) $ \addpercent -> do + (encryptdesc cost cores) $ \addpercent -> do let esk = encrypt tunables kek secretkey shares <- genShares esk tunables _ <- esk `deepseq` addpercent 25 @@ -161,8 +162,8 @@ backup storagelocations ui tunables secretkeysource secretkey = do crackdesc crackcost thisyear = unlines $ "Rough estimate of the cost to crack your password: " : costOverTimeTable crackcost thisyear - encryptdesc cost = unlines - [ "This will probably take around " ++ showCostMinutes cost + encryptdesc cost cores = unlines + [ "This will probably take around " ++ showCostMinutes cores cost , "" , "(It's a feature that this takes a while; it makes it hard" , "for anyone to find your data, or crack your password.)" @@ -181,6 +182,7 @@ otherNameSuggestions = unlines $ map (" * " ++) restore :: StorageLocations -> UI -> [Tunables] -> SecretKeySource -> IO () restore storagelocations ui possibletunables secretkeydest = do + cores <- fromMaybe 1 <$> getNumCores username <- userName Name theirname <- fromMaybe (error "Aborting on no username") <$> promptName ui "Enter your name" @@ -204,7 +206,7 @@ restore storagelocations ui possibletunables secretkeydest = do Left e -> showError ui e Right esk -> do final <- withProgress ui "Decrypting" - (decryptdesc cost) $ \setpercent -> + (decryptdesc cost cores) $ \setpercent -> go tunables [shares] sis setpercent $ tryDecrypt candidatekeys esk final @@ -242,8 +244,8 @@ restore storagelocations ui possibletunables secretkeydest = do passworddesc = unlines [ "Enter the password to unlock your secret key." ] - decryptdesc cost = unlines - [ "This will probably take around " ++ showCostMinutes cost + decryptdesc cost cores = unlines + [ "This will probably take around " ++ showCostMinutes cores cost , "" , "(It's a feature that this takes so long; it prevents cracking your password.)" , "" @@ -259,8 +261,9 @@ downloadInitialShares -> (Tunables -> ShareIdents) -> [Tunables] -> IO (Maybe (Tunables, S.Set Share, ShareIdents)) -downloadInitialShares storagelocations ui mksis possibletunables = - withProgressIncremental ui "Downloading encrypted data" message $ \addpercent -> do +downloadInitialShares storagelocations ui mksis possibletunables = do + cores <- fromMaybe 1 <$> getNumCores + withProgressIncremental ui "Downloading encrypted data" (message cores) $ \addpercent -> do go possibletunables addpercent where go [] _ = return Nothing @@ -277,9 +280,9 @@ downloadInitialShares storagelocations ui mksis possibletunables = else return $ Just (tunables, shares, sis') possiblesis = map mksis possibletunables - message = unlines + message cores = unlines [ "This will probably take around " - ++ showCostMinutes (mconcat $ map getCreationCost possiblesis) + ++ showCostMinutes cores (mconcat $ map getCreationCost possiblesis) , "" , "(It's a feature that this takes a while; it makes it hard" , "for anyone else to find your data.)" |