Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / DataCollectors / Drbd.hs @ 7660aaf3

History | View | Annotate | Download (7.8 kB)

1
{-| DRBD data collector.
2

    
3
-}
4

    
5
{-
6

    
7
Copyright (C) 2012, 2013 Google Inc.
8

    
9
This program is free software; you can redistribute it and/or modify
10
it under the terms of the GNU General Public License as published by
11
the Free Software Foundation; either version 2 of the License, or
12
(at your option) any later version.
13

    
14
This program is distributed in the hope that it will be useful, but
15
WITHOUT ANY WARRANTY; without even the implied warranty of
16
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
17
General Public License for more details.
18

    
19
You should have received a copy of the GNU General Public License
20
along with this program; if not, write to the Free Software
21
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
22
02110-1301, USA.
23

    
24
-}
25

    
26
module Ganeti.DataCollectors.Drbd
27
  ( main
28
  , options
29
  , arguments
30
  , dcName
31
  , dcVersion
32
  , dcFormatVersion
33
  , dcCategory
34
  , dcKind
35
  , dcReport
36
  ) where
37

    
38

    
39
import qualified Control.Exception as E
40
import Control.Monad
41
import Data.Attoparsec.Text.Lazy as A
42
import Data.List
43
import Data.Maybe
44
import Data.Text.Lazy (pack, unpack)
45
import Network.BSD (getHostName)
46
import qualified Text.JSON as J
47

    
48
import qualified Ganeti.BasicTypes as BT
49
import qualified Ganeti.Constants as C
50
import Ganeti.Block.Drbd.Parser(drbdStatusParser)
51
import Ganeti.Block.Drbd.Types
52
import Ganeti.Common
53
import Ganeti.Confd.Client
54
import Ganeti.Confd.Types
55
import Ganeti.DataCollectors.CLI
56
import Ganeti.DataCollectors.Types
57
import Ganeti.Utils
58

    
59

    
60
-- | The default path of the DRBD status file.
61
-- It is hardcoded because it is not likely to change.
62
defaultFile :: FilePath
63
defaultFile = C.drbdStatusFile
64

    
65
-- | The default setting for the maximum amount of not parsed character to
66
-- print in case of error.
67
-- It is set to use most of the screen estate on a standard 80x25 terminal.
68
-- TODO: add the possibility to set this with a command line parameter.
69
defaultCharNum :: Int
70
defaultCharNum = 80*20
71

    
72
-- | The name of this data collector.
73
dcName :: String
74
dcName = "drbd"
75

    
76
-- | The version of this data collector.
77
dcVersion :: DCVersion
78
dcVersion = DCVerBuiltin
79

    
80
-- | The version number for the data format of this data collector.
81
dcFormatVersion :: Int
82
dcFormatVersion = 1
83

    
84
-- | The category of this data collector.
85
dcCategory :: Maybe DCCategory
86
dcCategory = Just DCStorage
87

    
88
-- | The kind of this data collector.
89
dcKind :: DCKind
90
dcKind = DCKStatus
91

    
92
-- | The data exported by the data collector, taken from the default location.
93
dcReport :: IO DCReport
94
dcReport = buildDCReport defaultFile Nothing
95

    
96
-- * Command line options
97

    
98
options :: IO [OptType]
99
options =
100
  return
101
    [ oDrbdStatus
102
    , oDrbdPairing
103
    ]
104

    
105
-- | The list of arguments supported by the program.
106
arguments :: [ArgCompletion]
107
arguments = [ArgCompletion OptComplFile 0 (Just 0)]
108

    
109
-- | Get information about the pairing of DRBD minors and Ganeti instances
110
-- on the current node. The information is taken from the Confd client
111
-- or, if a filename is specified, from a JSON encoded file (for testing
112
-- purposes).
113
getPairingInfo :: Maybe String -> IO (BT.Result [DrbdInstMinor])
114
getPairingInfo Nothing = do
115
  curNode <- getHostName
116
  client <- getConfdClient Nothing Nothing
117
  reply <- query client ReqNodeDrbd $ PlainQuery curNode
118
  return $
119
    case fmap (J.readJSONs . confdReplyAnswer) reply of
120
      Just (J.Ok instMinor) -> BT.Ok instMinor
121
      Just (J.Error msg) -> BT.Bad msg
122
      Nothing -> BT.Bad "No answer from the Confd server"
123
getPairingInfo (Just filename) = do
124
  content <- readFile filename
125
  return $
126
    case J.decode content of
127
      J.Ok instMinor -> BT.Ok instMinor
128
      J.Error msg -> BT.Bad msg
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

    
191
-- | This function computes the JSON representation of the DRBD status.
192
buildJsonReport :: FilePath -> Maybe FilePath -> IO J.JSValue
193
buildJsonReport statusFile pairingFile = do
194
  contents <-
195
    ((E.try $ readFile statusFile) :: IO (Either IOError String)) >>=
196
      exitIfBad "reading from file" . either (BT.Bad . show) BT.Ok
197
  pairingResult <- getPairingInfo pairingFile
198
  pairing <- exitIfBad "Can't get pairing info" pairingResult
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
207

    
208
-- | This function computes the DCReport for the DRBD status.
209
buildDCReport :: FilePath -> Maybe FilePath -> IO DCReport
210
buildDCReport statusFile pairingFile =
211
  buildJsonReport statusFile pairingFile >>=
212
    buildReport dcName dcVersion dcFormatVersion dcCategory dcKind
213

    
214
-- | Main function.
215
main :: Options -> [String] -> IO ()
216
main opts args = do
217
  let statusFile = fromMaybe defaultFile $ optDrbdStatus opts
218
      pairingFile = optDrbdPairing opts
219
  unless (null args) . exitErr $ "This program takes exactly zero" ++
220
                                  " arguments, got '" ++ unwords args ++ "'"
221
  report <- buildDCReport statusFile pairingFile
222
  putStrLn $ J.encode report