1 {-| Implementation of the Ganeti configuration database.
7 Copyright (C) 2011, 2012 Google Inc.
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.
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.
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
34 , getInstancesIpByLink
41 , getInstMinorsForNode
42 , buildLinkIpInstnameMap
46 import Control.Monad (liftM)
47 import Data.List (foldl')
48 import qualified Data.Map as M
49 import qualified Data.Set as S
50 import qualified Text.JSON as J
52 import Ganeti.HTools.JSON
53 import Ganeti.BasicTypes
55 import qualified Ganeti.Constants as C
58 -- | Type alias for the link and ip map.
59 type LinkIpMap = M.Map String (M.Map String String)
61 -- | Type class denoting objects which have node parameters.
62 class NdParamObject a where
63 getNdParamsOf :: ConfigData -> a -> Maybe FilledNDParams
65 -- | Reads the config file.
66 readConfig :: FilePath -> IO String
69 -- | Parses the configuration file.
70 parseConfig :: String -> Result ConfigData
71 parseConfig = fromJResult "parsing configuration" . J.decodeStrict
73 -- | Wrapper over 'readConfig' and 'parseConfig'.
74 loadConfig :: FilePath -> IO (Result ConfigData)
75 loadConfig = fmap parseConfig . readConfig
79 -- | Computes the nodes covered by a disk.
80 computeDiskNodes :: Disk -> S.Set String
81 computeDiskNodes dsk =
82 case diskLogicalId dsk of
83 LIDDrbd8 nodeA nodeB _ _ _ _ -> S.fromList [nodeA, nodeB]
86 -- | Computes all disk-related nodes of an instance. For non-DRBD,
87 -- this will be empty, for DRBD it will contain both the primary and
89 instDiskNodes :: Instance -> S.Set String
90 instDiskNodes = S.unions . map computeDiskNodes . instDisks
92 -- | Computes all nodes of an instance.
93 instNodes :: Instance -> S.Set String
94 instNodes inst = instPrimaryNode inst `S.insert` instDiskNodes inst
96 -- | Computes the secondary nodes of an instance. Since this is valid
97 -- only for DRBD, we call directly 'instDiskNodes', skipping over the
98 -- extra primary insert.
99 instSecondaryNodes :: Instance -> S.Set String
100 instSecondaryNodes inst =
101 instPrimaryNode inst `S.delete` instDiskNodes inst
103 -- | Get instances of a given node.
104 getNodeInstances :: ConfigData -> String -> ([Instance], [Instance])
105 getNodeInstances cfg nname =
106 let all_inst = M.elems . fromContainer . configInstances $ cfg
107 pri_inst = filter ((== nname) . instPrimaryNode) all_inst
108 sec_inst = filter ((nname `S.member`) . instSecondaryNodes) all_inst
109 in (pri_inst, sec_inst)
111 -- | Computes the role of a node.
112 getNodeRole :: ConfigData -> Node -> NodeRole
114 | nodeName node == (clusterMasterNode $ configCluster cfg) = NRMaster
115 | nodeMasterCandidate node = NRCandidate
116 | nodeDrained node = NRDrained
117 | nodeOffline node = NROffline
118 | otherwise = NRRegular
120 -- | Returns the default cluster link.
121 getDefaultNicLink :: ConfigData -> String
123 nicpLink . (M.! C.ppDefault) . fromContainer .
124 clusterNicparams . configCluster
126 -- | Returns instances of a given link.
127 getInstancesIpByLink :: LinkIpMap -> String -> [String]
128 getInstancesIpByLink linkipmap link =
129 M.keys $ M.findWithDefault M.empty link linkipmap
131 -- | Generic lookup function that converts from a possible abbreviated
132 -- name to a full name.
133 getItem :: String -> String -> M.Map String a -> Result a
134 getItem kind name allitems = do
135 let lresult = lookupName (M.keys allitems) name
136 err = \details -> Bad $ kind ++ " name " ++ name ++ " " ++ details
137 fullname <- case lrMatchPriority lresult of
138 PartialMatch -> Ok $ lrContent lresult
139 ExactMatch -> Ok $ lrContent lresult
140 MultipleMatch -> err "has multiple matches"
141 FailMatch -> err "not found"
142 maybe (err "not found after successfull match?!") Ok $
143 M.lookup fullname allitems
145 -- | Looks up a node.
146 getNode :: ConfigData -> String -> Result Node
147 getNode cfg name = getItem "Node" name (fromContainer $ configNodes cfg)
149 -- | Looks up an instance.
150 getInstance :: ConfigData -> String -> Result Instance
151 getInstance cfg name =
152 getItem "Instance" name (fromContainer $ configInstances cfg)
154 -- | Looks up a node group. This is more tricky than for
155 -- node/instances since the groups map is indexed by uuid, not name.
156 getGroup :: ConfigData -> String -> Result NodeGroup
158 let groups = fromContainer (configNodegroups cfg)
159 in case getItem "NodeGroup" name groups of
160 -- if not found by uuid, we need to look it up by name, slow
162 Bad _ -> let by_name = M.mapKeys
163 (\k -> groupName ((M.!) groups k )) groups
164 in getItem "NodeGroup" name by_name
166 -- | Computes a node group's node params.
167 getGroupNdParams :: ConfigData -> NodeGroup -> FilledNDParams
168 getGroupNdParams cfg ng =
169 fillNDParams (clusterNdparams $ configCluster cfg) (groupNdparams ng)
171 -- | Looks up an instance's primary node.
172 getInstPrimaryNode :: ConfigData -> String -> Result Node
173 getInstPrimaryNode cfg name =
174 liftM instPrimaryNode (getInstance cfg name) >>= getNode cfg
176 -- | Filters DRBD minors for a given node.
177 getDrbdMinorsForNode :: String -> Disk -> [(Int, String)]
178 getDrbdMinorsForNode node disk =
179 let child_minors = concatMap (getDrbdMinorsForNode node) (diskChildren disk)
181 case diskLogicalId disk of
182 LIDDrbd8 nodeA nodeB _ minorA minorB _
183 | nodeA == node -> [(minorA, nodeB)]
184 | nodeB == node -> [(minorB, nodeA)]
186 in this_minors ++ child_minors
188 -- | String for primary role.
189 rolePrimary :: String
190 rolePrimary = "primary"
192 -- | String for secondary role.
193 roleSecondary :: String
194 roleSecondary = "secondary"
196 -- | Gets the list of DRBD minors for an instance that are related to
198 getInstMinorsForNode :: String -> Instance
199 -> [(String, Int, String, String, String, String)]
200 getInstMinorsForNode node inst =
201 let role = if node == instPrimaryNode inst
204 iname = instName inst
205 -- FIXME: the disk/ build there is hack-ish; unify this in a
206 -- separate place, or reuse the iv_name (but that is deprecated on
208 in concatMap (\(idx, dsk) ->
209 [(node, minor, iname, "disk/" ++ show idx, role, peer)
210 | (minor, peer) <- getDrbdMinorsForNode node dsk]) .
211 zip [(0::Int)..] . instDisks $ inst
213 -- | Builds link -> ip -> instname map.
215 -- TODO: improve this by splitting it into multiple independent functions:
217 -- * abstract the \"fetch instance with filled params\" functionality
219 -- * abstsract the [instance] -> [(nic, instance_name)] part
222 buildLinkIpInstnameMap :: ConfigData -> LinkIpMap
223 buildLinkIpInstnameMap cfg =
224 let cluster = configCluster cfg
225 instances = M.elems . fromContainer . configInstances $ cfg
226 defparams = (M.!) (fromContainer $ clusterNicparams cluster) C.ppDefault
227 nics = concatMap (\i -> [(instName i, nic) | nic <- instNics i])
229 in foldl' (\accum (iname, nic) ->
230 let pparams = nicNicparams nic
231 fparams = fillNicParams defparams pparams
232 link = nicpLink fparams
235 Just ip -> let oldipmap = M.findWithDefault (M.empty)
237 newipmap = M.insert ip iname oldipmap
238 in M.insert link newipmap accum
242 -- | Returns a node's group, with optional failure if we can't find it
243 -- (configuration corrupt).
244 getGroupOfNode :: ConfigData -> Node -> Maybe NodeGroup
245 getGroupOfNode cfg node =
246 M.lookup (nodeGroup node) (fromContainer . configNodegroups $ cfg)
248 -- | Returns a node's ndparams, filled.
249 getNodeNdParams :: ConfigData -> Node -> Maybe FilledNDParams
250 getNodeNdParams cfg node = do
251 group <- getGroupOfNode cfg node
252 let gparams = getGroupNdParams cfg group
253 return $ fillNDParams gparams (nodeNdparams node)
255 instance NdParamObject Node where
256 getNdParamsOf = getNodeNdParams
258 instance NdParamObject NodeGroup where
259 getNdParamsOf cfg = Just . getGroupNdParams cfg
261 instance NdParamObject Cluster where
262 getNdParamsOf _ = Just . clusterNdparams