diff options
| -rw-r--r-- | CHANGELOG | 3 | ||||
| -rw-r--r-- | CmdLine.hs | 10 | ||||
| -rw-r--r-- | HTTP/Server.hs | 24 | ||||
| -rw-r--r-- | INSTALL | 4 | ||||
| -rw-r--r-- | Storage.hs | 18 | ||||
| -rw-r--r-- | Storage/Local.hs | 14 | ||||
| -rw-r--r-- | Storage/Network.hs | 6 | ||||
| -rw-r--r-- | Types/Storage.hs | 2 | ||||
| -rw-r--r-- | keysafe.hs | 7 |
9 files changed, 54 insertions, 34 deletions
@@ -1,6 +1,6 @@ keysafe (0.20160820) UNRELEASED; urgency=medium - * Server implementation. + * Server implementation is ready for deployment. * Removed embedded copy of secret-sharing library, since finite-field only supports prime fields. This caused shares to be twice the size of the input value. @@ -9,6 +9,7 @@ keysafe (0.20160820) UNRELEASED; urgency=medium * Tuned argon2 hash parameters on better hardware than my fanless laptop. * Improve time estimates, taking into account the number of cores. * Added basic test suite. + * Added options: --store-directory -- Joey Hess <id@joeyh.name> Mon, 22 Aug 2016 13:56:16 -0400 @@ -6,6 +6,7 @@ module CmdLine where import Types +import Types.Storage import Tunables import qualified Gpg import Options.Applicative @@ -17,6 +18,7 @@ data CmdLine = CmdLine { mode :: Maybe Mode , secretkeysource :: Maybe SecretKeySource , localstorage :: Bool + , localstoragedirectory :: Maybe LocalStorageDirectory , gui :: Bool , testMode :: Bool , customShareParams :: Maybe ShareParams @@ -36,6 +38,7 @@ parse = CmdLine <$> optional (backup <|> restore <|> uploadqueued <|> server <|> benchmark <|> test) <*> optional (gpgswitch <|> fileswitch) <*> localstorageswitch + <*> localstoragedirectory <*> guiswitch <*> testmodeswitch <*> optional (ShareParams <$> totalobjects <*> neededobjects) @@ -77,7 +80,12 @@ parse = CmdLine ) localstorageswitch = switch ( long "store-local" - <> help "Store data locally, in ~/.keysafe/objects/local/. (The default is to store data in the cloud.)" + <> help "Store data locally. (The default is to store data in the cloud.)" + ) + localstoragedirectory = optional $ LocalStorageDirectory <$> option str + ( long "store-directory" + <> metavar "DIR" + <> help "Where to store data locally. (default: ~/.keysafe/objects/)" ) testmodeswitch = switch ( long "testmode" diff --git a/HTTP/Server.hs b/HTTP/Server.hs index 3e0b9aa..5d5c87f 100644 --- a/HTTP/Server.hs +++ b/HTTP/Server.hs @@ -24,23 +24,25 @@ import qualified Data.ByteString as B data ServerState = ServerState { obscurerRequest :: TMVar () + , storageDirectory :: Maybe LocalStorageDirectory } -newServerState :: IO ServerState -newServerState = ServerState +newServerState :: Maybe LocalStorageDirectory -> IO ServerState +newServerState d = ServerState <$> newEmptyTMVarIO + <*> pure d -runServer :: String -> Port -> IO () -runServer bindaddress port = do - st <- newServerState +runServer :: Maybe LocalStorageDirectory -> String -> Port -> IO () +runServer d bindaddress port = do + st <- newServerState d _ <- forkIO $ obscurerThread st runSettings settings (app st) where settings = setHost host $ setPort port $ defaultSettings host = fromString bindaddress -serverStorage :: Storage -serverStorage = localStorage userStorageDir "server" +serverStorage :: ServerState -> Storage +serverStorage st = localStorage (storageDir $ storageDirectory st) "server" app :: ServerState -> Application app st = serve userAPI (server st) @@ -59,7 +61,7 @@ motd = return $ Motd "Hello World!" getObject :: ServerState -> StorableObjectIdent -> Maybe ProofOfWork -> Handler (ProofOfWorkRequirement StorableObject) getObject st i _pow = do - r <- liftIO $ retrieveShare serverStorage dummyShareNum i + r <- liftIO $ retrieveShare (serverStorage st) dummyShareNum i liftIO $ requestObscure st case r of RetrieveSuccess (Share _n o) -> return $ Result o @@ -69,7 +71,7 @@ putObject :: ServerState -> StorableObjectIdent -> Maybe ProofOfWork -> Storable putObject st i _pow o = do if validObjectsize o then do - r <- liftIO $ storeShare serverStorage i (Share dummyShareNum o) + r <- liftIO $ storeShare (serverStorage st) i (Share dummyShareNum o) liftIO $ requestObscure st return $ Result r else return $ Result $ StoreFailure "invalid object size" @@ -80,7 +82,7 @@ validObjectsize o = any (sz ==) knownObjectSizes sz = B.length (fromStorableObject o) countObjects :: ServerState -> Maybe ProofOfWork -> Handler (ProofOfWorkRequirement CountResult) -countObjects _st _pow = liftIO $ Result <$> countShares serverStorage +countObjects st _pow = liftIO $ Result <$> countShares (serverStorage st) -- | 1 is a dummy value; the server does not know the actual share numbers. dummyShareNum :: ShareNum @@ -91,7 +93,7 @@ dummyShareNum = 1 -- the thread runs a maximum of once per half-hour. obscurerThread :: ServerState -> IO () obscurerThread st = do - _ <- obscureShares serverStorage + _ <- obscureShares (serverStorage st) putStrLn "obscured shares" threadDelay (1000000*60*30) _ <- atomically $ takeTMVar (obscurerRequest st) @@ -8,3 +8,7 @@ Then to build and install keysafe: stack install keysafe Note that there is a manpage, but stack doesn't install it yet. + +## Server installation + +useradd --system keysafe @@ -16,15 +16,15 @@ import System.FilePath import Control.Monad import qualified Data.Set as S -allStorageLocations :: IO StorageLocations -allStorageLocations = do +allStorageLocations :: Maybe LocalStorageDirectory -> IO StorageLocations +allStorageLocations d = do servers <- networkServers return $ StorageLocations $ - map networkStorage servers <> map uploadQueue servers + map networkStorage servers <> map (uploadQueue d) servers -localStorageLocations :: StorageLocations -localStorageLocations = StorageLocations $ - map (localStorage userStorageDir . ("local" </>) . show) +localStorageLocations :: Maybe LocalStorageDirectory -> StorageLocations +localStorageLocations d = StorageLocations $ + map (localStorage (storageDir d) . ("local" </>) . show) [1..100 :: Int] type UpdateProgress = IO () @@ -99,7 +99,7 @@ retrieveShares (StorageLocations locs) sis updateprogress = do -- all of them. go (unusedlocs++[loc]) usedlocs' rest shares' -uploadQueued :: IO () -uploadQueued = do +uploadQueued :: Maybe LocalStorageDirectory -> IO () +uploadQueued d = do servers <- networkServers - forM_ servers $ \s -> moveShares (uploadQueue s) (networkStorage s) + forM_ servers $ \s -> moveShares (uploadQueue d s) (networkStorage s) diff --git a/Storage/Local.hs b/Storage/Local.hs index d0a1d15..38fc5b7 100644 --- a/Storage/Local.hs +++ b/Storage/Local.hs @@ -3,7 +3,7 @@ - Licensed under the GNU AGPL version 3 or higher. -} -module Storage.Local (localStorage, userStorageDir, testStorageDir, uploadQueue) where +module Storage.Local (localStorage, storageDir, testStorageDir, uploadQueue) where import Types import Types.Storage @@ -38,8 +38,8 @@ localStorage getsharedir n = Storage where section = Section n -uploadQueue :: Server -> Storage -uploadQueue s = localStorage userStorageDir ("uploadqueue" </> serverName s) +uploadQueue :: Maybe LocalStorageDirectory -> Server -> Storage +uploadQueue d s = localStorage (storageDir d) ("uploadqueue" </> serverName s) store :: Section -> GetShareDir -> StorableObjectIdent -> Share -> IO StoreResult store section getsharedir i s = onError (StoreFailure . show) $ do @@ -117,13 +117,15 @@ onError f a = do Left e -> f e Right r -> r -userStorageDir :: GetShareDir -userStorageDir (Section section) = do +storageDir :: Maybe LocalStorageDirectory -> GetShareDir +storageDir Nothing (Section section) = do u <- getUserEntryForID =<< getEffectiveUserID return $ homeDirectory u </> dotdir </> section +storageDir (Just (LocalStorageDirectory d)) (Section section) = + pure $ d </> section testStorageDir :: FilePath -> GetShareDir -testStorageDir tmpdir (Section section) = pure $ tmpdir </> section +testStorageDir tmpdir = storageDir (Just (LocalStorageDirectory tmpdir)) -- | The takeFileName ensures that, if the StorableObjectIdent somehow -- contains a path (eg starts with "../" or "/"), it is not allowed diff --git a/Storage/Network.hs b/Storage/Network.hs index 356f5ad..d16d693 100644 --- a/Storage/Network.hs +++ b/Storage/Network.hs @@ -42,9 +42,9 @@ serverUrl srv = BaseUrl Http (serverName srv) (serverPort srv) "" -- Using tor is highly recommended, to avoid correlation attacks. networkServers :: IO [Server] networkServers = return - [ Server "localhost" 8080 - , Server "localhost" 8080 - , Server "localhost" 8080 + [ Server "localhost" 4242 + , Server "localhost" 4242 + , Server "localhost" 4242 ] networkStorage :: Server -> Storage diff --git a/Types/Storage.hs b/Types/Storage.hs index d8cc181..bc186e7 100644 --- a/Types/Storage.hs +++ b/Types/Storage.hs @@ -17,6 +17,8 @@ import Data.Aeson.Types newtype StorageLocations = StorageLocations [Storage] deriving (Monoid) +newtype LocalStorageDirectory = LocalStorageDirectory FilePath + -- | Storage interface. This can be used both for local storage, -- an upload queue, or a remote server. -- @@ -43,8 +43,8 @@ main = do return (mkt testModeTunables, [mkt testModeTunables]) else return (mkt defaultTunables, map (mkt . snd) knownTunings) storagelocations <- if CmdLine.localstorage cmdline - then return localStorageLocations - else allStorageLocations + then pure $ localStorageLocations (CmdLine.localstoragedirectory cmdline) + else allStorageLocations (CmdLine.localstoragedirectory cmdline) dispatch cmdline ui storagelocations tunables possibletunables dispatch :: CmdLine.CmdLine -> UI -> StorageLocations -> Tunables -> [Tunables] -> IO () @@ -63,9 +63,10 @@ dispatch cmdline ui storagelocations tunables possibletunables = do go CmdLine.Restore Nothing = restore storagelocations ui possibletunables Gpg.anyKey go CmdLine.UploadQueued _ = - uploadQueued + uploadQueued (CmdLine.localstoragedirectory cmdline) go (CmdLine.Server) _ = runServer + (CmdLine.localstoragedirectory cmdline) (CmdLine.serverAddress $ CmdLine.serverConfig cmdline) (CmdLine.serverPort $ CmdLine.serverConfig cmdline) go CmdLine.Benchmark _ = |