diff options
Diffstat (limited to 'Storage.hs')
| -rw-r--r-- | Storage.hs | 36 |
1 files changed, 35 insertions, 1 deletions
@@ -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 |