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     , getGroupOfNode
  40     , getInstPrimaryNode
  41     , getInstMinorsForNode
  42     , buildLinkIpInstnameMap
  43     , instNodes
  44     ) where
  45
  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
  51
  52 import Ganeti.JSON
  53 import Ganeti.BasicTypes
  54
  55 import qualified Ganeti.Constants as C
  56 import Ganeti.Objects
  57
  58 -- | Type alias for the link and ip map.
  59 type LinkIpMap = M.Map String (M.Map String String)
  60
  61 -- | Type class denoting objects which have node parameters.
  62 class NdParamObject a where
  63   getNdParamsOf :: ConfigData -> a -> Maybe FilledNDParams
  64
  65 -- | Reads the config file.
  66 readConfig :: FilePath -> IO String
  67 readConfig = readFile
  68
  69 -- | Parses the configuration file.
  70 parseConfig :: String -> Result ConfigData
  71 parseConfig = fromJResult "parsing configuration" . J.decodeStrict
  72
  73 -- | Wrapper over 'readConfig' and 'parseConfig'.
  74 loadConfig :: FilePath -> IO (Result ConfigData)
  75 loadConfig = fmap parseConfig . readConfig
  76
  77 -- * Query functions
  78
  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]
  84     _ -> S.empty
  85
  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
  88 -- the secondaries.
  89 instDiskNodes :: Instance -> S.Set String
  90 instDiskNodes = S.unions . map computeDiskNodes . instDisks
  91
  92 -- | Computes all nodes of an instance.
  93 instNodes :: Instance -> S.Set String
  94 instNodes inst = instPrimaryNode inst `S.insert` instDiskNodes inst
  95
  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
 102
 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)
 110
 111 -- | Computes the role of a node.
 112 getNodeRole :: ConfigData -> Node -> NodeRole
 113 getNodeRole cfg node
 114   | nodeName node == clusterMasterNode (configCluster cfg) = NRMaster
 115   | nodeMasterCandidate node = NRCandidate
 116   | nodeDrained node = NRDrained
 117   | nodeOffline node = NROffline
 118   | otherwise = NRRegular
 119
 120 -- | Returns the default cluster link.
 121 getDefaultNicLink :: ConfigData -> String
 122 getDefaultNicLink =
 123   nicpLink . (M.! C.ppDefault) . fromContainer .
 124   clusterNicparams . configCluster
 125
 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
 130
 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 msg = Bad $ kind ++ " name " ++ name ++ " " ++ msg
 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
 144
 145 -- | Looks up a node.
 146 getNode :: ConfigData -> String -> Result Node
 147 getNode cfg name = getItem "Node" name (fromContainer $ configNodes cfg)
 148
 149 -- | Looks up an instance.
 150 getInstance :: ConfigData -> String -> Result Instance
 151 getInstance cfg name =
 152   getItem "Instance" name (fromContainer $ configInstances cfg)
 153
 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
 157 getGroup cfg name =
 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
 161        Ok grp -> Ok grp
 162        Bad _ -> let by_name = M.mapKeys
 163                               (groupName . (M.!) groups) groups
 164                 in getItem "NodeGroup" name by_name
 165
 166 -- | Computes a node group's node params.
 167 getGroupNdParams :: ConfigData -> NodeGroup -> FilledNDParams
 168 getGroupNdParams cfg ng =
 169   fillNDParams (clusterNdparams $ configCluster cfg) (groupNdparams ng)
 170
 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
 175
 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)
 180       this_minors =
 181         case diskLogicalId disk of
 182           LIDDrbd8 nodeA nodeB _ minorA minorB _
 183             | nodeA == node -> [(minorA, nodeB)]
 184             | nodeB == node -> [(minorB, nodeA)]
 185           _ -> []
 186   in this_minors ++ child_minors
 187
 188 -- | String for primary role.
 189 rolePrimary :: String
 190 rolePrimary = "primary"
 191
 192 -- | String for secondary role.
 193 roleSecondary :: String
 194 roleSecondary = "secondary"
 195
 196 -- | Gets the list of DRBD minors for an instance that are related to
 197 -- a given node.
 198 getInstMinorsForNode :: String -> Instance
 199                      -> [(String, Int, String, String, String, String)]
 200 getInstMinorsForNode node inst =
 201   let role = if node == instPrimaryNode inst
 202                then rolePrimary
 203                else roleSecondary
 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
 207   -- the Python side)
 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
 212
 213 -- | Builds link -> ip -> instname map.
 214 --
 215 -- TODO: improve this by splitting it into multiple independent functions:
 216 --
 217 -- * abstract the \"fetch instance with filled params\" functionality
 218 --
 219 -- * abstsract the [instance] -> [(nic, instance_name)] part
 220 --
 221 -- * etc.
 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])
 228              instances
 229   in foldl' (\accum (iname, nic) ->
 230                let pparams = nicNicparams nic
 231                    fparams = fillNicParams defparams pparams
 232                    link = nicpLink fparams
 233                in case nicIp nic of
 234                     Nothing -> accum
 235                     Just ip -> let oldipmap = M.findWithDefault M.empty
 236                                               link accum
 237                                    newipmap = M.insert ip iname oldipmap
 238                                in M.insert link newipmap accum
 239             ) M.empty nics
 240
 241
 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)
 247
 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)
 254
 255 instance NdParamObject Node where
 256   getNdParamsOf = getNodeNdParams
 257
 258 instance NdParamObject NodeGroup where
 259   getNdParamsOf cfg = Just . getGroupNdParams cfg
 260
 261 instance NdParamObject Cluster where
 262   getNdParamsOf _ = Just . clusterNdparams