From 823ebff934cf2e23afae199c24cc599983209438 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 23 Sep 2016 17:42:45 -0400 Subject: Added --chaff-max-delay option for slower chaffing. This commit was sponsored by Jeff Goeke-Smith on Patreon. --- CHANGELOG | 1 + CmdLine.hs | 57 ++++++++++++++++++++++++++++++++++++++++----------------- Storage.hs | 10 ++++++++-- Types/Cost.hs | 2 +- keysafe.hs | 1 + 5 files changed, 51 insertions(+), 20 deletions(-) diff --git a/CHANGELOG b/CHANGELOG index d4a2ce2..461db24 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -1,6 +1,7 @@ keysafe (0.20160923) UNRELEASED; urgency=medium * Makefile: Avoid rebuilding on make install, so that sudo make install works. + * Added --chaff-max-delay option for slower chaffing. -- Joey Hess Fri, 23 Sep 2016 10:40:55 -0400 diff --git a/CmdLine.hs b/CmdLine.hs index 4011f56..bb68623 100644 --- a/CmdLine.hs +++ b/CmdLine.hs @@ -8,6 +8,7 @@ module CmdLine where import Types import Types.Storage import Types.Server (HostName) +import Types.Cost (Seconds(..)) import Tunables import qualified Gpg import Options.Applicative @@ -27,6 +28,7 @@ data CmdLine = CmdLine , name :: Maybe Name , othername :: Maybe Name , serverConfig :: ServerConfig + , chaffMaxDelay :: Maybe Seconds } data Mode = Backup | Restore | UploadQueued | AutoStart | Server | BackupServer FilePath | RestoreServer FilePath | Chaff HostName | Benchmark | Test @@ -43,13 +45,14 @@ parse = CmdLine <$> optional parseMode <*> optional (gpgswitch <|> fileswitch) <*> localstorageswitch - <*> localstoragedirectoryopt + <*> optional localstoragedirectoryopt <*> guiswitch <*> testmodeswitch - <*> optional (ShareParams <$> totalobjects <*> neededobjects) - <*> nameopt - <*> othernameopt + <*> optional parseShareParams + <*> optional nameopt + <*> optional othernameopt <*> parseServerConfig + <*> optional chaffmaxdelayopt where gpgswitch = GpgKey . KeyId . T.pack <$> strOption ( long "gpgkeyid" @@ -65,7 +68,7 @@ parse = CmdLine ( long "store-local" <> help "Store data locally. (The default is to store data in the cloud.)" ) - localstoragedirectoryopt = optional $ LocalStorageDirectory <$> option str + localstoragedirectoryopt = LocalStorageDirectory <$> option str ( long "store-directory" <> metavar "DIR" <> help "Where to store data locally. (default: ~/.keysafe/objects/)" @@ -78,26 +81,21 @@ parse = CmdLine ( long "gui" <> help "Use GUI interface for interaction. Default is to use readline interface when run in a terminal, and GUI otherwise." ) - totalobjects = option auto - ( long "totalshares" - <> metavar "M" - <> help ("Configure the number of shares to split encrypted secret key into. (default: " ++ show (totalObjects (shareParams defaultTunables)) ++ ") (When this option is used to back up a key, it must also be provided at restore time.)") - ) - neededobjects = option auto - ( long "neededshares" - <> metavar "N" - <> help ("Configure the number of shares needed to restore. (default: " ++ show (neededObjects (shareParams defaultTunables)) ++ ") (When this option is used to back up a key, it must also be provided at restore time.)") - ) - nameopt = optional $ Name . BU8.fromString <$> strOption + nameopt = option nameOption ( long "name" <> metavar "N" <> help "Specify name used for key backup/restore, avoiding the usual prompt." ) - othernameopt = optional $ Name . BU8.fromString <$> strOption + othernameopt = option nameOption ( long "othername" <> metavar "N" <> help "Specify other name used for key backup/restore, avoiding the usual prompt." ) + chaffmaxdelayopt = option secondsOption + ( long "chaff-max-delay" + <> metavar "SECONDS" + <> help "Specify a delay between chaff uploads. Will delay a random amount between 0 and this many seconds." + ) parseMode :: Parser Mode parseMode = @@ -145,6 +143,25 @@ parseMode = <> help "Run test suite." ) +parseShareParams :: Parser ShareParams +parseShareParams = ShareParams <$> totalobjects <*> neededobjects + where + totalobjects = option auto + ( long "totalshares" + <> metavar "M" + <> help ("Configure the number of shares to split encrypted secret key into. " + ++ showdefault totalObjects ++ neededboth) + ) + neededobjects = option auto + ( long "neededshares" + <> metavar "N" + <> help ("Configure the number of shares needed to restore. " + ++ showdefault neededObjects ++ neededboth) + ) + showdefault f = "(default: " ++ show (f (shareParams defaultTunables)) ++ ")" + neededboth = " (When this option is used to back up a key, it must also be provided at restore time.)" + + parseServerConfig :: Parser ServerConfig parseServerConfig = ServerConfig <$> option auto @@ -193,3 +210,9 @@ customizeShareParams :: CmdLine -> Tunables -> Tunables customizeShareParams cmdline t = case customShareParams cmdline of Nothing -> t Just ps -> t { shareParams = ps } + +secondsOption :: ReadM Seconds +secondsOption = Seconds . toRational <$> (auto :: ReadM Double) + +nameOption :: ReadM Name +nameOption = Name . BU8.fromString <$> auto diff --git a/Storage.hs b/Storage.hs index b5d847f..b5d07f5 100644 --- a/Storage.hs +++ b/Storage.hs @@ -10,6 +10,7 @@ module Storage (module Storage, module Types.Storage) where import Types import Types.Storage import Types.Server +import Types.Cost import Share import Storage.Local import Storage.Network @@ -22,6 +23,8 @@ import System.IO import System.FilePath import Control.Monad import Crypto.Random +import System.Random +import Control.Concurrent.Thread.Delay import Control.Concurrent.Async import qualified Data.Set as S import Network.Wai.Handler.Warp (Port) @@ -134,8 +137,8 @@ tryUploadQueued d = do processresults (StoreAlreadyExists:rs) c = processresults rs ("Unable to upload a share to a server due to a name conflict.":c) -storeChaff :: HostName -> Port -> IO () -storeChaff hn port = forever $ do +storeChaff :: HostName -> Port -> Maybe Seconds -> IO () +storeChaff hn port delayseconds = forever $ do putStrLn $ "Sending chaff to " ++ hn ++ " (press ctrl-c to stop)" putStrLn "Legend: + = successful upload, ! = upload failure" rng <- (cprgCreate <$> createEntropyPool) :: IO SystemRNG @@ -151,6 +154,7 @@ storeChaff hn port = forever $ do server = networkStorage Nothing $ Server (ServerName hn) Untrusted [ServerAddress hn port] objsize = objectSize defaultTunables * shareOverhead defaultTunables + maxmsdelay = ceiling $ 1000000 * fromMaybe 0 delayseconds go sis rng n = do let (b, rng') = cprgGenerate objsize rng let share = Share 0 (StorableObject b) @@ -161,4 +165,6 @@ storeChaff hn port = forever $ do StoreSuccess -> putStr "+" _ -> putStr "!" hFlush stdout + msdelay <- getStdRandom (randomR (0, maxmsdelay)) + delay msdelay go sis' rng' n diff --git a/Types/Cost.hs b/Types/Cost.hs index 08f98eb..521d6c1 100644 --- a/Types/Cost.hs +++ b/Types/Cost.hs @@ -14,7 +14,7 @@ data Cost op deriving (Show, Eq, Ord) newtype Seconds = Seconds Rational - deriving (Num, Fractional, Eq, Ord) + deriving (Num, Fractional, Real, RealFrac, Eq, Ord) instance Show Seconds where show (Seconds n) = show (fromRational n :: Double) ++ "s" diff --git a/keysafe.hs b/keysafe.hs index 3da20c6..f4ee878 100644 --- a/keysafe.hs +++ b/keysafe.hs @@ -79,6 +79,7 @@ dispatch cmdline ui tunables possibletunables = do restoreServer (CmdLine.localstoragedirectory cmdline) d go (CmdLine.Chaff hn) _ = storeChaff hn (CmdLine.serverPort (CmdLine.serverConfig cmdline)) + (CmdLine.chaffMaxDelay cmdline) go CmdLine.Benchmark _ = benchmarkTunables tunables go CmdLine.Test _ = -- cgit v1.2.3