[PATCH master 1/4] Parser for DRBD proc file added

[Michele Tartara]

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 <mtar...@google.com>
---
Makefile.am | 5 +
htools/Ganeti/Block/DRBDDataTypes.hs | 165 +++++++++++++++++
htools/Ganeti/Block/DRBDParser.hs | 331 ++++++++++++++++++++++++++++++++++
3 files changed, 501 insertions(+), 0 deletions(-)
create mode 100644 htools/Ganeti/Block/DRBDDataTypes.hs
create mode 100644 htools/Ganeti/Block/DRBDParser.hs

diff --git a/Makefile.am b/Makefile.am
index 2ca6ed7..13119f0 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -57,6 +57,7 @@ myexeclibdir = $(pkglibdir)
HTOOLS_DIRS = \
htools \
htools/Ganeti \
+ htools/Ganeti/Block \
htools/Ganeti/Confd \
htools/Ganeti/HTools \
htools/Ganeti/HTools/Backend \
@@ -108,6 +109,7 @@ BUILDTIME_DIR_AUTOCREATE = \
$(APIDOC_DIR) \
$(APIDOC_HS_DIR) \
$(APIDOC_HS_DIR)/Ganeti \
+ $(APIDOC_HS_DIR)/Ganeti/Block \
$(APIDOC_HS_DIR)/Ganeti/Confd \
$(APIDOC_HS_DIR)/Ganeti/HTools \
$(APIDOC_HS_DIR)/Ganeti/HTools/Backend \
@@ -424,6 +426,8 @@ HPCEXCL = --exclude Main \
$(patsubst htools.%,--exclude Test.%,$(subst /,.,$(patsubst %.hs,%, $(HS_LIB_SRCS))))

HS_LIB_SRCS = \
+ htools/Ganeti/Block/DRBDDataTypes.hs \
+ htools/Ganeti/Block/DRBDParser.hs \
htools/Ganeti/BasicTypes.hs \
htools/Ganeti/Common.hs \
htools/Ganeti/Compat.hs \
@@ -1608,6 +1612,7 @@ 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/Confd
@mkdir_p@ $(APIDOC_HS_DIR)/Ganeti/Query
$(HSCOLOUR) -print-css > $(APIDOC_HS_DIR)/Ganeti/hscolour.css
diff --git a/htools/Ganeti/Block/DRBDDataTypes.hs b/htools/Ganeti/Block/DRBDDataTypes.hs
new file mode 100644
index 0000000..19b7ecf
--- /dev/null
+++ b/htools/Ganeti/Block/DRBDDataTypes.hs
@@ -0,0 +1,165 @@
+{-| 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.DRBDDataTypes (DRBDStatus(..),
+ VersionInfo(..),
+ DeviceInfo(..),
+ ConnectionState(..),
+ LocalRemote(..),
+ Role(..),
+ DiskState(..),
+ PerformanceIndicators(..),
+ SyncStatus(..),
+ SizeUnit(..),
+ Time(..),
+ TimeUnit(..),
+ AdditionalInfo(..)) where
+
+-- | Data type contaning all the data about the status of DRBD
+data DRBDStatus = DRBDStatus { versionInfo::VersionInfo,
+ deviceInfo::[DeviceInfo] } deriving (Eq, Show)
+
+-- | Data type describing the DRBD version
+data VersionInfo = VersionInfo { version::Maybe String,
+ api::Maybe String,
+ proto::Maybe String,
+ srcversion::Maybe String,
+ gitHash::Maybe String,
+ buildBy::Maybe String } deriving (Eq, Show)
+
+-- | Data type describing a device
+data DeviceInfo = UnconfiguredDevice Int |
+ DeviceInfo { deviceNumber::Int,
+ connectionState::ConnectionState,
+ resourceRoles::LocalRemote Role,
+ diskStates::LocalRemote DiskState,
+ replicationProtocol::Char,
+ ioFlags::String,
+ performanceIndicators::PerformanceIndicators,
+ syncStatus::Maybe SyncStatus,
+ resync::Maybe AdditionalInfo,
+ actLog::Maybe AdditionalInfo
+ } deriving (Eq, Show)
+
+-- | Data type describing the state of the connection
+data ConnectionState = StandAlone
+ | Disconnecting
+ | Unconnected
+ | Timeout
+ | BrokenPipe
+ | NetworkFailure
+ | ProtocolError
+ | TearDown
+ | WFConnection
+ | WFReportParams
+ | Connected
+ | StartingSyncS
+ | StartingSyncT
+ | WFBitMapS
+ | WFBitMapT
+ | WFSyncUUID
+ | SyncSource
+ | SyncTarget
+ | PausedSyncS
+ | PausedSyncT
+ | VerifyS
+ | VerifyT
+ | Unconfigured deriving (Show, Eq)
+
+-- | Algebraic data type describing something that has a local and a remote
+-- value
+data LocalRemote a = LocalRemote { local::a,
+ remote::a
+ } deriving (Eq, Show)
+
+-- | Data type describing
+data Role = Primary
+ | Secondary
+ | Unknown deriving (Eq, Show)
+
+-- | Data type describing disk states
+data DiskState = Diskless
+ | Attaching
+ | Failed
+ | Negotiating
+ | Inconsistent
+ | Outdated
+ | DUnknown
+ | Consistent
+ | UpToDate deriving (Eq, Show)
+
+-- | Data type containing data about performance indicators
+data PerformanceIndicators = PerformanceIndicators {
+ networkSend::Int,
+ networkReceive::Int,
+ diskWrite::Int,
+ diskRead::Int,
+ activityLog::Int,
+ bitMap::Int,
+ localCount::Int,
+ pending::Int,
+ unacknowledged::Int,
+ applicationPending::Int,
+ epochs::Maybe Int,
+ writeOrder::Maybe Char,
+ outOfSync::Maybe Int } deriving (Eq, Show)
+
+-- | Data type containing data about the synchronization status of a device
+data SyncStatus = SyncStatus {
+ percentage::Double,
+ partialSyncSize::Int,
+ totalSyncSize::Int,
+ syncUnit::SizeUnit,
+ timeToFinish::Time,
+ speed::Double,
+ want::Maybe Double,
+ speedSizeUnit::SizeUnit,
+ speedTimeUnit::TimeUnit
+ } 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 information produced by drbd <= 8.0
+data AdditionalInfo = AdditionalInfo {
+ partialUsed::Int,
+ totalUsed::Int,
+ hits::Int,
+ misses::Int,
+ starving::Int,
+ dirty::Int,
+ changed::Int
+ } deriving (Eq, Show)
diff --git a/htools/Ganeti/Block/DRBDParser.hs b/htools/Ganeti/Block/DRBDParser.hs
new file mode 100644
index 0000000..9ed805d
--- /dev/null
+++ b/htools/Ganeti/Block/DRBDParser.hs
@@ -0,0 +1,331 @@
+{-# 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.DRBDParser (drbdStatusParser) where
+
+import Control.Applicative ((<*>), (*>), (<*), (<$>), (<|>), pure, some)
+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.DRBDDataTypes
+
+-- | 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
+
+-- | 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 vers
+ <*> optional a
+ <*> optional p
+ <*> optional srcVersion
+ <*> (fmap unpack <$> optional gh)
+ <*> (fmap unpack <$> optional builder)
+ where vers = A.string "version:"
+ *> skipSpaces
+ *> fmap Data.Text.unpack (A.takeWhile $ not .
+ A.isHorizontalSpace)
+ a = skipSpacesAndString "(api:" . fmap unpack
+ $ A.takeWhile (/= '/')
+ p = 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.endOfLine
+ 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 = some (A.notChar '\n')
+
+-- | 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
+ *> commaDoubleParser
+ <* skipSpaces
+ <* A.char '('
+ <* commaDoubleParser
+ <* A.char ')'
+ )
+ w <- skipSpacesAndString "want:" (skipSpaces
+ *> (Just <$> commaDoubleParser)
+ )
+ <|> 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
+ m = A.char ':' *> A.decimal
+ s = A.char ':' *> A.decimal
+
+-- | 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 recognises '.' as the separator for the decimal part of numbers,
+-- but DRBD uses comma, so we need an ah-hoc parser.
+commaDoubleParser :: Parser Double
+commaDoubleParser = do
+ intPart <- A.decimal
+ _ <- A.char ','
+ decimalPart <- decimalPartParser []
+ pure $ fromIntegral (intPart::Integer) + decimalPart
+
+-- | Helper for commaDoubleParser for computing the decimal part
+decimalPartParser :: String -> Parser Double
+decimalPartParser acc = goOn <|> finished
+ where goOn = do
+ d <- A.digit
+ decimalPartParser $ acc ++ [d]
+ finished = let digits = read acc
+ numDecimalDigits = length acc
+ decimalPart = digits / (10 ^ numDecimalDigits)
+ in pure decimalPart
+
+-- | 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
--
1.7.7.3

[Michele Tartara]

This patch set adds the DRBD parser to the ganeti tree.
The parser is, up to now, just used by its unit tests module.
More tests to come soon.
Also, a few utility functions for opening test data files from
Haskell unit tests have been added.


Michele Tartara (4):
Parser for DRBD proc file added
Improved TestHelper module docstring
Utility functions for loading data from test files added
DRBDParser unit test added

Makefile.am | 7 +
htest/Test/Ganeti/Block/DRBDParser.hs | 122 ++++++++++++
htest/Test/Ganeti/TestCommon.hs | 24 +++
htest/Test/Ganeti/TestHelper.hs | 2 +-
htest/test.hs | 2 +
htools/Ganeti/Block/DRBDDataTypes.hs | 165 ++++++++++++++++
htools/Ganeti/Block/DRBDParser.hs | 331 +++++++++++++++++++++++++++++++++
7 files changed, 652 insertions(+), 1 deletions(-)
create mode 100644 htest/Test/Ganeti/Block/DRBDParser.hs

create mode 100644 htools/Ganeti/Block/DRBDDataTypes.hs
create mode 100644 htools/Ganeti/Block/DRBDParser.hs

--
1.7.7.3

[Michele Tartara]

Signed-off-by: Michele Tartara <mtar...@google.com>
---

htest/Test/Ganeti/TestHelper.hs | 2 +-
1 files changed, 1 insertions(+), 1 deletions(-)

diff --git a/htest/Test/Ganeti/TestHelper.hs b/htest/Test/Ganeti/TestHelper.hs
index 04eb490..92f5d08 100644
--- a/htest/Test/Ganeti/TestHelper.hs
+++ b/htest/Test/Ganeti/TestHelper.hs
@@ -1,6 +1,6 @@
{-# LANGUAGE TemplateHaskell #-}

-{-| Unittest helpers for Haskell components
+{-| Unittest helpers for TemplateHaskell components

-}

--
1.7.7.3

[Michele Tartara]

They mimic their python counterparts.

Added functions:
* getSourceDir
* testDataFilename
* readTestData
* readPythonTestData

Signed-off-by: Michele Tartara <mtar...@google.com>
---

htest/Test/Ganeti/TestCommon.hs | 24 ++++++++++++++++++++++++
1 files changed, 24 insertions(+), 0 deletions(-)

diff --git a/htest/Test/Ganeti/TestCommon.hs b/htest/Test/Ganeti/TestCommon.hs
index fdfa7f1..8e8c56b 100644
--- a/htest/Test/Ganeti/TestCommon.hs
+++ b/htest/Test/Ganeti/TestCommon.hs
@@ -217,3 +217,27 @@ testSerialisation a =
resultProp :: (Show a) => BasicTypes.GenericResult a b -> PropertyM IO b
resultProp (BasicTypes.Bad err) = stop . failTest $ show err
resultProp (BasicTypes.Ok val) = return val
+
+-- | Return the source directory of Ganeti
+getSourceDir :: IO FilePath
+getSourceDir = catchJust (guard . isDoesNotExistError)
+ (getEnv "TOP_SRCDIR")
+ (const (return "."))
+
+-- | Returns the path of a file in the test data directory, given its name
+testDataFilename :: String -> String -> IO FilePath
+testDataFilename datadir name = do
+ src <- getSourceDir
+ return $ src ++ datadir ++ name
+
+-- | Returns the content of the specified python test data file
+readPythonTestData :: String -> IO String
+readPythonTestData filename = do
+ name <- testDataFilename "/test/data/" filename
+ readFile name
+
+-- | Returns the content of the specified haskell test data file
+readTestData :: String -> IO String
+readTestData filename = do
+ name <- testDataFilename "/htest/data/" filename
+ readFile name
--
1.7.7.3

[Michele Tartara]

Signed-off-by: Michele Tartara <mtar...@google.com>
---

Makefile.am | 2 +
htest/Test/Ganeti/Block/DRBDParser.hs | 122 +++++++++++++++++++++++++++++++++
htest/test.hs | 2 +
3 files changed, 126 insertions(+), 0 deletions(-)
create mode 100644 htest/Test/Ganeti/Block/DRBDParser.hs

diff --git a/Makefile.am b/Makefile.am
index 13119f0..46717c3 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -66,6 +66,7 @@ HTOOLS_DIRS = \
htest \
htest/Test \
htest/Test/Ganeti \
+ htest/Test/Ganeti/Block \
htest/Test/Ganeti/Confd \
htest/Test/Ganeti/HTools \
htest/Test/Ganeti/HTools/Backend \
@@ -487,6 +488,7 @@ HS_TEST_SRCS = \
htest/Test/Ganeti/Common.hs \
htest/Test/Ganeti/Confd/Utils.hs \
htest/Test/Ganeti/Daemon.hs \
+ htest/Test/Ganeti/Block/DRBDParser.hs \
htest/Test/Ganeti/Errors.hs \
htest/Test/Ganeti/HTools/Backend/Simu.hs \
htest/Test/Ganeti/HTools/Backend/Text.hs \
diff --git a/htest/Test/Ganeti/Block/DRBDParser.hs b/htest/Test/Ganeti/Block/DRBDParser.hs
new file mode 100644
index 0000000..7f2780d
--- /dev/null
+++ b/htest/Test/Ganeti/Block/DRBDParser.hs
@@ -0,0 +1,122 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+{-| Unittests for Attoparsec support for unicode -}
+

+{-
+
+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 Test.Ganeti.Block.DRBDParser (testBlock_DRBDParser) where
+
+import Test.HUnit
+
+import Test.Ganeti.TestHelper
+import Test.Ganeti.TestCommon (readPythonTestData)
+

+import qualified Data.Attoparsec.Text as A

+import Data.Text (pack)
+
+import Ganeti.Block.DRBDParser (drbdStatusParser)
+import Ganeti.Block.DRBDDataTypes
+
+case_drbd8 :: Assertion
+case_drbd8 = do
+ fileContent <- readPythonTestData "proc_drbd8.txt"
+ case A.parseOnly drbdStatusParser $ pack fileContent of
+ Left msg -> assertFailure $ "Parsing failed: " ++ msg
+ Right obtained -> assertEqual "drbd8" expected obtained
+ where expected = DRBDStatus (VersionInfo (Just "8.0.12") (Just "86")
+ (Just "86") Nothing
+ (Just
+ "5c9f89594553e32adb87d9638dce591782f947e3")
+ (Just "XXX")
+ )
+ [DeviceInfo 0 Connected (LocalRemote Primary
+ Secondary)
+ (LocalRemote UpToDate UpToDate) 'C' "r---"
+ (PerformanceIndicators 4375577 0 4446279 674
+ 1067 69 0 0 0 0 Nothing Nothing Nothing)
+ Nothing
+ (Just $ AdditionalInfo 0 61 0 0 0 0 0)
+ (Just $ AdditionalInfo 0 257 793749 1067 0 0
+ 1067
+ ),
+ DeviceInfo 1 Connected (LocalRemote Secondary
+ Primary)
+ (LocalRemote UpToDate UpToDate) 'C' "r---"
+ (PerformanceIndicators 738320 0 738320
+ 554400 67 0 0 0 0 0 Nothing Nothing
+ Nothing)
+ Nothing
+ (Just $ AdditionalInfo 0 61 0 0 0 0 0)
+ (Just $ AdditionalInfo 0 257 92464 67 0 0 67
+ ),
+ UnconfiguredDevice 2,
+ DeviceInfo 4 WFConnection (LocalRemote Primary
+ Unknown)
+ (LocalRemote UpToDate DUnknown) 'C' "r---"
+ (PerformanceIndicators 738320 0 738320
+ 554400 67 0 0 0 0 0 Nothing Nothing
+ Nothing)
+ Nothing
+ (Just $ AdditionalInfo 0 61 0 0 0 0 0)
+ (Just $ AdditionalInfo 0 257 92464 67 0 0 67
+ ),
+ DeviceInfo 5 Connected (LocalRemote Primary
+ Secondary)
+ (LocalRemote UpToDate Diskless) 'C' "r---"
+ (PerformanceIndicators 4375581 0 4446283 674
+ 1069 69 0 0 0 0 Nothing Nothing Nothing)
+ Nothing
+ (Just $ AdditionalInfo 0 61 0 0 0 0 0)
+ (Just $ AdditionalInfo 0 257 793750 1069 0 0
+ 1069
+ ),
+ DeviceInfo 6 Connected (LocalRemote Secondary
+ Primary)
+ (LocalRemote Diskless UpToDate) 'C' "r---"
+ (PerformanceIndicators 0 4375581 5186925 327
+ 75 214 0 0 0 0 Nothing Nothing Nothing)
+ Nothing
+ Nothing
+ Nothing,
+ DeviceInfo 7 WFConnection (LocalRemote
+ Secondary
+ Unknown)
+ (LocalRemote UpToDate DUnknown) 'C' "r---"
+ (PerformanceIndicators 0 0 0 0 0 0 0 0 0 0
+ Nothing Nothing Nothing)
+ Nothing
+ (Just $ AdditionalInfo 0 61 0 0 0 0 0)
+ (Just $ AdditionalInfo 0 257 0 0 0 0 0),
+ DeviceInfo 8 StandAlone (LocalRemote Secondary
+ Unknown)
+ (LocalRemote UpToDate DUnknown) ' ' "r---"
+ (PerformanceIndicators 0 0 0 0 0 0 0 0 0 0
+ Nothing Nothing Nothing)
+ Nothing
+ (Just $ AdditionalInfo 0 61 0 0 0 0 0)
+ (Just $ AdditionalInfo 0 257 0 0 0 0 0)
+ ]
+
+
+testSuite "Block_DRBDParser"
+ [ 'case_drbd8
+ ]
diff --git a/htest/test.hs b/htest/test.hs
index b41fb99..ee3f5a6 100644
--- a/htest/test.hs
+++ b/htest/test.hs
@@ -32,6 +32,7 @@ import System.Environment (getArgs)
import Test.Ganeti.TestImports ()
import Test.Ganeti.Attoparsec
import Test.Ganeti.BasicTypes
+import Test.Ganeti.Block.DRBDParser
import Test.Ganeti.Common
import Test.Ganeti.Confd.Utils
import Test.Ganeti.Daemon
@@ -79,6 +80,7 @@ allTests =
, testCommon
, testConfd_Utils
, testDaemon
+ , testBlock_DRBDParser
, testErrors
, testHTools_Backend_Simu
, testHTools_Backend_Text
--
1.7.7.3

[Iustin Pop]

LGTM, thanks. I'll add a dot at the end there.

iustin

[Iustin Pop]

On Fri, Nov 16, 2012 at 09:53:38AM +0100, Michele Tartara wrote:
> They mimic their python counterparts.
>
> Added functions:
> * getSourceDir
> * testDataFilename
> * readTestData
> * readPythonTestData
>
> Signed-off-by: Michele Tartara <mtar...@google.com>
> ---
> htest/Test/Ganeti/TestCommon.hs | 24 ++++++++++++++++++++++++
> 1 files changed, 24 insertions(+), 0 deletions(-)
>
> diff --git a/htest/Test/Ganeti/TestCommon.hs b/htest/Test/Ganeti/TestCommon.hs
> index fdfa7f1..8e8c56b 100644
> --- a/htest/Test/Ganeti/TestCommon.hs
> +++ b/htest/Test/Ganeti/TestCommon.hs
> @@ -217,3 +217,27 @@ testSerialisation a =
> resultProp :: (Show a) => BasicTypes.GenericResult a b -> PropertyM IO b
> resultProp (BasicTypes.Bad err) = stop . failTest $ show err
> resultProp (BasicTypes.Ok val) = return val
> +
> +-- | Return the source directory of Ganeti

'.' at end of docstrings; same for the other functions.

> +getSourceDir :: IO FilePath
> +getSourceDir = catchJust (guard . isDoesNotExistError)
> + (getEnv "TOP_SRCDIR")
> + (const (return "."))
> +
> +-- | Returns the path of a file in the test data directory, given its name
> +testDataFilename :: String -> String -> IO FilePath
> +testDataFilename datadir name = do
> + src <- getSourceDir
> + return $ src ++ datadir ++ name
> +
> +-- | Returns the content of the specified python test data file
> +readPythonTestData :: String -> IO String
> +readPythonTestData filename = do
> + name <- testDataFilename "/test/data/" filename
> + readFile name
> +
> +-- | Returns the content of the specified haskell test data file
> +readTestData :: String -> IO String

For consistency, should this be readHaskellTestData? Just wondering.

iustin

[Michele Tartara]

On Fri, Nov 16, 2012 at 11:01 AM, Iustin Pop <ius...@google.com> wrote:

On Fri, Nov 16, 2012 at 09:53:38AM +0100, Michele Tartara wrote:
> They mimic their python counterparts.
>
> Added functions:
> * getSourceDir
> * testDataFilename
> * readTestData
> * readPythonTestData
>
> Signed-off-by: Michele Tartara <mtar...@google.com>
> ---
>  htest/Test/Ganeti/TestCommon.hs |   24 ++++++++++++++++++++++++
>  1 files changed, 24 insertions(+), 0 deletions(-)
>
> diff --git a/htest/Test/Ganeti/TestCommon.hs b/htest/Test/Ganeti/TestCommon.hs
> index fdfa7f1..8e8c56b 100644
> --- a/htest/Test/Ganeti/TestCommon.hs
> +++ b/htest/Test/Ganeti/TestCommon.hs
> @@ -217,3 +217,27 @@ testSerialisation a =
>  resultProp :: (Show a) => BasicTypes.GenericResult a b -> PropertyM IO b
>  resultProp (BasicTypes.Bad err) = stop . failTest $ show err
>  resultProp (BasicTypes.Ok  val) = return val
> +
> +-- | Return the source directory of Ganeti

'.' at end of docstrings; same for the other functions.

Ok, I'll fix it.

 

> +getSourceDir :: IO FilePath
> +getSourceDir = catchJust (guard . isDoesNotExistError)
> +            (getEnv "TOP_SRCDIR")
> +            (const (return "."))
> +
> +-- | Returns the path of a file in the test data directory, given its name
> +testDataFilename :: String -> String -> IO FilePath
> +testDataFilename datadir name = do
> +        src <- getSourceDir
> +        return $ src ++ datadir ++ name
> +
> +-- | Returns the content of the specified python test data file
> +readPythonTestData :: String -> IO String
> +readPythonTestData filename = do
> +    name <- testDataFilename "/test/data/" filename
> +    readFile name
> +
> +-- | Returns the content of the specified haskell test data file
> +readTestData :: String -> IO String

For consistency, should this be readHaskellTestData? Just wondering.

I thought about that, but in the end I preferred to go for a "default implementation" for the test data specific for the current language and a "named" implementation for the external language (python).

Also because in my opinion having a single test data directory would make more sense (data are not language specific) and if they ever end up being joined, a language-agnostic function to access the data would make more sense.

Thanks

Michele

[Iustin Pop]

Ack, makes sense.

> Also because in my opinion having a single test data directory would make
> more sense (data are not language specific) and if they ever end up being
> joined, a language-agnostic function to access the data would make more
> sense.

Hmm. We actually had them (test data) together, but then I split them
for clarity.

Maybe we want to change the tree as follows?

\-pytest
\-hstest
\-test-data

So that the test files are separated, but test data files are common?

iustin

[Michele Tartara]

Ok, I'm resending the patch with the docstring's full stops added, and without changing the function names.

 

> Also because in my opinion having a single test data directory would make
> more sense (data are not language specific) and if they ever end up being
> joined, a language-agnostic function to access the data would make more
> sense.

Hmm. We actually had them (test data) together, but then I split them
for clarity.

Maybe we want to change the tree as follows?

\-pytest
\-hstest
\-test-data

So that the test files are separated, but test data files are common?

It sounds like the best approach to me.

But that definitely goes in a different patch! :-p 

Thanks,

Michele

[Michele Tartara]

They mimic their python counterparts.

Added functions:
* getSourceDir
* testDataFilename
* readTestData
* readPythonTestData

Signed-off-by: Michele Tartara <mtar...@google.com>
---
htest/Test/Ganeti/TestCommon.hs | 24 ++++++++++++++++++++++++
1 files changed, 24 insertions(+), 0 deletions(-)

diff --git a/htest/Test/Ganeti/TestCommon.hs b/htest/Test/Ganeti/TestCommon.hs

index fdfa7f1..c108079 100644

--- a/htest/Test/Ganeti/TestCommon.hs
+++ b/htest/Test/Ganeti/TestCommon.hs
@@ -217,3 +217,27 @@ testSerialisation a =
resultProp :: (Show a) => BasicTypes.GenericResult a b -> PropertyM IO b
resultProp (BasicTypes.Bad err) = stop . failTest $ show err
resultProp (BasicTypes.Ok val) = return val
+

+-- | Return the source directory of Ganeti.

+getSourceDir :: IO FilePath
+getSourceDir = catchJust (guard . isDoesNotExistError)
+ (getEnv "TOP_SRCDIR")
+ (const (return "."))
+

+-- | Returns the path of a file in the test data directory, given its name.

+testDataFilename :: String -> String -> IO FilePath
+testDataFilename datadir name = do
+ src <- getSourceDir
+ return $ src ++ datadir ++ name
+

+-- | Returns the content of the specified python test data file.

+readPythonTestData :: String -> IO String
+readPythonTestData filename = do
+ name <- testDataFilename "/test/data/" filename
+ readFile name
+

+-- | Returns the content of the specified haskell test data file.

+readTestData :: String -> IO String

[Iustin Pop]

Absolutely, was just discussing here as it came up.

thanks,
iustin

[Iustin Pop]

On Fri, Nov 16, 2012 at 01:23:02PM +0100, Michele Tartara wrote:
> They mimic their python counterparts.
>
> Added functions:
> * getSourceDir
> * testDataFilename
> * readTestData
> * readPythonTestData
>
> Signed-off-by: Michele Tartara <mtar...@google.com>

LGTM, thanks.

[Iustin Pop]

On Fri, Nov 16, 2012 at 09:53:36AM +0100, Michele Tartara wrote:
> 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 <mtar...@google.com>
> ---
> Makefile.am | 5 +
> htools/Ganeti/Block/DRBDDataTypes.hs | 165 +++++++++++++++++
> htools/Ganeti/Block/DRBDParser.hs | 331 ++++++++++++++++++++++++++++++++++
> 3 files changed, 501 insertions(+), 0 deletions(-)
> create mode 100644 htools/Ganeti/Block/DRBDDataTypes.hs
> create mode 100644 htools/Ganeti/Block/DRBDParser.hs

Hi,

You shouldn't do that - I mean, grouping modules based on filenames
rather than structure.

If you need two modules, then these should be:

- Ganeti/Block/Drbd/Types.hs
- Ganeti/Block/Drbd/Parser.hs

(No all uppercase DRBD as well).

Please use, here and in all multi-line declarations below, Haskell-style
indendation - check the other source files. This should be rather:

module Test.Ganeti.TestHelper
( testSuite
, genArbitrary
, …
) where

> +-- | Data type contaning all the data about the status of DRBD
> +data DRBDStatus = DRBDStatus { versionInfo::VersionInfo,
> + deviceInfo::[DeviceInfo] } deriving (Eq, Show)

White space around '::'. Deriving should be on its own line. Docstrings
for the actual member types.

Same comment for all these three, and the following ones.

And up to here. Also, don't forget dots at the end of docstrings (but
not in member variable docstrings; check other existing code).

If the function definition doesn't fit on a single line, please indent
and start from the left side. This prevents huge reindentation if the
function name changes.

> + <*> optional a
> + <*> optional p
> + <*> optional srcVersion
> + <*> (fmap unpack <$> optional gh)
> + <*> (fmap unpack <$> optional builder)
> + where vers = A.string "version:"
> + *> skipSpaces
> + *> fmap Data.Text.unpack (A.takeWhile $ not .
> + A.isHorizontalSpace)
> + a = skipSpacesAndString "(api:" . fmap unpack
> + $ A.takeWhile (/= '/')
> + p = A.string "/proto:"
> + *> fmap Data.Text.unpack (A.takeWhile (/= ')'))
> + <* A.takeTill A.isEndOfLine <* A.endOfLine

Please use more descriptive names, instea of 'a', 'p', 'gh'.

> + 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
> + )

Question here: why did you use 'where …', if the variables are used only
once? Just for readability in the actual parser composition?

Same question here (about where) - just curious.

Also, while the code looks good for now, I'll make the note that, for
example, this seems quite uniform/regular, so it could be
simplified/generated via TH.

Here and in similar spaces, it is recommended to use $ instead of ( ),
if the precedence of operators allows it.

OK, one thing that I don't see is the special-casing of some newlines
being replaced by '^M' (some kernel versions had this bug). See
test/data/proc_drbd83_sync_krnl2.6.39.txt for an example - make sure
this parses that correctly as well.

thanks,
iustin

[Iustin Pop]

Wrong indentation here - 2 spaces, not 4. Possible in the other patches
as well.

Also, I would really prefer if we test all existing test files; we have
multiple ones especially to handle variations in /proc/drbd format.

iustin

[Michele Tartara]

On Fri, Nov 16, 2012 at 1:43 PM, Iustin Pop <ius...@google.com> wrote:

On Fri, Nov 16, 2012 at 09:53:36AM +0100, Michele Tartara wrote:
> 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 <mtar...@google.com>
> ---
>  Makefile.am                          |    5 +
>  htools/Ganeti/Block/DRBDDataTypes.hs |  165 +++++++++++++++++
>  htools/Ganeti/Block/DRBDParser.hs    |  331 ++++++++++++++++++++++++++++++++++
>  3 files changed, 501 insertions(+), 0 deletions(-)
>  create mode 100644 htools/Ganeti/Block/DRBDDataTypes.hs
>  create mode 100644 htools/Ganeti/Block/DRBDParser.hs

Hi,

You shouldn't do that - I mean, grouping modules based on filenames
rather than structure.

If you need two modules, then these should be:

- Ganeti/Block/Drbd/Types.hs
- Ganeti/Block/Drbd/Parser.hs

(No all uppercase DRBD as well).

Ok.

Ok, I'll find the proper style guide (if it exists) or I will just look at the rest of the code.

 

> +-- | Data type contaning all the data about the status of DRBD
> +data DRBDStatus = DRBDStatus { versionInfo::VersionInfo,
> +                               deviceInfo::[DeviceInfo] } deriving (Eq, Show)

White space around '::'. Deriving should be on its own line. Docstrings
for the actual member types.

Ok for the spaces and and for "deriving" on its own line. 

But what do you mean exactly with "actual member types"? One docstring for every constructor?

Ok, I'll fix them as I did in the other patch.

Ok.

 

> +                                <*> optional a
> +                                <*> optional p
> +                                <*> optional srcVersion
> +                                <*> (fmap unpack <$> optional gh)
> +                                <*> (fmap unpack <$> optional builder)
> +          where vers = A.string "version:"
> +                       *> skipSpaces
> +                       *> fmap Data.Text.unpack (A.takeWhile $ not .
> +                                                  A.isHorizontalSpace)
> +                a = skipSpacesAndString "(api:" . fmap unpack
> +                                                         $ A.takeWhile (/= '/')
> +                p = A.string "/proto:"
> +                        *> fmap Data.Text.unpack (A.takeWhile (/= ')'))
> +                        <* A.takeTill A.isEndOfLine <* A.endOfLine

Please use more descriptive names, instea of 'a', 'p', 'gh'.

I tend to use really descriptive names (as you have probably seen) and I used them here too, but then they clashed with the names of the corresponding fields imported from the data type definition module.

But I had forgotten about the "hiding" option of the "import" command, so I think I will use that one and I will go back to using the full names here in the parser.

I don't need to directly access members of the data structures from here anyway.

> +                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
> +                          )

Question here: why did you use 'where …', if the variables are used only
once? Just for readability in the actual parser composition?

Exactly. This way it is easy to see what the parser is actually doing (it almost looks like a parsing grammar), whereas if I do not name the various parts through "where", it looks quite like a mess.

Here the improved readability is much more debatable but yes, the reason is fundamentally the same.

 

Also, while the code looks good for now, I'll make the note that, for
example, this seems quite uniform/regular, so it could be
simplified/generated via TH.

I'll have a look at it for the future, then. I really like automatic code generation, so TH looks really interesting to me.

But, writing my first Haskell program, my first attoparsec parser and my first template haskell program all in one go would have probably been too much :-p

I did in some places, not in others. I will transform all of them in $ then.

Yes, that file is parsed correctly, but I thought it was only a problem in that given point of the file so I handled that with an "optional A.endOfLine".

If the actually issue was having newlines, in general, replaced by ^M, I will write my own endOfLine parser, able to recognize ^M as well.

Thanks,

Michele

[Michele Tartara]

Ok, I'll fix it.

 

Also, I would really prefer if we test all existing test files; we have
multiple ones especially to handle variations in /proc/drbd format.

This has always been my plan as well :-)

I already wrote some more of them, and I'm writing the others. That's what I meant with "More tests to come" in the cover letter.

I just wanted to submit something as soon as I could, in order to get feedback on the coding style, so that I can directly write the rest of the tests (and of the code, in general) with the correct style, without wasting time reformatting them afterwards.

Thanks,

Michele

[Iustin Pop]

http://code.google.com/p/ganeti/wiki/HaskellStyleGuide btw. Not sure if
complete.

> > > +-- | Data type contaning all the data about the status of DRBD
> > > +data DRBDStatus = DRBDStatus { versionInfo::VersionInfo,
> > > + deviceInfo::[DeviceInfo] } deriving (Eq,
> > Show)
> >
> > White space around '::'. Deriving should be on its own line. Docstrings
> > for the actual member types.
> >
>
> Ok for the spaces and and for "deriving" on its own line.
> But what do you mean exactly with "actual member types"? One docstring for
> every constructor?

Yes, for both constructor and record names. Since you have only one
constructor here, we don't need to document it, but we need to document
the record fields:

data DRBDStatus = DRBDStatus
{ versionInfo :: VersionInfo -- ^ The driver version
, deviceInfo :: [DeviceInfo] -- ^ Per-minor information
} deriving (Show, Read, Eq)

Speaking of which. Why is deviceInfo a list? Is the minor index itself
present in DeviceInfo?

Yes, but that might restrict you in the future. You don't need to use
the exact names - here is not 'api' but rather 'apiParser'. So I would
use: apiP, protoP, githashP, etc.

> > > + 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
> > > + )
> >
> > Question here: why did you use 'where …', if the variables are used only
> > once? Just for readability in the actual parser composition?
> >
>
> Exactly. This way it is easy to see what the parser is actually doing (it
> almost looks like a parsing grammar), whereas if I do not name the various
> parts through "where", it looks quite like a mess.

Agreed, makes lot of sense. Thanks!

Totally agreed. Just saying that this particular type (not the others)
seems very 'regular' (if we can say that).

> > OK, one thing that I don't see is the special-casing of some newlines
> > being replaced by '^M' (some kernel versions had this bug). See
> > test/data/proc_drbd83_sync_krnl2.6.39.txt for an example - make sure
> > this parses that correctly as well.
> >
>
> Yes, that file is parsed correctly, but I thought it was only a problem in
> that given point of the file so I handled that with an "optional
> A.endOfLine".
> If the actually issue was having newlines, in general, replaced by ^M, I
> will write my own endOfLine parser, able to recognize ^M as well.

No, if you handle that correctly, it's fine. Was a problem just in that
particular point in the file (well, for each minor it can be a
possibility).

thanks!
iustin

[Iustin Pop]

Oh sorry, I didn't see that (more to come later). Sounds good, thanks!

iustin

[Michele Tartara]

Great! Thanks!

 

> > > +-- | Data type contaning all the data about the status of DRBD
> > > +data DRBDStatus = DRBDStatus { versionInfo::VersionInfo,
> > > +                               deviceInfo::[DeviceInfo] } deriving (Eq,
> > Show)
> >
> > White space around '::'. Deriving should be on its own line. Docstrings
> > for the actual member types.
> >
>
> Ok for the spaces and and for "deriving" on its own line.
> But what do you mean exactly with "actual member types"? One docstring for
> every constructor?

Yes, for both constructor and record names. Since you have only one
constructor here, we don't need to document it, but we need to document
the record fields:

Ok

 

data DRBDStatus = DRBDStatus
                  { versionInfo :: VersionInfo -- ^ The driver version
                  , deviceInfo  :: [DeviceInfo] -- ^ Per-minor information
                  } deriving (Show, Read, Eq)

Speaking of which. Why is deviceInfo a list? Is the minor index itself
present in DeviceInfo?

 

Yes, the minor index is the deviceNumber field of DeviceInfo (probably I should change the name to minorNumber). 

Each "DeviceInfo" represents a single DRBD device, that's why it's a list: you can have multiple DeviceInfos.

Why by the way makes me think that the deviceInfo field of DRBDStatus should be renamed to deviceInfos.

Ok, good idea, thanks!

All the "leaf" types of the parsing tree that are composed by a fixed set of alternatives look like this (ConnectionState, Role, DeviceState, etc...)

It would actually made a lot of sense (for the future data collectors) for me to learn TH to implement them.

> > OK, one thing that I don't see is the special-casing of some newlines
> > being replaced by '^M' (some kernel versions had this bug). See
> > test/data/proc_drbd83_sync_krnl2.6.39.txt for an example - make sure
> > this parses that correctly as well.
> >
>
> Yes, that file is parsed correctly, but I thought it was only a problem in
> that given point of the file so I handled that with an "optional
> A.endOfLine".
> If the actually issue was having newlines, in general, replaced by ^M, I
> will write my own endOfLine parser, able to recognize ^M as well.

No, if you handle that correctly, it's fine. Was a problem just in that
particular point in the file (well, for each minor it can be a
possibility).

Well, of course, being inside the deviceInfoParser, it is able to deal with it every time it appears in a minor.

Ok, then. I will not change it.

Best,

Michele

[Iustin Pop]

Yes. I also wonder if this shouldn't be a Data.IntMap rather than a
list; well, if we never want to lookup a given device by index, then not
necessarily.

> > > > Also, while the code looks good for now, I'll make the note that, for
> > > > example, this seems quite uniform/regular, so it could be
> > > > simplified/generated via TH.
> > > >
> > >
> > > I'll have a look at it for the future, then. I really like automatic code
> > > generation, so TH looks really interesting to me.
> > > But, writing my first Haskell program, my first attoparsec parser and my
> > > first template haskell program all in one go would have probably been too
> > > much :-p
> >
> > Totally agreed. Just saying that this particular type (not the others)
> > seems very 'regular' (if we can say that).
> >
>
> All the "leaf" types of the parsing tree that are composed by a fixed set
> of alternatives look like this (ConnectionState, Role, DeviceState, etc...)
> It would actually made a lot of sense (for the future data collectors) for
> me to learn TH to implement them.

OK, not for now, but let me know when you want to start that, and I
could explain how our TH code is structured.

thanks,
iustin

[Michele Tartara]

It might be a good idea. On the other hand, I don't think the list would be extremely long anyway, so I guess the speedup of not using a list would be quite negligible.

I will think about it while I restructure the rest of the code according to your suggestions.

> > > > Also, while the code looks good for now, I'll make the note that, for
> > > > example, this seems quite uniform/regular, so it could be
> > > > simplified/generated via TH.
> > > >
> > >
> > > I'll have a look at it for the future, then. I really like automatic code
> > > generation, so TH looks really interesting to me.
> > > But, writing my first Haskell program, my first attoparsec parser and my
> > > first template haskell program all in one go would have probably been too
> > > much :-p
> >
> > Totally agreed. Just saying that this particular type (not the others)
> > seems very 'regular' (if we can say that).
> >
>
> All the "leaf" types of the parsing tree that are composed by a fixed set
> of alternatives look like this (ConnectionState, Role, DeviceState, etc...)
> It would actually made a lot of sense (for the future data collectors) for
> me to learn TH to implement them.

OK, not for now, but let me know when you want to start that, and I
could explain how our TH code is structured.

Great, thanks!

Michele

[Iustin Pop]

Oh, speedup was not necessarily my goal. But the fact that a Map
represents the structure of the data better (unique minor indices,
etc.). Whereas a list only says there could be "some" devices.

Anyway, please don't rewrite now, just add a TODO. That's minor point.

thanks,
iustin

[Michele Tartara]

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 <mtar...@google.com>
---

Makefile.am | 8 +
htools/Ganeti/Block/Drbd/Parser.hs | 332 ++++++++++++++++++++++++++++++++++++
htools/Ganeti/Block/Drbd/Types.hs | 191 +++++++++++++++++++++
3 files changed, 531 insertions(+), 0 deletions(-)
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 5ea9925..756b714 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 \
@@ -1610,6 +1616,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..c848b80
--- /dev/null
+++ b/htools/Ganeti/Block/Drbd/Parser.hs
@@ -0,0 +1,332 @@

+{-# 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) where

+
+import Control.Applicative ((<*>), (*>), (<*), (<$>), (<|>), pure, some)
+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
+
+-- | 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.endOfLine
+ 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

+
+-- | 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 = some (A.notChar '\n')

+
+-- | 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
+ *> commaDoubleParser

+ <* skipSpaces

+ <* A.char '('
+ <* commaDoubleParser
+ <* A.char ')'

+ w <- skipSpacesAndString "want:" (
+ skipSpaces

+ *> (Just <$> commaDoubleParser)
+ )
+ <|> 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
+ m = A.char ':' *> A.decimal
+ s = A.char ':' *> A.decimal

+

+-- | 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 recognises '.' as the separator for the decimal part of numbers,
+-- but DRBD uses comma, so we need an ah-hoc parser.
+commaDoubleParser :: Parser Double
+commaDoubleParser = do
+ intPart <- A.decimal
+ _ <- A.char ','
+ decimalPart <- decimalPartParser []
+ pure $ fromIntegral (intPart::Integer) + decimalPart
+

+-- | Helper for commaDoubleParser for computing the decimal part.

+decimalPartParser :: String -> Parser Double
+decimalPartParser acc = goOn <|> finished
+ where goOn = do
+ d <- A.digit
+ decimalPartParser $ acc ++ [d]
+ finished = let digits = read acc
+ numDecimalDigits = length acc
+ decimalPart = digits / (10 ^ numDecimalDigits)
+ in pure decimalPart
+

+-- | 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..8987e54
--- /dev/null
+++ b/htools/Ganeti/Block/Drbd/Types.hs
@@ -0,0 +1,191 @@

+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 :: Double -- ^ Speed of the syncronization
+ , want :: Maybe Double -- ^ 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.7.3

[Michele Tartara]

Signed-off-by: Michele Tartara <mtar...@google.com>
---

Makefile.am | 3 +
htest/Test/Ganeti/Block/Drbd/Parser.hs | 128 ++++++++++++++++++++++++++++++++
htest/test.hs | 2 +
3 files changed, 133 insertions(+), 0 deletions(-)
create mode 100644 htest/Test/Ganeti/Block/Drbd/Parser.hs

diff --git a/Makefile.am b/Makefile.am
index 756b714..af4580b 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -67,6 +67,8 @@ HTOOLS_DIRS = \

htest \
htest/Test \
htest/Test/Ganeti \
+ htest/Test/Ganeti/Block \

+ htest/Test/Ganeti/Block/Drbd \
htest/Test/Ganeti/Confd \
htest/Test/Ganeti/HTools \
htest/Test/Ganeti/HTools/Backend \
@@ -491,6 +493,7 @@ HS_TEST_SRCS = \
htest/Test/Ganeti/Common.hs \
htest/Test/Ganeti/Confd/Utils.hs \
htest/Test/Ganeti/Daemon.hs \
+ htest/Test/Ganeti/Block/Drbd/Parser.hs \
htest/Test/Ganeti/Errors.hs \
htest/Test/Ganeti/HTools/Backend/Simu.hs \
htest/Test/Ganeti/HTools/Backend/Text.hs \
diff --git a/htest/Test/Ganeti/Block/Drbd/Parser.hs b/htest/Test/Ganeti/Block/Drbd/Parser.hs
new file mode 100644
index 0000000..b02165c
--- /dev/null
+++ b/htest/Test/Ganeti/Block/Drbd/Parser.hs
@@ -0,0 +1,128 @@

+module Test.Ganeti.Block.Drbd.Parser (testBlock_DRBDParser) where

+
+import Test.HUnit
+
+import Test.Ganeti.TestHelper
+import Test.Ganeti.TestCommon (readPythonTestData)
+
+import qualified Data.Attoparsec.Text as A
+import Data.Text (pack)
+

+import Ganeti.Block.Drbd.Parser (drbdStatusParser)
+import Ganeti.Block.Drbd.Types
+
+-- | Function for testing whether a file is parsed correctly
+testFile :: String -> DRBDStatus -> Assertion
+testFile fileName expectedContent = do
+ fileContent <- readPythonTestData fileName

+ case A.parseOnly drbdStatusParser $ pack fileContent of
+ Left msg -> assertFailure $ "Parsing failed: " ++ msg

+ Right obtained -> assertEqual fileName expectedContent obtained
+
+case_drbd80_emptyline :: Assertion
+case_drbd80_emptyline = testFile "proc_drbd80-emptyline.txt" $
+ DRBDStatus
+ ( VersionInfo Nothing Nothing Nothing Nothing
+ (Just "5c9f89594553e32adb87d9638dce591782f947e3")
+ (Just "ro...@node1.example.com, 2009-05-22 12:47:52")
+ )
+ [ DeviceInfo 0 Connected (LocalRemote Primary Secondary)

+ (LocalRemote UpToDate UpToDate) 'C' "r---"

+ (PerformanceIndicators 78728316 0 77675644 1277039 254 270 0 0 0 0 Nothing
+ Nothing Nothing)
+ Nothing
+ (Just $ AdditionalInfo 0 61 65657 135 0 0 135)
+ (Just $ AdditionalInfo 0 257 11378843 254 0 0 254),
+ UnconfiguredDevice 1,
+ UnconfiguredDevice 2,
+ UnconfiguredDevice 5,
+ UnconfiguredDevice 6
+ ]
+
+case_drbd8 :: Assertion
+case_drbd8 = testFile "proc_drbd8.txt" $
+ DRBDStatus
+ ( VersionInfo (Just "8.0.12") (Just "86") (Just "86") Nothing
+ (Just "5c9f89594553e32adb87d9638dce591782f947e3")

+ (Just "XXX")
+ )

+ [ DeviceInfo 0 Connected (LocalRemote Primary Secondary)

+ (LocalRemote UpToDate UpToDate) 'C' "r---"

+ (PerformanceIndicators 4375577 0 4446279 674 1067 69 0 0 0 0 Nothing
+ Nothing Nothing)

+ Nothing
+ (Just $ AdditionalInfo 0 61 0 0 0 0 0)

+ (Just $ AdditionalInfo 0 257 793749 1067 0 0 1067),
+ DeviceInfo 1 Connected (LocalRemote Secondary Primary)

+ (LocalRemote UpToDate UpToDate) 'C' "r---"

+ (PerformanceIndicators 738320 0 738320 554400 67 0 0 0 0 0 Nothing
+ Nothing Nothing)

+ Nothing
+ (Just $ AdditionalInfo 0 61 0 0 0 0 0)

+ (Just $ AdditionalInfo 0 257 92464 67 0 0 67),
+ UnconfiguredDevice 2,
+ DeviceInfo 4 WFConnection (LocalRemote Primary Unknown)

+ (LocalRemote UpToDate DUnknown) 'C' "r---"

+ (PerformanceIndicators 738320 0 738320 554400 67 0 0 0 0 0 Nothing
+ Nothing Nothing)

+ Nothing
+ (Just $ AdditionalInfo 0 61 0 0 0 0 0)

+ (Just $ AdditionalInfo 0 257 92464 67 0 0 67),
+ DeviceInfo 5 Connected (LocalRemote Primary Secondary)

+ (LocalRemote UpToDate Diskless) 'C' "r---"

+ (PerformanceIndicators 4375581 0 4446283 674 1069 69 0 0 0 0 Nothing
+ Nothing Nothing)

+ Nothing
+ (Just $ AdditionalInfo 0 61 0 0 0 0 0)

+ (Just $ AdditionalInfo 0 257 793750 1069 0 0 1069),
+ DeviceInfo 6 Connected (LocalRemote Secondary Primary)

+ (LocalRemote Diskless UpToDate) 'C' "r---"

+ (PerformanceIndicators 0 4375581 5186925 327 75 214 0 0 0 0 Nothing
+ Nothing Nothing)

+ Nothing
+ Nothing
+ Nothing,

+ DeviceInfo 7 WFConnection (LocalRemote Secondary Unknown)

+ (LocalRemote UpToDate DUnknown) 'C' "r---"

+ (PerformanceIndicators 0 0 0 0 0 0 0 0 0 0 Nothing Nothing Nothing)

+ Nothing
+ (Just $ AdditionalInfo 0 61 0 0 0 0 0)
+ (Just $ AdditionalInfo 0 257 0 0 0 0 0),

+ DeviceInfo 8 StandAlone (LocalRemote Secondary Unknown)

+ (LocalRemote UpToDate DUnknown) ' ' "r---"

+ (PerformanceIndicators 0 0 0 0 0 0 0 0 0 0 Nothing Nothing Nothing)

+ Nothing
+ (Just $ AdditionalInfo 0 61 0 0 0 0 0)
+ (Just $ AdditionalInfo 0 257 0 0 0 0 0)
+ ]
+
+
+testSuite "Block_DRBDParser"

+ [ 'case_drbd80_emptyline,

+ 'case_drbd8
+ ]
diff --git a/htest/test.hs b/htest/test.hs

index b41fb99..a3906e9 100644

--- a/htest/test.hs
+++ b/htest/test.hs
@@ -32,6 +32,7 @@ import System.Environment (getArgs)
import Test.Ganeti.TestImports ()
import Test.Ganeti.Attoparsec
import Test.Ganeti.BasicTypes

+import Test.Ganeti.Block.Drbd.Parser

[Michele Tartara]

Please, ignore  the previous patch, I will send a new one shortly.

[Michele Tartara]

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 <mtar...@google.com>
---
Makefile.am | 8 +

htools/Ganeti/Block/Drbd/Parser.hs | 333 ++++++++++++++++++++++++++++++++++++
htools/Ganeti/Block/Drbd/Types.hs | 191 +++++++++++++++++++++
3 files changed, 532 insertions(+), 0 deletions(-)

index 0000000..06a5931
--- /dev/null
+++ b/htools/Ganeti/Block/Drbd/Parser.hs
@@ -0,0 +1,333 @@

+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

+ io <- skipSpaces *> ioFlagsParser <* A.skipWhile isBadEndOfLine

+ioFlagsParser = fmap unpack . A.takeWhile $ not . isBadEndOfLine

+ *> commaIntParser

+ <* skipSpaces
+ <* A.char '('

+ <* commaIntParser

+ <* A.char ')'
+ w <- skipSpacesAndString "want:" (
+ skipSpaces

+ *> (Just <$> commaIntParser)

+-- | 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 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..20b57f1

+ , speed :: Int -- ^ Speed of the syncronization
+ , want :: Maybe Int -- ^ Want of the syncronization

[Michele Tartara]

Signed-off-by: Michele Tartara <mtar...@google.com>
---

Makefile.am | 4 +
htest/Test/Ganeti/Block/Drbd/Parser.hs | 330 ++++++++++++++++++++++++++++++++
htest/test.hs | 2 +
test/data/proc_drbd83_sync_want.txt | 9 +
4 files changed, 345 insertions(+), 0 deletions(-)
create mode 100644 htest/Test/Ganeti/Block/Drbd/Parser.hs
create mode 100644 test/data/proc_drbd83_sync_want.txt

diff --git a/Makefile.am b/Makefile.am
index 756b714..33dd0fc 100644

--- a/Makefile.am
+++ b/Makefile.am
@@ -67,6 +67,8 @@ HTOOLS_DIRS = \
htest \
htest/Test \
htest/Test/Ganeti \
+ htest/Test/Ganeti/Block \
+ htest/Test/Ganeti/Block/Drbd \
htest/Test/Ganeti/Confd \
htest/Test/Ganeti/HTools \
htest/Test/Ganeti/HTools/Backend \
@@ -491,6 +493,7 @@ HS_TEST_SRCS = \
htest/Test/Ganeti/Common.hs \
htest/Test/Ganeti/Confd/Utils.hs \
htest/Test/Ganeti/Daemon.hs \
+ htest/Test/Ganeti/Block/Drbd/Parser.hs \
htest/Test/Ganeti/Errors.hs \
htest/Test/Ganeti/HTools/Backend/Simu.hs \
htest/Test/Ganeti/HTools/Backend/Text.hs \

@@ -884,6 +887,7 @@ TEST_FILES = \
test/data/proc_drbd80-emptyline.txt \
test/data/proc_drbd83.txt \
test/data/proc_drbd83_sync.txt \
+ test/data/proc_drbd83_sync_want.txt \
test/data/proc_drbd83_sync_krnl2.6.39.txt \
test/data/sys_drbd_usermode_helper.txt \
test/data/vgreduce-removemissing-2.02.02.txt \

diff --git a/htest/Test/Ganeti/Block/Drbd/Parser.hs b/htest/Test/Ganeti/Block/Drbd/Parser.hs
new file mode 100644

index 0000000..19d6542
--- /dev/null
+++ b/htest/Test/Ganeti/Block/Drbd/Parser.hs
@@ -0,0 +1,330 @@

+import Ganeti.Block.Drbd.Parser (drbdStatusParser, commaIntParser)
+import Ganeti.Block.Drbd.Types
+
+-- | Function for testing whether a file is parsed correctly.

+testFile :: String -> DRBDStatus -> Assertion
+testFile fileName expectedContent = do
+ fileContent <- readPythonTestData fileName
+ case A.parseOnly drbdStatusParser $ pack fileContent of
+ Left msg -> assertFailure $ "Parsing failed: " ++ msg
+ Right obtained -> assertEqual fileName expectedContent obtained
+

+-- | Test a DRBD 8.0 file with an empty line inside.

+case_drbd80_emptyline :: Assertion
+case_drbd80_emptyline = testFile "proc_drbd80-emptyline.txt" $
+ DRBDStatus
+ ( VersionInfo Nothing Nothing Nothing Nothing
+ (Just "5c9f89594553e32adb87d9638dce591782f947e3")
+ (Just "ro...@node1.example.com, 2009-05-22 12:47:52")
+ )
+ [ DeviceInfo 0 Connected (LocalRemote Primary Secondary)
+ (LocalRemote UpToDate UpToDate) 'C' "r---"
+ (PerformanceIndicators 78728316 0 77675644 1277039 254 270 0 0 0 0

+ Nothing Nothing Nothing)
+ Nothing

+ (Just $ AdditionalInfo 0 61 65657 135 0 0 135)
+ (Just $ AdditionalInfo 0 257 11378843 254 0 0 254),
+ UnconfiguredDevice 1,
+ UnconfiguredDevice 2,
+ UnconfiguredDevice 5,
+ UnconfiguredDevice 6
+ ]
+

+-- | Test a DRBD 8.3 file with a NULL caracter inside.
+case_drbd83_sync_krnl2_6_39 :: Assertion
+case_drbd83_sync_krnl2_6_39 = testFile "proc_drbd83_sync_krnl2.6.39.txt" $
+ DRBDStatus
+ ( VersionInfo (Just "8.3.1") (Just "88") (Just "86-89") Nothing
+ (Just "fd40f4a8f9104941537d1afc8521e584a6d3003c")
+ (Just "phil@fat-tyre, 2009-03-27 12:19:49")

+ )
+ [ DeviceInfo 0 Connected (LocalRemote Primary Secondary)

+ (LocalRemote UpToDate UpToDate) 'C' "r----"
+ (PerformanceIndicators 140978 0 9906 131533 27 8 0 0 0 0 (Just 1)
+ (Just 'b') (Just 0))

+ Nothing
+ Nothing
+ Nothing,

+ DeviceInfo 1 Connected (LocalRemote Secondary Primary)
+ (LocalRemote UpToDate UpToDate) 'C' "r---"

+ (PerformanceIndicators 0 140980 140980 0 0 8 0 0 0 0 (Just 1) (Just 'f')
+ (Just 0))

+ Nothing
+ Nothing
+ Nothing,

+ UnconfiguredDevice 2,
+ DeviceInfo 3 SyncSource (LocalRemote Primary Secondary)
+ (LocalRemote UpToDate Inconsistent) 'A' "r-----"
+ (PerformanceIndicators 373888 0 0 374088 0 22 7 27 7 0 (Just 1)
+ (Just 'f') (Just 15358208))
+ (Just $ SyncStatus 2.4 14996 15360 MegaByte (Time 0 4 8) 61736 Nothing
+ KiloByte Second)
+ Nothing
+ Nothing,

+ DeviceInfo 4 WFConnection (LocalRemote Primary Unknown)

+ (LocalRemote UpToDate DUnknown) 'C' "r----"
+ (PerformanceIndicators 140978 0 9906 131534 27 8 0 0 0 0 (Just 1)
+ (Just 'b') (Just 0))

+ Nothing
+ Nothing
+ Nothing

+ ]
+
+-- | Test a DRBD 8.3 file with an ongoing synchronization.
+case_drbd83_sync :: Assertion
+case_drbd83_sync = testFile "proc_drbd83_sync.txt" $
+ DRBDStatus
+ ( VersionInfo (Just "8.3.1") (Just "88") (Just "86-89") Nothing
+ (Just "fd40f4a8f9104941537d1afc8521e584a6d3003c")
+ (Just "phil@fat-tyre, 2009-03-27 12:19:49")

+ )
+ [ DeviceInfo 0 Connected (LocalRemote Primary Secondary)

+ (LocalRemote UpToDate UpToDate) 'C' "r----"
+ (PerformanceIndicators 140978 0 9906 131533 27 8 0 0 0 0 (Just 1)
+ (Just 'b') (Just 0))

+ Nothing
+ Nothing
+ Nothing,

+ DeviceInfo 1 Connected (LocalRemote Secondary Primary)
+ (LocalRemote UpToDate UpToDate) 'C' "r---"

+ (PerformanceIndicators 0 140980 140980 0 0 8 0 0 0 0 (Just 1) (Just 'f')
+ (Just 0))

+ Nothing
+ Nothing
+ Nothing,

+ UnconfiguredDevice 2,
+ DeviceInfo 3 SyncTarget (LocalRemote Primary Secondary)
+ (LocalRemote Inconsistent UpToDate) 'C' "r----"
+ (PerformanceIndicators 0 178176 178176 0 104 42 0 0 0 0 (Just 1)
+ (Just 'b') (Just 346112))
+ (Just $ SyncStatus 34.9 346112 524288 MegaByte (Time 0 0 5) 59392 Nothing
+ KiloByte Second)
+ Nothing
+ Nothing,

+ DeviceInfo 4 WFConnection (LocalRemote Primary Unknown)

+ (LocalRemote UpToDate DUnknown) 'C' "r----"
+ (PerformanceIndicators 140978 0 9906 131534 27 8 0 0 0 0 (Just 1)
+ (Just 'b') (Just 0))

+ Nothing
+ Nothing
+ Nothing

+ ]
+
+-- | Test a DRBD 8.3 file not from git sources, with an ongoing synchronization
+-- and the "want" field
+case_drbd83_sync_want :: Assertion
+case_drbd83_sync_want = testFile "proc_drbd83_sync_want.txt" $
+ DRBDStatus
+ ( VersionInfo (Just "8.3.11") (Just "88") (Just "86-96")
+ (Just "2D876214BAAD53B31ADC1D6")
+ Nothing Nothing
+ )
+ [ DeviceInfo 0 SyncTarget (LocalRemote Secondary Primary)
+ (LocalRemote Inconsistent UpToDate) 'C' "r-----"
+ (PerformanceIndicators 0 460288 460160 0 0 28 2 4 1 0 (Just 1)
+ (Just 'f') (Just 588416))
+ (Just $ SyncStatus 44.4 588416 1048576 KiloByte (Time 0 0 8) 65736
+ (Just 61440) KiloByte Second)
+ Nothing
+ Nothing,

+ UnconfiguredDevice 1,
+ UnconfiguredDevice 2,

+ UnconfiguredDevice 3
+ ]
+
+-- | Test a DRBD 8.3 file.
+case_drbd83 :: Assertion
+case_drbd83 = testFile "proc_drbd83.txt" $
+ DRBDStatus
+ ( VersionInfo (Just "8.3.1") (Just "88") (Just "86-89")
+ Nothing
+ (Just "fd40f4a8f9104941537d1afc8521e584a6d3003c")
+ (Just "phil@fat-tyre, 2009-03-27 12:19:49")

+ )
+ [ DeviceInfo 0 Connected (LocalRemote Primary Secondary)

+ (LocalRemote UpToDate UpToDate) 'C' "r----"
+ (PerformanceIndicators 140978 0 9906 131533 27 8 0 0 0 0 (Just 1)
+ (Just 'b') (Just 0))

+ Nothing
+ Nothing
+ Nothing,

+ DeviceInfo 1 Connected (LocalRemote Secondary Primary)
+ (LocalRemote UpToDate UpToDate) 'C' "r---"

+ (PerformanceIndicators 0 140980 140980 0 0 8 0 0 0 0 (Just 1) (Just 'f')
+ (Just 0))

+ Nothing
+ Nothing
+ Nothing,

+ UnconfiguredDevice 2,
+ DeviceInfo 4 WFConnection (LocalRemote Primary Unknown)

+ (LocalRemote UpToDate DUnknown) 'C' "r----"
+ (PerformanceIndicators 140978 0 9906 131534 27 8 0 0 0 0 (Just 1)
+ (Just 'b') (Just 0))

+ Nothing
+ Nothing
+ Nothing,

+ DeviceInfo 5 Connected (LocalRemote Primary Secondary)

+ (LocalRemote UpToDate Diskless) 'C' "r----"
+ (PerformanceIndicators 140978 0 9906 131533 19 8 0 0 0 0 (Just 1)
+ (Just 'b') (Just 0))

+ Nothing
+ Nothing
+ Nothing,

+ DeviceInfo 6 Connected (LocalRemote Secondary Primary)
+ (LocalRemote Diskless UpToDate) 'C' "r---"

+ (PerformanceIndicators 0 140978 140978 0 0 8 0 0 0 0 (Just 1) (Just 'f')
+ (Just 0))

+ Nothing
+ Nothing
+ Nothing,
+ DeviceInfo 7 WFConnection (LocalRemote Secondary Unknown)
+ (LocalRemote UpToDate DUnknown) 'C' "r---"

+ (PerformanceIndicators 0 140978 140978 0 0 8 0 0 0 0 (Just 1) (Just 'f')
+ (Just 0))

+ Nothing
+ Nothing
+ Nothing,

+ DeviceInfo 8 StandAlone (LocalRemote Secondary Unknown)
+ (LocalRemote UpToDate DUnknown) ' ' "r---"

+ (PerformanceIndicators 0 140978 140978 0 0 8 0 0 0 0 (Just 1)
+ (Just 'f') (Just 0))

+ Nothing
+ Nothing
+ Nothing

+ ]
+
+-- | Test a DRBD 8.0 file with a missing device.

+-- | Function for testing whether a comma-separated integer is parsed correctly.
+testCommaInt :: String -> Int -> Assertion
+testCommaInt numString expectedResult =
+ case A.parseOnly commaIntParser $ pack numString of

+ Left msg -> assertFailure $ "Parsing failed: " ++ msg

+ Right obtained -> assertEqual numString expectedResult obtained
+
+-- | Test if 1 digit integers are recognized correctly.
+case_commaInt_1digit :: Assertion
+case_commaInt_1digit = testCommaInt "1" 1
+
+-- | Test if 3 digits integers are recognized correctly.
+case_commaInt_3digits :: Assertion
+case_commaInt_3digits = testCommaInt "123" 123
+
+-- | Test if integers with 1 comma are recognized correctly.
+case_commaInt_1comma :: Assertion
+case_commaInt_1comma = testCommaInt "61,736" 61736
+
+-- | Test if integers with 2 commas are recognized correctly.
+case_commaInt_2commas :: Assertion
+case_commaInt_2commas = testCommaInt "61,736,123" 61736123
+
+-- | Test if non-triplets are handled correctly (they are assumed NOT being part
+-- of the number).
+case_commaInt_non_triplet :: Assertion
+case_commaInt_non_triplet = testCommaInt "61,736,12" 61736

+
+
+testSuite "Block_DRBDParser"
+ [ 'case_drbd80_emptyline,

+ 'case_drbd83_sync_krnl2_6_39,
+ 'case_drbd83_sync,
+ 'case_drbd83_sync_want,
+ 'case_drbd83,
+ 'case_drbd8,
+ 'case_commaInt_1digit,
+ 'case_commaInt_3digits,
+ 'case_commaInt_1comma,
+ 'case_commaInt_2commas,
+ 'case_commaInt_non_triplet

+ ]
diff --git a/htest/test.hs b/htest/test.hs
index b41fb99..a3906e9 100644
--- a/htest/test.hs
+++ b/htest/test.hs
@@ -32,6 +32,7 @@ import System.Environment (getArgs)
import Test.Ganeti.TestImports ()
import Test.Ganeti.Attoparsec
import Test.Ganeti.BasicTypes
+import Test.Ganeti.Block.Drbd.Parser
import Test.Ganeti.Common
import Test.Ganeti.Confd.Utils
import Test.Ganeti.Daemon
@@ -79,6 +80,7 @@ allTests =
, testCommon
, testConfd_Utils
, testDaemon
+ , testBlock_DRBDParser
, testErrors
, testHTools_Backend_Simu
, testHTools_Backend_Text

diff --git a/test/data/proc_drbd83_sync_want.txt b/test/data/proc_drbd83_sync_want.txt
new file mode 100644
index 0000000..079fc42
--- /dev/null
+++ b/test/data/proc_drbd83_sync_want.txt
@@ -0,0 +1,9 @@
+version: 8.3.11 (api:88/proto:86-96)
+srcversion: 2D876214BAAD53B31ADC1D6
+ 0: cs:SyncTarget ro:Secondary/Primary ds:Inconsistent/UpToDate C r-----
+ ns:0 nr:460288 dw:460160 dr:0 al:0 bm:28 lo:2 pe:4 ua:1 ap:0 ep:1 wo:f oos:588416
+ [=======>............] sync'ed: 44.4% (588416/1048576)K
+ finish: 0:00:08 speed: 65,736 (65,736) want: 61,440 K/sec
+ 1: cs:Unconfigured
+ 2: cs:Unconfigured
+ 3: cs:Unconfigured
--
1.7.7.3

[Iustin Pop]

On Mon, Nov 19, 2012 at 03:19:51PM +0100, Michele Tartara wrote:
> 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 <mtar...@google.com>
> ---
> Makefile.am | 8 +
> htools/Ganeti/Block/Drbd/Parser.hs | 333 ++++++++++++++++++++++++++++++++++++
> htools/Ganeti/Block/Drbd/Types.hs | 191 +++++++++++++++++++++
> 3 files changed, 532 insertions(+), 0 deletions(-)
> create mode 100644 htools/Ganeti/Block/Drbd/Parser.hs
> create mode 100644 htools/Ganeti/Block/Drbd/Types.hs

LGTM, I'll have a few small indentation fixes while pushing:

> +-- | 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 =

Here "where" is indented right under '<*>'…

FYI, for such block-style declarations we use a different style usually:

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

aligned on both the '=' and the '*>'. IMHO it results in _much_ better
readability.

> +-- | 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

Whereas here "where" is much more indented. I'd expect it around the
same level, somewhere under <|>.

And the field comments are usually aligned…

> +-- | 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)

And the fields definitely so.

I'd recommend checking the version I will push against the version you
have, to see the diffs I applied.

thanks,
iustin

[Michele Tartara]

Ok, I will.

Thanks,

Michele

[Iustin Pop]

On Mon, Nov 19, 2012 at 03:19:51PM +0100, Michele Tartara wrote:

> 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 <mtar...@google.com>

One separate comment:

> +-- | 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)

Should this be 'builtBy'?

thanks,
iustin

[Michele Tartara]

According to English, yes, according to /proc/drbd, no.

I guess they mean it in the sense that "This software build was made by..."

But "build by" and not "built by" is what appears in the file.

Thanks,

Michele

[Iustin Pop]

Ack. DRBD use of English aside, should this be builtBy in _our code_?

iustin

[Iustin Pop]

On Mon, Nov 19, 2012 at 03:19:51PM +0100, Michele Tartara wrote:

> 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 <mtar...@google.com>
> ---
> Makefile.am | 8 +
> htools/Ganeti/Block/Drbd/Parser.hs | 333 ++++++++++++++++++++++++++++++++++++
> htools/Ganeti/Block/Drbd/Types.hs | 191 +++++++++++++++++++++
> 3 files changed, 532 insertions(+), 0 deletions(-)
> create mode 100644 htools/Ganeti/Block/Drbd/Parser.hs
> create mode 100644 htools/Ganeti/Block/Drbd/Types.hs

After looking some more at the types, I have some notes. Nothing needs
to change now, just wanted to discuss a bit.

> +-- | 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)

I don't like something about this data type, but not sure why.

The first note would be that both members hold the minor index, but one
of them is declared as normal constructor whereas the other one as
record. Declaring both as record means you could safely always use
'minorNumber' against a device, whatever value it has. Alternatively,
extracting the minor out might make sense as well.

The second part is that ADTs + records do not play very nicely together
in Haskell (the record system is due to an overhaul for ages now). It
would be better to have a separate data type for all the flags/etc,
e.g.:

data ActiveDevice = ActiveDevice { minorNumber, connectionState, etc. }

and then

data DeviceInfo = UnconfiguredDevice | ConfDevice ActiveDevice

The rationale for this is that now you could accidentally ask "resync
(UnconfiguredDevice 0)", which leads to a runtime error; there is a
warning for it but we didn't enable it yet, because then you can't use
accessor functions ever (with multi-constructor types).

This leaves some questions about how do we deal with the minor index,
but would be somewhat cleaner.

…

> +-- | 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)

Hmm, some things are using Int, whereas you use explicitly Integer. Do
you expect 'seconds' to overflow a 32-bit integer, or altenatively, are
you use totalSyncSize won't overflow one?

thanks,
iustin

[Michele Tartara]

I agree, and I think I would go for declaring both as records. I really don't like how easy it is in Haskell to create things without names. It is really handy, but I guess it becomes confusing when you go back and look at your code (or, even worse, somebody else's) after a while.

The second part is that ADTs + records do not play very nicely together
in Haskell (the record system is due to an overhaul for ages now). It
would be better to have a separate data type for all the flags/etc,
e.g.:

data ActiveDevice = ActiveDevice { minorNumber, connectionState, etc. }

and then

data DeviceInfo = UnconfiguredDevice | ConfDevice ActiveDevice

The rationale for this is that now you could accidentally ask "resync
(UnconfiguredDevice 0)", which leads to a runtime error; there is a
warning for it but we didn't enable it yet, because then you can't use
accessor functions ever (with multi-constructor types).

This leaves some questions about how do we deal with the minor index,
but would be somewhat cleaner.

I see... I had no idea about this.

 

…

You're right, they should be reversed.

I will probably send a patch for this soon.

Thanks,

Michele

[Iustin Pop]

On Mon, Nov 19, 2012 at 03:20:36PM +0100, Michele Tartara wrote:
> Signed-off-by: Michele Tartara <mtar...@google.com>
> ---
> Makefile.am | 4 +
> htest/Test/Ganeti/Block/Drbd/Parser.hs | 330 ++++++++++++++++++++++++++++++++
> htest/test.hs | 2 +
> test/data/proc_drbd83_sync_want.txt | 9 +
> 4 files changed, 345 insertions(+), 0 deletions(-)
> create mode 100644 htest/Test/Ganeti/Block/Drbd/Parser.hs
> create mode 100644 test/data/proc_drbd83_sync_want.txt

LGTM, some comments:

>
> diff --git a/Makefile.am b/Makefile.am
> index 756b714..33dd0fc 100644
> --- a/Makefile.am
> +++ b/Makefile.am
> @@ -67,6 +67,8 @@ HTOOLS_DIRS = \
> htest \
> htest/Test \
> htest/Test/Ganeti \
> + htest/Test/Ganeti/Block \
> + htest/Test/Ganeti/Block/Drbd \
> htest/Test/Ganeti/Confd \
> htest/Test/Ganeti/HTools \
> htest/Test/Ganeti/HTools/Backend \
> @@ -491,6 +493,7 @@ HS_TEST_SRCS = \
> htest/Test/Ganeti/Common.hs \
> htest/Test/Ganeti/Confd/Utils.hs \
> htest/Test/Ganeti/Daemon.hs \
> + htest/Test/Ganeti/Block/Drbd/Parser.hs \

This is not sorted correctly.

> htest/Test/Ganeti/Errors.hs \
> htest/Test/Ganeti/HTools/Backend/Simu.hs \
> htest/Test/Ganeti/HTools/Backend/Text.hs \
> @@ -884,6 +887,7 @@ TEST_FILES = \
> test/data/proc_drbd80-emptyline.txt \
> test/data/proc_drbd83.txt \
> test/data/proc_drbd83_sync.txt \
> + test/data/proc_drbd83_sync_want.txt \
> test/data/proc_drbd83_sync_krnl2.6.39.txt \
> test/data/sys_drbd_usermode_helper.txt \
> test/data/vgreduce-removemissing-2.02.02.txt \

…

I see only classical (HUnit) tests here, whereas a pure function like
commaIntParser should be an excellent target for quickcheck tests.

So the question is: what properties can you say about commaIntParser?

For example, case_commaInt_3digits as written today is very
"suboptimal", what you want to say: every integer between 100 and 999
should be parsed back as itself:

prop_commaInt_3digits :: Property
prop_commaInt_3digits =
forAll (choose (100, 999)) $ \i ->
testCommaIntProperty (show i) i

I suspect similar things can be said about 1, 2, 3, … N commas as well.

I'll push this patch for now, but this is an immediate TODO.

thanks,
iustin

[Michele Tartara]

It was in the correct place when the file was named DRBDParser.hs, then I forgot to move it. Sorry.

Ok. I'm on it.

Thanks,

Michele