root / htools / Ganeti / Block / Drbd / Parser.hs @ cefd4a4a
History | View | Annotate | Download (12.6 kB)
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.Maybe |
35 |
import Data.Text (Text, unpack) |
36 |
|
37 |
import Ganeti.Block.Drbd.Types |
38 |
|
39 |
-- | Our own space-skipping function, because A.skipSpace also skips |
40 |
-- newline characters. It skips ZERO or more spaces, so it does not |
41 |
-- fail if there are no spaces. |
42 |
skipSpaces :: Parser () |
43 |
skipSpaces = A.skipWhile A.isHorizontalSpace |
44 |
|
45 |
-- | Skips spaces and the given string, then executes a parser and |
46 |
-- returns its result. |
47 |
skipSpacesAndString :: Text -> Parser a -> Parser a |
48 |
skipSpacesAndString s parser = |
49 |
skipSpaces |
50 |
*> A.string s |
51 |
*> parser |
52 |
|
53 |
-- | Predicate verifying (potentially bad) end of lines |
54 |
isBadEndOfLine :: Char -> Bool |
55 |
isBadEndOfLine c = (c == '\0') || A.isEndOfLine c |
56 |
|
57 |
-- | Takes a parser and returns it with the content wrapped in a Maybe |
58 |
-- object. The resulting parser never fails, but contains Nothing if |
59 |
-- it couldn't properly parse the string. |
60 |
optional :: Parser a -> Parser (Maybe a) |
61 |
optional parser = (Just <$> parser) <|> pure Nothing |
62 |
|
63 |
-- | The parser for a whole DRBD status file. |
64 |
drbdStatusParser :: Parser DRBDStatus |
65 |
drbdStatusParser = |
66 |
DRBDStatus <$> versionInfoParser |
67 |
<*> deviceParser `AC.manyTill` A.endOfInput |
68 |
<* A.endOfInput |
69 |
|
70 |
-- | The parser for the version information lines. |
71 |
versionInfoParser :: Parser VersionInfo |
72 |
versionInfoParser = do |
73 |
versionF <- optional versionP |
74 |
apiF <- optional apiP |
75 |
protoF <- optional protoP |
76 |
srcVersionF <- optional srcVersion |
77 |
ghF <- fmap unpack <$> optional gh |
78 |
builderF <- fmap unpack <$> optional builder |
79 |
if isNothing versionF |
80 |
&& isNothing apiF |
81 |
&& isNothing protoF |
82 |
&& isNothing srcVersionF |
83 |
&& isNothing ghF |
84 |
&& isNothing builderF |
85 |
then fail "versionInfo" |
86 |
else pure $ VersionInfo versionF apiF protoF srcVersionF ghF builderF |
87 |
|
88 |
where versionP = |
89 |
A.string "version:" |
90 |
*> skipSpaces |
91 |
*> fmap unpack (A.takeWhile $ not . A.isHorizontalSpace) |
92 |
apiP = |
93 |
skipSpacesAndString "(api:" . fmap unpack $ A.takeWhile (/= '/') |
94 |
protoP = |
95 |
A.string "/proto:" |
96 |
*> fmap Data.Text.unpack (A.takeWhile (/= ')')) |
97 |
<* A.takeTill A.isEndOfLine <* A.endOfLine |
98 |
srcVersion = |
99 |
A.string "srcversion:" |
100 |
*> AC.skipMany1 A.space |
101 |
*> fmap unpack (A.takeTill A.isEndOfLine) |
102 |
<* A.endOfLine |
103 |
gh = |
104 |
A.string "GIT-hash:" |
105 |
*> skipSpaces |
106 |
*> A.takeWhile (not . A.isHorizontalSpace) |
107 |
builder = |
108 |
skipSpacesAndString "build by" $ |
109 |
skipSpaces |
110 |
*> A.takeTill A.isEndOfLine |
111 |
<* A.endOfLine |
112 |
|
113 |
-- | The parser for a (multi-line) string representing a device. |
114 |
deviceParser :: Parser DeviceInfo |
115 |
deviceParser = do |
116 |
deviceNum <- skipSpaces *> A.decimal <* A.char ':' |
117 |
cs <- skipSpacesAndString "cs:" connStateParser |
118 |
if cs == Unconfigured |
119 |
then do |
120 |
_ <- additionalEOL |
121 |
return $ UnconfiguredDevice deviceNum |
122 |
else do |
123 |
ro <- skipSpaces *> skipRoleString *> localRemoteParser roleParser |
124 |
ds <- skipSpacesAndString "ds:" $ localRemoteParser diskStateParser |
125 |
replicProtocol <- A.space *> A.anyChar |
126 |
io <- skipSpaces *> ioFlagsParser <* A.skipWhile isBadEndOfLine |
127 |
pIndicators <- perfIndicatorsParser |
128 |
syncS <- conditionalSyncStatusParser cs |
129 |
reS <- optional resyncParser |
130 |
act <- optional actLogParser |
131 |
_ <- additionalEOL |
132 |
return $ DeviceInfo deviceNum cs ro ds replicProtocol io pIndicators |
133 |
syncS reS act |
134 |
|
135 |
where conditionalSyncStatusParser SyncSource = Just <$> syncStatusParser |
136 |
conditionalSyncStatusParser SyncTarget = Just <$> syncStatusParser |
137 |
conditionalSyncStatusParser _ = pure Nothing |
138 |
skipRoleString = A.string "ro:" <|> A.string "st:" |
139 |
resyncParser = skipSpacesAndString "resync:" additionalInfoParser |
140 |
actLogParser = skipSpacesAndString "act_log:" additionalInfoParser |
141 |
additionalEOL = A.skipWhile A.isEndOfLine |
142 |
|
143 |
-- | The parser for the connection state. |
144 |
connStateParser :: Parser ConnState |
145 |
connStateParser = |
146 |
standAlone |
147 |
<|> disconnecting |
148 |
<|> unconnected |
149 |
<|> timeout |
150 |
<|> brokenPipe |
151 |
<|> networkFailure |
152 |
<|> protocolError |
153 |
<|> tearDown |
154 |
<|> wfConnection |
155 |
<|> wfReportParams |
156 |
<|> connected |
157 |
<|> startingSyncS |
158 |
<|> startingSyncT |
159 |
<|> wfBitMapS |
160 |
<|> wfBitMapT |
161 |
<|> wfSyncUUID |
162 |
<|> syncSource |
163 |
<|> syncTarget |
164 |
<|> pausedSyncS |
165 |
<|> pausedSyncT |
166 |
<|> verifyS |
167 |
<|> verifyT |
168 |
<|> unconfigured |
169 |
where standAlone = A.string "StandAlone" *> pure StandAlone |
170 |
disconnecting = A.string "Disconnectiog" *> pure Disconnecting |
171 |
unconnected = A.string "Unconnected" *> pure Unconnected |
172 |
timeout = A.string "Timeout" *> pure Timeout |
173 |
brokenPipe = A.string "BrokenPipe" *> pure BrokenPipe |
174 |
networkFailure = A.string "NetworkFailure" *> pure NetworkFailure |
175 |
protocolError = A.string "ProtocolError" *> pure ProtocolError |
176 |
tearDown = A.string "TearDown" *> pure TearDown |
177 |
wfConnection = A.string "WFConnection" *> pure WFConnection |
178 |
wfReportParams = A.string "WFReportParams" *> pure WFReportParams |
179 |
connected = A.string "Connected" *> pure Connected |
180 |
startingSyncS = A.string "StartingSyncS" *> pure StartingSyncS |
181 |
startingSyncT = A.string "StartingSyncT" *> pure StartingSyncT |
182 |
wfBitMapS = A.string "WFBitMapS" *> pure WFBitMapS |
183 |
wfBitMapT = A.string "WFBitMapT" *> pure WFBitMapT |
184 |
wfSyncUUID = A.string "WFSyncUUID" *> pure WFSyncUUID |
185 |
syncSource = A.string "SyncSource" *> pure SyncSource |
186 |
syncTarget = A.string "SyncTarget" *> pure SyncTarget |
187 |
pausedSyncS = A.string "PausedSyncS" *> pure PausedSyncS |
188 |
pausedSyncT = A.string "PausedSyncT" *> pure PausedSyncT |
189 |
verifyS = A.string "VerifyS" *> pure VerifyS |
190 |
verifyT = A.string "VerifyT" *> pure VerifyT |
191 |
unconfigured = A.string "Unconfigured" *> pure Unconfigured |
192 |
|
193 |
-- | Parser for recognizing strings describing two elements of the |
194 |
-- same type separated by a '/'. The first one is considered local, |
195 |
-- the second remote. |
196 |
localRemoteParser :: Parser a -> Parser (LocalRemote a) |
197 |
localRemoteParser parser = LocalRemote <$> parser <*> (A.char '/' *> parser) |
198 |
|
199 |
-- | The parser for resource roles. |
200 |
roleParser :: Parser Role |
201 |
roleParser = |
202 |
primary |
203 |
<|> secondary |
204 |
<|> unknown |
205 |
where primary = A.string "Primary" *> pure Primary |
206 |
secondary = A.string "Secondary" *> pure Secondary |
207 |
unknown = A.string "Unknown" *> pure Unknown |
208 |
|
209 |
-- | The parser for disk states. |
210 |
diskStateParser :: Parser DiskState |
211 |
diskStateParser = |
212 |
diskless |
213 |
<|> attaching |
214 |
<|> failed |
215 |
<|> negotiating |
216 |
<|> inconsistent |
217 |
<|> outdated |
218 |
<|> dUnknown |
219 |
<|> consistent |
220 |
<|> upToDate |
221 |
where diskless = A.string "Diskless" *> pure Diskless |
222 |
attaching = A.string "Attaching" *> pure Attaching |
223 |
failed = A.string "Failed" *> pure Failed |
224 |
negotiating = A.string "Negotiating" *> pure Negotiating |
225 |
inconsistent = A.string "Inconsistent" *> pure Inconsistent |
226 |
outdated = A.string "Outdated" *> pure Outdated |
227 |
dUnknown = A.string "DUnknown" *> pure DUnknown |
228 |
consistent = A.string "Consistent" *> pure Consistent |
229 |
upToDate = A.string "UpToDate" *> pure UpToDate |
230 |
|
231 |
-- | The parser for I/O flags. |
232 |
ioFlagsParser :: Parser String |
233 |
ioFlagsParser = fmap unpack . A.takeWhile $ not . isBadEndOfLine |
234 |
|
235 |
-- | The parser for performance indicators. |
236 |
perfIndicatorsParser :: Parser PerfIndicators |
237 |
perfIndicatorsParser = |
238 |
PerfIndicators |
239 |
<$> skipSpacesAndString "ns:" A.decimal |
240 |
<*> skipSpacesAndString "nr:" A.decimal |
241 |
<*> skipSpacesAndString "dw:" A.decimal |
242 |
<*> skipSpacesAndString "dr:" A.decimal |
243 |
<*> skipSpacesAndString "al:" A.decimal |
244 |
<*> skipSpacesAndString "bm:" A.decimal |
245 |
<*> skipSpacesAndString "lo:" A.decimal |
246 |
<*> skipSpacesAndString "pe:" A.decimal |
247 |
<*> skipSpacesAndString "ua:" A.decimal |
248 |
<*> skipSpacesAndString "ap:" A.decimal |
249 |
<*> optional (skipSpacesAndString "ep:" A.decimal) |
250 |
<*> optional (skipSpacesAndString "wo:" A.anyChar) |
251 |
<*> optional (skipSpacesAndString "oos:" A.decimal) |
252 |
<* skipSpaces <* A.endOfLine |
253 |
|
254 |
-- | The parser for the syncronization status. |
255 |
syncStatusParser :: Parser SyncStatus |
256 |
syncStatusParser = do |
257 |
_ <- statusBarParser |
258 |
percent <- |
259 |
skipSpacesAndString "sync'ed:" $ skipSpaces *> A.double <* A.char '%' |
260 |
partSyncSize <- skipSpaces *> A.char '(' *> A.decimal |
261 |
totSyncSize <- A.char '/' *> A.decimal <* A.char ')' |
262 |
sizeUnit <- sizeUnitParser <* optional A.endOfLine |
263 |
timeToEnd <- skipSpacesAndString "finish:" $ skipSpaces *> timeParser |
264 |
sp <- |
265 |
skipSpacesAndString "speed:" $ |
266 |
skipSpaces |
267 |
*> commaIntParser |
268 |
<* skipSpaces |
269 |
<* A.char '(' |
270 |
<* commaIntParser |
271 |
<* A.char ')' |
272 |
w <- skipSpacesAndString "want:" ( |
273 |
skipSpaces |
274 |
*> (Just <$> commaIntParser) |
275 |
) |
276 |
<|> pure Nothing |
277 |
sSizeUnit <- skipSpaces *> sizeUnitParser |
278 |
sTimeUnit <- A.char '/' *> timeUnitParser |
279 |
_ <- A.endOfLine |
280 |
return $ |
281 |
SyncStatus percent partSyncSize totSyncSize sizeUnit timeToEnd sp w |
282 |
sSizeUnit sTimeUnit |
283 |
|
284 |
-- | The parser for recognizing (and discarding) the sync status bar. |
285 |
statusBarParser :: Parser () |
286 |
statusBarParser = |
287 |
skipSpaces |
288 |
*> A.char '[' |
289 |
*> A.skipWhile (== '=') |
290 |
*> A.skipWhile (== '>') |
291 |
*> A.skipWhile (== '.') |
292 |
*> A.char ']' |
293 |
*> pure () |
294 |
|
295 |
-- | The parser for recognizing data size units (only the ones |
296 |
-- actually found in DRBD files are implemented). |
297 |
sizeUnitParser :: Parser SizeUnit |
298 |
sizeUnitParser = |
299 |
kilobyte |
300 |
<|> megabyte |
301 |
where kilobyte = A.string "K" *> pure KiloByte |
302 |
megabyte = A.string "M" *> pure MegaByte |
303 |
|
304 |
-- | The parser for recognizing time (hh:mm:ss). |
305 |
timeParser :: Parser Time |
306 |
timeParser = Time <$> h <*> m <*> s |
307 |
where h = A.decimal :: Parser Int |
308 |
m = A.char ':' *> A.decimal :: Parser Int |
309 |
s = A.char ':' *> A.decimal :: Parser Int |
310 |
|
311 |
-- | The parser for recognizing time units (only the ones actually |
312 |
-- found in DRBD files are implemented). |
313 |
timeUnitParser :: Parser TimeUnit |
314 |
timeUnitParser = second |
315 |
where second = A.string "sec" *> pure Second |
316 |
|
317 |
-- | Haskell does not recognise ',' as the thousands separator every 3 |
318 |
-- digits but DRBD uses it, so we need an ah-hoc parser. |
319 |
-- If a number beginning with more than 3 digits without a comma is |
320 |
-- parsed, only the first 3 digits are considered to be valid, the rest |
321 |
-- is not consumed, and left for further parsing. |
322 |
commaIntParser :: Parser Int |
323 |
commaIntParser = do |
324 |
first <- |
325 |
AC.count 3 A.digit <|> AC.count 2 A.digit <|> AC.count 1 A.digit |
326 |
allDigits <- commaIntHelper (read first) |
327 |
pure allDigits |
328 |
|
329 |
-- | Helper (triplet parser) for the commaIntParser |
330 |
commaIntHelper :: Int -> Parser Int |
331 |
commaIntHelper acc = nextTriplet <|> end |
332 |
where nextTriplet = do |
333 |
_ <- A.char ',' |
334 |
triplet <- AC.count 3 A.digit |
335 |
commaIntHelper $ acc * 1000 + (read triplet :: Int) |
336 |
end = pure acc :: Parser Int |
337 |
|
338 |
-- | Parser for the additional information provided by DRBD <= 8.0. |
339 |
additionalInfoParser::Parser AdditionalInfo |
340 |
additionalInfoParser = AdditionalInfo |
341 |
<$> skipSpacesAndString "used:" A.decimal |
342 |
<*> (A.char '/' *> A.decimal) |
343 |
<*> skipSpacesAndString "hits:" A.decimal |
344 |
<*> skipSpacesAndString "misses:" A.decimal |
345 |
<*> skipSpacesAndString "starving:" A.decimal |
346 |
<*> skipSpacesAndString "dirty:" A.decimal |
347 |
<*> skipSpacesAndString "changed:" A.decimal |
348 |
<* A.endOfLine |