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.Storage.Drbd.Parser(drbdStatusParser)
  51 import Ganeti.Storage.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 -- | Compute the status of a DRBD device and its error message.
 141 computeDevStatus :: DeviceInfo -> (DCStatusCode, String)
 142 computeDevStatus (UnconfiguredDevice _) = (DCSCOk, "")
 143 computeDevStatus dev =
 144   let errMsg s = show (minorNumber dev) ++ ": " ++ s
 145       compute_helper StandAlone =
 146         (DCSCBad, errMsg "No network config available")
 147       compute_helper Disconnecting =
 148         (DCSCBad, errMsg "The peer is being disconnected")
 149       compute_helper Unconnected =
 150         (DCSCTempBad, errMsg "Trying to establish a network connection")
 151       compute_helper Timeout =
 152         (DCSCTempBad, errMsg "Communication problems between the peers")
 153       compute_helper BrokenPipe =
 154         (DCSCTempBad, errMsg "Communication problems between the peers")
 155       compute_helper NetworkFailure =
 156         (DCSCTempBad, errMsg "Communication problems between the peers")
 157       compute_helper ProtocolError =
 158         (DCSCTempBad, errMsg "Communication problems between the peers")
 159       compute_helper TearDown =
 160         (DCSCBad, errMsg "The peer is closing the connection")
 161       compute_helper WFConnection =
 162         (DCSCTempBad, errMsg "Trying to establish a network connection")
 163       compute_helper WFReportParams =
 164         (DCSCTempBad, errMsg "Trying to establish a network connection")
 165       compute_helper Connected = (DCSCOk, "")
 166       compute_helper StartingSyncS = (DCSCOk, "")
 167       compute_helper StartingSyncT = (DCSCOk, "")
 168       compute_helper WFBitMapS = (DCSCOk, "")
 169       compute_helper WFBitMapT = (DCSCOk, "")
 170       compute_helper WFSyncUUID = (DCSCOk, "")
 171       compute_helper SyncSource = (DCSCOk, "")
 172       compute_helper SyncTarget = (DCSCOk, "")
 173       compute_helper PausedSyncS = (DCSCOk, "")
 174       compute_helper PausedSyncT = (DCSCOk, "")
 175       compute_helper VerifyS = (DCSCOk, "")
 176       compute_helper VerifyT = (DCSCOk, "")
 177       compute_helper Unconfigured = (DCSCOk, "")
 178   in compute_helper $ connectionState dev
 179
 180 -- | This function computes the JSON representation of the DRBD status.
 181 buildJsonReport :: FilePath -> Maybe FilePath -> IO J.JSValue
 182 buildJsonReport statusFile pairingFile = do
 183   contents <-
 184     ((E.try $ readFile statusFile) :: IO (Either IOError String)) >>=
 185       exitIfBad "reading from file" . either (BT.Bad . show) BT.Ok
 186   pairingResult <- getPairingInfo pairingFile
 187   pairing <- logWarningIfBad "Can't get pairing info" [] pairingResult
 188   drbdData <-
 189     case A.parse (drbdStatusParser pairing) $ pack contents of
 190       A.Fail unparsedText contexts errorMessage -> exitErr $
 191         show (Prelude.take defaultCharNum $ unpack unparsedText) ++ "\n"
 192           ++ show contexts ++ "\n" ++ errorMessage
 193       A.Done _ drbdS -> return drbdS
 194   let status = computeStatus drbdData
 195   return . addStatus status $ J.showJSON drbdData
 196
 197 -- | This function computes the DCReport for the DRBD status.
 198 buildDCReport :: FilePath -> Maybe FilePath -> IO DCReport
 199 buildDCReport statusFile pairingFile =
 200   buildJsonReport statusFile pairingFile >>=
 201     buildReport dcName dcVersion dcFormatVersion dcCategory dcKind
 202
 203 -- | Main function.
 204 main :: Options -> [String] -> IO ()
 205 main opts args = do
 206   let statusFile = fromMaybe defaultFile $ optDrbdStatus opts
 207       pairingFile = optDrbdPairing opts
 208   unless (null args) . exitErr $ "This program takes exactly zero" ++
 209                                   " arguments, got '" ++ unwords args ++ "'"
 210   report <- buildDCReport statusFile pairingFile
 211   putStrLn $ J.encode report