--- /dev/null
+{-# 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
--- /dev/null
+{-| 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)
projects / ganeti-local / commitdiff