Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / Config.hs @ 9491766c

History | View | Annotate | Download (12.5 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
    , getNode
37
    , getInstance
38
    , getGroup
39
    , getGroupNdParams
40
    , getGroupIpolicy
41
    , getGroupDiskParams
42
    , getGroupNodes
43
    , getGroupInstances
44
    , getGroupOfNode
45
    , getInstPrimaryNode
46
    , getInstMinorsForNode
47
    , getInstAllNodes
48
    , getNetwork
49
    , buildLinkIpInstnameMap
50
    , instNodes
51
    ) where
52

    
53
import Control.Monad (liftM)
54
import Data.List (foldl', nub)
55
import qualified Data.Map as M
56
import qualified Data.Set as S
57
import qualified Text.JSON as J
58

    
59
import Ganeti.BasicTypes
60
import qualified Ganeti.Constants as C
61
import Ganeti.Errors
62
import Ganeti.JSON
63
import Ganeti.Objects
64
import Ganeti.Types
65

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

    
69
-- | Type class denoting objects which have node parameters.
70
class NdParamObject a where
71
  getNdParamsOf :: ConfigData -> a -> Maybe FilledNDParams
72

    
73
-- | Reads the config file.
74
readConfig :: FilePath -> IO String
75
readConfig = readFile
76

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

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

    
85
-- * Query functions
86

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

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

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

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

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

    
120
-- | Computes the role of a node.
121
getNodeRole :: ConfigData -> Node -> NodeRole
122
getNodeRole cfg node
123
  | nodeName node == clusterMasterNode (configCluster cfg) = NRMaster
124
  | nodeMasterCandidate node = NRCandidate
125
  | nodeDrained node = NRDrained
126
  | nodeOffline node = NROffline
127
  | otherwise = NRRegular
128

    
129
-- | Returns the default cluster link.
130
getDefaultNicLink :: ConfigData -> String
131
getDefaultNicLink =
132
  nicpLink . (M.! C.ppDefault) . fromContainer .
133
  clusterNicparams . configCluster
134

    
135
-- | Returns the default cluster hypervisor.
136
getDefaultHypervisor :: ConfigData -> Hypervisor
137
getDefaultHypervisor cfg =
138
  case clusterEnabledHypervisors $ configCluster cfg of
139
    -- FIXME: this case shouldn't happen (configuration broken), but
140
    -- for now we handle it here because we're not authoritative for
141
    -- the config
142
    []  -> XenPvm
143
    x:_ -> x
144

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

    
150
-- | Generic lookup function that converts from a possible abbreviated
151
-- name to a full name.
152
getItem :: String -> String -> M.Map String a -> ErrorResult a
153
getItem kind name allitems = do
154
  let lresult = lookupName (M.keys allitems) name
155
      err msg = Bad $ OpPrereqError (kind ++ " name " ++ name ++ " " ++ msg)
156
                        ECodeNoEnt
157
  fullname <- case lrMatchPriority lresult of
158
                PartialMatch -> Ok $ lrContent lresult
159
                ExactMatch -> Ok $ lrContent lresult
160
                MultipleMatch -> err "has multiple matches"
161
                FailMatch -> err "not found"
162
  maybe (err "not found after successfull match?!") Ok $
163
        M.lookup fullname allitems
164

    
165
-- | Looks up a node by name or uuid.
166
getNode :: ConfigData -> String -> ErrorResult Node
167
getNode cfg name =
168
  let nodes = fromContainer (configNodes cfg)
169
  in case getItem "Node" name nodes of
170
       -- if not found by uuid, we need to look it up by name
171
       Ok node -> Ok node
172
       Bad _ -> let by_name = M.mapKeys
173
                              (nodeName . (M.!) nodes) nodes
174
                in getItem "Node" name by_name
175

    
176
-- | Looks up an instance by name or uuid.
177
getInstance :: ConfigData -> String -> ErrorResult Instance
178
getInstance cfg name =
179
  let instances = fromContainer (configInstances cfg)
180
  in case getItem "Instance" name instances of
181
       -- if not found by uuid, we need to look it up by name
182
       Ok inst -> Ok inst
183
       Bad _ -> let by_name = M.mapKeys
184
                              (instName . (M.!) instances) instances
185
                in getItem "Instance" name by_name
186

    
187
-- | Looks up a node group by name or uuid.
188
getGroup :: ConfigData -> String -> ErrorResult NodeGroup
189
getGroup cfg name =
190
  let groups = fromContainer (configNodegroups cfg)
191
  in case getItem "NodeGroup" name groups of
192
       -- if not found by uuid, we need to look it up by name, slow
193
       Ok grp -> Ok grp
194
       Bad _ -> let by_name = M.mapKeys
195
                              (groupName . (M.!) groups) groups
196
                in getItem "NodeGroup" name by_name
197

    
198
-- | Computes a node group's node params.
199
getGroupNdParams :: ConfigData -> NodeGroup -> FilledNDParams
200
getGroupNdParams cfg ng =
201
  fillNDParams (clusterNdparams $ configCluster cfg) (groupNdparams ng)
202

    
203
-- | Computes a node group's ipolicy.
204
getGroupIpolicy :: ConfigData -> NodeGroup -> FilledIPolicy
205
getGroupIpolicy cfg ng =
206
  fillIPolicy (clusterIpolicy $ configCluster cfg) (groupIpolicy ng)
207

    
208
-- | Computes a group\'s (merged) disk params.
209
getGroupDiskParams :: ConfigData -> NodeGroup -> DiskParams
210
getGroupDiskParams cfg ng =
211
  GenericContainer $
212
  fillDict (fromContainer . clusterDiskparams $ configCluster cfg)
213
           (fromContainer $ groupDiskparams ng) []
214

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

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

    
228
-- | Looks up a network. If looking up by uuid fails, we look up
229
-- by name.
230
getNetwork :: ConfigData -> String -> ErrorResult Network
231
getNetwork cfg name =
232
  let networks = fromContainer (configNetworks cfg)
233
  in case getItem "Network" name networks of
234
       Ok net -> Ok net
235
       Bad _ -> let by_name = M.mapKeys
236
                              (fromNonEmpty . networkName . (M.!) networks)
237
                              networks
238
                in getItem "Network" name by_name
239

    
240
-- | Looks up an instance's primary node.
241
getInstPrimaryNode :: ConfigData -> String -> ErrorResult Node
242
getInstPrimaryNode cfg name =
243
  liftM instPrimaryNode (getInstance cfg name) >>= getNode cfg
244

    
245
-- | Retrieves all nodes hosting a DRBD disk
246
getDrbdDiskNodes :: ConfigData -> Disk -> [Node]
247
getDrbdDiskNodes cfg disk =
248
  let retrieved = case diskLogicalId disk of
249
                    LIDDrbd8 nodeA nodeB _ _ _ _ ->
250
                      justOk [getNode cfg nodeA, getNode cfg nodeB]
251
                    _                            -> []
252
  in retrieved ++ concatMap (getDrbdDiskNodes cfg) (diskChildren disk)
253

    
254
-- | Retrieves all the nodes of the instance.
255
--
256
-- As instances not using DRBD can be sent as a parameter as well,
257
-- the primary node has to be appended to the results.
258
getInstAllNodes :: ConfigData -> String -> ErrorResult [Node]
259
getInstAllNodes cfg name = do
260
  inst <- getInstance cfg name
261
  let diskNodes = concatMap (getDrbdDiskNodes cfg) $ instDisks inst
262
  pNode <- getInstPrimaryNode cfg name
263
  return . nub $ pNode:diskNodes
264

    
265
-- | Filters DRBD minors for a given node.
266
getDrbdMinorsForNode :: String -> Disk -> [(Int, String)]
267
getDrbdMinorsForNode node disk =
268
  let child_minors = concatMap (getDrbdMinorsForNode node) (diskChildren disk)
269
      this_minors =
270
        case diskLogicalId disk of
271
          LIDDrbd8 nodeA nodeB _ minorA minorB _
272
            | nodeA == node -> [(minorA, nodeB)]
273
            | nodeB == node -> [(minorB, nodeA)]
274
          _ -> []
275
  in this_minors ++ child_minors
276

    
277
-- | String for primary role.
278
rolePrimary :: String
279
rolePrimary = "primary"
280

    
281
-- | String for secondary role.
282
roleSecondary :: String
283
roleSecondary = "secondary"
284

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

    
302
-- | Builds link -> ip -> instname map.
303
--
304
-- TODO: improve this by splitting it into multiple independent functions:
305
--
306
-- * abstract the \"fetch instance with filled params\" functionality
307
--
308
-- * abstsract the [instance] -> [(nic, instance_name)] part
309
--
310
-- * etc.
311
buildLinkIpInstnameMap :: ConfigData -> LinkIpMap
312
buildLinkIpInstnameMap cfg =
313
  let cluster = configCluster cfg
314
      instances = M.elems . fromContainer . configInstances $ cfg
315
      defparams = (M.!) (fromContainer $ clusterNicparams cluster) C.ppDefault
316
      nics = concatMap (\i -> [(instName i, nic) | nic <- instNics i])
317
             instances
318
  in foldl' (\accum (iname, nic) ->
319
               let pparams = nicNicparams nic
320
                   fparams = fillNicParams defparams pparams
321
                   link = nicpLink fparams
322
               in case nicIp nic of
323
                    Nothing -> accum
324
                    Just ip -> let oldipmap = M.findWithDefault M.empty
325
                                              link accum
326
                                   newipmap = M.insert ip iname oldipmap
327
                               in M.insert link newipmap accum
328
            ) M.empty nics
329

    
330

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

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

    
344
instance NdParamObject Node where
345
  getNdParamsOf = getNodeNdParams
346

    
347
instance NdParamObject NodeGroup where
348
  getNdParamsOf cfg = Just . getGroupNdParams cfg
349

    
350
instance NdParamObject Cluster where
351
  getNdParamsOf _ = Just . clusterNdparams