feat(monitoring): read status and logs of a service

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

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

src/System/Serverman/Action.hs

@@ -1,15 +1,6 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 
-module System.Serverman.Action ( ActionF(..)
+module System.Serverman.Action where
-                               , Action
-                               , call
-                               , fetchRepository
-                               , updateRepository
-                               , start
-                               , stop
-                               , install
-                               , remote
-                               , detectOS) 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 ()
+

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 ()

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
+      Right _ -> runAction servermanAddr keyPath
-        state <- get
-        liftIO $ threadDelay actionDelay
-
-        put $ state { remoteMode = Just (servermanAddr, keyPath) }
-        getOS
-        action
-
-        return ()
 
       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 $ Left ("could not run action remotely: " ++ show addr) 
-
-    return ()
 
     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

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)
 

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)

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 <service>", "start the service")
                           , ("service stop <service>", "stop the service")
+                          , ("service status <service>", "read service status")
+                          , ("service logs <service>", "read service logs")
                           , ("--remote <file>", "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 <service> --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 }