Contact all MonDs from HTools to fetch data from its Data
Collectors (only CPUload Data Collector is queried at the
moment). This information is available to all HTools and can be
ignored if the --ignore-dynu option is enabled. This
functionality is implemented in ExtLoader.hs.

Signed-off-by: Spyros Trigazis <[email protected]>
---
 src/Ganeti/HTools/Cluster.hs      |   15 ++++-
 src/Ganeti/HTools/ExtLoader.hs    |  129 ++++++++++++++++++++++++++++++++++++-
 src/Ganeti/HTools/Program/Hail.hs |   11 +++-
 3 files changed, 147 insertions(+), 8 deletions(-)

diff --git a/src/Ganeti/HTools/Cluster.hs b/src/Ganeti/HTools/Cluster.hs
index 88891a4..cf1705e 100644
--- a/src/Ganeti/HTools/Cluster.hs
+++ b/src/Ganeti/HTools/Cluster.hs
@@ -496,6 +496,17 @@ applyMove nl inst (FailoverAndReplace new_sdx) =
                 new_inst, old_sdx, new_sdx)
   in new_nl
 
+-- | Update the instance utilization according to the utilization of the
+-- given node and the requested number of cpus.
+uInstUtil :: Node.Node -> Instance.Instance -> Instance.Instance
+uInstUtil node inst =
+  let cpus = Node.uCpu node + Instance.vcpus inst
+      cpuLoad = cpuWeight . Node.utilLoad $ node
+      perCpu = cpuLoad / fromIntegral cpus
+      load = fromIntegral (Instance.vcpus inst) * perCpu
+      oldUtil = Instance.util inst
+  in inst { Instance.util = oldUtil { cpuWeight = load }}
+
 -- | Tries to allocate an instance on one given node.
 allocateOnSingle :: Node.List -> Instance.Instance -> Ndx
                  -> OpResult Node.AllocElement
@@ -504,7 +515,7 @@ allocateOnSingle nl inst new_pdx =
       new_inst = Instance.setBoth inst new_pdx Node.noSecondary
   in do
     Instance.instMatchesPolicy inst (Node.iPolicy p) (Node.exclStorage p)
-    new_p <- Node.addPri p inst
+    new_p <- Node.addPri p (uInstUtil p inst)
     let new_nl = Container.add new_pdx new_p nl
         new_score = compCV new_nl
     return (new_nl, new_inst, [new_p], new_score)
@@ -518,7 +529,7 @@ allocateOnPair nl inst new_pdx new_sdx =
   in do
     Instance.instMatchesPolicy inst (Node.iPolicy tgt_p)
       (Node.exclStorage tgt_p)
-    new_p <- Node.addPri tgt_p inst
+    new_p <- Node.addPri tgt_p (uInstUtil tgt_p inst)
     new_s <- Node.addSec tgt_s inst new_pdx
     let new_inst = Instance.setBoth inst new_pdx new_sdx
         new_nl = Container.addTwo new_pdx new_p new_sdx new_s nl
diff --git a/src/Ganeti/HTools/ExtLoader.hs b/src/Ganeti/HTools/ExtLoader.hs
index 488345b..d42c833 100644
--- a/src/Ganeti/HTools/ExtLoader.hs
+++ b/src/Ganeti/HTools/ExtLoader.hs
@@ -27,31 +27,47 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, 
MA
 
 -}
 
+{-# LANGUAGE BangPatterns #-}
+
 module Ganeti.HTools.ExtLoader
   ( loadExternalData
   , commonSuffix
   , maybeSaveData
+  , queryAllMonDDCs
   ) where
 
 import Control.Monad
 import Control.Exception
-import Data.Maybe (isJust, fromJust)
+import Data.Char
+import Data.Maybe (isJust, fromJust, catMaybes)
+import Network.Curl
 import System.FilePath
 import System.IO
 import System.Time (getClockTime)
 import Text.Printf (hPrintf)
 
+import qualified Text.JSON as J
+
+import qualified Ganeti.Constants as C
+import qualified Ganeti.DataCollectors.CPUload as CPUload
+import qualified Ganeti.HTools.Container as Container
 import qualified Ganeti.HTools.Backend.Luxi as Luxi
 import qualified Ganeti.HTools.Backend.Rapi as Rapi
 import qualified Ganeti.HTools.Backend.Simu as Simu
 import qualified Ganeti.HTools.Backend.Text as Text
 import qualified Ganeti.HTools.Backend.IAlloc as IAlloc
+import qualified Ganeti.HTools.Node as Node
+import qualified Ganeti.HTools.Instance as Instance
 import Ganeti.HTools.Loader (mergeData, checkData, ClusterData(..)
                             , commonSuffix, clearDynU)
 
 import Ganeti.BasicTypes
+import Ganeti.Cpu.Types
+import Ganeti.DataCollectors.Types
 import Ganeti.HTools.Types
 import Ganeti.HTools.CLI
+import Ganeti.JSON
+import Ganeti.Logging (logWarning)
 import Ganeti.Utils (sepSplit, tryRead, exitIfBad, exitWhen)
 
 -- | Error beautifier.
@@ -115,11 +131,12 @@ loadExternalData opts = do
       ldresult = input_data >>= (if ignoreDynU then clearDynU else return)
                             >>= mergeData eff_u exTags selInsts exInsts now
   cdata <- exitIfBad "failed to load data, aborting" ldresult
-  let (fix_msgs, nl) = checkData (cdNodes cdata) (cdInstances cdata)
+  cdata' <- if ignoreDynU then return cdata else queryAllMonDDCs cdata
+  let (fix_msgs, nl) = checkData (cdNodes cdata') (cdInstances cdata')
 
   unless (optVerbose opts == 0) $ maybeShowWarnings fix_msgs
 
-  return cdata {cdNodes = nl}
+  return cdata' {cdNodes = nl}
 
 -- | Function to save the cluster data to a file.
 maybeSaveData :: Maybe FilePath -- ^ The file prefix to save to
@@ -134,3 +151,109 @@ maybeSaveData (Just path) ext msg cdata = do
   writeFile out_path adata
   hPrintf stderr "The cluster state %s has been written to file '%s'\n"
           msg out_path
+
+-- | Type describing a data collector basic information
+data DataCollector = DataCollector
+  { dName     :: String           -- ^ Name of the data collector
+  , dCategory :: Maybe DCCategory -- ^ The name of the category
+  }
+
+-- | The actual data types for MonD's Data Collectors.
+data Report = CPUavgloadReport CPUavgload
+
+-- | The list of Data Collectors used by hail and hbal.
+collectors :: [DataCollector]
+collectors =
+  [ DataCollector CPUload.dcName CPUload.dcCategory ]
+
+-- | Query all MonDs for all Data Collector.
+queryAllMonDDCs :: ClusterData -> IO ClusterData
+queryAllMonDDCs cdata = do
+  let (ClusterData _ nl il _ _) = cdata
+  (nl', il') <- foldM queryAllMonDs (nl, il) collectors
+  return $ cdata {cdNodes = nl', cdInstances = il'}
+
+-- | Query all MonDs for a single Data Collector.
+queryAllMonDs :: (Node.List, Instance.List) -> DataCollector
+                 -> IO (Node.List, Instance.List)
+queryAllMonDs (nl, il) dc = do
+  elems <- mapM (queryAMonD dc) (Container.elems nl)
+  let elems' = catMaybes elems
+  if length elems == length elems'
+    then do
+      let il' = foldl updateUtilData il elems'
+          nl' = zip (Container.keys nl) elems'
+      return (Container.fromList nl', il')
+    else return (nl,il)
+
+-- | Query a specified MonD for a Data Collector.
+fromCurl :: DataCollector -> Node.Node -> IO (Maybe DCReport)
+fromCurl dc node = do
+  (code, !body) <-  curlGetString (prepareUrl dc node) []
+  case code of
+    CurlOK -> do
+      case J.decodeStrict body :: J.Result DCReport of
+        J.Ok r -> return $ Just r
+        J.Error _ -> return Nothing
+    _ -> do
+      logWarning $ "Failed to contact node's " ++ Node.name node
+                   ++ " MonD for DC " ++ dName dc
+      return Nothing
+
+-- | Return the data from correct combination of a Data Collector
+-- and a DCReport.
+mkReport :: DataCollector -> Maybe DCReport -> Maybe Report
+mkReport dc dcr =
+  case dcr of
+    Nothing -> Nothing
+    Just dcr' ->
+      case () of
+        _ | CPUload.dcName == dName dc ->
+              case fromJVal (dcReportData dcr') :: Result CPUavgload of
+                Ok cav -> Just $ CPUavgloadReport cav
+                Bad _ -> Nothing
+          | otherwise -> Nothing
+
+-- | Query a MonD for a single Data Collector.
+queryAMonD :: DataCollector -> Node.Node -> IO (Maybe Node.Node)
+queryAMonD dc node = do
+  dcReport <- fromCurl dc node
+  case mkReport dc dcReport of
+    Nothing -> return Nothing
+    Just report ->
+      case report of
+        CPUavgloadReport cav ->
+          let ct = cavCpuTotal cav
+              du = Node.utilLoad node
+              du' = du {cpuWeight = ct}
+          in return $ Just node {Node.utilLoad = du'}
+
+-- | Update utilization data.
+updateUtilData :: Instance.List -> Node.Node -> Instance.List
+updateUtilData il node =
+  let ct = cpuWeight (Node.utilLoad node)
+      n_uCpu = Node.uCpu node
+      upd inst =
+        if Node.idx node == Instance.pNode inst
+        then
+          let i_vcpus = Instance.vcpus inst
+              i_util = ct / fromIntegral n_uCpu * fromIntegral i_vcpus
+              i_du = Instance.util inst
+              i_du' = i_du {cpuWeight = i_util}
+          in inst {Instance.util = i_du'}
+        else inst
+  in Container.map upd il
+
+-- | Prepare url to query a single collector.
+prepareUrl :: DataCollector -> Node.Node -> URLString
+prepareUrl dc node =
+  Node.name node ++ ":" ++ show C.defaultMondPort ++ "/"
+  ++ "1" ++ "/report/" ++
+  getDCCName (dCategory dc) ++ "/" ++ dName dc
+
+-- | Get Category Name.
+getDCCName :: Maybe DCCategory -> String
+getDCCName dcc =
+  case dcc of
+    Nothing -> "default"
+    Just c -> map toLower . drop 2 . show $ c
diff --git a/src/Ganeti/HTools/Program/Hail.hs 
b/src/Ganeti/HTools/Program/Hail.hs
index 50009a3..507192c 100644
--- a/src/Ganeti/HTools/Program/Hail.hs
+++ b/src/Ganeti/HTools/Program/Hail.hs
@@ -39,7 +39,8 @@ import Ganeti.Common
 import Ganeti.HTools.CLI
 import Ganeti.HTools.Backend.IAlloc
 import Ganeti.HTools.Loader (Request(..), ClusterData(..))
-import Ganeti.HTools.ExtLoader (maybeSaveData, loadExternalData)
+import Ganeti.HTools.ExtLoader (maybeSaveData, loadExternalData
+                               , queryAllMonDDCs)
 import Ganeti.Utils
 
 -- | Options list and functions.
@@ -51,6 +52,7 @@ options =
     , oDataFile
     , oNodeSim
     , oVerbose
+    , oIgnoreDyn
     ]
 
 -- | The list of arguments supported by the program.
@@ -69,8 +71,11 @@ wrapReadRequest opts args = do
       cdata <- loadExternalData opts
       let Request rqt _ = r1
       return $ Request rqt cdata
-    else return r1
-
+    else do
+      let Request rqt cdata = r1
+      cdata' <-
+        if optIgnoreDynu opts then return cdata else queryAllMonDDCs cdata
+      return $ Request rqt cdata'
 
 -- | Main function.
 main :: Options -> [String] -> IO ()
-- 
1.7.10.4

Reply via email to