diff options
author | Joey Hess <joeyh@joeyh.name> | 2016-09-14 15:51:59 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2016-09-14 15:51:59 -0400 |
commit | 92f0a9c8b6c676281dcbee6e4bce938b969ef7c2 (patch) | |
tree | b5fb0fee6d476db3b6658c5d7ec07e9387658fb2 | |
parent | 0709306afeaba998d8f0a76e37517d4c227ac1c3 (diff) | |
download | keysafe-92f0a9c8b6c676281dcbee6e4bce938b969ef7c2.tar.gz |
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.
-rw-r--r-- | CHANGELOG | 4 | ||||
-rw-r--r-- | CmdLine.hs | 10 | ||||
-rw-r--r-- | Storage.hs | 36 | ||||
-rw-r--r-- | keysafe.cabal | 1 | ||||
-rw-r--r-- | keysafe.hs | 2 |
5 files changed, 50 insertions, 3 deletions
@@ -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 @@ -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." @@ -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.* @@ -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 _ = |