From 92f0a9c8b6c676281dcbee6e4bce938b969ef7c2 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Wed, 14 Sep 2016 15:51:59 -0400
Subject: Added --chaff mode which uploads random junk to servers.

This is useful both to test the server throttling of uploads, and to make
it harder for servers to know if an object actually contains secret key
information.

This commit was sponsored by Brock Spratlen on Patreon.
---
 CHANGELOG     |  4 ++++
 CmdLine.hs    | 10 ++++++++--
 Storage.hs    | 36 +++++++++++++++++++++++++++++++++++-
 keysafe.cabal |  1 +
 keysafe.hs    |  2 ++
 5 files changed, 50 insertions(+), 3 deletions(-)

diff --git a/CHANGELOG b/CHANGELOG
index 01108c3..38790af 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -11,6 +11,10 @@ keysafe (0.20160832) UNRELEASED; urgency=medium
   * Warn when uploads fail and are put in the upload queue.
   * Warn when --uploadqueued fails to upload to servers.
   * Fix --uploadqueued bug that prevented deletion of local queued file.
+  * Added --chaff mode which uploads random junk to servers.
+    This is useful both to test the server throttling of uploads,
+    and to make it harder for servers to know if an object actually
+    contains secret key information.
 
  -- Joey Hess <id@joeyh.name>  Thu, 01 Sep 2016 11:42:27 -0400
 
diff --git a/CmdLine.hs b/CmdLine.hs
index 67af2da..51bfa5c 100644
--- a/CmdLine.hs
+++ b/CmdLine.hs
@@ -8,6 +8,7 @@ module CmdLine where
 import Types
 import Types.Storage
 import Tunables
+import Servers (HostName)
 import qualified Gpg
 import Options.Applicative
 import qualified Data.ByteString.UTF8 as BU8
@@ -27,7 +28,7 @@ data CmdLine = CmdLine
 	, serverConfig :: ServerConfig
 	}
 
-data Mode = Backup | Restore | UploadQueued | Server | Benchmark | Test
+data Mode = Backup | Restore | UploadQueued | Server | Chaff HostName | Benchmark | Test
 	deriving (Show)
 
 data ServerConfig = ServerConfig
@@ -38,7 +39,7 @@ data ServerConfig = ServerConfig
 
 parse :: Parser CmdLine
 parse = CmdLine
-	<$> optional (backup <|> restore <|> uploadqueued <|> server <|> benchmark <|> test)
+	<$> optional (backup <|> restore <|> uploadqueued <|> server <|> chaff <|> benchmark <|> test)
 	<*> optional (gpgswitch <|> fileswitch)
 	<*> localstorageswitch
 	<*> localstoragedirectoryopt
@@ -65,6 +66,11 @@ parse = CmdLine
 		( long "server"
 		<> help "Run as a keysafe server, accepting objects and storing them to ~/.keysafe/objects/local/"
 		)
+	chaff = Chaff <$> strOption
+		( long "chaff"
+		<> metavar "HOSTNAME"
+		<> help "Upload random data to a keysafe server."
+		)
 	benchmark = flag' Benchmark
 		( long "benchmark"
 		<> help "Benchmark speed of keysafe's cryptographic primitives."
diff --git a/Storage.hs b/Storage.hs
index 2e35972..6115f30 100644
--- a/Storage.hs
+++ b/Storage.hs
@@ -3,6 +3,8 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
+{-# LANGUAGE OverloadedStrings #-}
+
 module Storage (module Storage, module Types.Storage) where
 
 import Types
@@ -11,11 +13,16 @@ import Share
 import Storage.Local
 import Storage.Network
 import Servers
+import Tunables
 import Data.Maybe
 import Data.List
+import Data.Monoid
+import System.IO
 import System.FilePath
 import Control.Monad
+import Crypto.Random
 import qualified Data.Set as S
+import Network.Wai.Handler.Warp (Port)
 
 allStorageLocations :: Maybe LocalStorageDirectory -> IO StorageLocations
 allStorageLocations d = do
@@ -124,4 +131,31 @@ uploadQueued d = do
 	processresults (StoreFailure e:rs) c = processresults rs (e:c)
 	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
+	putStrLn $ "Sending chaff to " ++ hn ++ " (press ctrl-c to stop)"
+	putStrLn "Legend: + = successful upload, ! = upload failure"
+	rng <- (cprgCreate <$> createEntropyPool) :: IO SystemRNG
+	let (randomname, rng') = cprgGenerate 128 rng
+	-- It's ok the use the testModeTunables here because
+	-- the randomname is not something that can be feasibly guessed.
+	-- Prefix "random chaff" to the name to avoid ever using a name
+	-- that a real user might want to use.
+	let sis = shareIdents testModeTunables (Name $ "random chaff:" <> randomname) (KeyFile "random")
+	go sis rng' (concat (repeat knownObjectSizes))
+  where
+	server = networkStorage Nothing $ Server hn port
+	go _ _ [] = return ()
+	go sis rng (s:sizes) = do
+		let (b, rng') = cprgGenerate s rng
+		let share = Share 0 (StorableObject b)
+		let ident = StorableObjectIdent 
+		let (is, sis') = nextShareIdents sis
+		let i = head (S.toList is)
+		r <- storeShare server i share
+		case r of
+			StoreSuccess -> putStr "."
+			_ -> putStr "!"
+		hFlush stdout
+		go sis' rng' sizes
diff --git a/keysafe.cabal b/keysafe.cabal
index 0d256bc..e6405d5 100644
--- a/keysafe.cabal
+++ b/keysafe.cabal
@@ -67,6 +67,7 @@ Executable keysafe
     , unbounded-delays == 0.1.*
     , fast-logger == 2.4.*
     , SafeSemaphore == 0.10.*
+    , crypto-random == 0.0.*
     -- Temporarily inlined due to FTBFS bug
     -- https://github.com/ocharles/argon2/issues/2
     -- argon2 == 1.1.*
diff --git a/keysafe.hs b/keysafe.hs
index 04f2d9b..1abab5f 100644
--- a/keysafe.hs
+++ b/keysafe.hs
@@ -71,6 +71,8 @@ dispatch cmdline ui storagelocations tunables possibletunables = do
 		runServer
 			(CmdLine.localstoragedirectory cmdline)
 			(CmdLine.serverConfig cmdline)
+	go (CmdLine.Chaff hn) _ = storeChaff hn
+		(CmdLine.serverPort (CmdLine.serverConfig cmdline))
 	go CmdLine.Benchmark _ =
 		benchmarkTunables tunables
 	go CmdLine.Test _ =
-- 
cgit v1.2.3