From 8fe65bd0f70c1cd2fc83469f401c987d69eb4370 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 27 Sep 2016 13:09:30 -0400 Subject: Added --check-servers mode, which is useful both at the command line to see what servers keysafe knows about, and as a cron job. This commit was sponsored by Jake Vosloo on Patreon. --- CHANGELOG | 2 ++ CmdLine.hs | 6 +++++- HTTP/Client.hs | 2 +- Types/Server.hs | 2 +- keysafe.hs | 45 +++++++++++++++++++++++++++++++++++++++++++++ 5 files changed, 54 insertions(+), 3 deletions(-) diff --git a/CHANGELOG b/CHANGELOG index 40fe268..1557009 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -12,6 +12,8 @@ keysafe (0.20160923) UNRELEASED; urgency=medium by Marek Isalski at Faelix. Currently located in UK, but planned move to CH. Currently at Alternate level until verification is complete. * Server: --motd can be used to provide a Message Of The Day. + * Added --check-servers mode, which is useful both at the command line + to see what servers keysafe knows about, and as a cron job. -- Joey Hess Fri, 23 Sep 2016 10:40:55 -0400 diff --git a/CmdLine.hs b/CmdLine.hs index 6c5bafd..702c97d 100644 --- a/CmdLine.hs +++ b/CmdLine.hs @@ -31,7 +31,7 @@ data CmdLine = CmdLine , chaffMaxDelay :: Maybe Seconds } -data Mode = Backup | Restore | UploadQueued | AutoStart | Server | BackupServer FilePath | RestoreServer FilePath | Chaff HostName | Benchmark | Test +data Mode = Backup | Restore | UploadQueued | AutoStart | Server | BackupServer FilePath | RestoreServer FilePath | Chaff HostName | CheckServers | Benchmark | Test deriving (Show) data ServerConfig = ServerConfig @@ -135,6 +135,10 @@ parseMode = <> metavar "HOSTNAME" <> help "Upload random data to a keysafe server." ) + <|> flag' CheckServers + ( long "check-servers" + <> help "Tries to connect to each server in the server list. Displays the server's MOTD, and the amount of data stored on it. Prints message to stderr and exits nonzero if any of the servers are not accessible." + ) <|> flag' Benchmark ( long "benchmark" <> help "Benchmark speed of keysafe's cryptographic primitives." diff --git a/HTTP/Client.hs b/HTTP/Client.hs index f13620e..50c5906 100644 --- a/HTTP/Client.hs +++ b/HTTP/Client.hs @@ -76,7 +76,7 @@ serverRequest' serverRequest' srv a = go Nothing (serverUrls srv) where go lasterr [] = return $ Left $ - maybe "no available servers" (\err -> "server failure: " ++ show err) lasterr + maybe "no known address" (\err -> "server failure: " ++ show err) lasterr go _ (url:urls) = do manager <- torableManager res <- runExceptT $ a manager url diff --git a/Types/Server.hs b/Types/Server.hs index 785dd24..5caf9db 100644 --- a/Types/Server.hs +++ b/Types/Server.hs @@ -21,7 +21,7 @@ data ServerAddress = ServerAddress HostName Port -- | Name used in queuing uploads to the server. Should remain stable -- across keysafe versions. -newtype ServerName = ServerName String +newtype ServerName = ServerName { fromServerName :: String } deriving (Show, Eq, Ord, Generic) instance ToJSON ServerName diff --git a/keysafe.hs b/keysafe.hs index 7306a29..d27f87a 100644 --- a/keysafe.hs +++ b/keysafe.hs @@ -19,10 +19,14 @@ import Cost import SecretKey import Share import Storage +import Servers import Types.Server import BackupLog import AutoStart +import HTTP import HTTP.Server +import HTTP.Client +import HTTP.ProofOfWork import ServerBackup import qualified Gpg import Data.Maybe @@ -31,10 +35,12 @@ import Data.Time.Calendar import Data.Monoid import Data.List import Control.DeepSeq +import Control.Concurrent.Async import qualified Data.Text as T import qualified Data.ByteString as B import qualified Data.ByteString.UTF8 as BU8 import qualified Data.Set as S +import System.IO import System.Posix.User (userGecos, getUserEntryForID, getEffectiveUserID) main :: IO () @@ -80,6 +86,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.Benchmark _ = benchmarkTunables tunables go CmdLine.Test _ = @@ -401,3 +408,41 @@ autoStart cmdline tunables ui = do =<< Gpg.getSecretKey kid else storeBackupLog =<< mkBackupLog (BackupSkipped (GpgKey kid)) + +checkServers :: IO () +checkServers = do + putStrLn $ "Checking " ++ show (length networkServers) ++ " servers concurrently; please wait..." + results <- mapConcurrently check networkServers + mapM_ display results + case filter failed results of + [] -> return () + l + | length l == length networkServers -> + error "Failed to connect to any servers. Perhaps TOR is not running?" + | otherwise -> + error $ "Failed to connect to some servers: " + ++ show (map (sn . fst) l) + where + check s = do + m <- serverRequest' s motd + c <- serverRequest s Left Right NoPOWIdent countObjects + case (m, c) of + (Right (Motd mt), Right (CountResult cr)) -> + return (s, Right (mt, cr)) + (Left e, _) -> return (s, Left e) + (_, Left e) -> return (s, Left e) + (_, Right (CountFailure e)) -> return (s, Left e) + + display (s, v) = do + putStrLn $ "* " ++ sn s ++ " -- " ++ serverDesc s + case v of + Right (mt, cr) -> do + putStrLn $ " MOTD: " ++ T.unpack mt + putStrLn $ " object count: " ++ show cr + Left e -> hPutStrLn stderr $ + " failed to get connect to " ++ sn s ++ ": " ++ e + + failed (_, Left _) = True + failed _ = False + + sn = fromServerName . serverName -- cgit v1.2.3