Revision d78970ba src/Ganeti/DataCollectors/Drbd.hs
| b/src/Ganeti/DataCollectors/Drbd.hs | ||
|---|---|---|
| 31 | 31 |
|
| 32 | 32 |
|
| 33 | 33 |
import qualified Control.Exception as E |
| 34 |
import Control.Monad |
|
| 34 | 35 |
import Data.Attoparsec.Text.Lazy as A |
| 36 |
import Data.Maybe |
|
| 35 | 37 |
import Data.Text.Lazy (pack, unpack) |
| 36 |
import Text.JSON |
|
| 38 |
import Network.BSD (getHostName) |
|
| 39 |
import qualified Text.JSON as J |
|
| 37 | 40 |
|
| 38 | 41 |
import qualified Ganeti.BasicTypes as BT |
| 39 | 42 |
import qualified Ganeti.Constants as C |
| 40 | 43 |
import Ganeti.Block.Drbd.Parser(drbdStatusParser) |
| 44 |
import Ganeti.Block.Drbd.Types(DrbdInstMinor) |
|
| 41 | 45 |
import Ganeti.Common |
| 46 |
import Ganeti.Confd.Client |
|
| 47 |
import Ganeti.Confd.Types |
|
| 42 | 48 |
import Ganeti.DataCollectors.CLI |
| 43 | 49 |
import Ganeti.Utils |
| 44 | 50 |
|
| ... | ... | |
| 56 | 62 |
defaultCharNum = 80*20 |
| 57 | 63 |
|
| 58 | 64 |
options :: IO [OptType] |
| 59 |
options = return [] |
|
| 65 |
options = |
|
| 66 |
return |
|
| 67 |
[ oDrbdStatus |
|
| 68 |
, oDrbdPairing |
|
| 69 |
] |
|
| 60 | 70 |
|
| 61 | 71 |
-- | The list of arguments supported by the program. |
| 62 | 72 |
arguments :: [ArgCompletion] |
| 63 |
arguments = [ArgCompletion OptComplFile 0 (Just 1)]
|
|
| 73 |
arguments = [ArgCompletion OptComplFile 0 (Just 0)]
|
|
| 64 | 74 |
|
| 65 | 75 |
-- * Command line options |
| 66 | 76 |
|
| 77 |
-- | Get information about the pairing of DRBD minors and Ganeti instances |
|
| 78 |
-- on the current node. The information is taken from the Confd client |
|
| 79 |
-- or, if a filename is specified, from a JSON encoded file (for testing |
|
| 80 |
-- purposes). |
|
| 81 |
getPairingInfo :: Maybe String -> IO (BT.Result [DrbdInstMinor]) |
|
| 82 |
getPairingInfo Nothing = do |
|
| 83 |
curNode <- getHostName |
|
| 84 |
client <- getConfdClient |
|
| 85 |
reply <- query client ReqNodeDrbd $ PlainQuery curNode |
|
| 86 |
return $ |
|
| 87 |
case fmap (J.readJSONs . confdReplyAnswer) reply of |
|
| 88 |
Just (J.Ok instMinor) -> BT.Ok instMinor |
|
| 89 |
Just (J.Error msg) -> BT.Bad msg |
|
| 90 |
Nothing -> BT.Bad "No answer from the Confd server" |
|
| 91 |
getPairingInfo (Just filename) = do |
|
| 92 |
content <- readFile filename |
|
| 93 |
return $ |
|
| 94 |
case J.decode content of |
|
| 95 |
J.Ok instMinor -> BT.Ok instMinor |
|
| 96 |
J.Error msg -> BT.Bad msg |
|
| 97 |
|
|
| 67 | 98 |
-- | Main function. |
| 68 | 99 |
main :: Options -> [String] -> IO () |
| 69 |
main _ args = do |
|
| 70 |
proc_drbd <- case args of |
|
| 71 |
[ ] -> return defaultFile |
|
| 72 |
[x] -> return x |
|
| 73 |
_ -> exitErr $ "This program takes only one argument," ++ |
|
| 74 |
" got '" ++ unwords args ++ "'" |
|
| 100 |
main opts args = do |
|
| 101 |
let proc_drbd = fromMaybe defaultFile $ optDrbdStatus opts |
|
| 102 |
instMinor = optDrbdPairing opts |
|
| 103 |
unless (null args) . exitErr $ "This program takes exactly zero" ++ |
|
| 104 |
" arguments, got '" ++ unwords args ++ "'" |
|
| 75 | 105 |
contents <- |
| 76 | 106 |
((E.try $ readFile proc_drbd) :: IO (Either IOError String)) >>= |
| 77 | 107 |
exitIfBad "reading from file" . either (BT.Bad . show) BT.Ok |
| 108 |
pairingResult <- getPairingInfo instMinor |
|
| 109 |
pairing <- exitIfBad "Can't get pairing info" pairingResult |
|
| 78 | 110 |
output <- |
| 79 |
case A.parse (drbdStatusParser []) $ pack contents of
|
|
| 111 |
case A.parse (drbdStatusParser pairing) $ pack contents of
|
|
| 80 | 112 |
A.Fail unparsedText contexts errorMessage -> exitErr $ |
| 81 | 113 |
show (Prelude.take defaultCharNum $ unpack unparsedText) ++ "\n" |
| 82 | 114 |
++ show contexts ++ "\n" ++ errorMessage |
| 83 |
A.Done _ drbdStatus -> return $ encode drbdStatus |
|
| 115 |
A.Done _ drbdStatus -> return $ J.encode drbdStatus
|
|
| 84 | 116 |
putStrLn output |
Also available in: Unified diff