Revision c5f6cba2
b/Makefile.am | ||
---|---|---|
63 | 63 |
HS_DIRS = \ |
64 | 64 |
src \ |
65 | 65 |
src/Ganeti \ |
66 |
src/Ganeti/Block \ |
|
67 |
src/Ganeti/Block/Diskstats \ |
|
68 |
src/Ganeti/Block/Drbd \ |
|
69 | 66 |
src/Ganeti/Confd \ |
70 | 67 |
src/Ganeti/Curl \ |
71 | 68 |
src/Ganeti/DataCollectors \ |
... | ... | |
76 | 73 |
src/Ganeti/Hypervisor/Xen \ |
77 | 74 |
src/Ganeti/Monitoring \ |
78 | 75 |
src/Ganeti/Query \ |
76 |
src/Ganeti/Storage \ |
|
77 |
src/Ganeti/Storage/Diskstats \ |
|
78 |
src/Ganeti/Storage/Drbd \ |
|
79 | 79 |
test/hs \ |
80 | 80 |
test/hs/Test \ |
81 | 81 |
test/hs/Test/Ganeti \ |
82 |
test/hs/Test/Ganeti/Block \
|
|
83 |
test/hs/Test/Ganeti/Block/Diskstats \
|
|
84 |
test/hs/Test/Ganeti/Block/Drbd \
|
|
82 |
test/hs/Test/Ganeti/Storage \
|
|
83 |
test/hs/Test/Ganeti/Storage/Diskstats \
|
|
84 |
test/hs/Test/Ganeti/Storage/Drbd \
|
|
85 | 85 |
test/hs/Test/Ganeti/Confd \ |
86 | 86 |
test/hs/Test/Ganeti/HTools \ |
87 | 87 |
test/hs/Test/Ganeti/HTools/Backend \ |
... | ... | |
533 | 533 |
$(patsubst src.%,--exclude Test.%,$(subst /,.,$(patsubst %.hs,%, $(HS_LIB_SRCS)))) |
534 | 534 |
|
535 | 535 |
HS_LIB_SRCS = \ |
536 |
src/Ganeti/Block/Diskstats/Parser.hs \ |
|
537 |
src/Ganeti/Block/Diskstats/Types.hs \ |
|
538 |
src/Ganeti/Block/Drbd/Parser.hs \ |
|
539 |
src/Ganeti/Block/Drbd/Types.hs \ |
|
540 | 536 |
src/Ganeti/BasicTypes.hs \ |
541 | 537 |
src/Ganeti/Common.hs \ |
542 | 538 |
src/Ganeti/Compat.hs \ |
... | ... | |
611 | 607 |
src/Ganeti/Rpc.hs \ |
612 | 608 |
src/Ganeti/Runtime.hs \ |
613 | 609 |
src/Ganeti/Ssconf.hs \ |
610 |
src/Ganeti/Storage/Diskstats/Parser.hs \ |
|
611 |
src/Ganeti/Storage/Diskstats/Types.hs \ |
|
612 |
src/Ganeti/Storage/Drbd/Parser.hs \ |
|
613 |
src/Ganeti/Storage/Drbd/Types.hs \ |
|
614 | 614 |
src/Ganeti/THH.hs \ |
615 | 615 |
src/Ganeti/Types.hs \ |
616 | 616 |
src/Ganeti/Utils.hs |
... | ... | |
618 | 618 |
HS_TEST_SRCS = \ |
619 | 619 |
test/hs/Test/Ganeti/Attoparsec.hs \ |
620 | 620 |
test/hs/Test/Ganeti/BasicTypes.hs \ |
621 |
test/hs/Test/Ganeti/Block/Diskstats/Parser.hs \ |
|
622 |
test/hs/Test/Ganeti/Block/Drbd/Parser.hs \ |
|
623 |
test/hs/Test/Ganeti/Block/Drbd/Types.hs \ |
|
624 | 621 |
test/hs/Test/Ganeti/Common.hs \ |
625 | 622 |
test/hs/Test/Ganeti/Confd/Types.hs \ |
626 | 623 |
test/hs/Test/Ganeti/Confd/Utils.hs \ |
... | ... | |
652 | 649 |
test/hs/Test/Ganeti/Rpc.hs \ |
653 | 650 |
test/hs/Test/Ganeti/Runtime.hs \ |
654 | 651 |
test/hs/Test/Ganeti/Ssconf.hs \ |
652 |
test/hs/Test/Ganeti/Storage/Diskstats/Parser.hs \ |
|
653 |
test/hs/Test/Ganeti/Storage/Drbd/Parser.hs \ |
|
654 |
test/hs/Test/Ganeti/Storage/Drbd/Types.hs \ |
|
655 | 655 |
test/hs/Test/Ganeti/THH.hs \ |
656 | 656 |
test/hs/Test/Ganeti/TestCommon.hs \ |
657 | 657 |
test/hs/Test/Ganeti/TestHTools.hs \ |
/dev/null | ||
---|---|---|
1 |
{-# LANGUAGE OverloadedStrings #-} |
|
2 |
{-| Diskstats proc file parser |
|
3 |
|
|
4 |
This module holds the definition of the parser that extracts status |
|
5 |
information about the disks of the system from the @/proc/diskstats@ file. |
|
6 |
|
|
7 |
-} |
|
8 |
{- |
|
9 |
|
|
10 |
Copyright (C) 2013 Google Inc. |
|
11 |
|
|
12 |
This program is free software; you can redistribute it and/or modify |
|
13 |
it under the terms of the GNU General Public License as published by |
|
14 |
the Free Software Foundation; either version 2 of the License, or |
|
15 |
(at your option) any later version. |
|
16 |
|
|
17 |
This program is distributed in the hope that it will be useful, but |
|
18 |
WITHOUT ANY WARRANTY; without even the implied warranty of |
|
19 |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
|
20 |
General Public License for more details. |
|
21 |
|
|
22 |
You should have received a copy of the GNU General Public License |
|
23 |
along with this program; if not, write to the Free Software |
|
24 |
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
|
25 |
02110-1301, USA. |
|
26 |
|
|
27 |
-} |
|
28 |
module Ganeti.Block.Diskstats.Parser (diskstatsParser) where |
|
29 |
|
|
30 |
import Control.Applicative ((<*>), (*>), (<*), (<$>)) |
|
31 |
import qualified Data.Attoparsec.Text as A |
|
32 |
import qualified Data.Attoparsec.Combinator as AC |
|
33 |
import Data.Attoparsec.Text (Parser) |
|
34 |
import Data.Text (unpack) |
|
35 |
|
|
36 |
import Ganeti.Block.Diskstats.Types |
|
37 |
|
|
38 |
-- * Utility functions |
|
39 |
|
|
40 |
-- | Our own space-skipping function, because A.skipSpace also skips |
|
41 |
-- newline characters. It skips ZERO or more spaces, so it does not |
|
42 |
-- fail if there are no spaces. |
|
43 |
skipSpaces :: Parser () |
|
44 |
skipSpaces = A.skipWhile A.isHorizontalSpace |
|
45 |
|
|
46 |
-- | A parser recognizing a number preceeded by spaces. |
|
47 |
numberP :: Parser Int |
|
48 |
numberP = skipSpaces *> A.decimal |
|
49 |
|
|
50 |
-- | A parser recognizing a word preceded by spaces, and closed by a space. |
|
51 |
stringP :: Parser String |
|
52 |
stringP = skipSpaces *> fmap unpack (A.takeWhile $ not . A.isHorizontalSpace) |
|
53 |
|
|
54 |
-- * Parser implementation |
|
55 |
|
|
56 |
-- | The parser for one line of the diskstatus file. |
|
57 |
oneDiskstatsParser :: Parser Diskstats |
|
58 |
oneDiskstatsParser = |
|
59 |
Diskstats <$> numberP <*> numberP <*> stringP <*> numberP <*> numberP |
|
60 |
<*> numberP <*> numberP <*> numberP <*> numberP <*> numberP <*> numberP |
|
61 |
<*> numberP <*> numberP <*> numberP <* A.endOfLine |
|
62 |
|
|
63 |
-- | The parser for a whole diskstatus file. |
|
64 |
diskstatsParser :: Parser [Diskstats] |
|
65 |
diskstatsParser = oneDiskstatsParser `AC.manyTill` A.endOfInput |
/dev/null | ||
---|---|---|
1 |
{-# LANGUAGE TemplateHaskell #-} |
|
2 |
{-| Diskstats data types |
|
3 |
|
|
4 |
This module holds the definition of the data types describing the status of the |
|
5 |
disks according to the information contained in @/proc/diskstats@. |
|
6 |
|
|
7 |
-} |
|
8 |
{- |
|
9 |
|
|
10 |
Copyright (C) 2013 Google Inc. |
|
11 |
|
|
12 |
This program is free software; you can redistribute it and/or modify |
|
13 |
it under the terms of the GNU General Public License as published by |
|
14 |
the Free Software Foundation; either version 2 of the License, or |
|
15 |
(at your option) any later version. |
|
16 |
|
|
17 |
This program is distributed in the hope that it will be useful, but |
|
18 |
WITHOUT ANY WARRANTY; without even the implied warranty of |
|
19 |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
|
20 |
General Public License for more details. |
|
21 |
|
|
22 |
You should have received a copy of the GNU General Public License |
|
23 |
along with this program; if not, write to the Free Software |
|
24 |
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
|
25 |
02110-1301, USA. |
|
26 |
|
|
27 |
-} |
|
28 |
module Ganeti.Block.Diskstats.Types |
|
29 |
( Diskstats(..) |
|
30 |
) where |
|
31 |
|
|
32 |
import Ganeti.THH |
|
33 |
|
|
34 |
|
|
35 |
-- | This is the format of the report produced by each data collector. |
|
36 |
$(buildObject "Diskstats" "ds" |
|
37 |
[ simpleField "major" [t| Int |] |
|
38 |
, simpleField "minor" [t| Int |] |
|
39 |
, simpleField "name" [t| String |] |
|
40 |
, simpleField "readsNum" [t| Int |] |
|
41 |
, simpleField "mergedReads" [t| Int |] |
|
42 |
, simpleField "secRead" [t| Int |] |
|
43 |
, simpleField "timeRead" [t| Int |] |
|
44 |
, simpleField "writes" [t| Int |] |
|
45 |
, simpleField "mergedWrites" [t| Int |] |
|
46 |
, simpleField "secWritten" [t| Int |] |
|
47 |
, simpleField "timeWrite" [t| Int |] |
|
48 |
, simpleField "ios" [t| Int |] |
|
49 |
, simpleField "timeIO" [t| Int |] |
|
50 |
, simpleField "wIOmillis" [t| Int |] |
|
51 |
]) |
/dev/null | ||
---|---|---|
1 |
{-# LANGUAGE OverloadedStrings #-} |
|
2 |
{-| DRBD proc file parser |
|
3 |
|
|
4 |
This module holds the definition of the parser that extracts status |
|
5 |
information from the DRBD proc file. |
|
6 |
|
|
7 |
-} |
|
8 |
{- |
|
9 |
|
|
10 |
Copyright (C) 2012 Google Inc. |
|
11 |
|
|
12 |
This program is free software; you can redistribute it and/or modify |
|
13 |
it under the terms of the GNU General Public License as published by |
|
14 |
the Free Software Foundation; either version 2 of the License, or |
|
15 |
(at your option) any later version. |
|
16 |
|
|
17 |
This program is distributed in the hope that it will be useful, but |
|
18 |
WITHOUT ANY WARRANTY; without even the implied warranty of |
|
19 |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
|
20 |
General Public License for more details. |
|
21 |
|
|
22 |
You should have received a copy of the GNU General Public License |
|
23 |
along with this program; if not, write to the Free Software |
|
24 |
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
|
25 |
02110-1301, USA. |
|
26 |
|
|
27 |
-} |
|
28 |
module Ganeti.Block.Drbd.Parser (drbdStatusParser, commaIntParser) where |
|
29 |
|
|
30 |
import Control.Applicative ((<*>), (*>), (<*), (<$>), (<|>), pure) |
|
31 |
import qualified Data.Attoparsec.Text as A |
|
32 |
import qualified Data.Attoparsec.Combinator as AC |
|
33 |
import Data.Attoparsec.Text (Parser) |
|
34 |
import Data.List |
|
35 |
import Data.Maybe |
|
36 |
import Data.Text (Text, unpack) |
|
37 |
|
|
38 |
import Ganeti.Block.Drbd.Types |
|
39 |
|
|
40 |
-- | Our own space-skipping function, because A.skipSpace also skips |
|
41 |
-- newline characters. It skips ZERO or more spaces, so it does not |
|
42 |
-- fail if there are no spaces. |
|
43 |
skipSpaces :: Parser () |
|
44 |
skipSpaces = A.skipWhile A.isHorizontalSpace |
|
45 |
|
|
46 |
-- | Skips spaces and the given string, then executes a parser and |
|
47 |
-- returns its result. |
|
48 |
skipSpacesAndString :: Text -> Parser a -> Parser a |
|
49 |
skipSpacesAndString s parser = |
|
50 |
skipSpaces |
|
51 |
*> A.string s |
|
52 |
*> parser |
|
53 |
|
|
54 |
-- | Predicate verifying (potentially bad) end of lines |
|
55 |
isBadEndOfLine :: Char -> Bool |
|
56 |
isBadEndOfLine c = (c == '\0') || A.isEndOfLine c |
|
57 |
|
|
58 |
-- | Takes a parser and returns it with the content wrapped in a Maybe |
|
59 |
-- object. The resulting parser never fails, but contains Nothing if |
|
60 |
-- it couldn't properly parse the string. |
|
61 |
optional :: Parser a -> Parser (Maybe a) |
|
62 |
optional parser = (Just <$> parser) <|> pure Nothing |
|
63 |
|
|
64 |
-- | The parser for a whole DRBD status file. |
|
65 |
drbdStatusParser :: [DrbdInstMinor] -> Parser DRBDStatus |
|
66 |
drbdStatusParser instMinor = |
|
67 |
DRBDStatus <$> versionInfoParser |
|
68 |
<*> deviceParser instMinor `AC.manyTill` A.endOfInput |
|
69 |
<* A.endOfInput |
|
70 |
|
|
71 |
-- | The parser for the version information lines. |
|
72 |
versionInfoParser :: Parser VersionInfo |
|
73 |
versionInfoParser = do |
|
74 |
versionF <- optional versionP |
|
75 |
apiF <- optional apiP |
|
76 |
protoF <- optional protoP |
|
77 |
srcVersionF <- optional srcVersion |
|
78 |
ghF <- fmap unpack <$> optional gh |
|
79 |
builderF <- fmap unpack <$> optional builder |
|
80 |
if isNothing versionF |
|
81 |
&& isNothing apiF |
|
82 |
&& isNothing protoF |
|
83 |
&& isNothing srcVersionF |
|
84 |
&& isNothing ghF |
|
85 |
&& isNothing builderF |
|
86 |
then fail "versionInfo" |
|
87 |
else pure $ VersionInfo versionF apiF protoF srcVersionF ghF builderF |
|
88 |
|
|
89 |
where versionP = |
|
90 |
A.string "version:" |
|
91 |
*> skipSpaces |
|
92 |
*> fmap unpack (A.takeWhile $ not . A.isHorizontalSpace) |
|
93 |
apiP = |
|
94 |
skipSpacesAndString "(api:" . fmap unpack $ A.takeWhile (/= '/') |
|
95 |
protoP = |
|
96 |
A.string "/proto:" |
|
97 |
*> fmap Data.Text.unpack (A.takeWhile (/= ')')) |
|
98 |
<* A.takeTill A.isEndOfLine <* A.endOfLine |
|
99 |
srcVersion = |
|
100 |
A.string "srcversion:" |
|
101 |
*> AC.skipMany1 A.space |
|
102 |
*> fmap unpack (A.takeTill A.isEndOfLine) |
|
103 |
<* A.endOfLine |
|
104 |
gh = |
|
105 |
A.string "GIT-hash:" |
|
106 |
*> skipSpaces |
|
107 |
*> A.takeWhile (not . A.isHorizontalSpace) |
|
108 |
builder = |
|
109 |
skipSpacesAndString "build by" $ |
|
110 |
skipSpaces |
|
111 |
*> A.takeTill A.isEndOfLine |
|
112 |
<* A.endOfLine |
|
113 |
|
|
114 |
-- | The parser for a (multi-line) string representing a device. |
|
115 |
deviceParser :: [DrbdInstMinor] -> Parser DeviceInfo |
|
116 |
deviceParser instMinor = do |
|
117 |
deviceNum <- skipSpaces *> A.decimal <* A.char ':' |
|
118 |
cs <- skipSpacesAndString "cs:" connStateParser |
|
119 |
if cs == Unconfigured |
|
120 |
then do |
|
121 |
_ <- additionalEOL |
|
122 |
return $ UnconfiguredDevice deviceNum |
|
123 |
else do |
|
124 |
ro <- skipSpaces *> skipRoleString *> localRemoteParser roleParser |
|
125 |
ds <- skipSpacesAndString "ds:" $ localRemoteParser diskStateParser |
|
126 |
replicProtocol <- A.space *> A.anyChar |
|
127 |
io <- skipSpaces *> ioFlagsParser <* A.skipWhile isBadEndOfLine |
|
128 |
pIndicators <- perfIndicatorsParser |
|
129 |
syncS <- conditionalSyncStatusParser cs |
|
130 |
reS <- optional resyncParser |
|
131 |
act <- optional actLogParser |
|
132 |
_ <- additionalEOL |
|
133 |
let inst = find ((deviceNum ==) . dimMinor) instMinor |
|
134 |
iName = fmap dimInstName inst |
|
135 |
return $ DeviceInfo deviceNum cs ro ds replicProtocol io pIndicators |
|
136 |
syncS reS act iName |
|
137 |
|
|
138 |
where conditionalSyncStatusParser SyncSource = Just <$> syncStatusParser |
|
139 |
conditionalSyncStatusParser SyncTarget = Just <$> syncStatusParser |
|
140 |
conditionalSyncStatusParser _ = pure Nothing |
|
141 |
skipRoleString = A.string "ro:" <|> A.string "st:" |
|
142 |
resyncParser = skipSpacesAndString "resync:" additionalInfoParser |
|
143 |
actLogParser = skipSpacesAndString "act_log:" additionalInfoParser |
|
144 |
additionalEOL = A.skipWhile A.isEndOfLine |
|
145 |
|
|
146 |
-- | The parser for the connection state. |
|
147 |
connStateParser :: Parser ConnState |
|
148 |
connStateParser = |
|
149 |
standAlone |
|
150 |
<|> disconnecting |
|
151 |
<|> unconnected |
|
152 |
<|> timeout |
|
153 |
<|> brokenPipe |
|
154 |
<|> networkFailure |
|
155 |
<|> protocolError |
|
156 |
<|> tearDown |
|
157 |
<|> wfConnection |
|
158 |
<|> wfReportParams |
|
159 |
<|> connected |
|
160 |
<|> startingSyncS |
|
161 |
<|> startingSyncT |
|
162 |
<|> wfBitMapS |
|
163 |
<|> wfBitMapT |
|
164 |
<|> wfSyncUUID |
|
165 |
<|> syncSource |
|
166 |
<|> syncTarget |
|
167 |
<|> pausedSyncS |
|
168 |
<|> pausedSyncT |
|
169 |
<|> verifyS |
|
170 |
<|> verifyT |
|
171 |
<|> unconfigured |
|
172 |
where standAlone = A.string "StandAlone" *> pure StandAlone |
|
173 |
disconnecting = A.string "Disconnectiog" *> pure Disconnecting |
|
174 |
unconnected = A.string "Unconnected" *> pure Unconnected |
|
175 |
timeout = A.string "Timeout" *> pure Timeout |
|
176 |
brokenPipe = A.string "BrokenPipe" *> pure BrokenPipe |
|
177 |
networkFailure = A.string "NetworkFailure" *> pure NetworkFailure |
|
178 |
protocolError = A.string "ProtocolError" *> pure ProtocolError |
|
179 |
tearDown = A.string "TearDown" *> pure TearDown |
|
180 |
wfConnection = A.string "WFConnection" *> pure WFConnection |
|
181 |
wfReportParams = A.string "WFReportParams" *> pure WFReportParams |
|
182 |
connected = A.string "Connected" *> pure Connected |
|
183 |
startingSyncS = A.string "StartingSyncS" *> pure StartingSyncS |
|
184 |
startingSyncT = A.string "StartingSyncT" *> pure StartingSyncT |
|
185 |
wfBitMapS = A.string "WFBitMapS" *> pure WFBitMapS |
|
186 |
wfBitMapT = A.string "WFBitMapT" *> pure WFBitMapT |
|
187 |
wfSyncUUID = A.string "WFSyncUUID" *> pure WFSyncUUID |
|
188 |
syncSource = A.string "SyncSource" *> pure SyncSource |
|
189 |
syncTarget = A.string "SyncTarget" *> pure SyncTarget |
|
190 |
pausedSyncS = A.string "PausedSyncS" *> pure PausedSyncS |
|
191 |
pausedSyncT = A.string "PausedSyncT" *> pure PausedSyncT |
|
192 |
verifyS = A.string "VerifyS" *> pure VerifyS |
|
193 |
verifyT = A.string "VerifyT" *> pure VerifyT |
|
194 |
unconfigured = A.string "Unconfigured" *> pure Unconfigured |
|
195 |
|
|
196 |
-- | Parser for recognizing strings describing two elements of the |
|
197 |
-- same type separated by a '/'. The first one is considered local, |
|
198 |
-- the second remote. |
|
199 |
localRemoteParser :: Parser a -> Parser (LocalRemote a) |
|
200 |
localRemoteParser parser = LocalRemote <$> parser <*> (A.char '/' *> parser) |
|
201 |
|
|
202 |
-- | The parser for resource roles. |
|
203 |
roleParser :: Parser Role |
|
204 |
roleParser = |
|
205 |
primary |
|
206 |
<|> secondary |
|
207 |
<|> unknown |
|
208 |
where primary = A.string "Primary" *> pure Primary |
|
209 |
secondary = A.string "Secondary" *> pure Secondary |
|
210 |
unknown = A.string "Unknown" *> pure Unknown |
|
211 |
|
|
212 |
-- | The parser for disk states. |
|
213 |
diskStateParser :: Parser DiskState |
|
214 |
diskStateParser = |
|
215 |
diskless |
|
216 |
<|> attaching |
|
217 |
<|> failed |
|
218 |
<|> negotiating |
|
219 |
<|> inconsistent |
|
220 |
<|> outdated |
|
221 |
<|> dUnknown |
|
222 |
<|> consistent |
|
223 |
<|> upToDate |
|
224 |
where diskless = A.string "Diskless" *> pure Diskless |
|
225 |
attaching = A.string "Attaching" *> pure Attaching |
|
226 |
failed = A.string "Failed" *> pure Failed |
|
227 |
negotiating = A.string "Negotiating" *> pure Negotiating |
|
228 |
inconsistent = A.string "Inconsistent" *> pure Inconsistent |
|
229 |
outdated = A.string "Outdated" *> pure Outdated |
|
230 |
dUnknown = A.string "DUnknown" *> pure DUnknown |
|
231 |
consistent = A.string "Consistent" *> pure Consistent |
|
232 |
upToDate = A.string "UpToDate" *> pure UpToDate |
|
233 |
|
|
234 |
-- | The parser for I/O flags. |
|
235 |
ioFlagsParser :: Parser String |
|
236 |
ioFlagsParser = fmap unpack . A.takeWhile $ not . isBadEndOfLine |
|
237 |
|
|
238 |
-- | The parser for performance indicators. |
|
239 |
perfIndicatorsParser :: Parser PerfIndicators |
|
240 |
perfIndicatorsParser = |
|
241 |
PerfIndicators |
|
242 |
<$> skipSpacesAndString "ns:" A.decimal |
|
243 |
<*> skipSpacesAndString "nr:" A.decimal |
|
244 |
<*> skipSpacesAndString "dw:" A.decimal |
|
245 |
<*> skipSpacesAndString "dr:" A.decimal |
|
246 |
<*> skipSpacesAndString "al:" A.decimal |
|
247 |
<*> skipSpacesAndString "bm:" A.decimal |
|
248 |
<*> skipSpacesAndString "lo:" A.decimal |
|
249 |
<*> skipSpacesAndString "pe:" A.decimal |
|
250 |
<*> skipSpacesAndString "ua:" A.decimal |
|
251 |
<*> skipSpacesAndString "ap:" A.decimal |
|
252 |
<*> optional (skipSpacesAndString "ep:" A.decimal) |
|
253 |
<*> optional (skipSpacesAndString "wo:" A.anyChar) |
|
254 |
<*> optional (skipSpacesAndString "oos:" A.decimal) |
|
255 |
<* skipSpaces <* A.endOfLine |
|
256 |
|
|
257 |
-- | The parser for the syncronization status. |
|
258 |
syncStatusParser :: Parser SyncStatus |
|
259 |
syncStatusParser = do |
|
260 |
_ <- statusBarParser |
|
261 |
percent <- |
|
262 |
skipSpacesAndString "sync'ed:" $ skipSpaces *> A.double <* A.char '%' |
|
263 |
partSyncSize <- skipSpaces *> A.char '(' *> A.decimal |
|
264 |
totSyncSize <- A.char '/' *> A.decimal <* A.char ')' |
|
265 |
sizeUnit <- sizeUnitParser <* optional A.endOfLine |
|
266 |
timeToEnd <- skipSpacesAndString "finish:" $ skipSpaces *> timeParser |
|
267 |
sp <- |
|
268 |
skipSpacesAndString "speed:" $ |
|
269 |
skipSpaces |
|
270 |
*> commaIntParser |
|
271 |
<* skipSpaces |
|
272 |
<* A.char '(' |
|
273 |
<* commaIntParser |
|
274 |
<* A.char ')' |
|
275 |
w <- skipSpacesAndString "want:" ( |
|
276 |
skipSpaces |
|
277 |
*> (Just <$> commaIntParser) |
|
278 |
) |
|
279 |
<|> pure Nothing |
|
280 |
sSizeUnit <- skipSpaces *> sizeUnitParser |
|
281 |
sTimeUnit <- A.char '/' *> timeUnitParser |
|
282 |
_ <- A.endOfLine |
|
283 |
return $ |
|
284 |
SyncStatus percent partSyncSize totSyncSize sizeUnit timeToEnd sp w |
|
285 |
sSizeUnit sTimeUnit |
|
286 |
|
|
287 |
-- | The parser for recognizing (and discarding) the sync status bar. |
|
288 |
statusBarParser :: Parser () |
|
289 |
statusBarParser = |
|
290 |
skipSpaces |
|
291 |
*> A.char '[' |
|
292 |
*> A.skipWhile (== '=') |
|
293 |
*> A.skipWhile (== '>') |
|
294 |
*> A.skipWhile (== '.') |
|
295 |
*> A.char ']' |
|
296 |
*> pure () |
|
297 |
|
|
298 |
-- | The parser for recognizing data size units (only the ones |
|
299 |
-- actually found in DRBD files are implemented). |
|
300 |
sizeUnitParser :: Parser SizeUnit |
|
301 |
sizeUnitParser = |
|
302 |
kilobyte |
|
303 |
<|> megabyte |
|
304 |
where kilobyte = A.string "K" *> pure KiloByte |
|
305 |
megabyte = A.string "M" *> pure MegaByte |
|
306 |
|
|
307 |
-- | The parser for recognizing time (hh:mm:ss). |
|
308 |
timeParser :: Parser Time |
|
309 |
timeParser = Time <$> h <*> m <*> s |
|
310 |
where h = A.decimal :: Parser Int |
|
311 |
m = A.char ':' *> A.decimal :: Parser Int |
|
312 |
s = A.char ':' *> A.decimal :: Parser Int |
|
313 |
|
|
314 |
-- | The parser for recognizing time units (only the ones actually |
|
315 |
-- found in DRBD files are implemented). |
|
316 |
timeUnitParser :: Parser TimeUnit |
|
317 |
timeUnitParser = second |
|
318 |
where second = A.string "sec" *> pure Second |
|
319 |
|
|
320 |
-- | Haskell does not recognise ',' as the thousands separator every 3 |
|
321 |
-- digits but DRBD uses it, so we need an ah-hoc parser. |
|
322 |
-- If a number beginning with more than 3 digits without a comma is |
|
323 |
-- parsed, only the first 3 digits are considered to be valid, the rest |
|
324 |
-- is not consumed, and left for further parsing. |
|
325 |
commaIntParser :: Parser Int |
|
326 |
commaIntParser = do |
|
327 |
first <- |
|
328 |
AC.count 3 A.digit <|> AC.count 2 A.digit <|> AC.count 1 A.digit |
|
329 |
allDigits <- commaIntHelper (read first) |
|
330 |
pure allDigits |
|
331 |
|
|
332 |
-- | Helper (triplet parser) for the commaIntParser |
|
333 |
commaIntHelper :: Int -> Parser Int |
|
334 |
commaIntHelper acc = nextTriplet <|> end |
|
335 |
where nextTriplet = do |
|
336 |
_ <- A.char ',' |
|
337 |
triplet <- AC.count 3 A.digit |
|
338 |
commaIntHelper $ acc * 1000 + (read triplet :: Int) |
|
339 |
end = pure acc :: Parser Int |
|
340 |
|
|
341 |
-- | Parser for the additional information provided by DRBD <= 8.0. |
|
342 |
additionalInfoParser::Parser AdditionalInfo |
|
343 |
additionalInfoParser = AdditionalInfo |
|
344 |
<$> skipSpacesAndString "used:" A.decimal |
|
345 |
<*> (A.char '/' *> A.decimal) |
|
346 |
<*> skipSpacesAndString "hits:" A.decimal |
|
347 |
<*> skipSpacesAndString "misses:" A.decimal |
|
348 |
<*> skipSpacesAndString "starving:" A.decimal |
|
349 |
<*> skipSpacesAndString "dirty:" A.decimal |
|
350 |
<*> skipSpacesAndString "changed:" A.decimal |
|
351 |
<* A.endOfLine |
/dev/null | ||
---|---|---|
1 |
{-| DRBD Data Types |
|
2 |
|
|
3 |
This module holds the definition of the data types describing the status of |
|
4 |
DRBD. |
|
5 |
|
|
6 |
-} |
|
7 |
{- |
|
8 |
|
|
9 |
Copyright (C) 2012 Google Inc. |
|
10 |
|
|
11 |
This program is free software; you can redistribute it and/or modify |
|
12 |
it under the terms of the GNU General Public License as published by |
|
13 |
the Free Software Foundation; either version 2 of the License, or |
|
14 |
(at your option) any later version. |
|
15 |
|
|
16 |
This program is distributed in the hope that it will be useful, but |
|
17 |
WITHOUT ANY WARRANTY; without even the implied warranty of |
|
18 |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
|
19 |
General Public License for more details. |
|
20 |
|
|
21 |
You should have received a copy of the GNU General Public License |
|
22 |
along with this program; if not, write to the Free Software |
|
23 |
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
|
24 |
02110-1301, USA. |
|
25 |
|
|
26 |
-} |
|
27 |
module Ganeti.Block.Drbd.Types |
|
28 |
( DRBDStatus(..) |
|
29 |
, VersionInfo(..) |
|
30 |
, DeviceInfo(..) |
|
31 |
, ConnState(..) |
|
32 |
, LocalRemote(..) |
|
33 |
, Role(..) |
|
34 |
, DiskState(..) |
|
35 |
, PerfIndicators(..) |
|
36 |
, SyncStatus(..) |
|
37 |
, SizeUnit(..) |
|
38 |
, Time(..) |
|
39 |
, TimeUnit(..) |
|
40 |
, AdditionalInfo(..) |
|
41 |
, DrbdInstMinor(..) |
|
42 |
) where |
|
43 |
|
|
44 |
import Control.Monad |
|
45 |
import Text.JSON |
|
46 |
import Text.Printf |
|
47 |
|
|
48 |
import Ganeti.JSON |
|
49 |
|
|
50 |
--TODO: consider turning deviceInfos into an IntMap |
|
51 |
-- | Data type contaning all the data about the status of DRBD. |
|
52 |
data DRBDStatus = |
|
53 |
DRBDStatus |
|
54 |
{ versionInfo :: VersionInfo -- ^ Version information about DRBD |
|
55 |
, deviceInfos :: [DeviceInfo] -- ^ Per-minor information |
|
56 |
} deriving (Eq, Show) |
|
57 |
|
|
58 |
-- | The DRBDStatus instance of JSON. |
|
59 |
instance JSON DRBDStatus where |
|
60 |
showJSON d = makeObj |
|
61 |
[ ("versionInfo", showJSON $ versionInfo d) |
|
62 |
, ("deviceInfos", showJSONs $ deviceInfos d) |
|
63 |
] |
|
64 |
|
|
65 |
readJSON = error "JSON read instance not implemented for type DRBDStatus" |
|
66 |
|
|
67 |
-- | Data type describing the DRBD version. |
|
68 |
data VersionInfo = |
|
69 |
VersionInfo |
|
70 |
{ version :: Maybe String -- ^ DRBD driver version |
|
71 |
, api :: Maybe String -- ^ The api version |
|
72 |
, proto :: Maybe String -- ^ The protocol version |
|
73 |
, srcversion :: Maybe String -- ^ The version of the source files |
|
74 |
, gitHash :: Maybe String -- ^ Git hash of the source files |
|
75 |
, buildBy :: Maybe String -- ^ Who built the binary (and, |
|
76 |
-- optionally, when) |
|
77 |
} deriving (Eq, Show) |
|
78 |
|
|
79 |
-- | The VersionInfo instance of JSON. |
|
80 |
instance JSON VersionInfo where |
|
81 |
showJSON (VersionInfo versionF apiF protoF srcversionF gitHashF buildByF) = |
|
82 |
optFieldsToObj |
|
83 |
[ optionalJSField "version" versionF |
|
84 |
, optionalJSField "api" apiF |
|
85 |
, optionalJSField "proto" protoF |
|
86 |
, optionalJSField "srcversion" srcversionF |
|
87 |
, optionalJSField "gitHash" gitHashF |
|
88 |
, optionalJSField "buildBy" buildByF |
|
89 |
] |
|
90 |
|
|
91 |
readJSON = error "JSON read instance not implemented for type VersionInfo" |
|
92 |
|
|
93 |
-- | Data type describing a device. |
|
94 |
data DeviceInfo = |
|
95 |
UnconfiguredDevice Int -- ^ An DRBD minor marked as unconfigured |
|
96 |
| -- | A configured DRBD minor |
|
97 |
DeviceInfo |
|
98 |
{ minorNumber :: Int -- ^ The minor index of the device |
|
99 |
, connectionState :: ConnState -- ^ State of the connection |
|
100 |
, resourceRoles :: LocalRemote Role -- ^ Roles of the resources |
|
101 |
, diskStates :: LocalRemote DiskState -- ^ Status of the disks |
|
102 |
, replicationProtocol :: Char -- ^ The replication protocol |
|
103 |
-- being used |
|
104 |
, ioFlags :: String -- ^ The input/output flags |
|
105 |
, perfIndicators :: PerfIndicators -- ^ Performance indicators |
|
106 |
, syncStatus :: Maybe SyncStatus -- ^ The status of the |
|
107 |
-- syncronization of the disk |
|
108 |
-- (only if it is happening) |
|
109 |
, resync :: Maybe AdditionalInfo -- ^ Additional info by DRBD 8.0 |
|
110 |
, actLog :: Maybe AdditionalInfo -- ^ Additional info by DRBD 8.0 |
|
111 |
, instName :: Maybe String -- ^ The name of the associated |
|
112 |
-- instance |
|
113 |
} deriving (Eq, Show) |
|
114 |
|
|
115 |
-- | The DeviceInfo instance of JSON. |
|
116 |
instance JSON DeviceInfo where |
|
117 |
showJSON (UnconfiguredDevice num) = makeObj |
|
118 |
[ ("minor", showJSON num) |
|
119 |
, ("connectionState", showJSON Unconfigured) |
|
120 |
] |
|
121 |
showJSON (DeviceInfo minorNumberF connectionStateF (LocalRemote |
|
122 |
localRole remoteRole) (LocalRemote localState remoteState) |
|
123 |
replicProtocolF ioFlagsF perfIndicatorsF syncStatusF _ _ instNameF) = |
|
124 |
optFieldsToObj |
|
125 |
[ Just ("minor", showJSON minorNumberF) |
|
126 |
, Just ("connectionState", showJSON connectionStateF) |
|
127 |
, Just ("localRole", showJSON localRole) |
|
128 |
, Just ("remoteRole", showJSON remoteRole) |
|
129 |
, Just ("localState", showJSON localState) |
|
130 |
, Just ("remoteState", showJSON remoteState) |
|
131 |
, Just ("replicationProtocol", showJSON replicProtocolF) |
|
132 |
, Just ("ioFlags", showJSON ioFlagsF) |
|
133 |
, Just ("perfIndicators", showJSON perfIndicatorsF) |
|
134 |
, optionalJSField "syncStatus" syncStatusF |
|
135 |
, Just ("instance", maybe JSNull showJSON instNameF) |
|
136 |
] |
|
137 |
|
|
138 |
readJSON = error "JSON read instance not implemented for type DeviceInfo" |
|
139 |
|
|
140 |
-- | Data type describing the state of the connection. |
|
141 |
data ConnState |
|
142 |
= StandAlone -- ^ No network configuration available |
|
143 |
| Disconnecting -- ^ Temporary state during disconnection |
|
144 |
| Unconnected -- ^ Prior to a connection attempt |
|
145 |
| Timeout -- ^ Following a timeout in the communication |
|
146 |
| BrokenPipe -- ^ After the connection to the peer was lost |
|
147 |
| NetworkFailure -- ^ After the connection to the partner was lost |
|
148 |
| ProtocolError -- ^ After the connection to the partner was lost |
|
149 |
| TearDown -- ^ The peer is closing the connection |
|
150 |
| WFConnection -- ^ Waiting for the peer to become visible |
|
151 |
| WFReportParams -- ^ Waiting for first packet from peer |
|
152 |
| Connected -- ^ Connected, data mirroring active |
|
153 |
| StartingSyncS -- ^ Source of a full sync started by admin |
|
154 |
| StartingSyncT -- ^ Target of a full sync started by admin |
|
155 |
| WFBitMapS -- ^ Source of a just starting partial sync |
|
156 |
| WFBitMapT -- ^ Target of a just starting partial sync |
|
157 |
| WFSyncUUID -- ^ Synchronization is about to begin |
|
158 |
| SyncSource -- ^ Source of a running synchronization |
|
159 |
| SyncTarget -- ^ Target of a running synchronization |
|
160 |
| PausedSyncS -- ^ Source of a paused synchronization |
|
161 |
| PausedSyncT -- ^ Target of a paused synchronization |
|
162 |
| VerifyS -- ^ Source of a running verification |
|
163 |
| VerifyT -- ^ Target of a running verification |
|
164 |
| Unconfigured -- ^ The device is not configured |
|
165 |
deriving (Show, Eq) |
|
166 |
|
|
167 |
-- | The ConnState instance of JSON. |
|
168 |
instance JSON ConnState where |
|
169 |
showJSON = showJSON . show |
|
170 |
|
|
171 |
readJSON = error "JSON read instance not implemented for type ConnState" |
|
172 |
|
|
173 |
-- | Algebraic data type describing something that has a local and a remote |
|
174 |
-- value. |
|
175 |
data LocalRemote a = |
|
176 |
LocalRemote |
|
177 |
{ local :: a -- ^ The local value |
|
178 |
, remote :: a -- ^ The remote value |
|
179 |
} deriving (Eq, Show) |
|
180 |
|
|
181 |
-- | Data type describing. |
|
182 |
data Role = Primary -- ^ The device role is primary |
|
183 |
| Secondary -- ^ The device role is secondary |
|
184 |
| Unknown -- ^ The device role is unknown |
|
185 |
deriving (Eq, Show) |
|
186 |
|
|
187 |
-- | The Role instance of JSON. |
|
188 |
instance JSON Role where |
|
189 |
showJSON = showJSON . show |
|
190 |
|
|
191 |
readJSON = error "JSON read instance not implemented for type Role" |
|
192 |
|
|
193 |
-- | Data type describing disk states. |
|
194 |
data DiskState |
|
195 |
= Diskless -- ^ No local block device assigned to the DRBD driver |
|
196 |
| Attaching -- ^ Reading meta data |
|
197 |
| Failed -- ^ I/O failure |
|
198 |
| Negotiating -- ^ "Attach" on an already-connected device |
|
199 |
| Inconsistent -- ^ The data is inconsistent between nodes. |
|
200 |
| Outdated -- ^ Data consistent but outdated |
|
201 |
| DUnknown -- ^ No network connection available |
|
202 |
| Consistent -- ^ Consistent data, but without network connection |
|
203 |
| UpToDate -- ^ Consistent, up-to-date. This is the normal state |
|
204 |
deriving (Eq, Show) |
|
205 |
|
|
206 |
-- | The DiskState instance of JSON. |
|
207 |
instance JSON DiskState where |
|
208 |
showJSON = showJSON . show |
|
209 |
|
|
210 |
readJSON = error "JSON read instance not implemented for type DiskState" |
|
211 |
|
|
212 |
-- | Data type containing data about performance indicators. |
|
213 |
data PerfIndicators = PerfIndicators |
|
214 |
{ networkSend :: Int -- ^ KiB of data sent on the network |
|
215 |
, networkReceive :: Int -- ^ KiB of data received from the network |
|
216 |
, diskWrite :: Int -- ^ KiB of data written on local disk |
|
217 |
, diskRead :: Int -- ^ KiB of data read from local disk |
|
218 |
, activityLog :: Int -- ^ Number of updates of the activity log |
|
219 |
, bitMap :: Int -- ^ Number of updates to the bitmap area of the metadata |
|
220 |
, localCount :: Int -- ^ Number of open requests to the local I/O subsystem |
|
221 |
, pending :: Int -- ^ Num of requests sent to the partner but not yet answered |
|
222 |
, unacknowledged :: Int -- ^ Num of requests received by the partner but still |
|
223 |
-- to be answered |
|
224 |
, applicationPending :: Int -- ^ Num of block I/O requests forwarded |
|
225 |
-- to DRBD but that have not yet been |
|
226 |
-- answered |
|
227 |
, epochs :: Maybe Int -- ^ Number of epoch objects |
|
228 |
, writeOrder :: Maybe Char -- ^ Currently used write ordering method |
|
229 |
, outOfSync :: Maybe Int -- ^ KiB of storage currently out of sync |
|
230 |
} deriving (Eq, Show) |
|
231 |
|
|
232 |
-- | The PerfIndicators instance of JSON. |
|
233 |
instance JSON PerfIndicators where |
|
234 |
showJSON p = optFieldsToObj |
|
235 |
[ Just ("networkSend", showJSON $ networkSend p) |
|
236 |
, Just ("networkReceive", showJSON $ networkReceive p) |
|
237 |
, Just ("diskWrite", showJSON $ diskWrite p) |
|
238 |
, Just ("diskRead", showJSON $ diskRead p) |
|
239 |
, Just ("activityLog", showJSON $ activityLog p) |
|
240 |
, Just ("bitMap", showJSON $ bitMap p) |
|
241 |
, Just ("localCount", showJSON $ localCount p) |
|
242 |
, Just ("pending", showJSON $ pending p) |
|
243 |
, Just ("unacknowledged", showJSON $ unacknowledged p) |
|
244 |
, Just ("applicationPending", showJSON $ applicationPending p) |
|
245 |
, optionalJSField "epochs" $ epochs p |
|
246 |
, optionalJSField "writeOrder" $ writeOrder p |
|
247 |
, optionalJSField "outOfSync" $ outOfSync p |
|
248 |
] |
|
249 |
|
|
250 |
readJSON = error "JSON read instance not implemented for type PerfIndicators" |
|
251 |
|
|
252 |
-- | Data type containing data about the synchronization status of a device. |
|
253 |
data SyncStatus = |
|
254 |
SyncStatus |
|
255 |
{ percentage :: Double -- ^ Percentage of syncronized data |
|
256 |
, partialSyncSize :: Int -- ^ Numerator of the fraction of synced data |
|
257 |
, totalSyncSize :: Int -- ^ Denominator of the fraction of |
|
258 |
-- synced data |
|
259 |
, syncUnit :: SizeUnit -- ^ Measurement unit of the previous |
|
260 |
-- fraction |
|
261 |
, timeToFinish :: Time -- ^ Expected time before finishing |
|
262 |
-- the syncronization |
|
263 |
, speed :: Int -- ^ Speed of the syncronization |
|
264 |
, want :: Maybe Int -- ^ Want of the syncronization |
|
265 |
, speedSizeUnit :: SizeUnit -- ^ Size unit of the speed |
|
266 |
, speedTimeUnit :: TimeUnit -- ^ Time unit of the speed |
|
267 |
} deriving (Eq, Show) |
|
268 |
|
|
269 |
-- | The SyncStatus instance of JSON. |
|
270 |
instance JSON SyncStatus where |
|
271 |
showJSON s = optFieldsToObj |
|
272 |
[ Just ("percentage", showJSON $ percentage s) |
|
273 |
, Just ("progress", showJSON $ show (partialSyncSize s) ++ "/" ++ |
|
274 |
show (totalSyncSize s)) |
|
275 |
, Just ("progressUnit", showJSON $ syncUnit s) |
|
276 |
, Just ("timeToFinish", showJSON $ timeToFinish s) |
|
277 |
, Just ("speed", showJSON $ speed s) |
|
278 |
, optionalJSField "want" $ want s |
|
279 |
, Just ("speedUnit", showJSON $ show (speedSizeUnit s) ++ "/" ++ |
|
280 |
show (speedTimeUnit s)) |
|
281 |
] |
|
282 |
|
|
283 |
readJSON = error "JSON read instance not implemented for type SyncStatus" |
|
284 |
|
|
285 |
-- | Data type describing a size unit for memory. |
|
286 |
data SizeUnit = KiloByte | MegaByte deriving (Eq, Show) |
|
287 |
|
|
288 |
-- | The SizeUnit instance of JSON. |
|
289 |
instance JSON SizeUnit where |
|
290 |
showJSON = showJSON . show |
|
291 |
|
|
292 |
readJSON = error "JSON read instance not implemented for type SizeUnit" |
|
293 |
|
|
294 |
-- | Data type describing a time (hh:mm:ss). |
|
295 |
data Time = Time |
|
296 |
{ hour :: Int |
|
297 |
, min :: Int |
|
298 |
, sec :: Int |
|
299 |
} deriving (Eq, Show) |
|
300 |
|
|
301 |
-- | The Time instance of JSON. |
|
302 |
instance JSON Time where |
|
303 |
showJSON (Time h m s) = showJSON (printf "%02d:%02d:%02d" h m s :: String) |
|
304 |
|
|
305 |
readJSON = error "JSON read instance not implemented for type Time" |
|
306 |
|
|
307 |
-- | Data type describing a time unit. |
|
308 |
data TimeUnit = Second deriving (Eq, Show) |
|
309 |
|
|
310 |
-- | The TimeUnit instance of JSON. |
|
311 |
instance JSON TimeUnit where |
|
312 |
showJSON Second = showJSON "Second" |
|
313 |
|
|
314 |
readJSON = error "JSON read instance not implemented for type TimeUnit" |
|
315 |
|
|
316 |
-- | Additional device-specific cache-like information produced by |
|
317 |
-- drbd <= 8.0. |
|
318 |
-- |
|
319 |
-- Internal debug information exported by old DRBD versions. |
|
320 |
-- Undocumented both in DRBD and here. |
|
321 |
data AdditionalInfo = AdditionalInfo |
|
322 |
{ partialUsed :: Int |
|
323 |
, totalUsed :: Int |
|
324 |
, hits :: Int |
|
325 |
, misses :: Int |
|
326 |
, starving :: Int |
|
327 |
, dirty :: Int |
|
328 |
, changed :: Int |
|
329 |
} deriving (Eq, Show) |
|
330 |
|
|
331 |
-- | Data type representing the pairing of a DRBD minor with an instance. |
|
332 |
data DrbdInstMinor = DrbdInstMinor |
|
333 |
{ dimNode :: String |
|
334 |
, dimMinor :: Int |
|
335 |
, dimInstName :: String |
|
336 |
, dimDiskIdx :: String |
|
337 |
, dimRole :: String |
|
338 |
, dimPeer :: String |
|
339 |
} deriving (Show) |
|
340 |
|
|
341 |
-- | The DrbdInstMinor instance of JSON. |
|
342 |
instance JSON DrbdInstMinor where |
|
343 |
showJSON (DrbdInstMinor a b c d e f) = |
|
344 |
JSArray |
|
345 |
[ showJSON a |
|
346 |
, showJSON b |
|
347 |
, showJSON c |
|
348 |
, showJSON d |
|
349 |
, showJSON e |
|
350 |
, showJSON f |
|
351 |
] |
|
352 |
readJSON (JSArray [a, b, c, d, e, f]) = |
|
353 |
DrbdInstMinor |
|
354 |
`fmap` readJSON a |
|
355 |
`ap` readJSON b |
|
356 |
`ap` readJSON c |
|
357 |
`ap` readJSON d |
|
358 |
`ap` readJSON e |
|
359 |
`ap` readJSON f |
|
360 |
readJSON _ = fail "Unable to read a DrbdInstMinor" |
b/src/Ganeti/DataCollectors/Diskstats.hs | ||
---|---|---|
45 | 45 |
|
46 | 46 |
import qualified Ganeti.BasicTypes as BT |
47 | 47 |
import qualified Ganeti.Constants as C |
48 |
import Ganeti.Block.Diskstats.Parser(diskstatsParser)
|
|
48 |
import Ganeti.Storage.Diskstats.Parser(diskstatsParser)
|
|
49 | 49 |
import Ganeti.Common |
50 | 50 |
import Ganeti.DataCollectors.CLI |
51 | 51 |
import Ganeti.DataCollectors.Types |
b/src/Ganeti/DataCollectors/Drbd.hs | ||
---|---|---|
47 | 47 |
|
48 | 48 |
import qualified Ganeti.BasicTypes as BT |
49 | 49 |
import qualified Ganeti.Constants as C |
50 |
import Ganeti.Block.Drbd.Parser(drbdStatusParser)
|
|
51 |
import Ganeti.Block.Drbd.Types
|
|
50 |
import Ganeti.Storage.Drbd.Parser(drbdStatusParser)
|
|
51 |
import Ganeti.Storage.Drbd.Types
|
|
52 | 52 |
import Ganeti.Common |
53 | 53 |
import Ganeti.Confd.Client |
54 | 54 |
import Ganeti.Confd.Types |
b/src/Ganeti/Storage/Diskstats/Parser.hs | ||
---|---|---|
1 |
{-# LANGUAGE OverloadedStrings #-} |
|
2 |
{-| Diskstats proc file parser |
|
3 |
|
|
4 |
This module holds the definition of the parser that extracts status |
|
5 |
information about the disks of the system from the @/proc/diskstats@ file. |
|
6 |
|
|
7 |
-} |
|
8 |
{- |
|
9 |
|
|
10 |
Copyright (C) 2013 Google Inc. |
|
11 |
|
|
12 |
This program is free software; you can redistribute it and/or modify |
|
13 |
it under the terms of the GNU General Public License as published by |
|
14 |
the Free Software Foundation; either version 2 of the License, or |
|
15 |
(at your option) any later version. |
|
16 |
|
|
17 |
This program is distributed in the hope that it will be useful, but |
|
18 |
WITHOUT ANY WARRANTY; without even the implied warranty of |
|
19 |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
|
20 |
General Public License for more details. |
|
21 |
|
|
22 |
You should have received a copy of the GNU General Public License |
|
23 |
along with this program; if not, write to the Free Software |
|
24 |
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
|
25 |
02110-1301, USA. |
|
26 |
|
|
27 |
-} |
|
28 |
module Ganeti.Storage.Diskstats.Parser (diskstatsParser) where |
|
29 |
|
|
30 |
import Control.Applicative ((<*>), (*>), (<*), (<$>)) |
|
31 |
import qualified Data.Attoparsec.Text as A |
|
32 |
import qualified Data.Attoparsec.Combinator as AC |
|
33 |
import Data.Attoparsec.Text (Parser) |
|
34 |
import Data.Text (unpack) |
|
35 |
|
|
36 |
import Ganeti.Storage.Diskstats.Types |
|
37 |
|
|
38 |
-- * Utility functions |
|
39 |
|
|
40 |
-- | Our own space-skipping function, because A.skipSpace also skips |
|
41 |
-- newline characters. It skips ZERO or more spaces, so it does not |
|
42 |
-- fail if there are no spaces. |
|
43 |
skipSpaces :: Parser () |
|
44 |
skipSpaces = A.skipWhile A.isHorizontalSpace |
|
45 |
|
|
46 |
-- | A parser recognizing a number preceeded by spaces. |
|
47 |
numberP :: Parser Int |
|
48 |
numberP = skipSpaces *> A.decimal |
|
49 |
|
|
50 |
-- | A parser recognizing a word preceded by spaces, and closed by a space. |
|
51 |
stringP :: Parser String |
|
52 |
stringP = skipSpaces *> fmap unpack (A.takeWhile $ not . A.isHorizontalSpace) |
|
53 |
|
|
54 |
-- * Parser implementation |
|
55 |
|
|
56 |
-- | The parser for one line of the diskstatus file. |
|
57 |
oneDiskstatsParser :: Parser Diskstats |
|
58 |
oneDiskstatsParser = |
|
59 |
Diskstats <$> numberP <*> numberP <*> stringP <*> numberP <*> numberP |
|
60 |
<*> numberP <*> numberP <*> numberP <*> numberP <*> numberP <*> numberP |
|
61 |
<*> numberP <*> numberP <*> numberP <* A.endOfLine |
|
62 |
|
|
63 |
-- | The parser for a whole diskstatus file. |
|
64 |
diskstatsParser :: Parser [Diskstats] |
|
65 |
diskstatsParser = oneDiskstatsParser `AC.manyTill` A.endOfInput |
b/src/Ganeti/Storage/Diskstats/Types.hs | ||
---|---|---|
1 |
{-# LANGUAGE TemplateHaskell #-} |
|
2 |
{-| Diskstats data types |
|
3 |
|
|
4 |
This module holds the definition of the data types describing the status of the |
|
5 |
disks according to the information contained in @/proc/diskstats@. |
|
6 |
|
|
7 |
-} |
|
8 |
{- |
|
9 |
|
|
10 |
Copyright (C) 2013 Google Inc. |
|
11 |
|
|
12 |
This program is free software; you can redistribute it and/or modify |
|
13 |
it under the terms of the GNU General Public License as published by |
|
14 |
the Free Software Foundation; either version 2 of the License, or |
|
15 |
(at your option) any later version. |
|
16 |
|
|
17 |
This program is distributed in the hope that it will be useful, but |
|
18 |
WITHOUT ANY WARRANTY; without even the implied warranty of |
|
19 |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
|
20 |
General Public License for more details. |
|
21 |
|
|
22 |
You should have received a copy of the GNU General Public License |
|
23 |
along with this program; if not, write to the Free Software |
|
24 |
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
|
25 |
02110-1301, USA. |
|
26 |
|
|
27 |
-} |
|
28 |
module Ganeti.Storage.Diskstats.Types |
|
29 |
( Diskstats(..) |
|
30 |
) where |
|
31 |
|
|
32 |
import Ganeti.THH |
|
33 |
|
|
34 |
|
|
35 |
-- | This is the format of the report produced by each data collector. |
|
36 |
$(buildObject "Diskstats" "ds" |
|
37 |
[ simpleField "major" [t| Int |] |
|
38 |
, simpleField "minor" [t| Int |] |
|
39 |
, simpleField "name" [t| String |] |
|
40 |
, simpleField "readsNum" [t| Int |] |
|
41 |
, simpleField "mergedReads" [t| Int |] |
|
42 |
, simpleField "secRead" [t| Int |] |
|
43 |
, simpleField "timeRead" [t| Int |] |
|
44 |
, simpleField "writes" [t| Int |] |
|
45 |
, simpleField "mergedWrites" [t| Int |] |
|
46 |
, simpleField "secWritten" [t| Int |] |
|
47 |
, simpleField "timeWrite" [t| Int |] |
|
48 |
, simpleField "ios" [t| Int |] |
|
49 |
, simpleField "timeIO" [t| Int |] |
|
50 |
, simpleField "wIOmillis" [t| Int |] |
|
51 |
]) |
b/src/Ganeti/Storage/Drbd/Parser.hs | ||
---|---|---|
1 |
{-# LANGUAGE OverloadedStrings #-} |
|
2 |
{-| DRBD proc file parser |
|
3 |
|
|
4 |
This module holds the definition of the parser that extracts status |
|
5 |
information from the DRBD proc file. |
|
6 |
|
|
7 |
-} |
|
8 |
{- |
|
9 |
|
|
10 |
Copyright (C) 2012 Google Inc. |
|
11 |
|
|
12 |
This program is free software; you can redistribute it and/or modify |
|
13 |
it under the terms of the GNU General Public License as published by |
|
14 |
the Free Software Foundation; either version 2 of the License, or |
|
15 |
(at your option) any later version. |
|
16 |
|
|
17 |
This program is distributed in the hope that it will be useful, but |
|
18 |
WITHOUT ANY WARRANTY; without even the implied warranty of |
|
19 |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
|
20 |
General Public License for more details. |
|
21 |
|
|
22 |
You should have received a copy of the GNU General Public License |
|
23 |
along with this program; if not, write to the Free Software |
|
24 |
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
|
25 |
02110-1301, USA. |
|
26 |
|
|
27 |
-} |
|
28 |
module Ganeti.Storage.Drbd.Parser (drbdStatusParser, commaIntParser) where |
|
29 |
|
|
30 |
import Control.Applicative ((<*>), (*>), (<*), (<$>), (<|>), pure) |
|
31 |
import qualified Data.Attoparsec.Text as A |
|
32 |
import qualified Data.Attoparsec.Combinator as AC |
|
33 |
import Data.Attoparsec.Text (Parser) |
|
34 |
import Data.List |
|
35 |
import Data.Maybe |
|
36 |
import Data.Text (Text, unpack) |
|
37 |
|
|
38 |
import Ganeti.Storage.Drbd.Types |
|
39 |
|
|
40 |
-- | Our own space-skipping function, because A.skipSpace also skips |
|
41 |
-- newline characters. It skips ZERO or more spaces, so it does not |
|
42 |
-- fail if there are no spaces. |
|
43 |
skipSpaces :: Parser () |
|
44 |
skipSpaces = A.skipWhile A.isHorizontalSpace |
|
45 |
|
|
46 |
-- | Skips spaces and the given string, then executes a parser and |
|
47 |
-- returns its result. |
|
48 |
skipSpacesAndString :: Text -> Parser a -> Parser a |
|
49 |
skipSpacesAndString s parser = |
|
50 |
skipSpaces |
|
51 |
*> A.string s |
|
52 |
*> parser |
|
53 |
|
|
54 |
-- | Predicate verifying (potentially bad) end of lines |
|
55 |
isBadEndOfLine :: Char -> Bool |
|
56 |
isBadEndOfLine c = (c == '\0') || A.isEndOfLine c |
|
57 |
|
|
58 |
-- | Takes a parser and returns it with the content wrapped in a Maybe |
|
59 |
-- object. The resulting parser never fails, but contains Nothing if |
|
60 |
-- it couldn't properly parse the string. |
|
61 |
optional :: Parser a -> Parser (Maybe a) |
|
62 |
optional parser = (Just <$> parser) <|> pure Nothing |
|
63 |
|
|
64 |
-- | The parser for a whole DRBD status file. |
|
65 |
drbdStatusParser :: [DrbdInstMinor] -> Parser DRBDStatus |
|
66 |
drbdStatusParser instMinor = |
|
67 |
DRBDStatus <$> versionInfoParser |
|
68 |
<*> deviceParser instMinor `AC.manyTill` A.endOfInput |
|
69 |
<* A.endOfInput |
|
70 |
|
|
71 |
-- | The parser for the version information lines. |
|
72 |
versionInfoParser :: Parser VersionInfo |
|
73 |
versionInfoParser = do |
|
74 |
versionF <- optional versionP |
|
75 |
apiF <- optional apiP |
|
76 |
protoF <- optional protoP |
|
77 |
srcVersionF <- optional srcVersion |
|
78 |
ghF <- fmap unpack <$> optional gh |
|
79 |
builderF <- fmap unpack <$> optional builder |
|
80 |
if isNothing versionF |
|
81 |
&& isNothing apiF |
|
82 |
&& isNothing protoF |
|
83 |
&& isNothing srcVersionF |
|
84 |
&& isNothing ghF |
|
85 |
&& isNothing builderF |
|
86 |
then fail "versionInfo" |
|
87 |
else pure $ VersionInfo versionF apiF protoF srcVersionF ghF builderF |
|
88 |
|
|
89 |
where versionP = |
|
90 |
A.string "version:" |
|
91 |
*> skipSpaces |
|
92 |
*> fmap unpack (A.takeWhile $ not . A.isHorizontalSpace) |
|
93 |
apiP = |
|
94 |
skipSpacesAndString "(api:" . fmap unpack $ A.takeWhile (/= '/') |
|
95 |
protoP = |
|
96 |
A.string "/proto:" |
|
97 |
*> fmap Data.Text.unpack (A.takeWhile (/= ')')) |
|
98 |
<* A.takeTill A.isEndOfLine <* A.endOfLine |
|
99 |
srcVersion = |
|
100 |
A.string "srcversion:" |
|
101 |
*> AC.skipMany1 A.space |
|
102 |
*> fmap unpack (A.takeTill A.isEndOfLine) |
|
103 |
<* A.endOfLine |
|
104 |
gh = |
|
105 |
A.string "GIT-hash:" |
|
106 |
*> skipSpaces |
|
107 |
*> A.takeWhile (not . A.isHorizontalSpace) |
|
108 |
builder = |
|
109 |
skipSpacesAndString "build by" $ |
|
110 |
skipSpaces |
|
111 |
*> A.takeTill A.isEndOfLine |
|
112 |
<* A.endOfLine |
|
113 |
|
|
114 |
-- | The parser for a (multi-line) string representing a device. |
|
115 |
deviceParser :: [DrbdInstMinor] -> Parser DeviceInfo |
|
116 |
deviceParser instMinor = do |
|
117 |
deviceNum <- skipSpaces *> A.decimal <* A.char ':' |
|
118 |
cs <- skipSpacesAndString "cs:" connStateParser |
|
119 |
if cs == Unconfigured |
|
120 |
then do |
|
121 |
_ <- additionalEOL |
|
122 |
return $ UnconfiguredDevice deviceNum |
|
123 |
else do |
|
124 |
ro <- skipSpaces *> skipRoleString *> localRemoteParser roleParser |
|
125 |
ds <- skipSpacesAndString "ds:" $ localRemoteParser diskStateParser |
|
126 |
replicProtocol <- A.space *> A.anyChar |
|
127 |
io <- skipSpaces *> ioFlagsParser <* A.skipWhile isBadEndOfLine |
|
128 |
pIndicators <- perfIndicatorsParser |
|
129 |
syncS <- conditionalSyncStatusParser cs |
|
130 |
reS <- optional resyncParser |
|
131 |
act <- optional actLogParser |
|
132 |
_ <- additionalEOL |
|
133 |
let inst = find ((deviceNum ==) . dimMinor) instMinor |
|
134 |
iName = fmap dimInstName inst |
|
135 |
return $ DeviceInfo deviceNum cs ro ds replicProtocol io pIndicators |
|
136 |
syncS reS act iName |
|
137 |
|
|
138 |
where conditionalSyncStatusParser SyncSource = Just <$> syncStatusParser |
|
139 |
conditionalSyncStatusParser SyncTarget = Just <$> syncStatusParser |
|
140 |
conditionalSyncStatusParser _ = pure Nothing |
|
141 |
skipRoleString = A.string "ro:" <|> A.string "st:" |
|
142 |
resyncParser = skipSpacesAndString "resync:" additionalInfoParser |
|
143 |
actLogParser = skipSpacesAndString "act_log:" additionalInfoParser |
|
144 |
additionalEOL = A.skipWhile A.isEndOfLine |
|
145 |
|
|
146 |
-- | The parser for the connection state. |
|
147 |
connStateParser :: Parser ConnState |
|
148 |
connStateParser = |
|
149 |
standAlone |
|
150 |
<|> disconnecting |
|
151 |
<|> unconnected |
|
152 |
<|> timeout |
|
153 |
<|> brokenPipe |
|
154 |
<|> networkFailure |
|
155 |
<|> protocolError |
|
156 |
<|> tearDown |
|
157 |
<|> wfConnection |
|
158 |
<|> wfReportParams |
|
159 |
<|> connected |
|
160 |
<|> startingSyncS |
|
161 |
<|> startingSyncT |
|
162 |
<|> wfBitMapS |
|
163 |
<|> wfBitMapT |
|
164 |
<|> wfSyncUUID |
|
165 |
<|> syncSource |
|
166 |
<|> syncTarget |
|
167 |
<|> pausedSyncS |
|
168 |
<|> pausedSyncT |
|
169 |
<|> verifyS |
|
170 |
<|> verifyT |
|
171 |
<|> unconfigured |
|
172 |
where standAlone = A.string "StandAlone" *> pure StandAlone |
|
173 |
disconnecting = A.string "Disconnectiog" *> pure Disconnecting |
|
174 |
unconnected = A.string "Unconnected" *> pure Unconnected |
|
175 |
timeout = A.string "Timeout" *> pure Timeout |
|
176 |
brokenPipe = A.string "BrokenPipe" *> pure BrokenPipe |
|
177 |
networkFailure = A.string "NetworkFailure" *> pure NetworkFailure |
|
178 |
protocolError = A.string "ProtocolError" *> pure ProtocolError |
|
179 |
tearDown = A.string "TearDown" *> pure TearDown |
|
180 |
wfConnection = A.string "WFConnection" *> pure WFConnection |
|
181 |
wfReportParams = A.string "WFReportParams" *> pure WFReportParams |
|
182 |
connected = A.string "Connected" *> pure Connected |
|
183 |
startingSyncS = A.string "StartingSyncS" *> pure StartingSyncS |
|
184 |
startingSyncT = A.string "StartingSyncT" *> pure StartingSyncT |
|
185 |
wfBitMapS = A.string "WFBitMapS" *> pure WFBitMapS |
|
186 |
wfBitMapT = A.string "WFBitMapT" *> pure WFBitMapT |
|
187 |
wfSyncUUID = A.string "WFSyncUUID" *> pure WFSyncUUID |
|
188 |
syncSource = A.string "SyncSource" *> pure SyncSource |
|
189 |
syncTarget = A.string "SyncTarget" *> pure SyncTarget |
|
190 |
pausedSyncS = A.string "PausedSyncS" *> pure PausedSyncS |
|
191 |
pausedSyncT = A.string "PausedSyncT" *> pure PausedSyncT |
|
192 |
verifyS = A.string "VerifyS" *> pure VerifyS |
|
193 |
verifyT = A.string "VerifyT" *> pure VerifyT |
|
194 |
unconfigured = A.string "Unconfigured" *> pure Unconfigured |
|
195 |
|
|
196 |
-- | Parser for recognizing strings describing two elements of the |
|
197 |
-- same type separated by a '/'. The first one is considered local, |
|
198 |
-- the second remote. |
|
199 |
localRemoteParser :: Parser a -> Parser (LocalRemote a) |
|
200 |
localRemoteParser parser = LocalRemote <$> parser <*> (A.char '/' *> parser) |
|
201 |
|
|
202 |
-- | The parser for resource roles. |
|
203 |
roleParser :: Parser Role |
|
204 |
roleParser = |
|
205 |
primary |
|
206 |
<|> secondary |
|
207 |
<|> unknown |
|
208 |
where primary = A.string "Primary" *> pure Primary |
|
209 |
secondary = A.string "Secondary" *> pure Secondary |
|
210 |
unknown = A.string "Unknown" *> pure Unknown |
|
211 |
|
|
212 |
-- | The parser for disk states. |
|
213 |
diskStateParser :: Parser DiskState |
|
214 |
diskStateParser = |
|
215 |
diskless |
|
216 |
<|> attaching |
|
217 |
<|> failed |
|
218 |
<|> negotiating |
|
219 |
<|> inconsistent |
|
220 |
<|> outdated |
|
221 |
<|> dUnknown |
|
222 |
<|> consistent |
|
223 |
<|> upToDate |
|
224 |
where diskless = A.string "Diskless" *> pure Diskless |
|
225 |
attaching = A.string "Attaching" *> pure Attaching |
|
226 |
failed = A.string "Failed" *> pure Failed |
|
227 |
negotiating = A.string "Negotiating" *> pure Negotiating |
|
228 |
inconsistent = A.string "Inconsistent" *> pure Inconsistent |
|
229 |
outdated = A.string "Outdated" *> pure Outdated |
|
230 |
dUnknown = A.string "DUnknown" *> pure DUnknown |
|
231 |
consistent = A.string "Consistent" *> pure Consistent |
|
232 |
upToDate = A.string "UpToDate" *> pure UpToDate |
|
233 |
|
|
234 |
-- | The parser for I/O flags. |
|
235 |
ioFlagsParser :: Parser String |
|
236 |
ioFlagsParser = fmap unpack . A.takeWhile $ not . isBadEndOfLine |
|
237 |
|
|
238 |
-- | The parser for performance indicators. |
|
239 |
perfIndicatorsParser :: Parser PerfIndicators |
|
240 |
perfIndicatorsParser = |
|
241 |
PerfIndicators |
|
242 |
<$> skipSpacesAndString "ns:" A.decimal |
|
243 |
<*> skipSpacesAndString "nr:" A.decimal |
|
244 |
<*> skipSpacesAndString "dw:" A.decimal |
|
245 |
<*> skipSpacesAndString "dr:" A.decimal |
|
246 |
<*> skipSpacesAndString "al:" A.decimal |
|
247 |
<*> skipSpacesAndString "bm:" A.decimal |
|
248 |
<*> skipSpacesAndString "lo:" A.decimal |
|
249 |
<*> skipSpacesAndString "pe:" A.decimal |
|
250 |
<*> skipSpacesAndString "ua:" A.decimal |
|
251 |
<*> skipSpacesAndString "ap:" A.decimal |
|
252 |
<*> optional (skipSpacesAndString "ep:" A.decimal) |
|
253 |
<*> optional (skipSpacesAndString "wo:" A.anyChar) |
|
254 |
<*> optional (skipSpacesAndString "oos:" A.decimal) |
|
255 |
<* skipSpaces <* A.endOfLine |
|
256 |
|
|
257 |
-- | The parser for the syncronization status. |
|
258 |
syncStatusParser :: Parser SyncStatus |
|
259 |
syncStatusParser = do |
|
260 |
_ <- statusBarParser |
|
261 |
percent <- |
|
262 |
skipSpacesAndString "sync'ed:" $ skipSpaces *> A.double <* A.char '%' |
|
263 |
partSyncSize <- skipSpaces *> A.char '(' *> A.decimal |
|
264 |
totSyncSize <- A.char '/' *> A.decimal <* A.char ')' |
|
265 |
sizeUnit <- sizeUnitParser <* optional A.endOfLine |
|
266 |
timeToEnd <- skipSpacesAndString "finish:" $ skipSpaces *> timeParser |
|
267 |
sp <- |
|
268 |
skipSpacesAndString "speed:" $ |
|
269 |
skipSpaces |
|
270 |
*> commaIntParser |
|
271 |
<* skipSpaces |
|
272 |
<* A.char '(' |
|
273 |
<* commaIntParser |
|
274 |
<* A.char ')' |
|
275 |
w <- skipSpacesAndString "want:" ( |
|
276 |
skipSpaces |
|
277 |
*> (Just <$> commaIntParser) |
|
278 |
) |
|
279 |
<|> pure Nothing |
|
280 |
sSizeUnit <- skipSpaces *> sizeUnitParser |
|
281 |
sTimeUnit <- A.char '/' *> timeUnitParser |
|
282 |
_ <- A.endOfLine |
|
283 |
return $ |
|
284 |
SyncStatus percent partSyncSize totSyncSize sizeUnit timeToEnd sp w |
|
285 |
sSizeUnit sTimeUnit |
|
286 |
|
|
287 |
-- | The parser for recognizing (and discarding) the sync status bar. |
|
288 |
statusBarParser :: Parser () |
|
289 |
statusBarParser = |
|
290 |
skipSpaces |
|
291 |
*> A.char '[' |
|
292 |
*> A.skipWhile (== '=') |
|
293 |
*> A.skipWhile (== '>') |
|
294 |
*> A.skipWhile (== '.') |
|
295 |
*> A.char ']' |
|
296 |
*> pure () |
|
297 |
|
|
298 |
-- | The parser for recognizing data size units (only the ones |
|
299 |
-- actually found in DRBD files are implemented). |
|
300 |
sizeUnitParser :: Parser SizeUnit |
|
301 |
sizeUnitParser = |
|
302 |
kilobyte |
|
303 |
<|> megabyte |
|
304 |
where kilobyte = A.string "K" *> pure KiloByte |
|
305 |
megabyte = A.string "M" *> pure MegaByte |
|
306 |
|
|
307 |
-- | The parser for recognizing time (hh:mm:ss). |
|
308 |
timeParser :: Parser Time |
|
309 |
timeParser = Time <$> h <*> m <*> s |
|
310 |
where h = A.decimal :: Parser Int |
|
311 |
m = A.char ':' *> A.decimal :: Parser Int |
|
312 |
s = A.char ':' *> A.decimal :: Parser Int |
|
313 |
|
|
314 |
-- | The parser for recognizing time units (only the ones actually |
|
315 |
-- found in DRBD files are implemented). |
|
316 |
timeUnitParser :: Parser TimeUnit |
|
317 |
timeUnitParser = second |
|
318 |
where second = A.string "sec" *> pure Second |
|
319 |
|
|
320 |
-- | Haskell does not recognise ',' as the thousands separator every 3 |
|
321 |
-- digits but DRBD uses it, so we need an ah-hoc parser. |
|
322 |
-- If a number beginning with more than 3 digits without a comma is |
|
323 |
-- parsed, only the first 3 digits are considered to be valid, the rest |
|
324 |
-- is not consumed, and left for further parsing. |
|
325 |
commaIntParser :: Parser Int |
|
326 |
commaIntParser = do |
|
327 |
first <- |
|
328 |
AC.count 3 A.digit <|> AC.count 2 A.digit <|> AC.count 1 A.digit |
|
329 |
allDigits <- commaIntHelper (read first) |
|
330 |
pure allDigits |
|
331 |
|
|
332 |
-- | Helper (triplet parser) for the commaIntParser |
|
333 |
commaIntHelper :: Int -> Parser Int |
|
334 |
commaIntHelper acc = nextTriplet <|> end |
|
335 |
where nextTriplet = do |
|
336 |
_ <- A.char ',' |
|
337 |
triplet <- AC.count 3 A.digit |
|
338 |
commaIntHelper $ acc * 1000 + (read triplet :: Int) |
|
339 |
end = pure acc :: Parser Int |
|
340 |
|
|
341 |
-- | Parser for the additional information provided by DRBD <= 8.0. |
|
342 |
additionalInfoParser::Parser AdditionalInfo |
|
343 |
additionalInfoParser = AdditionalInfo |
|
344 |
<$> skipSpacesAndString "used:" A.decimal |
|
345 |
<*> (A.char '/' *> A.decimal) |
|
346 |
<*> skipSpacesAndString "hits:" A.decimal |
|
347 |
<*> skipSpacesAndString "misses:" A.decimal |
|
348 |
<*> skipSpacesAndString "starving:" A.decimal |
|
349 |
<*> skipSpacesAndString "dirty:" A.decimal |
|
350 |
<*> skipSpacesAndString "changed:" A.decimal |
|
351 |
<* A.endOfLine |
b/src/Ganeti/Storage/Drbd/Types.hs | ||
---|---|---|
1 |
{-| DRBD Data Types |
|
2 |
|
|
3 |
This module holds the definition of the data types describing the status of |
|
4 |
DRBD. |
|
5 |
|
|
6 |
-} |
|
7 |
{- |
|
8 |
|
|
9 |
Copyright (C) 2012 Google Inc. |
|
10 |
|
|
11 |
This program is free software; you can redistribute it and/or modify |
|
12 |
it under the terms of the GNU General Public License as published by |
|
13 |
the Free Software Foundation; either version 2 of the License, or |
|
14 |
(at your option) any later version. |
|
15 |
|
|
16 |
This program is distributed in the hope that it will be useful, but |
|
17 |
WITHOUT ANY WARRANTY; without even the implied warranty of |
|
18 |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
|
19 |
General Public License for more details. |
|
20 |
|
|
21 |
You should have received a copy of the GNU General Public License |
|
22 |
along with this program; if not, write to the Free Software |
|
23 |
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
|
24 |
02110-1301, USA. |
|
25 |
|
|
26 |
-} |
|
27 |
module Ganeti.Storage.Drbd.Types |
|
28 |
( DRBDStatus(..) |
|
29 |
, VersionInfo(..) |
|
30 |
, DeviceInfo(..) |
|
31 |
, ConnState(..) |
|
32 |
, LocalRemote(..) |
|
33 |
, Role(..) |
|
34 |
, DiskState(..) |
|
35 |
, PerfIndicators(..) |
|
36 |
, SyncStatus(..) |
|
37 |
, SizeUnit(..) |
|
38 |
, Time(..) |
|
39 |
, TimeUnit(..) |
|
40 |
, AdditionalInfo(..) |
Also available in: Unified diff