diff options
Diffstat (limited to 'keysafe.hs')
| -rw-r--r-- | keysafe.hs | 21 |
1 files changed, 9 insertions, 12 deletions
@@ -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: " |