diff options
| -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 _ = |