LGTM, thanks
On Fri, Jul 4, 2014 at 12:59 PM, 'Klaus Aehlig' via ganeti-devel < [email protected]> wrote: > > > 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 >
