module Ganeti.Config
( LinkIpMap
+ , NdParamObject(..)
, loadConfig
, getNodeInstances
+ , getNodeRole
+ , getNodeNdParams
, getDefaultNicLink
+ , getDefaultHypervisor
, getInstancesIpByLink
, getNode
, getInstance
+ , getGroup
+ , getGroupNdParams
+ , getGroupIpolicy
+ , getGroupDiskParams
+ , getGroupNodes
+ , getGroupInstances
+ , getGroupOfNode
, getInstPrimaryNode
, getInstMinorsForNode
, buildLinkIpInstnameMap
, instNodes
) where
+import Control.Monad (liftM)
import Data.List (foldl')
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Text.JSON as J
-import Ganeti.HTools.JSON
import Ganeti.BasicTypes
-
import qualified Ganeti.Constants as C
+import Ganeti.Errors
+import Ganeti.JSON
import Ganeti.Objects
-- | Type alias for the link and ip map.
type LinkIpMap = M.Map String (M.Map String String)
+-- | Type class denoting objects which have node parameters.
+class NdParamObject a where
+ getNdParamsOf :: ConfigData -> a -> Maybe FilledNDParams
+
-- | Reads the config file.
readConfig :: FilePath -> IO String
readConfig = readFile
-- | Get instances of a given node.
getNodeInstances :: ConfigData -> String -> ([Instance], [Instance])
getNodeInstances cfg nname =
- let all_inst = M.elems . configInstances $ cfg
+ let all_inst = M.elems . fromContainer . configInstances $ cfg
pri_inst = filter ((== nname) . instPrimaryNode) all_inst
sec_inst = filter ((nname `S.member`) . instSecondaryNodes) all_inst
in (pri_inst, sec_inst)
+-- | Computes the role of a node.
+getNodeRole :: ConfigData -> Node -> NodeRole
+getNodeRole cfg node
+ | nodeName node == clusterMasterNode (configCluster cfg) = NRMaster
+ | nodeMasterCandidate node = NRCandidate
+ | nodeDrained node = NRDrained
+ | nodeOffline node = NROffline
+ | otherwise = NRRegular
+
-- | Returns the default cluster link.
getDefaultNicLink :: ConfigData -> String
getDefaultNicLink =
- nicpLink . (M.! C.ppDefault) . clusterNicparams . configCluster
+ nicpLink . (M.! C.ppDefault) . fromContainer .
+ clusterNicparams . configCluster
+
+-- | 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
-- | Returns instances of a given link.
getInstancesIpByLink :: LinkIpMap -> String -> [String]
-- | Generic lookup function that converts from a possible abbreviated
-- name to a full name.
-getItem :: String -> String -> M.Map String a -> Result a
+getItem :: String -> String -> M.Map String a -> ErrorResult a
getItem kind name allitems = do
let lresult = lookupName (M.keys allitems) name
- err = \details -> Bad $ kind ++ " name " ++ name ++ " " ++ details
+ err msg = Bad $ OpPrereqError (kind ++ " name " ++ name ++ " " ++ msg)
+ ECodeNoEnt
fullname <- case lrMatchPriority lresult of
PartialMatch -> Ok $ lrContent lresult
ExactMatch -> Ok $ lrContent lresult
M.lookup fullname allitems
-- | Looks up a node.
-getNode :: ConfigData -> String -> Result Node
-getNode cfg name = getItem "Node" name (configNodes cfg)
+getNode :: ConfigData -> String -> ErrorResult Node
+getNode cfg name = getItem "Node" name (fromContainer $ configNodes cfg)
-- | Looks up an instance.
-getInstance :: ConfigData -> String -> Result Instance
-getInstance cfg name = getItem "Instance" name (configInstances cfg)
+getInstance :: ConfigData -> String -> ErrorResult Instance
+getInstance cfg name =
+ getItem "Instance" name (fromContainer $ configInstances cfg)
+
+-- | Looks up a node group. This is more tricky than for
+-- node/instances since the groups map is indexed by uuid, not name.
+getGroup :: ConfigData -> String -> ErrorResult NodeGroup
+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
+ (groupName . (M.!) groups) groups
+ in getItem "NodeGroup" name by_name
+
+-- | Computes a node group's node params.
+getGroupNdParams :: ConfigData -> NodeGroup -> FilledNDParams
+getGroupNdParams cfg ng =
+ fillNDParams (clusterNdparams $ configCluster cfg) (groupNdparams ng)
+
+-- | Computes a node group's ipolicy.
+getGroupIpolicy :: ConfigData -> NodeGroup -> FilledIPolicy
+getGroupIpolicy cfg ng =
+ fillIPolicy (clusterIpolicy $ configCluster cfg) (groupIpolicy ng)
+
+-- | Computes a group\'s (merged) disk params.
+getGroupDiskParams :: ConfigData -> NodeGroup -> DiskParams
+getGroupDiskParams cfg ng =
+ Container $
+ fillDict (fromContainer . clusterDiskparams $ configCluster cfg)
+ (fromContainer $ groupDiskparams ng) []
+
+-- | 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 =
+ let gnodes = map nodeName (getGroupNodes cfg gname)
+ ginsts = map (getNodeInstances cfg) gnodes in
+ (concatMap fst ginsts, concatMap snd ginsts)
-- | Looks up an instance's primary node.
-getInstPrimaryNode :: ConfigData -> String -> Result Node
+getInstPrimaryNode :: ConfigData -> String -> ErrorResult Node
getInstPrimaryNode cfg name =
- getInstance cfg name >>= return . instPrimaryNode >>= getNode cfg
+ liftM instPrimaryNode (getInstance cfg name) >>= getNode cfg
-- | Filters DRBD minors for a given node.
getDrbdMinorsForNode :: String -> Disk -> [(Int, String)]
buildLinkIpInstnameMap :: ConfigData -> LinkIpMap
buildLinkIpInstnameMap cfg =
let cluster = configCluster cfg
- instances = M.elems . configInstances $ cfg
- defparams = (M.!) (clusterNicparams cluster) C.ppDefault
+ instances = M.elems . fromContainer . configInstances $ cfg
+ defparams = (M.!) (fromContainer $ clusterNicparams cluster) C.ppDefault
nics = concatMap (\i -> [(instName i, nic) | nic <- instNics i])
instances
in foldl' (\accum (iname, nic) ->
let pparams = nicNicparams nic
- fparams = fillNICParams defparams pparams
+ fparams = fillNicParams defparams pparams
link = nicpLink fparams
in case nicIp nic of
Nothing -> accum
- Just ip -> let oldipmap = M.findWithDefault (M.empty)
+ Just ip -> let oldipmap = M.findWithDefault M.empty
link accum
newipmap = M.insert ip iname oldipmap
in M.insert link newipmap accum
) M.empty nics
+
+
+-- | 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