Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / DataCollectors / Drbd.hs @ e8b46463

History | View | Annotate | Download (7.4 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
-- | Compute the status of a DRBD device and its error message.
141
computeDevStatus :: DeviceInfo -> (DCStatusCode, String)
142
computeDevStatus (UnconfiguredDevice _) = (DCSCOk, "")
143
computeDevStatus dev =
144
  let errMsg s = show (minorNumber dev) ++ ": " ++ s
145
      compute_helper StandAlone =
146
        (DCSCBad, errMsg "No network config available")
147
      compute_helper Disconnecting =
148
        (DCSCBad, errMsg "The peer is being disconnected")
149
      compute_helper Unconnected =
150
        (DCSCTempBad, errMsg "Trying to establish a network connection")
151
      compute_helper Timeout =
152
        (DCSCTempBad, errMsg "Communication problems between the peers")
153
      compute_helper BrokenPipe =
154
        (DCSCTempBad, errMsg "Communication problems between the peers")
155
      compute_helper NetworkFailure =
156
        (DCSCTempBad, errMsg "Communication problems between the peers")
157
      compute_helper ProtocolError =
158
        (DCSCTempBad, errMsg "Communication problems between the peers")
159
      compute_helper TearDown =
160
        (DCSCBad, errMsg "The peer is closing the connection")
161
      compute_helper WFConnection =
162
        (DCSCTempBad, errMsg "Trying to establish a network connection")
163
      compute_helper WFReportParams =
164
        (DCSCTempBad, errMsg "Trying to establish a network connection")
165
      compute_helper Connected = (DCSCOk, "")
166
      compute_helper StartingSyncS = (DCSCOk, "")
167
      compute_helper StartingSyncT = (DCSCOk, "")
168
      compute_helper WFBitMapS = (DCSCOk, "")
169
      compute_helper WFBitMapT = (DCSCOk, "")
170
      compute_helper WFSyncUUID = (DCSCOk, "")
171
      compute_helper SyncSource = (DCSCOk, "")
172
      compute_helper SyncTarget = (DCSCOk, "")
173
      compute_helper PausedSyncS = (DCSCOk, "")
174
      compute_helper PausedSyncT = (DCSCOk, "")
175
      compute_helper VerifyS = (DCSCOk, "")
176
      compute_helper VerifyT = (DCSCOk, "")
177
      compute_helper Unconfigured = (DCSCOk, "")
178
  in compute_helper $ connectionState dev
179

    
180
-- | This function computes the JSON representation of the DRBD status.
181
buildJsonReport :: FilePath -> Maybe FilePath -> IO J.JSValue
182
buildJsonReport statusFile pairingFile = do
183
  contents <-
184
    ((E.try $ readFile statusFile) :: IO (Either IOError String)) >>=
185
      exitIfBad "reading from file" . either (BT.Bad . show) BT.Ok
186
  pairingResult <- getPairingInfo pairingFile
187
  pairing <- exitIfBad "Can't get pairing info" pairingResult
188
  drbdData <-
189
    case A.parse (drbdStatusParser pairing) $ pack contents of
190
      A.Fail unparsedText contexts errorMessage -> exitErr $
191
        show (Prelude.take defaultCharNum $ unpack unparsedText) ++ "\n"
192
          ++ show contexts ++ "\n" ++ errorMessage
193
      A.Done _ drbdS -> return drbdS
194
  let status = computeStatus drbdData
195
  return . addStatus status $ J.showJSON drbdData
196

    
197
-- | This function computes the DCReport for the DRBD status.
198
buildDCReport :: FilePath -> Maybe FilePath -> IO DCReport
199
buildDCReport statusFile pairingFile =
200
  buildJsonReport statusFile pairingFile >>=
201
    buildReport dcName dcVersion dcFormatVersion dcCategory dcKind
202

    
203
-- | Main function.
204
main :: Options -> [String] -> IO ()
205
main opts args = do
206
  let statusFile = fromMaybe defaultFile $ optDrbdStatus opts
207
      pairingFile = optDrbdPairing opts
208
  unless (null args) . exitErr $ "This program takes exactly zero" ++
209
                                  " arguments, got '" ++ unwords args ++ "'"
210
  report <- buildDCReport statusFile pairingFile
211
  putStrLn $ J.encode report