code.grnet.gr Git - ganeti-local/blob - src/Ganeti/Config.hs

   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