Config.hs 11.6 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27
{-| Implementation of the Ganeti configuration database.

-}

{-

Copyright (C) 2011, 2012 Google Inc.

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
02110-1301, USA.

-}

module Ganeti.Config
    ( LinkIpMap
28
    , NdParamObject(..)
29 30
    , loadConfig
    , getNodeInstances
31 32
    , getNodeRole
    , getNodeNdParams
33
    , getDefaultNicLink
34
    , getDefaultHypervisor
35 36 37
    , getInstancesIpByLink
    , getNode
    , getInstance
38
    , getGroup
39
    , getGroupNdParams
40
    , getGroupIpolicy
41
    , getGroupDiskParams
42 43
    , getGroupNodes
    , getGroupInstances
44
    , getGroupOfNode
45
    , getInstPrimaryNode
46
    , getInstMinorsForNode
47
    , getNetwork
48
    , buildLinkIpInstnameMap
49
    , instNodes
50 51
    ) where

Iustin Pop's avatar
Iustin Pop committed
52
import Control.Monad (liftM)
53 54
import Data.List (foldl')
import qualified Data.Map as M
55
import qualified Data.Set as S
56 57 58 59
import qualified Text.JSON as J

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

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

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

72 73 74 75 76 77 78 79 80 81 82 83 84 85
-- | Reads the config file.
readConfig :: FilePath -> IO String
readConfig = readFile

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

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

-- * Query functions

86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109
-- | Computes the nodes covered by a disk.
computeDiskNodes :: Disk -> S.Set String
computeDiskNodes dsk =
  case diskLogicalId dsk of
    LIDDrbd8 nodeA nodeB _ _ _ _ -> S.fromList [nodeA, nodeB]
    _ -> S.empty

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

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

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

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

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

128 129 130
-- | Returns the default cluster link.
getDefaultNicLink :: ConfigData -> String
getDefaultNicLink =
Iustin Pop's avatar
Iustin Pop committed
131 132
  nicpLink . (M.! C.ppDefault) . fromContainer .
  clusterNicparams . configCluster
133

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

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

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

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

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

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

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

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

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

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

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

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

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

244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280
-- | Filters DRBD minors for a given node.
getDrbdMinorsForNode :: String -> Disk -> [(Int, String)]
getDrbdMinorsForNode node disk =
  let child_minors = concatMap (getDrbdMinorsForNode node) (diskChildren disk)
      this_minors =
        case diskLogicalId disk of
          LIDDrbd8 nodeA nodeB _ minorA minorB _
            | nodeA == node -> [(minorA, nodeB)]
            | nodeB == node -> [(minorB, nodeA)]
          _ -> []
  in this_minors ++ child_minors

-- | String for primary role.
rolePrimary :: String
rolePrimary = "primary"

-- | String for secondary role.
roleSecondary :: String
roleSecondary = "secondary"

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

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


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

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

instance NdParamObject Node where
  getNdParamsOf = getNodeNdParams

instance NdParamObject NodeGroup where
  getNdParamsOf cfg = Just . getGroupNdParams cfg

instance NdParamObject Cluster where
  getNdParamsOf _ = Just . clusterNdparams