Config.hs 18 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
    , loadConfig
30
    , saveConfig
31
    , getNodeInstances
32
33
    , getNodeRole
    , getNodeNdParams
34
    , getDefaultNicLink
35
    , getDefaultHypervisor
36
    , getInstancesIpByLink
37
    , getMasterNodes
38
    , getMasterCandidates
39
    , getMasterOrCandidates
40
    , getMasterNetworkParameters
41
    , getOnlineNodes
42
43
    , getNode
    , getInstance
44
    , getDisk
45
    , getGroup
46
    , getGroupNdParams
47
    , getGroupIpolicy
48
    , getGroupDiskParams
49
50
    , getGroupNodes
    , getGroupInstances
51
    , getGroupOfNode
52
    , getInstPrimaryNode
53
    , getInstMinorsForNode
54
    , getInstAllNodes
55
56
    , getInstDisks
    , getInstDisksFromObj
57
    , getDrbdMinorsForInstance
Hrvoje Ribicic's avatar
Hrvoje Ribicic committed
58
59
60
    , getFilledInstHvParams
    , getFilledInstBeParams
    , getFilledInstOsParams
61
    , getNetwork
62
    , buildLinkIpInstnameMap
63
    , instNodes
64
65
    ) where

Iustin Pop's avatar
Iustin Pop committed
66
import Control.Monad (liftM)
67
import qualified Data.Foldable as F
68
import Data.List (foldl', nub)
69
import qualified Data.Map as M
70
import qualified Data.Set as S
71
import qualified Text.JSON as J
72
import System.IO
73
74
75

import Ganeti.BasicTypes
import qualified Ganeti.Constants as C
76
77
import Ganeti.Errors
import Ganeti.JSON
78
import Ganeti.Objects
79
import Ganeti.Types
80
81
82
83

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

84
85
86
87
-- | Type class denoting objects which have node parameters.
class NdParamObject a where
  getNdParamsOf :: ConfigData -> a -> Maybe FilledNDParams

88
-- | Reads the config file.
89
90
readConfig :: FilePath -> IO (Result String)
readConfig = runResultT . liftIO . readFile
91
92
93
94
95

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

96
97
98
99
-- | Encodes the configuration file.
encodeConfig :: ConfigData -> String
encodeConfig = J.encodeStrict

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

104
105
106
107
-- | Wrapper over 'hPutStr' and 'encodeConfig'.
saveConfig :: Handle -> ConfigData -> IO ()
saveConfig fh = hPutStr fh . encodeConfig

108
109
-- * Query functions

110
111
112
113
114
115
116
117
118
119
-- | 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.
120
121
122
123
124
instDiskNodes :: ConfigData -> Instance -> S.Set String
instDiskNodes cfg inst =
  case getInstDisksFromObj cfg inst of
    Ok disks -> S.unions $ map computeDiskNodes disks
    Bad _ -> S.empty
125
126

-- | Computes all nodes of an instance.
127
128
instNodes :: ConfigData -> Instance -> S.Set String
instNodes cfg inst = instPrimaryNode inst `S.insert` instDiskNodes cfg inst
129
130
131
132

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

137
-- | Get instances of a given node.
138
-- The node is specified through its UUID.
139
140
getNodeInstances :: ConfigData -> String -> ([Instance], [Instance])
getNodeInstances cfg nname =
Iustin Pop's avatar
Iustin Pop committed
141
    let all_inst = M.elems . fromContainer . configInstances $ cfg
142
        pri_inst = filter ((== nname) . instPrimaryNode) all_inst
143
        sec_inst = filter ((nname `S.member`) . instSecondaryNodes cfg) all_inst
144
145
    in (pri_inst, sec_inst)

146
147
148
-- | Computes the role of a node.
getNodeRole :: ConfigData -> Node -> NodeRole
getNodeRole cfg node
Klaus Aehlig's avatar
Klaus Aehlig committed
149
  | nodeUuid node == clusterMasterNode (configCluster cfg) = NRMaster
150
151
152
153
154
  | nodeMasterCandidate node = NRCandidate
  | nodeDrained node = NRDrained
  | nodeOffline node = NROffline
  | otherwise = NRRegular

155
156
157
158
159
-- | Get the list of the master nodes (usually one).
getMasterNodes :: ConfigData -> [Node]
getMasterNodes cfg =
  filter ((==) NRMaster . getNodeRole cfg) . F.toList . configNodes $ cfg

160
-- | Get the list of master candidates, /not including/ the master itself.
161
162
getMasterCandidates :: ConfigData -> [Node]
getMasterCandidates cfg = 
163
164
  filter ((==) NRCandidate . getNodeRole cfg) . F.toList . configNodes $ cfg

165
166
167
168
169
170
-- | Get the list of master candidates, /including/ the master.
getMasterOrCandidates :: ConfigData -> [Node]
getMasterOrCandidates cfg =
  let isMC r = (r == NRCandidate) || (r == NRMaster)
  in filter (isMC . getNodeRole cfg) . F.toList . configNodes $ cfg

171
172
173
174
175
176
177
178
179
180
181
182
-- | Get the network parameters for the master IP address.
getMasterNetworkParameters :: ConfigData -> MasterNetworkParameters
getMasterNetworkParameters cfg =
  let cluster = configCluster cfg
  in MasterNetworkParameters
      { masterNetworkParametersUuid = clusterMasterNode cluster
      , masterNetworkParametersIp = clusterMasterIp cluster
      , masterNetworkParametersNetmask = clusterMasterNetmask cluster
      , masterNetworkParametersNetdev = clusterMasterNetdev cluster
      , masterNetworkParametersIpFamily = clusterPrimaryIpFamily cluster
      }

183
184
185
-- | Get the list of online nodes.
getOnlineNodes :: ConfigData -> [Node]
getOnlineNodes = filter (not . nodeOffline) . F.toList . configNodes
186

187
188
189
-- | Returns the default cluster link.
getDefaultNicLink :: ConfigData -> String
getDefaultNicLink =
Iustin Pop's avatar
Iustin Pop committed
190
191
  nicpLink . (M.! C.ppDefault) . fromContainer .
  clusterNicparams . configCluster
192

193
194
195
196
197
198
199
200
201
202
-- | Returns the default cluster hypervisor.
getDefaultHypervisor :: ConfigData -> Hypervisor
getDefaultHypervisor cfg =
  case clusterEnabledHypervisors $ configCluster cfg of
    -- FIXME: this case shouldn't happen (configuration broken), but
    -- for now we handle it here because we're not authoritative for
    -- the config
    []  -> XenPvm
    x:_ -> x

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

208
209
-- | Generic lookup function that converts from a possible abbreviated
-- name to a full name.
210
getItem :: String -> String -> M.Map String a -> ErrorResult a
211
212
getItem kind name allitems = do
  let lresult = lookupName (M.keys allitems) name
213
214
      err msg = Bad $ OpPrereqError (kind ++ " name " ++ name ++ " " ++ msg)
                        ECodeNoEnt
215
216
217
218
219
220
221
222
  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

Thomas Thrainer's avatar
Thomas Thrainer committed
223
-- | Looks up a node by name or uuid.
224
getNode :: ConfigData -> String -> ErrorResult Node
Thomas Thrainer's avatar
Thomas Thrainer committed
225
226
227
228
229
230
231
232
getNode cfg name =
  let nodes = fromContainer (configNodes cfg)
  in case getItem "Node" name nodes of
       -- if not found by uuid, we need to look it up by name
       Ok node -> Ok node
       Bad _ -> let by_name = M.mapKeys
                              (nodeName . (M.!) nodes) nodes
                in getItem "Node" name by_name
233

234
-- | Looks up an instance by name or uuid.
235
getInstance :: ConfigData -> String -> ErrorResult Instance
Iustin Pop's avatar
Iustin Pop committed
236
getInstance cfg name =
237
238
239
240
241
242
243
  let instances = fromContainer (configInstances cfg)
  in case getItem "Instance" name instances of
       -- if not found by uuid, we need to look it up by name
       Ok inst -> Ok inst
       Bad _ -> let by_name = M.mapKeys
                              (instName . (M.!) instances) instances
                in getItem "Instance" name by_name
244

245
246
247
248
249
250
-- | Looks up a disk by uuid.
getDisk :: ConfigData -> String -> ErrorResult Disk
getDisk cfg name =
  let disks = fromContainer (configDisks cfg)
  in getItem "Disk" name disks

251
-- | Looks up a node group by name or uuid.
252
getGroup :: ConfigData -> String -> ErrorResult NodeGroup
253
254
255
256
257
258
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
259
                              (groupName . (M.!) groups) groups
260
261
                in getItem "NodeGroup" name by_name

262
263
264
265
266
-- | Computes a node group's node params.
getGroupNdParams :: ConfigData -> NodeGroup -> FilledNDParams
getGroupNdParams cfg ng =
  fillNDParams (clusterNdparams $ configCluster cfg) (groupNdparams ng)

267
268
269
270
271
-- | Computes a node group's ipolicy.
getGroupIpolicy :: ConfigData -> NodeGroup -> FilledIPolicy
getGroupIpolicy cfg ng =
  fillIPolicy (clusterIpolicy $ configCluster cfg) (groupIpolicy ng)

272
-- | Computes a group\'s (merged) disk params.
273
getGroupDiskParams :: ConfigData -> NodeGroup -> GroupDiskParams
274
getGroupDiskParams cfg ng =
275
  GenericContainer $
276
277
278
  fillDict (fromContainer . clusterDiskparams $ configCluster cfg)
           (fromContainer $ groupDiskparams ng) []

279
280
281
282
283
284
285
286
287
-- | 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 =
288
  let gnodes = map nodeUuid (getGroupNodes cfg gname)
289
290
291
      ginsts = map (getNodeInstances cfg) gnodes in
  (concatMap fst ginsts, concatMap snd ginsts)

292
293
294
295
296
297
298
299
300
301
302
303
-- | Looks up a network. If looking up by uuid fails, we look up
-- by name.
getNetwork :: ConfigData -> String -> ErrorResult Network
getNetwork cfg name =
  let networks = fromContainer (configNetworks cfg)
  in case getItem "Network" name networks of
       Ok net -> Ok net
       Bad _ -> let by_name = M.mapKeys
                              (fromNonEmpty . networkName . (M.!) networks)
                              networks
                in getItem "Network" name by_name

Hrvoje Ribicic's avatar
Hrvoje Ribicic committed
304
305
-- | Retrieves the instance hypervisor params, missing values filled with
-- cluster defaults.
Hrvoje Ribicic's avatar
Hrvoje Ribicic committed
306
307
getFilledInstHvParams :: [String] -> ConfigData -> Instance -> HvParams
getFilledInstHvParams globals cfg inst =
Hrvoje Ribicic's avatar
Hrvoje Ribicic committed
308
309
310
311
312
313
314
315
316
317
318
319
  -- First get the defaults of the parent
  let hvName = hypervisorToRaw . instHypervisor $ inst
      hvParamMap = fromContainer . clusterHvparams $ configCluster cfg
      parentHvParams = maybe M.empty fromContainer $ M.lookup hvName hvParamMap
  -- Then the os defaults for the given hypervisor
      osName = instOs inst
      osParamMap = fromContainer . clusterOsHvp $ configCluster cfg
      osHvParamMap = maybe M.empty fromContainer $ M.lookup osName osParamMap
      osHvParams = maybe M.empty fromContainer $ M.lookup hvName osHvParamMap
  -- Then the child
      childHvParams = fromContainer . instHvparams $ inst
  -- Helper function
Hrvoje Ribicic's avatar
Hrvoje Ribicic committed
320
      fillFn con val = fillDict con val globals
Hrvoje Ribicic's avatar
Hrvoje Ribicic committed
321
322
323
324
325
326
327
328
329
330
331
  in GenericContainer $ fillFn (fillFn parentHvParams osHvParams) childHvParams

-- | Retrieves the instance backend params, missing values filled with cluster
-- defaults.
getFilledInstBeParams :: ConfigData -> Instance -> ErrorResult FilledBeParams
getFilledInstBeParams cfg inst = do
  let beParamMap = fromContainer . clusterBeparams . configCluster $ cfg
  parentParams <- getItem "FilledBeParams" C.ppDefault beParamMap
  return $ fillBeParams parentParams (instBeparams inst)

-- | Retrieves the instance os params, missing values filled with cluster
332
-- defaults. This does NOT include private and secret parameters.
Hrvoje Ribicic's avatar
Hrvoje Ribicic committed
333
334
335
336
337
338
339
340
341
342
343
getFilledInstOsParams :: ConfigData -> Instance -> OsParams
getFilledInstOsParams cfg inst =
  let osLookupName = takeWhile (/= '+') (instOs inst)
      osParamMap = fromContainer . clusterOsparams $ configCluster cfg
      childOsParams = instOsparams inst
  in case getItem "OsParams" osLookupName osParamMap of
       Ok parentOsParams -> GenericContainer $
                              fillDict (fromContainer parentOsParams)
                                       (fromContainer childOsParams) []
       Bad _             -> childOsParams

344
-- | Looks up an instance's primary node.
345
getInstPrimaryNode :: ConfigData -> String -> ErrorResult Node
346
getInstPrimaryNode cfg name =
Iustin Pop's avatar
Iustin Pop committed
347
  liftM instPrimaryNode (getInstance cfg name) >>= getNode cfg
348

349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
-- | Retrieves all nodes hosting a DRBD disk
getDrbdDiskNodes :: ConfigData -> Disk -> [Node]
getDrbdDiskNodes cfg disk =
  let retrieved = case diskLogicalId disk of
                    LIDDrbd8 nodeA nodeB _ _ _ _ ->
                      justOk [getNode cfg nodeA, getNode cfg nodeB]
                    _                            -> []
  in retrieved ++ concatMap (getDrbdDiskNodes cfg) (diskChildren disk)

-- | Retrieves all the nodes of the instance.
--
-- As instances not using DRBD can be sent as a parameter as well,
-- the primary node has to be appended to the results.
getInstAllNodes :: ConfigData -> String -> ErrorResult [Node]
getInstAllNodes cfg name = do
364
365
  inst_disks <- getInstDisks cfg name
  let diskNodes = concatMap (getDrbdDiskNodes cfg) inst_disks
366
367
368
  pNode <- getInstPrimaryNode cfg name
  return . nub $ pNode:diskNodes

369
370
371
-- | Get disks for a given instance.
-- The instance is specified by name or uuid.
getInstDisks :: ConfigData -> String -> ErrorResult [Disk]
372
373
getInstDisks cfg iname =
  getInstance cfg iname >>= mapM (getDisk cfg) . instDisks
374
375
376
377
378
379

-- | Get disks for a given instance object.
getInstDisksFromObj :: ConfigData -> Instance -> ErrorResult [Disk]
getInstDisksFromObj cfg =
  getInstDisks cfg . instUuid

380
381
382
383
384
385
386
387
-- | Returns the DRBD minors of a given 'Disk'
getDrbdMinorsForDisk :: Disk -> [(Int, String)]
getDrbdMinorsForDisk Disk { diskLogicalId = (LIDDrbd8 nA nB _ mnA mnB _)
                          , diskChildren = ch
                          } = [(mnA, nA), (mnB, nB)] ++
                              concatMap getDrbdMinorsForDisk ch
getDrbdMinorsForDisk d = concatMap getDrbdMinorsForDisk (diskChildren d)

388
389
390
391
392
393
394
395
396
397
398
399
-- | 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

400
401
402
403
404
405
-- | Returns the DRBD minors of a given instance
getDrbdMinorsForInstance :: ConfigData -> Instance
                         -> ErrorResult [(Int, String)]
getDrbdMinorsForInstance cfg =
  liftM (concatMap getDrbdMinorsForDisk) . getInstDisksFromObj cfg

406
407
408
409
410
411
412
413
414
415
-- | 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.
416
417
getInstMinorsForNode :: ConfigData
                     -> String -- ^ The UUID of a node.
418
                     -> Instance
419
                     -> [(String, Int, String, String, String, String)]
420
getInstMinorsForNode cfg node inst =
421
422
423
424
  let role = if node == instPrimaryNode inst
               then rolePrimary
               else roleSecondary
      iname = instName inst
425
426
427
      inst_disks = case getInstDisksFromObj cfg inst of
                     Ok disks -> disks
                     Bad _ -> []
428
429
430
431
432
433
  -- 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]) .
434
     zip [(0::Int)..] $ inst_disks
435

436
437
438
439
440
441
442
443
444
445
446
447
-- | 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
448
449
      instances = M.elems . fromContainer . configInstances $ cfg
      defparams = (M.!) (fromContainer $ clusterNicparams cluster) C.ppDefault
450
451
452
453
      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
454
                   fparams = fillNicParams defparams pparams
455
456
457
                   link = nicpLink fparams
               in case nicIp nic of
                    Nothing -> accum
Iustin Pop's avatar
Iustin Pop committed
458
                    Just ip -> let oldipmap = M.findWithDefault M.empty
459
460
461
462
                                              link accum
                                   newipmap = M.insert ip iname oldipmap
                               in M.insert link newipmap accum
            ) M.empty nics
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485


-- | 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