Add support for classic queries
[ganeti-local] / htools / Ganeti / Config.hs
index 139c450..a35c5d2 100644 (file)
@@ -25,24 +25,36 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
 
 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.JSON
 import Ganeti.BasicTypes
 
 import qualified Ganeti.Constants as C
@@ -51,6 +63,10 @@ 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
@@ -97,12 +113,31 @@ getNodeInstances cfg nname =
         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) . 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]
 getInstancesIpByLink linkipmap link =
@@ -113,7 +148,7 @@ getInstancesIpByLink linkipmap link =
 getItem :: String -> String -> M.Map String a -> Result a
 getItem kind name allitems = do
   let lresult = lookupName (M.keys allitems) name
-      err = \details -> Bad $ kind ++ " name " ++ name ++ " " ++ details
+      err msg = Bad $ kind ++ " name " ++ name ++ " " ++ msg
   fullname <- case lrMatchPriority lresult of
                 PartialMatch -> Ok $ lrContent lresult
                 ExactMatch -> Ok $ lrContent lresult
@@ -131,10 +166,52 @@ getInstance :: ConfigData -> String -> Result 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 -> Result 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 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)]
@@ -191,12 +268,35 @@ buildLinkIpInstnameMap cfg =
              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