Revision 2d1c753d src/Ganeti/DataCollectors/Drbd.hs
b/src/Ganeti/DataCollectors/Drbd.hs | ||
---|---|---|
39 | 39 |
import qualified Control.Exception as E |
40 | 40 |
import Control.Monad |
41 | 41 |
import Data.Attoparsec.Text.Lazy as A |
42 |
import Data.List |
|
42 | 43 |
import Data.Maybe |
43 | 44 |
import Data.Text.Lazy (pack, unpack) |
44 | 45 |
import Network.BSD (getHostName) |
... | ... | |
47 | 48 |
import qualified Ganeti.BasicTypes as BT |
48 | 49 |
import qualified Ganeti.Constants as C |
49 | 50 |
import Ganeti.Block.Drbd.Parser(drbdStatusParser) |
50 |
import Ganeti.Block.Drbd.Types(DrbdInstMinor)
|
|
51 |
import Ganeti.Block.Drbd.Types |
|
51 | 52 |
import Ganeti.Common |
52 | 53 |
import Ganeti.Confd.Client |
53 | 54 |
import Ganeti.Confd.Types |
... | ... | |
126 | 127 |
J.Ok instMinor -> BT.Ok instMinor |
127 | 128 |
J.Error msg -> BT.Bad msg |
128 | 129 |
|
130 |
-- | Compute the status code and message, given the current DRBD data |
|
131 |
-- The final state will have the code corresponding to the worst code of |
|
132 |
-- all the devices, and the error message given from the concatenation of the |
|
133 |
-- non-empty error messages. |
|
134 |
computeStatus :: DRBDStatus -> DCStatus |
|
135 |
computeStatus (DRBDStatus _ devInfos) = |
|
136 |
let statuses = map computeDevStatus devInfos |
|
137 |
(code, strList) = foldr mergeStatuses (DCSCOk, [""]) statuses |
|
138 |
in DCStatus code $ intercalate "\n" strList |
|
139 |
|
|
140 |
-- | Helper function for merging statuses. |
|
141 |
mergeStatuses :: (DCStatusCode, String) -> (DCStatusCode, [String]) |
|
142 |
-> (DCStatusCode, [String]) |
|
143 |
mergeStatuses (newStat, newStr) (storedStat, storedStrs) = |
|
144 |
let resStat = max newStat storedStat |
|
145 |
resStrs = |
|
146 |
if newStr == "" |
|
147 |
then storedStrs |
|
148 |
else storedStrs ++ [newStr] |
|
149 |
in (resStat, resStrs) |
|
150 |
|
|
151 |
-- | Compute the status of a DRBD device and its error message. |
|
152 |
computeDevStatus :: DeviceInfo -> (DCStatusCode, String) |
|
153 |
computeDevStatus (UnconfiguredDevice _) = (DCSCOk, "") |
|
154 |
computeDevStatus dev = |
|
155 |
let errMsg s = show (minorNumber dev) ++ ": " ++ s |
|
156 |
compute_helper StandAlone = |
|
157 |
(DCSCBad, errMsg "No network config available") |
|
158 |
compute_helper Disconnecting = |
|
159 |
(DCSCBad, errMsg "The peer is being disconnected") |
|
160 |
compute_helper Unconnected = |
|
161 |
(DCSCTempBad, errMsg "Trying to establish a network connection") |
|
162 |
compute_helper Timeout = |
|
163 |
(DCSCTempBad, errMsg "Communication problems between the peers") |
|
164 |
compute_helper BrokenPipe = |
|
165 |
(DCSCTempBad, errMsg "Communication problems between the peers") |
|
166 |
compute_helper NetworkFailure = |
|
167 |
(DCSCTempBad, errMsg "Communication problems between the peers") |
|
168 |
compute_helper ProtocolError = |
|
169 |
(DCSCTempBad, errMsg "Communication problems between the peers") |
|
170 |
compute_helper TearDown = |
|
171 |
(DCSCBad, errMsg "The peer is closing the connection") |
|
172 |
compute_helper WFConnection = |
|
173 |
(DCSCTempBad, errMsg "Trying to establish a network connection") |
|
174 |
compute_helper WFReportParams = |
|
175 |
(DCSCTempBad, errMsg "Trying to establish a network connection") |
|
176 |
compute_helper Connected = (DCSCOk, "") |
|
177 |
compute_helper StartingSyncS = (DCSCOk, "") |
|
178 |
compute_helper StartingSyncT = (DCSCOk, "") |
|
179 |
compute_helper WFBitMapS = (DCSCOk, "") |
|
180 |
compute_helper WFBitMapT = (DCSCOk, "") |
|
181 |
compute_helper WFSyncUUID = (DCSCOk, "") |
|
182 |
compute_helper SyncSource = (DCSCOk, "") |
|
183 |
compute_helper SyncTarget = (DCSCOk, "") |
|
184 |
compute_helper PausedSyncS = (DCSCOk, "") |
|
185 |
compute_helper PausedSyncT = (DCSCOk, "") |
|
186 |
compute_helper VerifyS = (DCSCOk, "") |
|
187 |
compute_helper VerifyT = (DCSCOk, "") |
|
188 |
compute_helper Unconfigured = (DCSCOk, "") |
|
189 |
in compute_helper $ connectionState dev |
|
190 |
|
|
129 | 191 |
-- | This function computes the JSON representation of the DRBD status. |
130 | 192 |
buildJsonReport :: FilePath -> Maybe FilePath -> IO J.JSValue |
131 | 193 |
buildJsonReport statusFile pairingFile = do |
... | ... | |
134 | 196 |
exitIfBad "reading from file" . either (BT.Bad . show) BT.Ok |
135 | 197 |
pairingResult <- getPairingInfo pairingFile |
136 | 198 |
pairing <- exitIfBad "Can't get pairing info" pairingResult |
137 |
case A.parse (drbdStatusParser pairing) $ pack contents of |
|
138 |
A.Fail unparsedText contexts errorMessage -> exitErr $ |
|
139 |
show (Prelude.take defaultCharNum $ unpack unparsedText) ++ "\n" |
|
140 |
++ show contexts ++ "\n" ++ errorMessage |
|
141 |
A.Done _ drbdStatus -> return $ J.showJSON drbdStatus |
|
199 |
drbdData <- |
|
200 |
case A.parse (drbdStatusParser pairing) $ pack contents of |
|
201 |
A.Fail unparsedText contexts errorMessage -> exitErr $ |
|
202 |
show (Prelude.take defaultCharNum $ unpack unparsedText) ++ "\n" |
|
203 |
++ show contexts ++ "\n" ++ errorMessage |
|
204 |
A.Done _ drbdS -> return drbdS |
|
205 |
let status = computeStatus drbdData |
|
206 |
return . addStatus status $ J.showJSON drbdData |
|
142 | 207 |
|
143 | 208 |
-- | Main function. |
144 | 209 |
main :: Options -> [String] -> IO () |
Also available in: Unified diff