module Ganeti.DataCollectors.Drbd
( main
, options
, arguments
) where
import qualified Control.Exception as E
import Control.Monad
import Data.Attoparsec.Text.Lazy as A
import Data.Maybe
import Data.Text.Lazy (pack, unpack)
import Network.BSD (getHostName)
import qualified Text.JSON as J
import qualified Ganeti.BasicTypes as BT
import qualified Ganeti.Constants as C
import Ganeti.Block.Drbd.Parser(drbdStatusParser)
import Ganeti.Block.Drbd.Types(DrbdInstMinor)
import Ganeti.Common
import Ganeti.Confd.Client
import Ganeti.Confd.Types
import Ganeti.DataCollectors.CLI
import Ganeti.DataCollectors.Types
import Ganeti.Utils
defaultFile :: FilePath
defaultFile = C.drbdStatusFile
defaultCharNum :: Int
defaultCharNum = 80*20
dcName :: String
dcName = "drbd"
dcFormatVersion :: Int
dcFormatVersion = 1
options :: IO [OptType]
options =
return
[ oDrbdStatus
, oDrbdPairing
]
arguments :: [ArgCompletion]
arguments = [ArgCompletion OptComplFile 0 (Just 0)]
getPairingInfo :: Maybe String -> IO (BT.Result [DrbdInstMinor])
getPairingInfo Nothing = do
curNode <- getHostName
client <- getConfdClient
reply <- query client ReqNodeDrbd $ PlainQuery curNode
return $
case fmap (J.readJSONs . confdReplyAnswer) reply of
Just (J.Ok instMinor) -> BT.Ok instMinor
Just (J.Error msg) -> BT.Bad msg
Nothing -> BT.Bad "No answer from the Confd server"
getPairingInfo (Just filename) = do
content <- readFile filename
return $
case J.decode content of
J.Ok instMinor -> BT.Ok instMinor
J.Error msg -> BT.Bad msg
buildDRBDReport :: FilePath -> Maybe FilePath -> IO DCReport
buildDRBDReport statusFile pairingFile = do
contents <-
((E.try $ readFile statusFile) :: IO (Either IOError String)) >>=
exitIfBad "reading from file" . either (BT.Bad . show) BT.Ok
pairingResult <- getPairingInfo pairingFile
pairing <- exitIfBad "Can't get pairing info" pairingResult
jsonData <-
case A.parse (drbdStatusParser pairing) $ pack contents of
A.Fail unparsedText contexts errorMessage -> exitErr $
show (Prelude.take defaultCharNum $ unpack unparsedText) ++ "\n"
++ show contexts ++ "\n" ++ errorMessage
A.Done _ drbdStatus -> return $ J.showJSON drbdStatus
buildReport dcName Nothing dcFormatVersion jsonData
main :: Options -> [String] -> IO ()
main opts args = do
let statusFile = fromMaybe defaultFile $ optDrbdStatus opts
pairingFile = optDrbdPairing opts
unless (null args) . exitErr $ "This program takes exactly zero" ++
" arguments, got '" ++ unwords args ++ "'"
report <- buildDRBDReport statusFile pairingFile
putStrLn $ J.encode report