code.grnet.gr Git - ganeti-local/blob - htools/Ganeti/Block/Drbd/Parser.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2 {-| DRBD proc file parser
   3
   4 This module holds the definition of the parser that extracts status
   5 information from the DRBD proc file.
   6
   7 -}
   8 {-
   9
  10 Copyright (C) 2012 Google Inc.
  11
  12 This program is free software; you can redistribute it and/or modify
  13 it under the terms of the GNU General Public License as published by
  14 the Free Software Foundation; either version 2 of the License, or
  15 (at your option) any later version.
  16
  17 This program is distributed in the hope that it will be useful, but
  18 WITHOUT ANY WARRANTY; without even the implied warranty of
  19 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20 General Public License for more details.
  21
  22 You should have received a copy of the GNU General Public License
  23 along with this program; if not, write to the Free Software
  24 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  25 02110-1301, USA.
  26
  27 -}
  28 module Ganeti.Block.Drbd.Parser (drbdStatusParser, commaIntParser) where
  29
  30 import Control.Applicative ((<*>), (*>), (<*), (<$>), (<|>), pure)
  31 import qualified Data.Attoparsec.Text as A
  32 import qualified Data.Attoparsec.Combinator as AC
  33 import Data.Attoparsec.Text (Parser)
  34 import Data.Text (Text, unpack)
  35
  36 import Ganeti.Block.Drbd.Types
  37
  38 -- | Our own space-skipping function, because A.skipSpace also skips
  39 -- newline characters. It skips ZERO or more spaces, so it does not
  40 -- fail if there are no spaces.
  41 skipSpaces :: Parser ()
  42 skipSpaces = A.skipWhile A.isHorizontalSpace
  43
  44 -- | Skips spaces and the given string, then executes a parser and
  45 -- returns its result.
  46 skipSpacesAndString :: Text -> Parser a -> Parser a
  47 skipSpacesAndString s parser =
  48   skipSpaces
  49   *> A.string s
  50   *> parser
  51
  52 -- | Predicate verifying (potentially bad) end of lines
  53 isBadEndOfLine :: Char -> Bool
  54 isBadEndOfLine c = (c == '\0') || A.isEndOfLine c
  55
  56 -- | Takes a parser and returns it with the content wrapped in a Maybe
  57 -- object. The resulting parser never fails, but contains Nothing if
  58 -- it couldn't properly parse the string.
  59 optional :: Parser a -> Parser (Maybe a)
  60 optional parser = (Just <$> parser) <|> pure Nothing
  61
  62 -- | The parser for a whole DRBD status file.
  63 drbdStatusParser :: Parser DRBDStatus
  64 drbdStatusParser =
  65   DRBDStatus <$> versionInfoParser
  66              <*> deviceParser `AC.manyTill` A.endOfInput
  67              <* A.endOfInput
  68
  69 -- | The parser for the version information lines.
  70 versionInfoParser :: Parser VersionInfo
  71 versionInfoParser =
  72   VersionInfo
  73     <$> optional versionP
  74     <*> optional apiP
  75     <*> optional protoP
  76     <*> optional srcVersion
  77     <*> (fmap unpack <$> optional gh)
  78     <*> (fmap unpack <$> optional builder)
  79     where versionP =
  80             A.string "version:"
  81             *> skipSpaces
  82             *> fmap unpack (A.takeWhile $ not . A.isHorizontalSpace)
  83           apiP =
  84             skipSpacesAndString "(api:" . fmap unpack $ A.takeWhile (/= '/')
  85           protoP =
  86             A.string "/proto:"
  87             *> fmap Data.Text.unpack (A.takeWhile (/= ')'))
  88             <* A.takeTill A.isEndOfLine <* A.endOfLine
  89           srcVersion =
  90             A.string "srcversion:"
  91             *> AC.skipMany1 A.space
  92             *> fmap unpack (A.takeTill A.isEndOfLine)
  93             <* A.endOfLine
  94           gh =
  95             A.string "GIT-hash:"
  96             *> skipSpaces
  97             *> A.takeWhile (not . A.isHorizontalSpace)
  98           builder =
  99             skipSpacesAndString "build by" $
 100               skipSpaces
 101               *> A.takeTill A.isEndOfLine
 102               <* A.endOfLine
 103
 104 -- | The parser for a (multi-line) string representing a device.
 105 deviceParser :: Parser DeviceInfo
 106 deviceParser = do
 107   deviceNum <- skipSpaces *> A.decimal <* A.char ':'
 108   cs <- skipSpacesAndString "cs:" connStateParser
 109   if cs == Unconfigured
 110     then do
 111       _ <- additionalEOL
 112       return $ UnconfiguredDevice deviceNum
 113     else do
 114       ro <- skipSpaces *> skipRoleString *> localRemoteParser roleParser
 115       ds <- skipSpacesAndString "ds:" $ localRemoteParser diskStateParser
 116       replicProtocol <- A.space *> A.anyChar
 117       io <- skipSpaces *> ioFlagsParser <* A.skipWhile isBadEndOfLine
 118       pIndicators <- perfIndicatorsParser
 119       syncS <- conditionalSyncStatusParser cs
 120       reS <- optional resyncParser
 121       act <- optional actLogParser
 122       _ <- additionalEOL
 123       return $ DeviceInfo deviceNum cs ro ds replicProtocol io pIndicators
 124                           syncS reS act
 125
 126     where conditionalSyncStatusParser SyncSource = Just <$> syncStatusParser
 127           conditionalSyncStatusParser SyncTarget = Just <$> syncStatusParser
 128           conditionalSyncStatusParser _ = pure Nothing
 129           skipRoleString = A.string "ro:" <|> A.string "st:"
 130           resyncParser = skipSpacesAndString "resync:" additionalInfoParser
 131           actLogParser = skipSpacesAndString "act_log:" additionalInfoParser
 132           additionalEOL = A.skipWhile A.isEndOfLine
 133
 134 -- | The parser for the connection state.
 135 connStateParser :: Parser ConnState
 136 connStateParser =
 137   standAlone
 138   <|> disconnecting
 139   <|> unconnected
 140   <|> timeout
 141   <|> brokenPipe
 142   <|> networkFailure
 143   <|> protocolError
 144   <|> tearDown
 145   <|> wfConnection
 146   <|> wfReportParams
 147   <|> connected
 148   <|> startingSyncS
 149   <|> startingSyncT
 150   <|> wfBitMapS
 151   <|> wfBitMapT
 152   <|> wfSyncUUID
 153   <|> syncSource
 154   <|> syncTarget
 155   <|> pausedSyncS
 156   <|> pausedSyncT
 157   <|> verifyS
 158   <|> verifyT
 159   <|> unconfigured
 160     where standAlone     = A.string "StandAlone"     *> pure StandAlone
 161           disconnecting  = A.string "Disconnectiog"  *> pure Disconnecting
 162           unconnected    = A.string "Unconnected"    *> pure Unconnected
 163           timeout        = A.string "Timeout"        *> pure Timeout
 164           brokenPipe     = A.string "BrokenPipe"     *> pure BrokenPipe
 165           networkFailure = A.string "NetworkFailure" *> pure NetworkFailure
 166           protocolError  = A.string "ProtocolError"  *> pure ProtocolError
 167           tearDown       = A.string "TearDown"       *> pure TearDown
 168           wfConnection   = A.string "WFConnection"   *> pure WFConnection
 169           wfReportParams = A.string "WFReportParams" *> pure WFReportParams
 170           connected      = A.string "Connected"      *> pure Connected
 171           startingSyncS  = A.string "StartingSyncS"  *> pure StartingSyncS
 172           startingSyncT  = A.string "StartingSyncT"  *> pure StartingSyncT
 173           wfBitMapS      = A.string "WFBitMapS"      *> pure WFBitMapS
 174           wfBitMapT      = A.string "WFBitMapT"      *> pure WFBitMapT
 175           wfSyncUUID     = A.string "WFSyncUUID"     *> pure WFSyncUUID
 176           syncSource     = A.string "SyncSource"     *> pure SyncSource
 177           syncTarget     = A.string "SyncTarget"     *> pure SyncTarget
 178           pausedSyncS    = A.string "PausedSyncS"    *> pure PausedSyncS
 179           pausedSyncT    = A.string "PausedSyncT"    *> pure PausedSyncT
 180           verifyS        = A.string "VerifyS"        *> pure VerifyS
 181           verifyT        = A.string "VerifyT"        *> pure VerifyT
 182           unconfigured   = A.string "Unconfigured"   *> pure Unconfigured
 183
 184 -- | Parser for recognizing strings describing two elements of the
 185 -- same type separated by a '/'. The first one is considered local,
 186 -- the second remote.
 187 localRemoteParser :: Parser a -> Parser (LocalRemote a)
 188 localRemoteParser parser = LocalRemote <$> parser <*> (A.char '/' *> parser)
 189
 190 -- | The parser for resource roles.
 191 roleParser :: Parser Role
 192 roleParser =
 193   primary
 194   <|> secondary
 195   <|> unknown
 196     where primary   = A.string "Primary"   *> pure Primary
 197           secondary = A.string "Secondary" *> pure Secondary
 198           unknown   = A.string "Unknown"   *> pure Unknown
 199
 200 -- | The parser for disk states.
 201 diskStateParser :: Parser DiskState
 202 diskStateParser =
 203   diskless
 204   <|> attaching
 205   <|> failed
 206   <|> negotiating
 207   <|> inconsistent
 208   <|> outdated
 209   <|> dUnknown
 210   <|> consistent
 211   <|> upToDate
 212     where diskless     = A.string "Diskless"     *> pure Diskless
 213           attaching    = A.string "Attaching"    *> pure Attaching
 214           failed       = A.string "Failed"       *> pure Failed
 215           negotiating  = A.string "Negotiating"  *> pure Negotiating
 216           inconsistent = A.string "Inconsistent" *> pure Inconsistent
 217           outdated     = A.string "Outdated"     *> pure Outdated
 218           dUnknown     = A.string "DUnknown"     *> pure DUnknown
 219           consistent   = A.string "Consistent"   *> pure Consistent
 220           upToDate     = A.string "UpToDate"     *> pure UpToDate
 221
 222 -- | The parser for I/O flags.
 223 ioFlagsParser :: Parser String
 224 ioFlagsParser = fmap unpack . A.takeWhile $ not . isBadEndOfLine
 225
 226 -- | The parser for performance indicators.
 227 perfIndicatorsParser :: Parser PerfIndicators
 228 perfIndicatorsParser =
 229   PerfIndicators
 230     <$> skipSpacesAndString "ns:" A.decimal
 231     <*> skipSpacesAndString "nr:" A.decimal
 232     <*> skipSpacesAndString "dw:" A.decimal
 233     <*> skipSpacesAndString "dr:" A.decimal
 234     <*> skipSpacesAndString "al:" A.decimal
 235     <*> skipSpacesAndString "bm:" A.decimal
 236     <*> skipSpacesAndString "lo:" A.decimal
 237     <*> skipSpacesAndString "pe:" A.decimal
 238     <*> skipSpacesAndString "ua:" A.decimal
 239     <*> skipSpacesAndString "ap:" A.decimal
 240     <*> optional (skipSpacesAndString "ep:" A.decimal)
 241     <*> optional (skipSpacesAndString "wo:" A.anyChar)
 242     <*> optional (skipSpacesAndString "oos:" A.decimal)
 243     <* skipSpaces <* A.endOfLine
 244
 245 -- | The parser for the syncronization status.
 246 syncStatusParser :: Parser SyncStatus
 247 syncStatusParser = do
 248   _ <- statusBarParser
 249   percent <-
 250     skipSpacesAndString "sync'ed:" $ skipSpaces *> A.double <* A.char '%'
 251   partSyncSize <- skipSpaces *> A.char '(' *> A.decimal
 252   totSyncSize <- A.char '/' *> A.decimal <* A.char ')'
 253   sizeUnit <- sizeUnitParser <* optional A.endOfLine
 254   timeToEnd <- skipSpacesAndString "finish:" $ skipSpaces *> timeParser
 255   sp <-
 256     skipSpacesAndString "speed:" $
 257       skipSpaces
 258       *> commaIntParser
 259       <* skipSpaces
 260       <* A.char '('
 261       <* commaIntParser
 262       <* A.char ')'
 263   w <- skipSpacesAndString "want:" (
 264          skipSpaces
 265          *> (Just <$> commaIntParser)
 266        )
 267        <|> pure Nothing
 268   sSizeUnit <- skipSpaces *> sizeUnitParser
 269   sTimeUnit <- A.char '/' *> timeUnitParser
 270   _ <- A.endOfLine
 271   return $
 272     SyncStatus percent partSyncSize totSyncSize sizeUnit timeToEnd sp w
 273       sSizeUnit sTimeUnit
 274
 275 -- | The parser for recognizing (and discarding) the sync status bar.
 276 statusBarParser :: Parser ()
 277 statusBarParser =
 278   skipSpaces
 279   *> A.char '['
 280   *> A.skipWhile (== '=')
 281   *> A.skipWhile (== '>')
 282   *> A.skipWhile (== '.')
 283   *> A.char ']'
 284   *> pure ()
 285
 286 -- | The parser for recognizing data size units (only the ones
 287 -- actually found in DRBD files are implemented).
 288 sizeUnitParser :: Parser SizeUnit
 289 sizeUnitParser =
 290   kilobyte
 291   <|> megabyte
 292     where kilobyte = A.string "K" *> pure KiloByte
 293           megabyte = A.string "M" *> pure MegaByte
 294
 295 -- | The parser for recognizing time (hh:mm:ss).
 296 timeParser :: Parser Time
 297 timeParser = Time <$> h <*> m <*> s
 298   where h = A.decimal :: Parser Int
 299         m = A.char ':' *> A.decimal :: Parser Int
 300         s = A.char ':' *> A.decimal :: Parser Int
 301
 302 -- | The parser for recognizing time units (only the ones actually
 303 -- found in DRBD files are implemented).
 304 timeUnitParser :: Parser TimeUnit
 305 timeUnitParser = second
 306   where second = A.string "sec" *> pure Second
 307
 308 -- | Haskell does not recognise ',' as the thousands separator every 3
 309 -- digits but DRBD uses it, so we need an ah-hoc parser.
 310 -- If a number beginning with more than 3 digits without a comma is
 311 -- parsed, only the first 3 digits are considered to be valid, the rest
 312 -- is not consumed, and left for further parsing.
 313 commaIntParser :: Parser Int
 314 commaIntParser = do
 315   first <-
 316     AC.count 3 A.digit <|> AC.count 2 A.digit <|> AC.count 1 A.digit
 317   allDigits <- commaIntHelper (read first)
 318   pure allDigits
 319
 320 -- | Helper (triplet parser) for the commaIntParser
 321 commaIntHelper :: Int -> Parser Int
 322 commaIntHelper acc = nextTriplet <|> end
 323   where nextTriplet = do
 324           _ <- A.char ','
 325           triplet <- AC.count 3 A.digit
 326           commaIntHelper $ acc * 1000 + (read triplet :: Int)
 327         end = pure acc :: Parser Int
 328
 329 -- | Parser for the additional information provided by DRBD <= 8.0.
 330 additionalInfoParser::Parser AdditionalInfo
 331 additionalInfoParser = AdditionalInfo
 332   <$> skipSpacesAndString "used:" A.decimal
 333   <*> (A.char '/' *> A.decimal)
 334   <*> skipSpacesAndString "hits:" A.decimal
 335   <*> skipSpacesAndString "misses:" A.decimal
 336   <*> skipSpacesAndString "starving:" A.decimal
 337   <*> skipSpacesAndString "dirty:" A.decimal
 338   <*> skipSpacesAndString "changed:" A.decimal
 339   <* A.endOfLine