From 3c1915dfb0daf52e5f70d3e8515ac600a729d3d4 Mon Sep 17 00:00:00 2001 From: Michele Tartara Date: Mon, 19 Nov 2012 15:19:51 +0100 Subject: [PATCH] Add parser for DRBD /proc file A new directory for haskell modules about block devices has been created The parser is divided in two modules: * one exports the data types describing the DRBD status * one exports the parser itself Signed-off-by: Michele Tartara [iustin@google.com: indentation/alignment fixes] Reviewed-by: Iustin Pop --- Makefile.am | 8 + htools/Ganeti/Block/Drbd/Parser.hs | 334 ++++++++++++++++++++++++++++++++++++ htools/Ganeti/Block/Drbd/Types.hs | 198 +++++++++++++++++++++ 3 files changed, 540 insertions(+) create mode 100644 htools/Ganeti/Block/Drbd/Parser.hs create mode 100644 htools/Ganeti/Block/Drbd/Types.hs diff --git a/Makefile.am b/Makefile.am index 9707e7e..673a2d3 100644 --- a/Makefile.am +++ b/Makefile.am @@ -57,6 +57,8 @@ myexeclibdir = $(pkglibdir) HTOOLS_DIRS = \ htools \ htools/Ganeti \ + htools/Ganeti/Block \ + htools/Ganeti/Block/Drbd \ htools/Ganeti/Confd \ htools/Ganeti/HTools \ htools/Ganeti/HTools/Backend \ @@ -108,6 +110,8 @@ BUILDTIME_DIR_AUTOCREATE = \ $(APIDOC_DIR) \ $(APIDOC_HS_DIR) \ $(APIDOC_HS_DIR)/Ganeti \ + $(APIDOC_HS_DIR)/Ganeti/Block \ + $(APIDOC_HS_DIR)/Ganeti/Block/Drbd \ $(APIDOC_HS_DIR)/Ganeti/Confd \ $(APIDOC_HS_DIR)/Ganeti/HTools \ $(APIDOC_HS_DIR)/Ganeti/HTools/Backend \ @@ -426,6 +430,8 @@ HPCEXCL = --exclude Main \ $(patsubst htools.%,--exclude Test.%,$(subst /,.,$(patsubst %.hs,%, $(HS_LIB_SRCS)))) HS_LIB_SRCS = \ + htools/Ganeti/Block/Drbd/Types.hs \ + htools/Ganeti/Block/Drbd/Parser.hs \ htools/Ganeti/BasicTypes.hs \ htools/Ganeti/Common.hs \ htools/Ganeti/Compat.hs \ @@ -1618,6 +1624,8 @@ hs-apidoc: $(HS_BUILT_SRCS) rm -rf $(APIDOC_HS_DIR)/* @mkdir_p@ $(APIDOC_HS_DIR)/Ganeti/HTools/Backend @mkdir_p@ $(APIDOC_HS_DIR)/Ganeti/HTools/Program + @mkdir_p@ $(APIDOC_HS_DIR)/Ganeti/Block + @mkdir_p@ $(APIDOC_HS_DIR)/Ganeti/Block/Drbd @mkdir_p@ $(APIDOC_HS_DIR)/Ganeti/Confd @mkdir_p@ $(APIDOC_HS_DIR)/Ganeti/Query $(HSCOLOUR) -print-css > $(APIDOC_HS_DIR)/Ganeti/hscolour.css diff --git a/htools/Ganeti/Block/Drbd/Parser.hs b/htools/Ganeti/Block/Drbd/Parser.hs new file mode 100644 index 0000000..4a85646 --- /dev/null +++ b/htools/Ganeti/Block/Drbd/Parser.hs @@ -0,0 +1,334 @@ +{-# 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.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 :: Parser DRBDStatus +drbdStatusParser = + DRBDStatus <$> versionInfoParser + <*> deviceParser `AC.manyTill` A.endOfInput + +-- | The parser for the version information lines. +versionInfoParser :: Parser VersionInfo +versionInfoParser = + VersionInfo + <$> optional versionP + <*> optional apiP + <*> optional protoP + <*> optional srcVersion + <*> (fmap unpack <$> optional gh) + <*> (fmap unpack <$> optional builder) + 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 :: Parser DeviceInfo +deviceParser = do + deviceNum <- skipSpaces *> A.decimal <* A.char ':' + cs <- skipSpacesAndString "cs:" connectionStateParser + 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 + perfIndicators <- performanceIndicatorsParser + syncS <- conditionalSyncStatusParser cs + reS <- optional resyncParser + act <- optional actLogParser + _ <- additionalEOL + return $ DeviceInfo deviceNum cs ro ds replicProtocol io perfIndicators + syncS reS act + + 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. +connectionStateParser :: Parser ConnectionState +connectionStateParser = + 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. +performanceIndicatorsParser :: Parser PerformanceIndicators +performanceIndicatorsParser = + PerformanceIndicators + <$> 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 Integer + m = A.char ':' *> A.decimal :: Parser Integer + s = A.char ':' *> A.decimal :: Parser Integer + +-- | 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 recognises ',' as the separator every 3 digits +-- but DRBD uses it, so we need an ah-hoc parser. +commaIntParser :: Parser Int +commaIntParser = do + first <- A.decimal + allDigits <- commaIntHelper 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 diff --git a/htools/Ganeti/Block/Drbd/Types.hs b/htools/Ganeti/Block/Drbd/Types.hs new file mode 100644 index 0000000..79b917f --- /dev/null +++ b/htools/Ganeti/Block/Drbd/Types.hs @@ -0,0 +1,198 @@ +{-| DRBD Data Types + +This module holds the definition of the data types describing the status of +DRBD. + +-} +{- + +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.Types + ( DRBDStatus(..) + , VersionInfo(..) + , DeviceInfo(..) + , ConnectionState(..) + , LocalRemote(..) + , Role(..) + , DiskState(..) + , PerformanceIndicators(..) + , SyncStatus(..) + , SizeUnit(..) + , Time(..) + , TimeUnit(..) + , AdditionalInfo(..) + ) where + +--TODO: consider turning deviceInfos into an IntMap +-- | Data type contaning all the data about the status of DRBD. +data DRBDStatus = + DRBDStatus + { versionInfo :: VersionInfo -- ^ Version information about DRBD + , deviceInfos :: [DeviceInfo] -- ^ Per-minor information + } deriving (Eq, Show) + +-- | Data type describing the DRBD version. +data VersionInfo = + VersionInfo + { version :: Maybe String -- ^ DRBD driver version + , api :: Maybe String -- ^ The api version + , proto :: Maybe String -- ^ The protocol version + , srcversion :: Maybe String -- ^ The version of the source files + , gitHash :: Maybe String -- ^ Git hash of the source files + , buildBy :: Maybe String -- ^ Who built the binary (and, + -- optionally, when) + } deriving (Eq, Show) + +-- | Data type describing a device. +data DeviceInfo = + UnconfiguredDevice Int -- ^ An DRBD minor marked as unconfigured + | -- | A configured DRBD minor + DeviceInfo + { minorNumber :: Int -- ^ The minor index of the device + , connectionState :: ConnectionState -- ^ State of the connection + , resourceRoles :: LocalRemote Role -- ^ Roles of the resources + , diskStates :: LocalRemote DiskState -- ^ Status of the disks + , replicationProtocol :: Char -- ^ The replication protocol being used + , ioFlags :: String -- ^ The input/output flags + , performanceIndicators :: PerformanceIndicators -- ^ Performance indicators + , syncStatus :: Maybe SyncStatus -- ^ The status of the syncronization of + -- the disk (only if it is happening) + , resync :: Maybe AdditionalInfo -- ^ Additional info by DRBD 8.0 + , actLog :: Maybe AdditionalInfo -- ^ Additional info by DRBD 8.0 + } deriving (Eq, Show) + +-- | Data type describing the state of the connection. +data ConnectionState + = StandAlone -- ^ No network configuration available + | Disconnecting -- ^ Temporary state during disconnection + | Unconnected -- ^ Prior to a connection attempt + | Timeout -- ^ Following a timeout in the communication + | BrokenPipe -- ^ After the connection to the peer was lost + | NetworkFailure -- ^ After the connection to the parner was lost + | ProtocolError -- ^ After the connection to the parner was lost + | TearDown -- ^ The peer is closing the connection + | WFConnection -- ^ Waiting for the peer to become visible + | WFReportParams -- ^ Waiting for first packet from peer + | Connected -- ^ Connected, data mirroring active + | StartingSyncS -- ^ Source of a full sync started by admin + | StartingSyncT -- ^ Target of a full sync started by admin + | WFBitMapS -- ^ Source of a just starting partial sync + | WFBitMapT -- ^ Target of a just starting partial sync + | WFSyncUUID -- ^ Synchronization is about to begin + | SyncSource -- ^ Source of a running synchronization + | SyncTarget -- ^ Target of a running synchronization + | PausedSyncS -- ^ Source of a paused synchronization + | PausedSyncT -- ^ Target of a paused synchronization + | VerifyS -- ^ Source of an running verification + | VerifyT -- ^ Target of an running verification + | Unconfigured -- ^ The device is not configured + deriving (Show, Eq) + +-- | Algebraic data type describing something that has a local and a remote +-- value. +data LocalRemote a = + LocalRemote + { local :: a -- ^ The local value + , remote :: a -- ^ The remote value + } deriving (Eq, Show) + +-- | Data type describing. +data Role = Primary -- ^ The device role is primary + | Secondary -- ^ The device role is secondary + | Unknown -- ^ The device role is unknown + deriving (Eq, Show) + +-- | Data type describing disk states. +data DiskState + = Diskless -- ^ No local block device assigned to the DRBD driver + | Attaching -- ^ Reading meta data + | Failed -- ^ I/O failure + | Negotiating -- ^ "Attach" on an already-connected device + | Inconsistent -- ^ The data is inconsistent between nodes. + | Outdated -- ^ Data consistent but outdated + | DUnknown -- ^ No network connection available + | Consistent -- ^ Consistent data, but without network connection + | UpToDate -- ^ Consistent, up-to-date. This is the normal state + deriving (Eq, Show) + +-- | Data type containing data about performance indicators. +data PerformanceIndicators = PerformanceIndicators + { networkSend :: Int -- ^ KiB of data sent on the network + , networkReceive :: Int -- ^ KiB of data received from the network + , diskWrite :: Int -- ^ KiB of data written on local disk + , diskRead :: Int -- ^ KiB of data read from local disk + , activityLog :: Int -- ^ Number of updates of the activity log + , bitMap :: Int -- ^ Number of updates to the bitmap area of the metadata + , localCount :: Int -- ^ Number of open requests to te local I/O subsystem + , pending :: Int -- ^ Num of requests sent to the partner but not yet answered + , unacknowledged :: Int -- ^ Num of requests received by the partner but still + -- to be answered + , applicationPending :: Int -- ^ Num of block I/O requests forwarded + -- to DRBD but that have not yet been + -- answered + , epochs :: Maybe Int -- ^ Number of epoch objects + , writeOrder :: Maybe Char -- ^ Currently used write ordering method + , outOfSync :: Maybe Int -- ^ KiB of storage currently out of sync + } deriving (Eq, Show) + +-- | Data type containing data about the synchronization status of a device. +data SyncStatus = + SyncStatus + { percentage :: Double -- ^ Percentage of syncronized data + , partialSyncSize :: Int -- ^ Numerator of the fraction of synced data + , totalSyncSize :: Int -- ^ Denominator of the fraction of + -- synced data + , syncUnit :: SizeUnit -- ^ Measurement unit of the previous + -- fraction + , timeToFinish :: Time -- ^ Expected time before finishing + -- the syncronization + , speed :: Int -- ^ Speed of the syncronization + , want :: Maybe Int -- ^ Want of the syncronization + , speedSizeUnit :: SizeUnit -- ^ Size unit of the speed + , speedTimeUnit :: TimeUnit -- ^ Time unit of the speed + } deriving (Eq, Show) + +-- | Data type describing a size unit for memory. +data SizeUnit = KiloByte | MegaByte deriving (Eq, Show) + +-- | Data type describing a time (hh:mm:ss). +data Time = Time + { hour :: Integer + , min :: Integer + , sec :: Integer + } deriving (Eq, Show) + +-- | Data type describing a time unit. +data TimeUnit = Second deriving (Eq, Show) + +-- | Additional device-specific cache-like information produced by +-- drbd <= 8.0. +-- +-- Internal debug information exported by old DRBD versions. +-- Undocumented both in DRBD and here. +data AdditionalInfo = AdditionalInfo + { partialUsed :: Int + , totalUsed :: Int + , hits :: Int + , misses :: Int + , starving :: Int + , dirty :: Int + , changed :: Int + } deriving (Eq, Show) -- 1.7.10.4