From b40d441c52f37584653e74fada9906cc8105c9f7 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 6 Oct 2016 13:54:52 -0400 Subject: move level from Server to Storage This allows local storage locations to have levels too, and also get shuffled nicely. This commit was sponsored by Ethan Aubin. --- keysafe.hs | 21 +++++++++------------ 1 file changed, 9 insertions(+), 12 deletions(-) (limited to 'keysafe.hs') diff --git a/keysafe.hs b/keysafe.hs index bd63ff1..11f52dc 100644 --- a/keysafe.hs +++ b/keysafe.hs @@ -20,7 +20,6 @@ import Cost import SecretKey import Share import Storage -import Servers import Types.Server import BackupLog import AutoStart @@ -86,7 +85,7 @@ dispatch cmdline ui tunables possibletunables = do go (CmdLine.Chaff hn) _ = storeChaff hn (CmdLine.serverPort (CmdLine.serverConfig cmdline)) (CmdLine.chaffMaxDelay cmdline) - go CmdLine.CheckServers _ = checkServers + go CmdLine.CheckServers _ = checkServers cmdline go CmdLine.Benchmark _ = benchmarkTunables tunables go CmdLine.Test _ = @@ -361,11 +360,7 @@ userName = do return $ Name $ BU8.fromString $ takeWhile (/= ',') (userGecos u) cmdLineStorageLocations :: CmdLine.CmdLine -> IO StorageLocations -cmdLineStorageLocations cmdline - | CmdLine.localstorage cmdline = return (localStorageLocations lsd) - | otherwise = networkStorageLocations lsd - where - lsd = CmdLine.localstoragedirectory cmdline +cmdLineStorageLocations = networkStorageLocations . CmdLine.localstoragedirectory getPasswordEntropy :: Password -> Name -> IO (Entropy UnknownPassword) getPasswordEntropy password name = do @@ -409,15 +404,17 @@ autoStart cmdline tunables ui = do else storeBackupLog =<< mkBackupLog (BackupSkipped (GpgKey kid)) -checkServers :: IO () -checkServers = do - say $ "Checking " ++ show (length networkServers) ++ " servers concurrently; please wait..." - results <- mapConcurrently check networkServers +checkServers :: CmdLine.CmdLine -> IO () +checkServers cmdline = do + StorageLocations sls <- cmdLineStorageLocations cmdline + let serverlist = mapMaybe getServer sls + say $ "Checking " ++ show (length serverlist) ++ " servers concurrently; please wait..." + results <- mapConcurrently check serverlist mapM_ displayresult results case filter failed results of [] -> return () l - | length l == length networkServers -> + | length l == length serverlist -> error "Failed to connect to any servers. Perhaps TOR is not running?" | otherwise -> error $ "Failed to connect to some servers: " -- cgit v1.2.3