Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / Config.hs @ a6a6a1b5

History | View | Annotate | Download (15.1 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
    , saveConfig
31
    , getNodeInstances
32
    , getNodeRole
33
    , getNodeNdParams
34
    , getDefaultNicLink
35
    , getDefaultHypervisor
36
    , getInstancesIpByLink
37
    , getMasterCandidates
38
    , getNode
39
    , getInstance
40
    , getGroup
41
    , getGroupNdParams
42
    , getGroupIpolicy
43
    , getGroupDiskParams
44
    , getGroupNodes
45
    , getGroupInstances
46
    , getGroupOfNode
47
    , getInstPrimaryNode
48
    , getInstMinorsForNode
49
    , getInstAllNodes
50
    , getFilledInstHvParams
51
    , getFilledInstBeParams
52
    , getFilledInstOsParams
53
    , getNetwork
54
    , buildLinkIpInstnameMap
55
    , instNodes
56
    ) where
57

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

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

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

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

    
79
-- | Reads the config file.
80
readConfig :: FilePath -> IO (Result String)
81
readConfig = runResultT . liftIO . readFile
82

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

    
87
-- | Encodes the configuration file.
88
encodeConfig :: ConfigData -> String
89
encodeConfig = J.encodeStrict
90

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

    
95
-- | Wrapper over 'hPutStr' and 'encodeConfig'.
96
saveConfig :: Handle -> ConfigData -> IO ()
97
saveConfig fh = hPutStr fh . encodeConfig
98

    
99
-- * Query functions
100

    
101
-- | Computes the nodes covered by a disk.
102
computeDiskNodes :: Disk -> S.Set String
103
computeDiskNodes dsk =
104
  case diskLogicalId dsk of
105
    LIDDrbd8 nodeA nodeB _ _ _ _ -> S.fromList [nodeA, nodeB]
106
    _ -> S.empty
107

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

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

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

    
125
-- | Get instances of a given node.
126
-- The node is specified through its UUID.
127
getNodeInstances :: ConfigData -> String -> ([Instance], [Instance])
128
getNodeInstances cfg nname =
129
    let all_inst = M.elems . fromContainer . configInstances $ cfg
130
        pri_inst = filter ((== nname) . instPrimaryNode) all_inst
131
        sec_inst = filter ((nname `S.member`) . instSecondaryNodes) all_inst
132
    in (pri_inst, sec_inst)
133

    
134
-- | Computes the role of a node.
135
getNodeRole :: ConfigData -> Node -> NodeRole
136
getNodeRole cfg node
137
  | nodeUuid node == clusterMasterNode (configCluster cfg) = NRMaster
138
  | nodeMasterCandidate node = NRCandidate
139
  | nodeDrained node = NRDrained
140
  | nodeOffline node = NROffline
141
  | otherwise = NRRegular
142

    
143
-- | Get the list of master candidates.
144
getMasterCandidates :: ConfigData -> [Node]
145
getMasterCandidates cfg = 
146
  filter ((==) NRCandidate . getNodeRole cfg)
147
    (map snd . M.toList . fromContainer . configNodes $ cfg)
148

    
149
-- | Returns the default cluster link.
150
getDefaultNicLink :: ConfigData -> String
151
getDefaultNicLink =
152
  nicpLink . (M.! C.ppDefault) . fromContainer .
153
  clusterNicparams . configCluster
154

    
155
-- | Returns the default cluster hypervisor.
156
getDefaultHypervisor :: ConfigData -> Hypervisor
157
getDefaultHypervisor cfg =
158
  case clusterEnabledHypervisors $ configCluster cfg of
159
    -- FIXME: this case shouldn't happen (configuration broken), but
160
    -- for now we handle it here because we're not authoritative for
161
    -- the config
162
    []  -> XenPvm
163
    x:_ -> x
164

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

    
170
-- | Generic lookup function that converts from a possible abbreviated
171
-- name to a full name.
172
getItem :: String -> String -> M.Map String a -> ErrorResult a
173
getItem kind name allitems = do
174
  let lresult = lookupName (M.keys allitems) name
175
      err msg = Bad $ OpPrereqError (kind ++ " name " ++ name ++ " " ++ msg)
176
                        ECodeNoEnt
177
  fullname <- case lrMatchPriority lresult of
178
                PartialMatch -> Ok $ lrContent lresult
179
                ExactMatch -> Ok $ lrContent lresult
180
                MultipleMatch -> err "has multiple matches"
181
                FailMatch -> err "not found"
182
  maybe (err "not found after successfull match?!") Ok $
183
        M.lookup fullname allitems
184

    
185
-- | Looks up a node by name or uuid.
186
getNode :: ConfigData -> String -> ErrorResult Node
187
getNode cfg name =
188
  let nodes = fromContainer (configNodes cfg)
189
  in case getItem "Node" name nodes of
190
       -- if not found by uuid, we need to look it up by name
191
       Ok node -> Ok node
192
       Bad _ -> let by_name = M.mapKeys
193
                              (nodeName . (M.!) nodes) nodes
194
                in getItem "Node" name by_name
195

    
196
-- | Looks up an instance by name or uuid.
197
getInstance :: ConfigData -> String -> ErrorResult Instance
198
getInstance cfg name =
199
  let instances = fromContainer (configInstances cfg)
200
  in case getItem "Instance" name instances of
201
       -- if not found by uuid, we need to look it up by name
202
       Ok inst -> Ok inst
203
       Bad _ -> let by_name = M.mapKeys
204
                              (instName . (M.!) instances) instances
205
                in getItem "Instance" name by_name
206

    
207
-- | Looks up a node group by name or uuid.
208
getGroup :: ConfigData -> String -> ErrorResult NodeGroup
209
getGroup cfg name =
210
  let groups = fromContainer (configNodegroups cfg)
211
  in case getItem "NodeGroup" name groups of
212
       -- if not found by uuid, we need to look it up by name, slow
213
       Ok grp -> Ok grp
214
       Bad _ -> let by_name = M.mapKeys
215
                              (groupName . (M.!) groups) groups
216
                in getItem "NodeGroup" name by_name
217

    
218
-- | Computes a node group's node params.
219
getGroupNdParams :: ConfigData -> NodeGroup -> FilledNDParams
220
getGroupNdParams cfg ng =
221
  fillNDParams (clusterNdparams $ configCluster cfg) (groupNdparams ng)
222

    
223
-- | Computes a node group's ipolicy.
224
getGroupIpolicy :: ConfigData -> NodeGroup -> FilledIPolicy
225
getGroupIpolicy cfg ng =
226
  fillIPolicy (clusterIpolicy $ configCluster cfg) (groupIpolicy ng)
227

    
228
-- | Computes a group\'s (merged) disk params.
229
getGroupDiskParams :: ConfigData -> NodeGroup -> DiskParams
230
getGroupDiskParams cfg ng =
231
  GenericContainer $
232
  fillDict (fromContainer . clusterDiskparams $ configCluster cfg)
233
           (fromContainer $ groupDiskparams ng) []
234

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

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

    
248
-- | Looks up a network. If looking up by uuid fails, we look up
249
-- by name.
250
getNetwork :: ConfigData -> String -> ErrorResult Network
251
getNetwork cfg name =
252
  let networks = fromContainer (configNetworks cfg)
253
  in case getItem "Network" name networks of
254
       Ok net -> Ok net
255
       Bad _ -> let by_name = M.mapKeys
256
                              (fromNonEmpty . networkName . (M.!) networks)
257
                              networks
258
                in getItem "Network" name by_name
259

    
260
-- | Retrieves the instance hypervisor params, missing values filled with
261
-- cluster defaults.
262
getFilledInstHvParams :: [String] -> ConfigData -> Instance -> HvParams
263
getFilledInstHvParams globals cfg inst =
264
  -- First get the defaults of the parent
265
  let hvName = hypervisorToRaw . instHypervisor $ inst
266
      hvParamMap = fromContainer . clusterHvparams $ configCluster cfg
267
      parentHvParams = maybe M.empty fromContainer $ M.lookup hvName hvParamMap
268
  -- Then the os defaults for the given hypervisor
269
      osName = instOs inst
270
      osParamMap = fromContainer . clusterOsHvp $ configCluster cfg
271
      osHvParamMap = maybe M.empty fromContainer $ M.lookup osName osParamMap
272
      osHvParams = maybe M.empty fromContainer $ M.lookup hvName osHvParamMap
273
  -- Then the child
274
      childHvParams = fromContainer . instHvparams $ inst
275
  -- Helper function
276
      fillFn con val = fillDict con val globals
277
  in GenericContainer $ fillFn (fillFn parentHvParams osHvParams) childHvParams
278

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

    
287
-- | Retrieves the instance os params, missing values filled with cluster
288
-- defaults. This does NOT include private and secret parameters.
289
getFilledInstOsParams :: ConfigData -> Instance -> OsParams
290
getFilledInstOsParams cfg inst =
291
  let osLookupName = takeWhile (/= '+') (instOs inst)
292
      osParamMap = fromContainer . clusterOsparams $ configCluster cfg
293
      childOsParams = instOsparams inst
294
  in case getItem "OsParams" osLookupName osParamMap of
295
       Ok parentOsParams -> GenericContainer $
296
                              fillDict (fromContainer parentOsParams)
297
                                       (fromContainer childOsParams) []
298
       Bad _             -> childOsParams
299

    
300
-- | Looks up an instance's primary node.
301
getInstPrimaryNode :: ConfigData -> String -> ErrorResult Node
302
getInstPrimaryNode cfg name =
303
  liftM instPrimaryNode (getInstance cfg name) >>= getNode cfg
304

    
305
-- | Retrieves all nodes hosting a DRBD disk
306
getDrbdDiskNodes :: ConfigData -> Disk -> [Node]
307
getDrbdDiskNodes cfg disk =
308
  let retrieved = case diskLogicalId disk of
309
                    LIDDrbd8 nodeA nodeB _ _ _ _ ->
310
                      justOk [getNode cfg nodeA, getNode cfg nodeB]
311
                    _                            -> []
312
  in retrieved ++ concatMap (getDrbdDiskNodes cfg) (diskChildren disk)
313

    
314
-- | Retrieves all the nodes of the instance.
315
--
316
-- As instances not using DRBD can be sent as a parameter as well,
317
-- the primary node has to be appended to the results.
318
getInstAllNodes :: ConfigData -> String -> ErrorResult [Node]
319
getInstAllNodes cfg name = do
320
  inst <- getInstance cfg name
321
  let diskNodes = concatMap (getDrbdDiskNodes cfg) $ instDisks inst
322
  pNode <- getInstPrimaryNode cfg name
323
  return . nub $ pNode:diskNodes
324

    
325
-- | Filters DRBD minors for a given node.
326
getDrbdMinorsForNode :: String -> Disk -> [(Int, String)]
327
getDrbdMinorsForNode node disk =
328
  let child_minors = concatMap (getDrbdMinorsForNode node) (diskChildren disk)
329
      this_minors =
330
        case diskLogicalId disk of
331
          LIDDrbd8 nodeA nodeB _ minorA minorB _
332
            | nodeA == node -> [(minorA, nodeB)]
333
            | nodeB == node -> [(minorB, nodeA)]
334
          _ -> []
335
  in this_minors ++ child_minors
336

    
337
-- | String for primary role.
338
rolePrimary :: String
339
rolePrimary = "primary"
340

    
341
-- | String for secondary role.
342
roleSecondary :: String
343
roleSecondary = "secondary"
344

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

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

    
390

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

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

    
404
instance NdParamObject Node where
405
  getNdParamsOf = getNodeNdParams
406

    
407
instance NdParamObject NodeGroup where
408
  getNdParamsOf cfg = Just . getGroupNdParams cfg
409

    
410
instance NdParamObject Cluster where
411
  getNdParamsOf _ = Just . clusterNdparams