Synnefo » snf-ganeti

{-# LANGUAGE OverloadedStrings #-}

{-| DRBD proc file parser

This module holds the definition of the parser that extracts status

information from the DRBD proc file.

-}

{-

Copyright (C) 2012 Google Inc.

This program is free software; you can redistribute it and/or modify

it under the terms of the GNU General Public License as published by

the Free Software Foundation; either version 2 of the License, or

(at your option) any later version.

This program is distributed in the hope that it will be useful, but

WITHOUT ANY WARRANTY; without even the implied warranty of

MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU

General Public License for more details.

You should have received a copy of the GNU General Public License

along with this program; if not, write to the Free Software

Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA

02110-1301, USA.

-}

module Ganeti.Block.Drbd.Parser (drbdStatusParser, commaIntParser) where

import Control.Applicative ((<*>), (*>), (<*), (<$>), (<|>), pure)

import qualified Data.Attoparsec.Text as A

import qualified Data.Attoparsec.Combinator as AC

import Data.Attoparsec.Text (Parser)

import Data.List

import Data.Maybe

import Data.Text (Text, unpack)

import Ganeti.Block.Drbd.Types

-- | Our own space-skipping function, because A.skipSpace also skips

-- newline characters. It skips ZERO or more spaces, so it does not

-- fail if there are no spaces.

skipSpaces :: Parser ()

skipSpaces = A.skipWhile A.isHorizontalSpace

-- | Skips spaces and the given string, then executes a parser and

-- returns its result.

skipSpacesAndString :: Text -> Parser a -> Parser a

skipSpacesAndString s parser =

  skipSpaces

  *> A.string s

  *> parser

-- | Predicate verifying (potentially bad) end of lines

isBadEndOfLine :: Char -> Bool

isBadEndOfLine c = (c == '\0') || A.isEndOfLine c

-- | Takes a parser and returns it with the content wrapped in a Maybe

-- object. The resulting parser never fails, but contains Nothing if

-- it couldn't properly parse the string.

optional :: Parser a -> Parser (Maybe a)

optional parser = (Just <$> parser) <|> pure Nothing

-- | The parser for a whole DRBD status file.

drbdStatusParser :: [DrbdInstMinor] -> Parser DRBDStatus

drbdStatusParser instMinor =

  DRBDStatus <$> versionInfoParser

             <*> deviceParser instMinor `AC.manyTill` A.endOfInput

             <* A.endOfInput

-- | The parser for the version information lines.

versionInfoParser :: Parser VersionInfo

versionInfoParser = do

  versionF <- optional versionP

  apiF <- optional apiP

  protoF <- optional protoP

  srcVersionF <- optional srcVersion

  ghF <- fmap unpack <$> optional gh

  builderF <- fmap unpack <$> optional builder

  if   isNothing versionF

    && isNothing apiF

    && isNothing protoF

    && isNothing srcVersionF

    && isNothing ghF

    && isNothing builderF

    then fail "versionInfo"

    else pure $ VersionInfo versionF apiF protoF srcVersionF ghF builderF

    where versionP =

            A.string "version:"

            *> skipSpaces

            *> fmap unpack (A.takeWhile $ not . A.isHorizontalSpace)

          apiP =

            skipSpacesAndString "(api:" . fmap unpack $ A.takeWhile (/= '/')

          protoP =

            A.string "/proto:"

            *> fmap Data.Text.unpack (A.takeWhile (/= ')'))

            <* A.takeTill A.isEndOfLine <* A.endOfLine

          srcVersion =

            A.string "srcversion:"

            *> AC.skipMany1 A.space

            *> fmap unpack (A.takeTill A.isEndOfLine)

            <* A.endOfLine

          gh =

            A.string "GIT-hash:"

            *> skipSpaces

            *> A.takeWhile (not . A.isHorizontalSpace)

          builder =

            skipSpacesAndString "build by" $

              skipSpaces

              *> A.takeTill A.isEndOfLine

              <* A.endOfLine

-- | The parser for a (multi-line) string representing a device.

deviceParser :: [DrbdInstMinor] -> Parser DeviceInfo

deviceParser instMinor = do

  deviceNum <- skipSpaces *> A.decimal <* A.char ':'

  cs <- skipSpacesAndString "cs:" connStateParser

  if cs == Unconfigured

    then do

      _ <- additionalEOL

      return $ UnconfiguredDevice deviceNum

    else do

      ro <- skipSpaces *> skipRoleString *> localRemoteParser roleParser

      ds <- skipSpacesAndString "ds:" $ localRemoteParser diskStateParser

      replicProtocol <- A.space *> A.anyChar

      io <- skipSpaces *> ioFlagsParser <* A.skipWhile isBadEndOfLine

      pIndicators <- perfIndicatorsParser

      syncS <- conditionalSyncStatusParser cs

      reS <- optional resyncParser

      act <- optional actLogParser

      _ <- additionalEOL

      let inst = find ((deviceNum ==) . dimMinor) instMinor

          iName = fmap dimInstName inst

      return $ DeviceInfo deviceNum cs ro ds replicProtocol io pIndicators

                          syncS reS act iName

    where conditionalSyncStatusParser SyncSource = Just <$> syncStatusParser

          conditionalSyncStatusParser SyncTarget = Just <$> syncStatusParser

          conditionalSyncStatusParser _ = pure Nothing

          skipRoleString = A.string "ro:" <|> A.string "st:"

          resyncParser = skipSpacesAndString "resync:" additionalInfoParser

          actLogParser = skipSpacesAndString "act_log:" additionalInfoParser

          additionalEOL = A.skipWhile A.isEndOfLine

-- | The parser for the connection state.

connStateParser :: Parser ConnState

connStateParser =

  standAlone

  <|> disconnecting

  <|> unconnected

  <|> timeout

  <|> brokenPipe

  <|> networkFailure

  <|> protocolError

  <|> tearDown

  <|> wfConnection

  <|> wfReportParams

  <|> connected

  <|> startingSyncS

  <|> startingSyncT

  <|> wfBitMapS

  <|> wfBitMapT

  <|> wfSyncUUID

  <|> syncSource

  <|> syncTarget

  <|> pausedSyncS

  <|> pausedSyncT

  <|> verifyS

  <|> verifyT

  <|> unconfigured

    where standAlone     = A.string "StandAlone"     *> pure StandAlone

          disconnecting  = A.string "Disconnectiog"  *> pure Disconnecting

          unconnected    = A.string "Unconnected"    *> pure Unconnected

          timeout        = A.string "Timeout"        *> pure Timeout

          brokenPipe     = A.string "BrokenPipe"     *> pure BrokenPipe

          networkFailure = A.string "NetworkFailure" *> pure NetworkFailure

          protocolError  = A.string "ProtocolError"  *> pure ProtocolError

          tearDown       = A.string "TearDown"       *> pure TearDown

          wfConnection   = A.string "WFConnection"   *> pure WFConnection

          wfReportParams = A.string "WFReportParams" *> pure WFReportParams

          connected      = A.string "Connected"      *> pure Connected

          startingSyncS  = A.string "StartingSyncS"  *> pure StartingSyncS

          startingSyncT  = A.string "StartingSyncT"  *> pure StartingSyncT

          wfBitMapS      = A.string "WFBitMapS"      *> pure WFBitMapS

          wfBitMapT      = A.string "WFBitMapT"      *> pure WFBitMapT

          wfSyncUUID     = A.string "WFSyncUUID"     *> pure WFSyncUUID

          syncSource     = A.string "SyncSource"     *> pure SyncSource

          syncTarget     = A.string "SyncTarget"     *> pure SyncTarget

          pausedSyncS    = A.string "PausedSyncS"    *> pure PausedSyncS

          pausedSyncT    = A.string "PausedSyncT"    *> pure PausedSyncT

          verifyS        = A.string "VerifyS"        *> pure VerifyS

          verifyT        = A.string "VerifyT"        *> pure VerifyT

          unconfigured   = A.string "Unconfigured"   *> pure Unconfigured

-- | Parser for recognizing strings describing two elements of the

-- same type separated by a '/'. The first one is considered local,

-- the second remote.

localRemoteParser :: Parser a -> Parser (LocalRemote a)

localRemoteParser parser = LocalRemote <$> parser <*> (A.char '/' *> parser)

-- | The parser for resource roles.

roleParser :: Parser Role

roleParser =

  primary

  <|> secondary

  <|> unknown

    where primary   = A.string "Primary"   *> pure Primary

          secondary = A.string "Secondary" *> pure Secondary

          unknown   = A.string "Unknown"   *> pure Unknown

-- | The parser for disk states.

diskStateParser :: Parser DiskState

diskStateParser =

  diskless

  <|> attaching

  <|> failed

  <|> negotiating

  <|> inconsistent

  <|> outdated

  <|> dUnknown

  <|> consistent

  <|> upToDate

    where diskless     = A.string "Diskless"     *> pure Diskless

          attaching    = A.string "Attaching"    *> pure Attaching

          failed       = A.string "Failed"       *> pure Failed

          negotiating  = A.string "Negotiating"  *> pure Negotiating

          inconsistent = A.string "Inconsistent" *> pure Inconsistent

          outdated     = A.string "Outdated"     *> pure Outdated

          dUnknown     = A.string "DUnknown"     *> pure DUnknown

          consistent   = A.string "Consistent"   *> pure Consistent

          upToDate     = A.string "UpToDate"     *> pure UpToDate

-- | The parser for I/O flags.

ioFlagsParser :: Parser String

ioFlagsParser = fmap unpack . A.takeWhile $ not . isBadEndOfLine

-- | The parser for performance indicators.

perfIndicatorsParser :: Parser PerfIndicators

perfIndicatorsParser =

  PerfIndicators

    <$> skipSpacesAndString "ns:" A.decimal

    <*> skipSpacesAndString "nr:" A.decimal

    <*> skipSpacesAndString "dw:" A.decimal

    <*> skipSpacesAndString "dr:" A.decimal

    <*> skipSpacesAndString "al:" A.decimal

    <*> skipSpacesAndString "bm:" A.decimal

    <*> skipSpacesAndString "lo:" A.decimal

    <*> skipSpacesAndString "pe:" A.decimal

    <*> skipSpacesAndString "ua:" A.decimal

    <*> skipSpacesAndString "ap:" A.decimal

    <*> optional (skipSpacesAndString "ep:" A.decimal)

    <*> optional (skipSpacesAndString "wo:" A.anyChar)

    <*> optional (skipSpacesAndString "oos:" A.decimal)

    <* skipSpaces <* A.endOfLine

-- | The parser for the syncronization status.

syncStatusParser :: Parser SyncStatus

syncStatusParser = do

  _ <- statusBarParser

  percent <-

    skipSpacesAndString "sync'ed:" $ skipSpaces *> A.double <* A.char '%'

  partSyncSize <- skipSpaces *> A.char '(' *> A.decimal

  totSyncSize <- A.char '/' *> A.decimal <* A.char ')'

  sizeUnit <- sizeUnitParser <* optional A.endOfLine

  timeToEnd <- skipSpacesAndString "finish:" $ skipSpaces *> timeParser

  sp <-

    skipSpacesAndString "speed:" $

      skipSpaces

      *> commaIntParser

      <* skipSpaces

      <* A.char '('

      <* commaIntParser

      <* A.char ')'

  w <- skipSpacesAndString "want:" (

         skipSpaces

         *> (Just <$> commaIntParser)

       )

       <|> pure Nothing

  sSizeUnit <- skipSpaces *> sizeUnitParser

  sTimeUnit <- A.char '/' *> timeUnitParser

  _ <- A.endOfLine

  return $

    SyncStatus percent partSyncSize totSyncSize sizeUnit timeToEnd sp w

      sSizeUnit sTimeUnit

-- | The parser for recognizing (and discarding) the sync status bar.

statusBarParser :: Parser ()

statusBarParser =

  skipSpaces

  *> A.char '['

  *> A.skipWhile (== '=')

  *> A.skipWhile (== '>')

  *> A.skipWhile (== '.')

  *> A.char ']'

  *> pure ()

-- | The parser for recognizing data size units (only the ones

-- actually found in DRBD files are implemented).

sizeUnitParser :: Parser SizeUnit

sizeUnitParser =

  kilobyte

  <|> megabyte

    where kilobyte = A.string "K" *> pure KiloByte

          megabyte = A.string "M" *> pure MegaByte

-- | The parser for recognizing time (hh:mm:ss).

timeParser :: Parser Time

timeParser = Time <$> h <*> m <*> s

  where h = A.decimal :: Parser Int

        m = A.char ':' *> A.decimal :: Parser Int

        s = A.char ':' *> A.decimal :: Parser Int

-- | The parser for recognizing time units (only the ones actually

-- found in DRBD files are implemented).

timeUnitParser :: Parser TimeUnit

timeUnitParser = second

  where second = A.string "sec" *> pure Second

-- | Haskell does not recognise ',' as the thousands separator every 3

-- digits but DRBD uses it, so we need an ah-hoc parser.

-- If a number beginning with more than 3 digits without a comma is

-- parsed, only the first 3 digits are considered to be valid, the rest

-- is not consumed, and left for further parsing.

commaIntParser :: Parser Int

commaIntParser = do

  first <-

    AC.count 3 A.digit <|> AC.count 2 A.digit <|> AC.count 1 A.digit

  allDigits <- commaIntHelper (read first)

  pure allDigits

-- | Helper (triplet parser) for the commaIntParser

commaIntHelper :: Int -> Parser Int

commaIntHelper acc = nextTriplet <|> end

  where nextTriplet = do

          _ <- A.char ','

          triplet <- AC.count 3 A.digit

          commaIntHelper $ acc * 1000 + (read triplet :: Int)

        end = pure acc :: Parser Int

-- | Parser for the additional information provided by DRBD <= 8.0.

additionalInfoParser::Parser AdditionalInfo

additionalInfoParser = AdditionalInfo

  <$> skipSpacesAndString "used:" A.decimal

  <*> (A.char '/' *> A.decimal)

  <*> skipSpacesAndString "hits:" A.decimal

  <*> skipSpacesAndString "misses:" A.decimal

  <*> skipSpacesAndString "starving:" A.decimal

  <*> skipSpacesAndString "dirty:" A.decimal

  <*> skipSpacesAndString "changed:" A.decimal

  <* A.endOfLine