Added --chaff-max-delay option for slower chaffing.

This commit was sponsored by Jeff Goeke-Smith on Patreon.

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 <id@joeyh.name>  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 _ =