Config.hs 9.8 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
{-| Implementation of the Ganeti configuration database.

-}

{-

Copyright (C) 2011, 2012 Google Inc.

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

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

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

-}

module Ganeti.Config
    ( LinkIpMap
28
    , NdParamObject(..)
29
30
    , loadConfig
    , getNodeInstances
31
32
    , getNodeRole
    , getNodeNdParams
33
34
35
36
    , getDefaultNicLink
    , getInstancesIpByLink
    , getNode
    , getInstance
37
    , getGroup
38
    , getGroupNdParams
39
40
41
    , getGroupIpolicy
    , getGroupNodes
    , getGroupInstances
42
    , getGroupOfNode
43
    , getInstPrimaryNode
44
    , getInstMinorsForNode
45
    , buildLinkIpInstnameMap
46
    , instNodes
47
48
    ) where

Iustin Pop's avatar
Iustin Pop committed
49
import Control.Monad (liftM)
50
51
import Data.List (foldl')
import qualified Data.Map as M
52
import qualified Data.Set as S
53
54
import qualified Text.JSON as J

55
import Ganeti.JSON
56
57
58
59
60
61
62
63
import Ganeti.BasicTypes

import qualified Ganeti.Constants as C
import Ganeti.Objects

-- | Type alias for the link and ip map.
type LinkIpMap = M.Map String (M.Map String String)

64
65
66
67
-- | Type class denoting objects which have node parameters.
class NdParamObject a where
  getNdParamsOf :: ConfigData -> a -> Maybe FilledNDParams

68
69
70
71
72
73
74
75
76
77
78
79
80
81
-- | Reads the config file.
readConfig :: FilePath -> IO String
readConfig = readFile

-- | Parses the configuration file.
parseConfig :: String -> Result ConfigData
parseConfig = fromJResult "parsing configuration" . J.decodeStrict

-- | Wrapper over 'readConfig' and 'parseConfig'.
loadConfig :: FilePath -> IO (Result ConfigData)
loadConfig = fmap parseConfig . readConfig

-- * Query functions

82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
-- | Computes the nodes covered by a disk.
computeDiskNodes :: Disk -> S.Set String
computeDiskNodes dsk =
  case diskLogicalId dsk of
    LIDDrbd8 nodeA nodeB _ _ _ _ -> S.fromList [nodeA, nodeB]
    _ -> S.empty

-- | Computes all disk-related nodes of an instance. For non-DRBD,
-- this will be empty, for DRBD it will contain both the primary and
-- the secondaries.
instDiskNodes :: Instance -> S.Set String
instDiskNodes = S.unions . map computeDiskNodes . instDisks

-- | Computes all nodes of an instance.
instNodes :: Instance -> S.Set String
instNodes inst = instPrimaryNode inst `S.insert` instDiskNodes inst

-- | Computes the secondary nodes of an instance. Since this is valid
-- only for DRBD, we call directly 'instDiskNodes', skipping over the
-- extra primary insert.
instSecondaryNodes :: Instance -> S.Set String
instSecondaryNodes inst =
  instPrimaryNode inst `S.delete` instDiskNodes inst

106
107
108
-- | Get instances of a given node.
getNodeInstances :: ConfigData -> String -> ([Instance], [Instance])
getNodeInstances cfg nname =
Iustin Pop's avatar
Iustin Pop committed
109
    let all_inst = M.elems . fromContainer . configInstances $ cfg
110
        pri_inst = filter ((== nname) . instPrimaryNode) all_inst
111
        sec_inst = filter ((nname `S.member`) . instSecondaryNodes) all_inst
112
113
    in (pri_inst, sec_inst)

114
115
116
-- | Computes the role of a node.
getNodeRole :: ConfigData -> Node -> NodeRole
getNodeRole cfg node
Iustin Pop's avatar
Iustin Pop committed
117
  | nodeName node == clusterMasterNode (configCluster cfg) = NRMaster
118
119
120
121
122
  | nodeMasterCandidate node = NRCandidate
  | nodeDrained node = NRDrained
  | nodeOffline node = NROffline
  | otherwise = NRRegular

123
124
125
-- | Returns the default cluster link.
getDefaultNicLink :: ConfigData -> String
getDefaultNicLink =
Iustin Pop's avatar
Iustin Pop committed
126
127
  nicpLink . (M.! C.ppDefault) . fromContainer .
  clusterNicparams . configCluster
128
129
130
131
132
133

-- | Returns instances of a given link.
getInstancesIpByLink :: LinkIpMap -> String -> [String]
getInstancesIpByLink linkipmap link =
  M.keys $ M.findWithDefault M.empty link linkipmap

134
135
136
137
138
-- | Generic lookup function that converts from a possible abbreviated
-- name to a full name.
getItem :: String -> String -> M.Map String a -> Result a
getItem kind name allitems = do
  let lresult = lookupName (M.keys allitems) name
Iustin Pop's avatar
Iustin Pop committed
139
      err msg = Bad $ kind ++ " name " ++ name ++ " " ++ msg
140
141
142
143
144
145
146
147
  fullname <- case lrMatchPriority lresult of
                PartialMatch -> Ok $ lrContent lresult
                ExactMatch -> Ok $ lrContent lresult
                MultipleMatch -> err "has multiple matches"
                FailMatch -> err "not found"
  maybe (err "not found after successfull match?!") Ok $
        M.lookup fullname allitems

148
149
-- | Looks up a node.
getNode :: ConfigData -> String -> Result Node
Iustin Pop's avatar
Iustin Pop committed
150
getNode cfg name = getItem "Node" name (fromContainer $ configNodes cfg)
151
152
153

-- | Looks up an instance.
getInstance :: ConfigData -> String -> Result Instance
Iustin Pop's avatar
Iustin Pop committed
154
155
getInstance cfg name =
  getItem "Instance" name (fromContainer $ configInstances cfg)
156

157
158
159
160
161
162
163
164
165
-- | Looks up a node group. This is more tricky than for
-- node/instances since the groups map is indexed by uuid, not name.
getGroup :: ConfigData -> String -> Result NodeGroup
getGroup cfg name =
  let groups = fromContainer (configNodegroups cfg)
  in case getItem "NodeGroup" name groups of
       -- if not found by uuid, we need to look it up by name, slow
       Ok grp -> Ok grp
       Bad _ -> let by_name = M.mapKeys
Iustin Pop's avatar
Iustin Pop committed
166
                              (groupName . (M.!) groups) groups
167
168
                in getItem "NodeGroup" name by_name

169
170
171
172
173
-- | Computes a node group's node params.
getGroupNdParams :: ConfigData -> NodeGroup -> FilledNDParams
getGroupNdParams cfg ng =
  fillNDParams (clusterNdparams $ configCluster cfg) (groupNdparams ng)

174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
-- | Computes a node group's ipolicy.
getGroupIpolicy :: ConfigData -> NodeGroup -> FilledIPolicy
getGroupIpolicy cfg ng =
  fillIPolicy (clusterIpolicy $ configCluster cfg) (groupIpolicy ng)

-- | Get nodes of a given node group.
getGroupNodes :: ConfigData -> String -> [Node]
getGroupNodes cfg gname =
  let all_nodes = M.elems . fromContainer . configNodes $ cfg in
  filter ((==gname) . nodeGroup) all_nodes

-- | Get (primary, secondary) instances of a given node group.
getGroupInstances :: ConfigData -> String -> ([Instance], [Instance])
getGroupInstances cfg gname =
  let gnodes = map nodeName (getGroupNodes cfg gname)
      ginsts = map (getNodeInstances cfg) gnodes in
  (concatMap fst ginsts, concatMap snd ginsts)

192
193
194
-- | Looks up an instance's primary node.
getInstPrimaryNode :: ConfigData -> String -> Result Node
getInstPrimaryNode cfg name =
Iustin Pop's avatar
Iustin Pop committed
195
  liftM instPrimaryNode (getInstance cfg name) >>= getNode cfg
196

197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
-- | Filters DRBD minors for a given node.
getDrbdMinorsForNode :: String -> Disk -> [(Int, String)]
getDrbdMinorsForNode node disk =
  let child_minors = concatMap (getDrbdMinorsForNode node) (diskChildren disk)
      this_minors =
        case diskLogicalId disk of
          LIDDrbd8 nodeA nodeB _ minorA minorB _
            | nodeA == node -> [(minorA, nodeB)]
            | nodeB == node -> [(minorB, nodeA)]
          _ -> []
  in this_minors ++ child_minors

-- | String for primary role.
rolePrimary :: String
rolePrimary = "primary"

-- | String for secondary role.
roleSecondary :: String
roleSecondary = "secondary"

-- | Gets the list of DRBD minors for an instance that are related to
-- a given node.
getInstMinorsForNode :: String -> Instance
                     -> [(String, Int, String, String, String, String)]
getInstMinorsForNode node inst =
  let role = if node == instPrimaryNode inst
               then rolePrimary
               else roleSecondary
      iname = instName inst
  -- FIXME: the disk/ build there is hack-ish; unify this in a
  -- separate place, or reuse the iv_name (but that is deprecated on
  -- the Python side)
  in concatMap (\(idx, dsk) ->
            [(node, minor, iname, "disk/" ++ show idx, role, peer)
               | (minor, peer) <- getDrbdMinorsForNode node dsk]) .
     zip [(0::Int)..] . instDisks $ inst

234
235
236
237
238
239
240
241
242
243
244
245
-- | Builds link -> ip -> instname map.
--
-- TODO: improve this by splitting it into multiple independent functions:
--
-- * abstract the \"fetch instance with filled params\" functionality
--
-- * abstsract the [instance] -> [(nic, instance_name)] part
--
-- * etc.
buildLinkIpInstnameMap :: ConfigData -> LinkIpMap
buildLinkIpInstnameMap cfg =
  let cluster = configCluster cfg
Iustin Pop's avatar
Iustin Pop committed
246
247
      instances = M.elems . fromContainer . configInstances $ cfg
      defparams = (M.!) (fromContainer $ clusterNicparams cluster) C.ppDefault
248
249
250
251
      nics = concatMap (\i -> [(instName i, nic) | nic <- instNics i])
             instances
  in foldl' (\accum (iname, nic) ->
               let pparams = nicNicparams nic
Iustin Pop's avatar
Iustin Pop committed
252
                   fparams = fillNicParams defparams pparams
253
254
255
                   link = nicpLink fparams
               in case nicIp nic of
                    Nothing -> accum
Iustin Pop's avatar
Iustin Pop committed
256
                    Just ip -> let oldipmap = M.findWithDefault M.empty
257
258
259
260
                                              link accum
                                   newipmap = M.insert ip iname oldipmap
                               in M.insert link newipmap accum
            ) M.empty nics
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283


-- | Returns a node's group, with optional failure if we can't find it
-- (configuration corrupt).
getGroupOfNode :: ConfigData -> Node -> Maybe NodeGroup
getGroupOfNode cfg node =
  M.lookup (nodeGroup node) (fromContainer . configNodegroups $ cfg)

-- | Returns a node's ndparams, filled.
getNodeNdParams :: ConfigData -> Node -> Maybe FilledNDParams
getNodeNdParams cfg node = do
  group <- getGroupOfNode cfg node
  let gparams = getGroupNdParams cfg group
  return $ fillNDParams gparams (nodeNdparams node)

instance NdParamObject Node where
  getNdParamsOf = getNodeNdParams

instance NdParamObject NodeGroup where
  getNdParamsOf cfg = Just . getGroupNdParams cfg

instance NdParamObject Cluster where
  getNdParamsOf _ = Just . clusterNdparams