From 0ffb61533f5afb615457ee8f1a061eb571576e0c Mon Sep 17 00:00:00 2001 From: Mahdi Dibaiee Date: Sun, 16 Apr 2017 16:50:20 +0430 Subject: [PATCH] feat(monitoring): read status and logs of a service --- serverman.cabal | 1 + src/System/Serverman.hs | 3 ++ src/System/Serverman/Action.hs | 22 ++++++------ src/System/Serverman/Actions/Monitor.hs | 45 +++++++++++++++++++++++++ src/System/Serverman/Actions/Remote.hs | 31 ++++++++--------- src/System/Serverman/Log.hs | 4 +++ src/System/Serverman/Types.hs | 8 +++-- src/System/Term.hs | 36 +++++++++++++++++++- 8 files changed, 121 insertions(+), 29 deletions(-) create mode 100644 src/System/Serverman/Actions/Monitor.hs diff --git a/serverman.cabal b/serverman.cabal index 67e29b5..fa1bde5 100644 --- a/serverman.cabal +++ b/serverman.cabal @@ -27,6 +27,7 @@ library , System.Serverman.Actions.Remote , System.Serverman.Actions.Repository , System.Serverman.Actions.Call + , System.Serverman.Actions.Monitor , System.Serverman.Types , System.Serverman.Services diff --git a/src/System/Serverman.hs b/src/System/Serverman.hs index 9af8936..e10121f 100644 --- a/src/System/Serverman.hs +++ b/src/System/Serverman.hs @@ -13,6 +13,7 @@ module System.Serverman ( run import System.Serverman.Actions.Env import System.Serverman.Actions.Install import System.Serverman.Actions.Manage + import System.Serverman.Actions.Monitor import System.Serverman.Actions.Repository import System.Serverman.Actions.Remote import System.Serverman.Actions.Call @@ -35,3 +36,5 @@ module System.Serverman ( run run (Free (FetchRepository next)) = fetchRepo False >> run next run (Free (UpdateRepository next)) = fetchRepo True >> run next + run (Free (Status service next)) = serviceStatus service >> run next + run (Free (Log service next)) = serviceLogs service >> run next diff --git a/src/System/Serverman/Action.hs b/src/System/Serverman/Action.hs index 5eba4d9..0913051 100644 --- a/src/System/Serverman/Action.hs +++ b/src/System/Serverman/Action.hs @@ -1,15 +1,6 @@ {-# LANGUAGE ScopedTypeVariables #-} -module System.Serverman.Action ( ActionF(..) - , Action - , call - , fetchRepository - , updateRepository - , start - , stop - , install - , remote - , detectOS) where +module System.Serverman.Action where import System.Serverman.Actions.Env import System.Serverman.Actions.Repository @@ -37,6 +28,8 @@ module System.Serverman.Action ( ActionF(..) | UpdateRepository x | Start Service x | Stop Service x + | Status Service x + | Log Service x instance Functor ActionF where fmap f (Call service remote x) = Call service remote (f x) @@ -47,6 +40,8 @@ module System.Serverman.Action ( ActionF(..) fmap f (Remote addr action x) = Remote addr action (f x) fmap f (FetchRepository x) = FetchRepository (f x) fmap f (UpdateRepository x) = UpdateRepository (f x) + fmap f (Status service x) = Status service (f x) + fmap f (Log service x) = Log service (f x) type Action = Free ActionF @@ -73,3 +68,10 @@ module System.Serverman.Action ( ActionF(..) updateRepository :: Action () updateRepository = liftF $ UpdateRepository () + + status :: Service -> Action () + status service = liftF $ Status service () + + readLogs :: Service -> Action () + readLogs service = liftF $ Log service () + diff --git a/src/System/Serverman/Actions/Monitor.hs b/src/System/Serverman/Actions/Monitor.hs new file mode 100644 index 0000000..2ecd9d4 --- /dev/null +++ b/src/System/Serverman/Actions/Monitor.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE NamedFieldPuns #-} +module System.Serverman.Actions.Monitor (serviceLogs, serviceStatus) where + import System.Serverman.Utils + import System.Serverman.Types + import System.Serverman.Log + + import Data.List + import Data.Maybe + import Control.Monad.State + + serviceStatus :: Service -> App () + serviceStatus s@Service { service } = do + result <- executeRoot "systemctl" ["status", service] "" False + + AppState { remoteMode } <- get + let addr = if isJust remoteMode then " on " ++ (show . fst . fromJust) remoteMode else "" + + case result of + Left e + | "Loaded: not-found" `isInfixOf` e -> + err $ "service " ++ service ++ " was not found" ++ addr + | "Active: inactive" `isInfixOf` e -> + warning $ "service " ++ service ++ " is inactive" ++ addr + | otherwise -> + err $ "service " ++ service ++ " errored!" ++ addr + Right out -> + success $ "service " ++ service ++ " is active" ++ addr + + return () + + + serviceLogs :: Service -> App () + serviceLogs s@Service { service } = do + result <- executeRoot "journalctl" ["-u", service, "--no-tail", "--no-pager"] "" False + + AppState { remoteMode } <- get + let addr = if isJust remoteMode then " on " ++ (show . fst . fromJust) remoteMode else "" + + case result of + Left e -> err $ "could not read service " ++ service ++ " logs: " ++ e + Right out -> do + success $ "service " ++ service ++ " logs " ++ addr + write out + + return () diff --git a/src/System/Serverman/Actions/Remote.hs b/src/System/Serverman/Actions/Remote.hs index 2b63b0d..a1947b3 100644 --- a/src/System/Serverman/Actions/Remote.hs +++ b/src/System/Serverman/Actions/Remote.hs @@ -32,7 +32,7 @@ module System.Serverman.Actions.Remote ( runRemotely execute "fusermount" ["-u", path] "" False return () - runRemotely :: Address -> App r -> App () + runRemotely :: Address -> App r -> App (Either String r) runRemotely addr@(Address host port user) action = do verbose $ "running action remotely on " ++ show addr done <- progressText $ "connecting to server " ++ show addr @@ -50,7 +50,8 @@ module System.Serverman.Actions.Remote ( runRemotely serverPaths = ["/usr/lib/openssh/sftp-server", "/usr/lib/ssh/sftp-server"] options = ["-o", "nonempty", - "-o", "sftp_server=sudo " ++ head serverPaths] + "-o", "sftp_server=sudo " ++ head serverPaths, + "-o", "StrictHostKeyChecking=no"] home <- liftIO getHomeDirectory @@ -80,15 +81,7 @@ module System.Serverman.Actions.Remote ( runRemotely done case result of - Right _ -> do - state <- get - liftIO $ threadDelay actionDelay - - put $ state { remoteMode = Just (servermanAddr, keyPath) } - getOS - action - - return () + Right _ -> runAction servermanAddr keyPath Left e -> do info $ "it seems to be the first time you are using serverman for configuring " ++ show addr @@ -122,13 +115,21 @@ module System.Serverman.Actions.Remote ( runRemotely done - runRemotely addr action + runAction servermanAddr keyPath - return () - - return () + return $ Left ("could not run action remotely: " ++ show addr) where + runAction servermanAddr keyPath = do + state <- get + r <- liftIO $ threadDelay actionDelay + + put $ state { remoteMode = Just (servermanAddr, keyPath) } + getOS + action + + return (Right r) + noPassword = ["-o", "PasswordAuthentication=no", "-o", "PubkeyAuthentication=yes"] modPath path c diff --git a/src/System/Serverman/Log.hs b/src/System/Serverman/Log.hs index 71bb5f8..1de7c99 100644 --- a/src/System/Serverman/Log.hs +++ b/src/System/Serverman/Log.hs @@ -8,6 +8,7 @@ module System.Serverman.Log ( verbose , progressText , warning , err + , success , die) where import System.Serverman.Types @@ -36,6 +37,9 @@ module System.Serverman.Log ( verbose info :: String -> App () info str = liftIO . putStrLn . format . reset $ read ("[info] " ++ str) + success :: String -> App () + success str = liftIO . putStrLn . format . F.green $ read str + warning :: String -> App () warning str = liftIO . putStrLn . format . F.yellow $ read ("[warning] " ++ str) diff --git a/src/System/Serverman/Types.hs b/src/System/Serverman/Types.hs index 16cb0d8..6e419f1 100644 --- a/src/System/Serverman/Types.hs +++ b/src/System/Serverman/Types.hs @@ -29,14 +29,16 @@ module System.Serverman.Types ( Service (..) readsPrec _ addr | '@' `elem` addr = let (user, rest) = (takeWhile (/= '@') addr, tail $ dropWhile (/= '@') addr) - (host, port) = readHostPort rest + (host, port) = readHostPort rest "22" in [(Address host port user, [])] | otherwise = - let (host, port) = readHostPort addr + let (host, port) = readHostPort addr "22" in [(Address host port "", [])] where - readHostPort str = (takeWhile (/= ':') str, tail $ dropWhile (/= ':') str) + readHostPort str defaultPort + | ':' `elem` str = (takeWhile (/= ':') str, tail $ dropWhile (/= ':') str) + | otherwise = (str, defaultPort) instance Show Address where show (Address host port user) diff --git a/src/System/Term.hs b/src/System/Term.hs index 684b940..ac59f14 100644 --- a/src/System/Term.hs +++ b/src/System/Term.hs @@ -63,6 +63,26 @@ module System.Term ( initialize ) where p@Params { update = True } -> S.run S.updateRepository + p@Params { status = Just service } -> do + verbose $ "reading status for " ++ service + ms <- findService service + + case ms of + Just s -> do + result <- handleRemote p $ S.status s + liftIO $ print result + Nothing -> die $ "service not found: " ++ service + + p@Params { logs = Just service } -> do + verbose $ "reading logs for " ++ service + ms <- findService service + + case ms of + Just s -> do + result <- handleRemote p $ S.readLogs s + liftIO $ print result + Nothing -> die $ "service not found: " ++ service + p@Params { manage = Just (act, service) } -> do verbose $ "preparing to " ++ show act ++ " " ++ service ms <- findService service @@ -112,11 +132,15 @@ module System.Term ( initialize ) where clearTemp path = execIfExists path $ do execute "fusermount" ["-u", path] "" False liftIO $ removeDirectoryRecursive path + -- if remote mode is set, read the file and run the action -- on servers, otherwise run action locally + handleRemote :: Params -> S.Action () -> S.App () handleRemote Params { remote = Just file } action = do list <- liftIO $ filter (not . null) . lines <$> readFile file S.run (S.remote (map read list) action) + return () + handleRemote Params { remote = Nothing } action = S.run action servermanHelp = do @@ -128,6 +152,8 @@ module System.Term ( initialize ) where , ("repository update", "update repository") , ("service start ", "start the service") , ("service stop ", "stop the service") + , ("service status ", "read service status") + , ("service logs ", "read service logs") , ("--remote ", "run in remote mode: takes a path to a file containing username@ip:port lines")] write "to learn about a service's options, run |serverman --help|" @@ -141,16 +167,20 @@ module System.Term ( initialize ) where , remote :: Maybe FilePath , rest :: [(String, Maybe String)] , verboseM :: Bool + , status :: Maybe String + , logs :: Maybe String } instance Show Params where - show Params { listServices, install, manage, update, remote, rest, verboseM } = + show Params { listServices, install, manage, update, remote, rest, verboseM, status, logs } = keyvalue [ ("list-services", show listServices) , ("install", show install) , ("manage", show manage) , ("update", show update) , ("remote", show remote) , ("rest", show rest) + , ("status", show status) + , ("logs", show logs) , ("verbose", show verboseM)] ": " instance Default Params where @@ -160,6 +190,8 @@ module System.Term ( initialize ) where , remote = Nothing , update = False , rest = [] + , status = Nothing + , logs = Nothing , verboseM = False } @@ -168,6 +200,8 @@ module System.Term ( initialize ) where parseParams ("repository":"update":xs) = (parseParams xs) { update = True } parseParams ("service":"start":s:xs) = (parseParams xs) { manage = Just (Start, s) } parseParams ("service":"stop":s:xs) = (parseParams xs) { manage = Just (Stop, s) } + parseParams ("service":"status":s:xs) = (parseParams xs) { status = Just s } + parseParams ("service":"logs":s:xs) = (parseParams xs) { logs = Just s } parseParams ("install":s:xs) = (parseParams xs) { install = Just s } parseParams ("--remote":s:xs) = (parseParams xs) { remote = Just s } parseParams ("--verbose":xs) = (parseParams xs) { verboseM = True }