code.grnet.gr Git - ganeti-local/blob - htools/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     , getInstancesIpByLink
  35     , getNode
  36     , getInstance
  37     , getGroup
  38     , getGroupNdParams
  39     , getGroupIpolicy
  40     , getGroupNodes
  41     , getGroupInstances
  42     , getGroupOfNode
  43     , getInstPrimaryNode
  44     , getInstMinorsForNode
  45     , buildLinkIpInstnameMap
  46     , instNodes
  47     ) where
  48
  49 import Control.Monad (liftM)
  50 import Data.List (foldl')
  51 import qualified Data.Map as M
  52 import qualified Data.Set as S
  53 import qualified Text.JSON as J
  54
  55 import Ganeti.JSON
  56 import Ganeti.BasicTypes
  57
  58 import qualified Ganeti.Constants as C
  59 import Ganeti.Objects
  60
  61 -- | Type alias for the link and ip map.
  62 type LinkIpMap = M.Map String (M.Map String String)
  63
  64 -- | Type class denoting objects which have node parameters.
  65 class NdParamObject a where
  66   getNdParamsOf :: ConfigData -> a -> Maybe FilledNDParams
  67
  68 -- | Reads the config file.
  69 readConfig :: FilePath -> IO String
  70 readConfig = readFile
  71
  72 -- | Parses the configuration file.
  73 parseConfig :: String -> Result ConfigData
  74 parseConfig = fromJResult "parsing configuration" . J.decodeStrict
  75
  76 -- | Wrapper over 'readConfig' and 'parseConfig'.
  77 loadConfig :: FilePath -> IO (Result ConfigData)
  78 loadConfig = fmap parseConfig . readConfig
  79
  80 -- * Query functions
  81
  82 -- | Computes the nodes covered by a disk.
  83 computeDiskNodes :: Disk -> S.Set String
  84 computeDiskNodes dsk =
  85   case diskLogicalId dsk of
  86     LIDDrbd8 nodeA nodeB _ _ _ _ -> S.fromList [nodeA, nodeB]
  87     _ -> S.empty
  88
  89 -- | Computes all disk-related nodes of an instance. For non-DRBD,
  90 -- this will be empty, for DRBD it will contain both the primary and
  91 -- the secondaries.
  92 instDiskNodes :: Instance -> S.Set String
  93 instDiskNodes = S.unions . map computeDiskNodes . instDisks
  94
  95 -- | Computes all nodes of an instance.
  96 instNodes :: Instance -> S.Set String
  97 instNodes inst = instPrimaryNode inst `S.insert` instDiskNodes inst
  98
  99 -- | Computes the secondary nodes of an instance. Since this is valid
 100 -- only for DRBD, we call directly 'instDiskNodes', skipping over the
 101 -- extra primary insert.
 102 instSecondaryNodes :: Instance -> S.Set String
 103 instSecondaryNodes inst =
 104   instPrimaryNode inst `S.delete` instDiskNodes inst
 105
 106 -- | Get instances of a given node.
 107 getNodeInstances :: ConfigData -> String -> ([Instance], [Instance])
 108 getNodeInstances cfg nname =
 109     let all_inst = M.elems . fromContainer . configInstances $ cfg
 110         pri_inst = filter ((== nname) . instPrimaryNode) all_inst
 111         sec_inst = filter ((nname `S.member`) . instSecondaryNodes) all_inst
 112     in (pri_inst, sec_inst)
 113
 114 -- | Computes the role of a node.
 115 getNodeRole :: ConfigData -> Node -> NodeRole
 116 getNodeRole cfg node
 117   | nodeName node == clusterMasterNode (configCluster cfg) = NRMaster
 118   | nodeMasterCandidate node = NRCandidate
 119   | nodeDrained node = NRDrained
 120   | nodeOffline node = NROffline
 121   | otherwise = NRRegular
 122
 123 -- | Returns the default cluster link.
 124 getDefaultNicLink :: ConfigData -> String
 125 getDefaultNicLink =
 126   nicpLink . (M.! C.ppDefault) . fromContainer .
 127   clusterNicparams . configCluster
 128
 129 -- | Returns instances of a given link.
 130 getInstancesIpByLink :: LinkIpMap -> String -> [String]
 131 getInstancesIpByLink linkipmap link =
 132   M.keys $ M.findWithDefault M.empty link linkipmap
 133
 134 -- | Generic lookup function that converts from a possible abbreviated
 135 -- name to a full name.
 136 getItem :: String -> String -> M.Map String a -> Result a
 137 getItem kind name allitems = do
 138   let lresult = lookupName (M.keys allitems) name
 139       err msg = Bad $ kind ++ " name " ++ name ++ " " ++ msg
 140   fullname <- case lrMatchPriority lresult of
 141                 PartialMatch -> Ok $ lrContent lresult
 142                 ExactMatch -> Ok $ lrContent lresult
 143                 MultipleMatch -> err "has multiple matches"
 144                 FailMatch -> err "not found"
 145   maybe (err "not found after successfull match?!") Ok $
 146         M.lookup fullname allitems
 147
 148 -- | Looks up a node.
 149 getNode :: ConfigData -> String -> Result Node
 150 getNode cfg name = getItem "Node" name (fromContainer $ configNodes cfg)
 151
 152 -- | Looks up an instance.
 153 getInstance :: ConfigData -> String -> Result Instance
 154 getInstance cfg name =
 155   getItem "Instance" name (fromContainer $ configInstances cfg)
 156
 157 -- | Looks up a node group. This is more tricky than for
 158 -- node/instances since the groups map is indexed by uuid, not name.
 159 getGroup :: ConfigData -> String -> Result NodeGroup
 160 getGroup cfg name =
 161   let groups = fromContainer (configNodegroups cfg)
 162   in case getItem "NodeGroup" name groups of
 163        -- if not found by uuid, we need to look it up by name, slow
 164        Ok grp -> Ok grp
 165        Bad _ -> let by_name = M.mapKeys
 166                               (groupName . (M.!) groups) groups
 167                 in getItem "NodeGroup" name by_name
 168
 169 -- | Computes a node group's node params.
 170 getGroupNdParams :: ConfigData -> NodeGroup -> FilledNDParams
 171 getGroupNdParams cfg ng =
 172   fillNDParams (clusterNdparams $ configCluster cfg) (groupNdparams ng)
 173
 174 -- | Computes a node group's ipolicy.
 175 getGroupIpolicy :: ConfigData -> NodeGroup -> FilledIPolicy
 176 getGroupIpolicy cfg ng =
 177   fillIPolicy (clusterIpolicy $ configCluster cfg) (groupIpolicy ng)
 178
 179 -- | Get nodes of a given node group.
 180 getGroupNodes :: ConfigData -> String -> [Node]
 181 getGroupNodes cfg gname =
 182   let all_nodes = M.elems . fromContainer . configNodes $ cfg in
 183   filter ((==gname) . nodeGroup) all_nodes
 184
 185 -- | Get (primary, secondary) instances of a given node group.
 186 getGroupInstances :: ConfigData -> String -> ([Instance], [Instance])
 187 getGroupInstances cfg gname =
 188   let gnodes = map nodeName (getGroupNodes cfg gname)
 189       ginsts = map (getNodeInstances cfg) gnodes in
 190   (concatMap fst ginsts, concatMap snd ginsts)
 191
 192 -- | Looks up an instance's primary node.
 193 getInstPrimaryNode :: ConfigData -> String -> Result Node
 194 getInstPrimaryNode cfg name =
 195   liftM instPrimaryNode (getInstance cfg name) >>= getNode cfg
 196
 197 -- | Filters DRBD minors for a given node.
 198 getDrbdMinorsForNode :: String -> Disk -> [(Int, String)]
 199 getDrbdMinorsForNode node disk =
 200   let child_minors = concatMap (getDrbdMinorsForNode node) (diskChildren disk)
 201       this_minors =
 202         case diskLogicalId disk of
 203           LIDDrbd8 nodeA nodeB _ minorA minorB _
 204             | nodeA == node -> [(minorA, nodeB)]
 205             | nodeB == node -> [(minorB, nodeA)]
 206           _ -> []
 207   in this_minors ++ child_minors
 208
 209 -- | String for primary role.
 210 rolePrimary :: String
 211 rolePrimary = "primary"
 212
 213 -- | String for secondary role.
 214 roleSecondary :: String
 215 roleSecondary = "secondary"
 216
 217 -- | Gets the list of DRBD minors for an instance that are related to
 218 -- a given node.
 219 getInstMinorsForNode :: String -> Instance
 220                      -> [(String, Int, String, String, String, String)]
 221 getInstMinorsForNode node inst =
 222   let role = if node == instPrimaryNode inst
 223                then rolePrimary
 224                else roleSecondary
 225       iname = instName inst
 226   -- FIXME: the disk/ build there is hack-ish; unify this in a
 227   -- separate place, or reuse the iv_name (but that is deprecated on
 228   -- the Python side)
 229   in concatMap (\(idx, dsk) ->
 230             [(node, minor, iname, "disk/" ++ show idx, role, peer)
 231                | (minor, peer) <- getDrbdMinorsForNode node dsk]) .
 232      zip [(0::Int)..] . instDisks $ inst
 233
 234 -- | Builds link -> ip -> instname map.
 235 --
 236 -- TODO: improve this by splitting it into multiple independent functions:
 237 --
 238 -- * abstract the \"fetch instance with filled params\" functionality
 239 --
 240 -- * abstsract the [instance] -> [(nic, instance_name)] part
 241 --
 242 -- * etc.
 243 buildLinkIpInstnameMap :: ConfigData -> LinkIpMap
 244 buildLinkIpInstnameMap cfg =
 245   let cluster = configCluster cfg
 246       instances = M.elems . fromContainer . configInstances $ cfg
 247       defparams = (M.!) (fromContainer $ clusterNicparams cluster) C.ppDefault
 248       nics = concatMap (\i -> [(instName i, nic) | nic <- instNics i])
 249              instances
 250   in foldl' (\accum (iname, nic) ->
 251                let pparams = nicNicparams nic
 252                    fparams = fillNicParams defparams pparams
 253                    link = nicpLink fparams
 254                in case nicIp nic of
 255                     Nothing -> accum
 256                     Just ip -> let oldipmap = M.findWithDefault M.empty
 257                                               link accum
 258                                    newipmap = M.insert ip iname oldipmap
 259                                in M.insert link newipmap accum
 260             ) M.empty nics
 261
 262
 263 -- | Returns a node's group, with optional failure if we can't find it
 264 -- (configuration corrupt).
 265 getGroupOfNode :: ConfigData -> Node -> Maybe NodeGroup
 266 getGroupOfNode cfg node =
 267   M.lookup (nodeGroup node) (fromContainer . configNodegroups $ cfg)
 268
 269 -- | Returns a node's ndparams, filled.
 270 getNodeNdParams :: ConfigData -> Node -> Maybe FilledNDParams
 271 getNodeNdParams cfg node = do
 272   group <- getGroupOfNode cfg node
 273   let gparams = getGroupNdParams cfg group
 274   return $ fillNDParams gparams (nodeNdparams node)
 275
 276 instance NdParamObject Node where
 277   getNdParamsOf = getNodeNdParams
 278
 279 instance NdParamObject NodeGroup where
 280   getNdParamsOf cfg = Just . getGroupNdParams cfg
 281
 282 instance NdParamObject Cluster where
 283   getNdParamsOf _ = Just . clusterNdparams