Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / Config.hs @ e817723c

History | View | Annotate | Download (14.8 kB)

1
{-| Implementation of the Ganeti configuration database.
2

    
3
-}
4

    
5
{-
6

    
7
Copyright (C) 2011, 2012 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.Config
27
    ( LinkIpMap
28
    , NdParamObject(..)
29
    , loadConfig
30
    , getNodeInstances
31
    , getNodeRole
32
    , getNodeNdParams
33
    , getDefaultNicLink
34
    , getDefaultHypervisor
35
    , getInstancesIpByLink
36
    , getMasterCandidates
37
    , getNode
38
    , getInstance
39
    , getGroup
40
    , getGroupNdParams
41
    , getGroupIpolicy
42
    , getGroupDiskParams
43
    , getGroupNodes
44
    , getGroupInstances
45
    , getGroupOfNode
46
    , getInstPrimaryNode
47
    , getInstMinorsForNode
48
    , getInstAllNodes
49
    , getFilledInstHvParams
50
    , getFilledInstBeParams
51
    , getFilledInstOsParams
52
    , getNetwork
53
    , buildLinkIpInstnameMap
54
    , instNodes
55
    ) where
56

    
57
import Control.Monad (liftM)
58
import Data.List (foldl', nub)
59
import qualified Data.Map as M
60
import qualified Data.Set as S
61
import qualified Text.JSON as J
62

    
63
import Ganeti.BasicTypes
64
import qualified Ganeti.Constants as C
65
import Ganeti.Errors
66
import Ganeti.JSON
67
import Ganeti.Objects
68
import Ganeti.Types
69

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

    
73
-- | Type class denoting objects which have node parameters.
74
class NdParamObject a where
75
  getNdParamsOf :: ConfigData -> a -> Maybe FilledNDParams
76

    
77
-- | Reads the config file.
78
readConfig :: FilePath -> IO String
79
readConfig = readFile
80

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

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

    
89
-- * Query functions
90

    
91
-- | Computes the nodes covered by a disk.
92
computeDiskNodes :: Disk -> S.Set String
93
computeDiskNodes dsk =
94
  case diskLogicalId dsk of
95
    LIDDrbd8 nodeA nodeB _ _ _ _ -> S.fromList [nodeA, nodeB]
96
    _ -> S.empty
97

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

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

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

    
115
-- | Get instances of a given node.
116
-- The node is specified through its UUID.
117
getNodeInstances :: ConfigData -> String -> ([Instance], [Instance])
118
getNodeInstances cfg nname =
119
    let all_inst = M.elems . fromContainer . configInstances $ cfg
120
        pri_inst = filter ((== nname) . instPrimaryNode) all_inst
121
        sec_inst = filter ((nname `S.member`) . instSecondaryNodes) all_inst
122
    in (pri_inst, sec_inst)
123

    
124
-- | Computes the role of a node.
125
getNodeRole :: ConfigData -> Node -> NodeRole
126
getNodeRole cfg node
127
  | nodeUuid node == clusterMasterNode (configCluster cfg) = NRMaster
128
  | nodeMasterCandidate node = NRCandidate
129
  | nodeDrained node = NRDrained
130
  | nodeOffline node = NROffline
131
  | otherwise = NRRegular
132

    
133
-- | Get the list of master candidates.
134
getMasterCandidates :: ConfigData -> [Node]
135
getMasterCandidates cfg = 
136
  filter ((==) NRCandidate . getNodeRole cfg)
137
    (map snd . M.toList . fromContainer . configNodes $ cfg)
138

    
139
-- | Returns the default cluster link.
140
getDefaultNicLink :: ConfigData -> String
141
getDefaultNicLink =
142
  nicpLink . (M.! C.ppDefault) . fromContainer .
143
  clusterNicparams . configCluster
144

    
145
-- | Returns the default cluster hypervisor.
146
getDefaultHypervisor :: ConfigData -> Hypervisor
147
getDefaultHypervisor cfg =
148
  case clusterEnabledHypervisors $ configCluster cfg of
149
    -- FIXME: this case shouldn't happen (configuration broken), but
150
    -- for now we handle it here because we're not authoritative for
151
    -- the config
152
    []  -> XenPvm
153
    x:_ -> x
154

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

    
160
-- | Generic lookup function that converts from a possible abbreviated
161
-- name to a full name.
162
getItem :: String -> String -> M.Map String a -> ErrorResult a
163
getItem kind name allitems = do
164
  let lresult = lookupName (M.keys allitems) name
165
      err msg = Bad $ OpPrereqError (kind ++ " name " ++ name ++ " " ++ msg)
166
                        ECodeNoEnt
167
  fullname <- case lrMatchPriority lresult of
168
                PartialMatch -> Ok $ lrContent lresult
169
                ExactMatch -> Ok $ lrContent lresult
170
                MultipleMatch -> err "has multiple matches"
171
                FailMatch -> err "not found"
172
  maybe (err "not found after successfull match?!") Ok $
173
        M.lookup fullname allitems
174

    
175
-- | Looks up a node by name or uuid.
176
getNode :: ConfigData -> String -> ErrorResult Node
177
getNode cfg name =
178
  let nodes = fromContainer (configNodes cfg)
179
  in case getItem "Node" name nodes of
180
       -- if not found by uuid, we need to look it up by name
181
       Ok node -> Ok node
182
       Bad _ -> let by_name = M.mapKeys
183
                              (nodeName . (M.!) nodes) nodes
184
                in getItem "Node" name by_name
185

    
186
-- | Looks up an instance by name or uuid.
187
getInstance :: ConfigData -> String -> ErrorResult Instance
188
getInstance cfg name =
189
  let instances = fromContainer (configInstances cfg)
190
  in case getItem "Instance" name instances of
191
       -- if not found by uuid, we need to look it up by name
192
       Ok inst -> Ok inst
193
       Bad _ -> let by_name = M.mapKeys
194
                              (instName . (M.!) instances) instances
195
                in getItem "Instance" name by_name
196

    
197
-- | Looks up a node group by name or uuid.
198
getGroup :: ConfigData -> String -> ErrorResult NodeGroup
199
getGroup cfg name =
200
  let groups = fromContainer (configNodegroups cfg)
201
  in case getItem "NodeGroup" name groups of
202
       -- if not found by uuid, we need to look it up by name, slow
203
       Ok grp -> Ok grp
204
       Bad _ -> let by_name = M.mapKeys
205
                              (groupName . (M.!) groups) groups
206
                in getItem "NodeGroup" name by_name
207

    
208
-- | Computes a node group's node params.
209
getGroupNdParams :: ConfigData -> NodeGroup -> FilledNDParams
210
getGroupNdParams cfg ng =
211
  fillNDParams (clusterNdparams $ configCluster cfg) (groupNdparams ng)
212

    
213
-- | Computes a node group's ipolicy.
214
getGroupIpolicy :: ConfigData -> NodeGroup -> FilledIPolicy
215
getGroupIpolicy cfg ng =
216
  fillIPolicy (clusterIpolicy $ configCluster cfg) (groupIpolicy ng)
217

    
218
-- | Computes a group\'s (merged) disk params.
219
getGroupDiskParams :: ConfigData -> NodeGroup -> DiskParams
220
getGroupDiskParams cfg ng =
221
  GenericContainer $
222
  fillDict (fromContainer . clusterDiskparams $ configCluster cfg)
223
           (fromContainer $ groupDiskparams ng) []
224

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

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

    
238
-- | Looks up a network. If looking up by uuid fails, we look up
239
-- by name.
240
getNetwork :: ConfigData -> String -> ErrorResult Network
241
getNetwork cfg name =
242
  let networks = fromContainer (configNetworks cfg)
243
  in case getItem "Network" name networks of
244
       Ok net -> Ok net
245
       Bad _ -> let by_name = M.mapKeys
246
                              (fromNonEmpty . networkName . (M.!) networks)
247
                              networks
248
                in getItem "Network" name by_name
249

    
250
-- | Retrieves the instance hypervisor params, missing values filled with
251
-- cluster defaults.
252
getFilledInstHvParams :: [String] -> ConfigData -> Instance -> HvParams
253
getFilledInstHvParams globals cfg inst =
254
  -- First get the defaults of the parent
255
  let hvName = hypervisorToRaw . instHypervisor $ inst
256
      hvParamMap = fromContainer . clusterHvparams $ configCluster cfg
257
      parentHvParams = maybe M.empty fromContainer $ M.lookup hvName hvParamMap
258
  -- Then the os defaults for the given hypervisor
259
      osName = instOs inst
260
      osParamMap = fromContainer . clusterOsHvp $ configCluster cfg
261
      osHvParamMap = maybe M.empty fromContainer $ M.lookup osName osParamMap
262
      osHvParams = maybe M.empty fromContainer $ M.lookup hvName osHvParamMap
263
  -- Then the child
264
      childHvParams = fromContainer . instHvparams $ inst
265
  -- Helper function
266
      fillFn con val = fillDict con val globals
267
  in GenericContainer $ fillFn (fillFn parentHvParams osHvParams) childHvParams
268

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

    
277
-- | Retrieves the instance os params, missing values filled with cluster
278
-- defaults.
279
getFilledInstOsParams :: ConfigData -> Instance -> OsParams
280
getFilledInstOsParams cfg inst =
281
  let osLookupName = takeWhile (/= '+') (instOs inst)
282
      osParamMap = fromContainer . clusterOsparams $ configCluster cfg
283
      childOsParams = instOsparams inst
284
  in case getItem "OsParams" osLookupName osParamMap of
285
       Ok parentOsParams -> GenericContainer $
286
                              fillDict (fromContainer parentOsParams)
287
                                       (fromContainer childOsParams) []
288
       Bad _             -> childOsParams
289

    
290
-- | Looks up an instance's primary node.
291
getInstPrimaryNode :: ConfigData -> String -> ErrorResult Node
292
getInstPrimaryNode cfg name =
293
  liftM instPrimaryNode (getInstance cfg name) >>= getNode cfg
294

    
295
-- | Retrieves all nodes hosting a DRBD disk
296
getDrbdDiskNodes :: ConfigData -> Disk -> [Node]
297
getDrbdDiskNodes cfg disk =
298
  let retrieved = case diskLogicalId disk of
299
                    LIDDrbd8 nodeA nodeB _ _ _ _ ->
300
                      justOk [getNode cfg nodeA, getNode cfg nodeB]
301
                    _                            -> []
302
  in retrieved ++ concatMap (getDrbdDiskNodes cfg) (diskChildren disk)
303

    
304
-- | Retrieves all the nodes of the instance.
305
--
306
-- As instances not using DRBD can be sent as a parameter as well,
307
-- the primary node has to be appended to the results.
308
getInstAllNodes :: ConfigData -> String -> ErrorResult [Node]
309
getInstAllNodes cfg name = do
310
  inst <- getInstance cfg name
311
  let diskNodes = concatMap (getDrbdDiskNodes cfg) $ instDisks inst
312
  pNode <- getInstPrimaryNode cfg name
313
  return . nub $ pNode:diskNodes
314

    
315
-- | Filters DRBD minors for a given node.
316
getDrbdMinorsForNode :: String -> Disk -> [(Int, String)]
317
getDrbdMinorsForNode node disk =
318
  let child_minors = concatMap (getDrbdMinorsForNode node) (diskChildren disk)
319
      this_minors =
320
        case diskLogicalId disk of
321
          LIDDrbd8 nodeA nodeB _ minorA minorB _
322
            | nodeA == node -> [(minorA, nodeB)]
323
            | nodeB == node -> [(minorB, nodeA)]
324
          _ -> []
325
  in this_minors ++ child_minors
326

    
327
-- | String for primary role.
328
rolePrimary :: String
329
rolePrimary = "primary"
330

    
331
-- | String for secondary role.
332
roleSecondary :: String
333
roleSecondary = "secondary"
334

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

    
352
-- | Builds link -> ip -> instname map.
353
--
354
-- TODO: improve this by splitting it into multiple independent functions:
355
--
356
-- * abstract the \"fetch instance with filled params\" functionality
357
--
358
-- * abstsract the [instance] -> [(nic, instance_name)] part
359
--
360
-- * etc.
361
buildLinkIpInstnameMap :: ConfigData -> LinkIpMap
362
buildLinkIpInstnameMap cfg =
363
  let cluster = configCluster cfg
364
      instances = M.elems . fromContainer . configInstances $ cfg
365
      defparams = (M.!) (fromContainer $ clusterNicparams cluster) C.ppDefault
366
      nics = concatMap (\i -> [(instName i, nic) | nic <- instNics i])
367
             instances
368
  in foldl' (\accum (iname, nic) ->
369
               let pparams = nicNicparams nic
370
                   fparams = fillNicParams defparams pparams
371
                   link = nicpLink fparams
372
               in case nicIp nic of
373
                    Nothing -> accum
374
                    Just ip -> let oldipmap = M.findWithDefault M.empty
375
                                              link accum
376
                                   newipmap = M.insert ip iname oldipmap
377
                               in M.insert link newipmap accum
378
            ) M.empty nics
379

    
380

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

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

    
394
instance NdParamObject Node where
395
  getNdParamsOf = getNodeNdParams
396

    
397
instance NdParamObject NodeGroup where
398
  getNdParamsOf cfg = Just . getGroupNdParams cfg
399

    
400
instance NdParamObject Cluster where
401
  getNdParamsOf _ = Just . clusterNdparams