Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / Config.hs @ 2d3d843d

History | View | Annotate | Download (11.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
    , 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
    , getNetwork
48
    , buildLinkIpInstnameMap
49
    , instNodes
50
    ) where
51

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

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

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

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

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

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

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

    
84
-- * Query functions
85

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

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

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

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

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

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

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

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

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

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

    
163
-- | Looks up a node.
164
getNode :: ConfigData -> String -> ErrorResult Node
165
getNode cfg name = getItem "Node" name (fromContainer $ configNodes cfg)
166

    
167
-- | Looks up an instance.
168
getInstance :: ConfigData -> String -> ErrorResult Instance
169
getInstance cfg name =
170
  getItem "Instance" name (fromContainer $ configInstances cfg)
171

    
172
-- | Looks up a node group. This is more tricky than for
173
-- node/instances since the groups map is indexed by uuid, not name.
174
getGroup :: ConfigData -> String -> ErrorResult NodeGroup
175
getGroup cfg name =
176
  let groups = fromContainer (configNodegroups cfg)
177
  in case getItem "NodeGroup" name groups of
178
       -- if not found by uuid, we need to look it up by name, slow
179
       Ok grp -> Ok grp
180
       Bad _ -> let by_name = M.mapKeys
181
                              (groupName . (M.!) groups) groups
182
                in getItem "NodeGroup" name by_name
183

    
184
-- | Computes a node group's node params.
185
getGroupNdParams :: ConfigData -> NodeGroup -> FilledNDParams
186
getGroupNdParams cfg ng =
187
  fillNDParams (clusterNdparams $ configCluster cfg) (groupNdparams ng)
188

    
189
-- | Computes a node group's ipolicy.
190
getGroupIpolicy :: ConfigData -> NodeGroup -> FilledIPolicy
191
getGroupIpolicy cfg ng =
192
  fillIPolicy (clusterIpolicy $ configCluster cfg) (groupIpolicy ng)
193

    
194
-- | Computes a group\'s (merged) disk params.
195
getGroupDiskParams :: ConfigData -> NodeGroup -> DiskParams
196
getGroupDiskParams cfg ng =
197
  GenericContainer $
198
  fillDict (fromContainer . clusterDiskparams $ configCluster cfg)
199
           (fromContainer $ groupDiskparams ng) []
200

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

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

    
214
-- | Looks up a network. If looking up by uuid fails, we look up
215
-- by name.
216
getNetwork :: ConfigData -> String -> ErrorResult Network
217
getNetwork cfg name =
218
  let networks = fromContainer (configNetworks cfg)
219
  in case getItem "Network" name networks of
220
       Ok net -> Ok net
221
       Bad _ -> let by_name = M.mapKeys
222
                              (fromNonEmpty . networkName . (M.!) networks)
223
                              networks
224
                in getItem "Network" name by_name
225

    
226
-- | Looks up an instance's primary node.
227
getInstPrimaryNode :: ConfigData -> String -> ErrorResult Node
228
getInstPrimaryNode cfg name =
229
  liftM instPrimaryNode (getInstance cfg name) >>= getNode cfg
230

    
231
-- | Filters DRBD minors for a given node.
232
getDrbdMinorsForNode :: String -> Disk -> [(Int, String)]
233
getDrbdMinorsForNode node disk =
234
  let child_minors = concatMap (getDrbdMinorsForNode node) (diskChildren disk)
235
      this_minors =
236
        case diskLogicalId disk of
237
          LIDDrbd8 nodeA nodeB _ minorA minorB _
238
            | nodeA == node -> [(minorA, nodeB)]
239
            | nodeB == node -> [(minorB, nodeA)]
240
          _ -> []
241
  in this_minors ++ child_minors
242

    
243
-- | String for primary role.
244
rolePrimary :: String
245
rolePrimary = "primary"
246

    
247
-- | String for secondary role.
248
roleSecondary :: String
249
roleSecondary = "secondary"
250

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

    
268
-- | Builds link -> ip -> instname map.
269
--
270
-- TODO: improve this by splitting it into multiple independent functions:
271
--
272
-- * abstract the \"fetch instance with filled params\" functionality
273
--
274
-- * abstsract the [instance] -> [(nic, instance_name)] part
275
--
276
-- * etc.
277
buildLinkIpInstnameMap :: ConfigData -> LinkIpMap
278
buildLinkIpInstnameMap cfg =
279
  let cluster = configCluster cfg
280
      instances = M.elems . fromContainer . configInstances $ cfg
281
      defparams = (M.!) (fromContainer $ clusterNicparams cluster) C.ppDefault
282
      nics = concatMap (\i -> [(instName i, nic) | nic <- instNics i])
283
             instances
284
  in foldl' (\accum (iname, nic) ->
285
               let pparams = nicNicparams nic
286
                   fparams = fillNicParams defparams pparams
287
                   link = nicpLink fparams
288
               in case nicIp nic of
289
                    Nothing -> accum
290
                    Just ip -> let oldipmap = M.findWithDefault M.empty
291
                                              link accum
292
                                   newipmap = M.insert ip iname oldipmap
293
                               in M.insert link newipmap accum
294
            ) M.empty nics
295

    
296

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

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

    
310
instance NdParamObject Node where
311
  getNdParamsOf = getNodeNdParams
312

    
313
instance NdParamObject NodeGroup where
314
  getNdParamsOf cfg = Just . getGroupNdParams cfg
315

    
316
instance NdParamObject Cluster where
317
  getNdParamsOf _ = Just . clusterNdparams