commit dcad1063405b3b72ce7f4d46584f752ff9303fe1
Merge: b9566a2 40d79e7
Author: Klaus Aehlig <[email protected]>
Date: Fri Jul 4 12:55:29 2014 +0200
Merge branch 'stable-2.8' into stable-2.9
* stable-2.8
DRBD parser: consume initial empty resource lines
Signed-off-by: Klaus Aehlig <[email protected]>
diff --cc src/Ganeti/Storage/Drbd/Parser.hs
index 952401e,0000000..e2ae40b
mode 100644,000000..100644
--- a/src/Ganeti/Storage/Drbd/Parser.hs
+++ b/src/Ganeti/Storage/Drbd/Parser.hs
@@@ -1,351 -1,0 +1,352 @@@
+{-# 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.Storage.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.Storage.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
++ _ <- additionalEOL
+ 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
--
Klaus Aehlig
Google Germany GmbH, Dienerstr. 12, 80331 Muenchen
Registergericht und -nummer: Hamburg, HRB 86891
Sitz der Gesellschaft: Hamburg
Geschaeftsfuehrer: Graham Law, Christine Elizabeth Flores
