Commit 3c1915df authored by Michele Tartara's avatar Michele Tartara Committed by Iustin Pop

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: default avatarMichele Tartara <mtartara@google.com>
[iustin@google.com: indentation/alignment fixes]
Reviewed-by: default avatarIustin Pop <iustin@google.com>
parent 1a865afe
......@@ -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
......
{-# 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
{-| 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)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment