code.grnet.gr Git - ganeti-local/blob - src/Ganeti/DataCollectors/Drbd.hs

   1 {-| DRBD data collector.
   2
   3 -}
   4
   5 {-
   6
   7 Copyright (C) 2012, 2013 Google Inc.
   8
   9 This program is free software; you can redistribute it and/or modify
  10 it under the terms of the GNU General Public License as published by
  11 the Free Software Foundation; either version 2 of the License, or
  12 (at your option) any later version.
  13
  14 This program is distributed in the hope that it will be useful, but
  15 WITHOUT ANY WARRANTY; without even the implied warranty of
  16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17 General Public License for more details.
  18
  19 You should have received a copy of the GNU General Public License
  20 along with this program; if not, write to the Free Software
  21 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  22 02110-1301, USA.
  23
  24 -}
  25
  26 module Ganeti.DataCollectors.Drbd
  27   ( main
  28   , options
  29   , arguments
  30   , dcName
  31   , dcVersion
  32   , dcFormatVersion
  33   , dcCategory
  34   , dcKind
  35   , dcReport
  36   ) where
  37
  38
  39 import qualified Control.Exception as E
  40 import Control.Monad
  41 import Data.Attoparsec.Text.Lazy as A
  42 import Data.List
  43 import Data.Maybe
  44 import Data.Text.Lazy (pack, unpack)
  45 import Network.BSD (getHostName)
  46 import qualified Text.JSON as J
  47
  48 import qualified Ganeti.BasicTypes as BT
  49 import qualified Ganeti.Constants as C
  50 import Ganeti.Block.Drbd.Parser(drbdStatusParser)
  51 import Ganeti.Block.Drbd.Types
  52 import Ganeti.Common
  53 import Ganeti.Confd.Client
  54 import Ganeti.Confd.Types
  55 import Ganeti.DataCollectors.CLI
  56 import Ganeti.DataCollectors.Types
  57 import Ganeti.Utils
  58
  59
  60 -- | The default path of the DRBD status file.
  61 -- It is hardcoded because it is not likely to change.
  62 defaultFile :: FilePath
  63 defaultFile = C.drbdStatusFile
  64
  65 -- | The default setting for the maximum amount of not parsed character to
  66 -- print in case of error.
  67 -- It is set to use most of the screen estate on a standard 80x25 terminal.
  68 -- TODO: add the possibility to set this with a command line parameter.
  69 defaultCharNum :: Int
  70 defaultCharNum = 80*20
  71
  72 -- | The name of this data collector.
  73 dcName :: String
  74 dcName = "drbd"
  75
  76 -- | The version of this data collector.
  77 dcVersion :: DCVersion
  78 dcVersion = DCVerBuiltin
  79
  80 -- | The version number for the data format of this data collector.
  81 dcFormatVersion :: Int
  82 dcFormatVersion = 1
  83
  84 -- | The category of this data collector.
  85 dcCategory :: Maybe DCCategory
  86 dcCategory = Just DCStorage
  87
  88 -- | The kind of this data collector.
  89 dcKind :: DCKind
  90 dcKind = DCKStatus
  91
  92 -- | The data exported by the data collector, taken from the default location.
  93 dcReport :: IO DCReport
  94 dcReport = buildDCReport defaultFile Nothing
  95
  96 -- * Command line options
  97
  98 options :: IO [OptType]
  99 options =
 100   return
 101     [ oDrbdStatus
 102     , oDrbdPairing
 103     ]
 104
 105 -- | The list of arguments supported by the program.
 106 arguments :: [ArgCompletion]
 107 arguments = [ArgCompletion OptComplFile 0 (Just 0)]
 108
 109 -- | Get information about the pairing of DRBD minors and Ganeti instances
 110 -- on the current node. The information is taken from the Confd client
 111 -- or, if a filename is specified, from a JSON encoded file (for testing
 112 -- purposes).
 113 getPairingInfo :: Maybe String -> IO (BT.Result [DrbdInstMinor])
 114 getPairingInfo Nothing = do
 115   curNode <- getHostName
 116   client <- getConfdClient Nothing Nothing
 117   reply <- query client ReqNodeDrbd $ PlainQuery curNode
 118   return $
 119     case fmap (J.readJSONs . confdReplyAnswer) reply of
 120       Just (J.Ok instMinor) -> BT.Ok instMinor
 121       Just (J.Error msg) -> BT.Bad msg
 122       Nothing -> BT.Bad "No answer from the Confd server"
 123 getPairingInfo (Just filename) = do
 124   content <- readFile filename
 125   return $
 126     case J.decode content of
 127       J.Ok instMinor -> BT.Ok instMinor
 128       J.Error msg -> BT.Bad msg
 129
 130 -- | Compute the status code and message, given the current DRBD data
 131 -- The final state will have the code corresponding to the worst code of
 132 -- all the devices, and the error message given from the concatenation of the
 133 -- non-empty error messages.
 134 computeStatus :: DRBDStatus -> DCStatus
 135 computeStatus (DRBDStatus _ devInfos) =
 136   let statuses = map computeDevStatus devInfos
 137       (code, strList) = foldr mergeStatuses (DCSCOk, [""]) statuses
 138   in DCStatus code $ intercalate "\n" strList
 139
 140 -- | Helper function for merging statuses.
 141 mergeStatuses :: (DCStatusCode, String) -> (DCStatusCode, [String])
 142               -> (DCStatusCode, [String])
 143 mergeStatuses (newStat, newStr) (storedStat, storedStrs) =
 144   let resStat = max newStat storedStat
 145       resStrs =
 146         if newStr == ""
 147           then storedStrs
 148           else storedStrs ++ [newStr]
 149   in (resStat, resStrs)
 150
 151 -- | Compute the status of a DRBD device and its error message.
 152 computeDevStatus :: DeviceInfo -> (DCStatusCode, String)
 153 computeDevStatus (UnconfiguredDevice _) = (DCSCOk, "")
 154 computeDevStatus dev =
 155   let errMsg s = show (minorNumber dev) ++ ": " ++ s
 156       compute_helper StandAlone =
 157         (DCSCBad, errMsg "No network config available")
 158       compute_helper Disconnecting =
 159         (DCSCBad, errMsg "The peer is being disconnected")
 160       compute_helper Unconnected =
 161         (DCSCTempBad, errMsg "Trying to establish a network connection")
 162       compute_helper Timeout =
 163         (DCSCTempBad, errMsg "Communication problems between the peers")
 164       compute_helper BrokenPipe =
 165         (DCSCTempBad, errMsg "Communication problems between the peers")
 166       compute_helper NetworkFailure =
 167         (DCSCTempBad, errMsg "Communication problems between the peers")
 168       compute_helper ProtocolError =
 169         (DCSCTempBad, errMsg "Communication problems between the peers")
 170       compute_helper TearDown =
 171         (DCSCBad, errMsg "The peer is closing the connection")
 172       compute_helper WFConnection =
 173         (DCSCTempBad, errMsg "Trying to establish a network connection")
 174       compute_helper WFReportParams =
 175         (DCSCTempBad, errMsg "Trying to establish a network connection")
 176       compute_helper Connected = (DCSCOk, "")
 177       compute_helper StartingSyncS = (DCSCOk, "")
 178       compute_helper StartingSyncT = (DCSCOk, "")
 179       compute_helper WFBitMapS = (DCSCOk, "")
 180       compute_helper WFBitMapT = (DCSCOk, "")
 181       compute_helper WFSyncUUID = (DCSCOk, "")
 182       compute_helper SyncSource = (DCSCOk, "")
 183       compute_helper SyncTarget = (DCSCOk, "")
 184       compute_helper PausedSyncS = (DCSCOk, "")
 185       compute_helper PausedSyncT = (DCSCOk, "")
 186       compute_helper VerifyS = (DCSCOk, "")
 187       compute_helper VerifyT = (DCSCOk, "")
 188       compute_helper Unconfigured = (DCSCOk, "")
 189   in compute_helper $ connectionState dev
 190
 191 -- | This function computes the JSON representation of the DRBD status.
 192 buildJsonReport :: FilePath -> Maybe FilePath -> IO J.JSValue
 193 buildJsonReport statusFile pairingFile = do
 194   contents <-
 195     ((E.try $ readFile statusFile) :: IO (Either IOError String)) >>=
 196       exitIfBad "reading from file" . either (BT.Bad . show) BT.Ok
 197   pairingResult <- getPairingInfo pairingFile
 198   pairing <- exitIfBad "Can't get pairing info" pairingResult
 199   drbdData <-
 200     case A.parse (drbdStatusParser pairing) $ pack contents of
 201       A.Fail unparsedText contexts errorMessage -> exitErr $
 202         show (Prelude.take defaultCharNum $ unpack unparsedText) ++ "\n"
 203           ++ show contexts ++ "\n" ++ errorMessage
 204       A.Done _ drbdS -> return drbdS
 205   let status = computeStatus drbdData
 206   return . addStatus status $ J.showJSON drbdData
 207
 208 -- | This function computes the DCReport for the DRBD status.
 209 buildDCReport :: FilePath -> Maybe FilePath -> IO DCReport
 210 buildDCReport statusFile pairingFile =
 211   buildJsonReport statusFile pairingFile >>=
 212     buildReport dcName dcVersion dcFormatVersion dcCategory dcKind
 213
 214 -- | Main function.
 215 main :: Options -> [String] -> IO ()
 216 main opts args = do
 217   let statusFile = fromMaybe defaultFile $ optDrbdStatus opts
 218       pairingFile = optDrbdPairing opts
 219   unless (null args) . exitErr $ "This program takes exactly zero" ++
 220                                   " arguments, got '" ++ unwords args ++ "'"
 221   report <- buildDCReport statusFile pairingFile
 222   putStrLn $ J.encode report