diff options
-rw-r--r-- | BackupRecord.hs | 2 | ||||
-rw-r--r-- | HTTP/Client.hs | 28 | ||||
-rw-r--r-- | Servers.hs | 20 | ||||
-rw-r--r-- | Storage.hs | 3 | ||||
-rw-r--r-- | Storage/Network.hs | 4 | ||||
-rw-r--r-- | Types/Server.hs | 23 |
6 files changed, 55 insertions, 25 deletions
diff --git a/BackupRecord.hs b/BackupRecord.hs index 6d150e1..0a90de2 100644 --- a/BackupRecord.hs +++ b/BackupRecord.hs @@ -33,7 +33,7 @@ import qualified Data.ByteString.Lazy as B -- this should only half the password crack time at worst. data BackupRecord = BackupRecord { backupDate :: POSIXTime - , backupServers :: [HostName] + , backupServers :: [ServerName] , secretKeySource :: SecretKeySource , passwordEntropy :: Int } deriving (Show, Generic) diff --git a/HTTP/Client.hs b/HTTP/Client.hs index 48a430c..f13620e 100644 --- a/HTTP/Client.hs +++ b/HTTP/Client.hs @@ -64,23 +64,25 @@ serverRequest srv onerr onsuccess p a = do (Just $ genProofOfWork req p) (Seconds timeleft - generationTime req) +-- A new Manager is allocated for each request, rather than reusing +-- any connection. This is a feature; it makes correlation attacks +-- harder because the server can't tell if two connections +-- accessing different objects came from the same user, except by +-- comparing IP addresses (which are masked somewhat by using tor). serverRequest' :: Server -> (Manager -> BaseUrl -> ExceptT ServantError IO r) -> IO (Either String r) -serverRequest' srv a = do - -- A new Manager is allocated for each request, rather than reusing - -- any connection. This is a feature; it makes correlation attacks - -- harder because the server can't tell if two connections - -- accessing different objects came from the same user, except by - -- comparing IP addresses (which are masked somewhat by using tor). - manager <- torableManager - res <- runExceptT $ a manager url - return $ case res of - Left err -> Left $ "server failure: " ++ show err - Right r -> Right r +serverRequest' srv a = go Nothing (serverUrls srv) where - url = serverUrl srv + go lasterr [] = return $ Left $ + maybe "no available servers" (\err -> "server failure: " ++ show err) lasterr + go _ (url:urls) = do + manager <- torableManager + res <- runExceptT $ a manager url + case res of + Left err -> go (Just err) urls + Right r -> return (Right r) -- | HTTP Manager supporting tor .onion and regular hosts torableManager :: IO Manager @@ -94,7 +96,7 @@ torableManager = newManager $ defaultManagerSettings regular <- managerRawConnection defaultManagerSettings regular addr host port -torConnection :: HostName -> Port -> IO Connection +torConnection :: String -> Port -> IO Connection torConnection onionaddress p = do (socket, _) <- socksConnect torsockconf socksaddr socketConnection socket 8192 @@ -8,14 +8,20 @@ module Servers where import Types.Server import Servant.Client -serverUrl :: Server -> BaseUrl -serverUrl srv = BaseUrl Http (serverName srv) (serverPort srv) "" +serverUrls :: Server -> [BaseUrl] +serverUrls srv = map go (serverAddress srv) + where + go (ServerAddress addr port) = BaseUrl Http addr port "" --- | These can be either tor .onion addresses, or regular hostnames. --- Using tor is highly recommended, to avoid correlation attacks. networkServers :: IO [Server] networkServers = return - [ Server "vzgrspuxbtnlrtup.onion" 4242 -- keysafe.joeyh.name - , Server "localhost" 4242 - , Server "localhost" 4242 + [ Server (ServerName "keysafe.joeyh.name") + [ServerAddress "vzgrspuxbtnlrtup.onion" 4242] + -- Purism server is not yet deployed, but planned. + , Server (ServerName "keysafe.puri.sm") + [] + -- Unknown yet who will provide this server, but allocate it now + -- so keysafe can start queuing uploads to it. + , Server (ServerName "thirdserver") + [] ] @@ -148,7 +148,8 @@ storeChaff hn port = forever $ do mapConcurrently (go sis rng') [1..totalObjects (shareParams testModeTunables)] where - server = networkStorage Nothing $ Server hn port + server = networkStorage Nothing $ Server (ServerName hn) + [ServerAddress hn port] objsize = objectSize defaultTunables * shareOverhead defaultTunables go sis rng n = do let (b, rng') = cprgGenerate objsize rng diff --git a/Storage/Network.hs b/Storage/Network.hs index dec6d57..f8169c9 100644 --- a/Storage/Network.hs +++ b/Storage/Network.hs @@ -25,9 +25,11 @@ networkStorage localdir server = Storage , countShares = count server , moveShares = move server , uploadQueue = Just $ localStorage (storageDir localdir) - ("uploadqueue" </> serverName server) + ("uploadqueue" </> name) , getServer = Just server } + where + ServerName name = serverName server store :: Server -> StorableObjectIdent -> Share -> IO StoreResult store srv i (Share _n o) = diff --git a/Types/Server.hs b/Types/Server.hs index dd06909..e1b4191 100644 --- a/Types/Server.hs +++ b/Types/Server.hs @@ -3,14 +3,33 @@ - Licensed under the GNU AGPL version 3 or higher. -} +{-# LANGUAGE DeriveGeneric #-} + module Types.Server where +import Data.Aeson +import GHC.Generics import Network.Wai.Handler.Warp (Port) type HostName = String +-- | Server address can use either tor .onion addresses, or regular +-- hostnames. Using tor is highly recommended, to avoid correlation +-- attacks. +data ServerAddress = ServerAddress HostName Port + deriving (Show) + +-- | Name used in queuing uploads to the server. Should remain stable +-- across keysafe versions. +newtype ServerName = ServerName String + deriving (Show, Generic) + +instance ToJSON ServerName +instance FromJSON ServerName + data Server = Server - { serverName :: HostName - , serverPort :: Port + { serverName :: ServerName + , serverAddress :: [ServerAddress] + -- ^ A server may have multiple addresses, or no current address. } deriving (Show) |