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 with the
--mond option 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/DataCollectors/Types.hs |    7 +-
 src/Ganeti/HTools/CLI.hs           |   10 +++
 src/Ganeti/HTools/ExtLoader.hs     |  133 +++++++++++++++++++++++++++++++++++-
 src/Ganeti/HTools/Program/Hail.hs  |   12 +++-
 src/Ganeti/HTools/Program/Hbal.hs  |    1 +
 src/Ganeti/HTools/Program/Hinfo.hs |    2 +
 6 files changed, 158 insertions(+), 7 deletions(-)

diff --git a/src/Ganeti/DataCollectors/Types.hs 
b/src/Ganeti/DataCollectors/Types.hs
index da2c793..49f3cfc 100644
--- a/src/Ganeti/DataCollectors/Types.hs
+++ b/src/Ganeti/DataCollectors/Types.hs
@@ -37,6 +37,7 @@ module Ganeti.DataCollectors.Types
   , CollectorMap
   , buildReport
   , mergeStatuses
+  , getCategoryName
   ) where
 
 import Data.Char
@@ -52,9 +53,13 @@ import Ganeti.Utils (getCurrentTime)
 data DCCategory = DCInstance | DCStorage | DCDaemon | DCHypervisor
   deriving (Show, Eq)
 
+-- | Get the category name and return it as a string.
+getCategoryName :: DCCategory -> String
+getCategoryName dcc = map toLower . drop 2 . show $ dcc
+
 -- | The JSON instance for DCCategory.
 instance JSON DCCategory where
-  showJSON = showJSON . map toLower . drop 2 . show
+  showJSON = showJSON . getCategoryName
   readJSON =
     error "JSON read instance not implemented for type DCCategory"
 
diff --git a/src/Ganeti/HTools/CLI.hs b/src/Ganeti/HTools/CLI.hs
index 12c3914..b01df61 100644
--- a/src/Ganeti/HTools/CLI.hs
+++ b/src/Ganeti/HTools/CLI.hs
@@ -48,6 +48,7 @@ module Ganeti.HTools.CLI
   , oDiskTemplate
   , oSpindleUse
   , oDynuFile
+  , oMonD
   , oEvacMode
   , oExInst
   , oExTags
@@ -123,6 +124,7 @@ data Options = Options
   , optSpindleUse  :: Maybe Int      -- ^ Override for the spindle usage
   , optDynuFile    :: Maybe FilePath -- ^ Optional file with dynamic use data
   , optIgnoreDynu  :: Bool           -- ^ Do not use dynamic use data
+  , optMonD        :: Bool           -- ^ Query MonDs
   , optEvacMode    :: Bool           -- ^ Enable evacuation mode
   , optExInst      :: [String]       -- ^ Instances to be excluded
   , optExTags      :: Maybe [String] -- ^ Tags to use for exclusion
@@ -178,6 +180,7 @@ defaultOptions  = Options
   , optSpindleUse  = Nothing
   , optIgnoreDynu  = False
   , optDynuFile    = Nothing
+  , optMonD        = False
   , optEvacMode    = False
   , optExInst      = []
   , optExTags      = Nothing
@@ -280,6 +283,13 @@ oDiskMoves =
    \ thus allowing only the 'cheap' failover/migrate operations",
    OptComplNone)
 
+oMonD :: OptType
+oMonD =
+  (Option "" ["mond"]
+   (NoArg (\ opts -> Ok opts {optMonD = True}))
+   "Query MonDs",
+   OptComplNone)
+
 oDiskTemplate :: OptType
 oDiskTemplate =
   (Option "" ["disk-template"]
diff --git a/src/Ganeti/HTools/ExtLoader.hs b/src/Ganeti/HTools/ExtLoader.hs
index 488345b..4030536 100644
--- a/src/Ganeti/HTools/ExtLoader.hs
+++ b/src/Ganeti/HTools/ExtLoader.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE BangPatterns #-}
+
 {-| External data loader.
 
 This module holds the external data loading, and thus is the only one
@@ -31,27 +33,40 @@ module Ganeti.HTools.ExtLoader
   ( loadExternalData
   , commonSuffix
   , maybeSaveData
+  , queryAllMonDDCs
   ) where
 
 import Control.Monad
 import Control.Exception
-import Data.Maybe (isJust, fromJust)
+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 +130,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 optMonD opts then queryAllMonDDCs cdata opts else return 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 +150,114 @@ 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 :: Options -> [DataCollector]
+collectors opts =
+  if optIgnoreDynu opts
+    then []
+    else [ 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 opts)
+  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
+      let il' = foldl updateUtilData il elems'
+          nl' = zip (Container.keys nl) elems'
+      in return (Container.fromList nl', il')
+    else do
+      logWarning $ "Didn't receive an answer by all MonDs, " ++ dName dc
+                   ++ "'s data will be ignored."
+      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 ->
+      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 ++ "/"
+  ++ show C.mondLatestApiVersion ++ "/report/" ++
+  getDCCName (dCategory dc) ++ "/" ++ dName dc
+
+-- | Get Category Name.
+getDCCName :: Maybe DCCategory -> String
+getDCCName dcc =
+  case dcc of
+    Nothing -> "default"
+    Just c -> getCategoryName c
diff --git a/src/Ganeti/HTools/Program/Hail.hs 
b/src/Ganeti/HTools/Program/Hail.hs
index 50009a3..13f5814 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,8 @@ options =
     , oDataFile
     , oNodeSim
     , oVerbose
+    , oIgnoreDyn
+    , oMonD
     ]
 
 -- | The list of arguments supported by the program.
@@ -69,8 +72,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 optMonD opts then queryAllMonDDCs cdata opts else return cdata
+      return $ Request rqt cdata'
 
 -- | Main function.
 main :: Options -> [String] -> IO ()
diff --git a/src/Ganeti/HTools/Program/Hbal.hs 
b/src/Ganeti/HTools/Program/Hbal.hs
index f863ad1..776b10f 100644
--- a/src/Ganeti/HTools/Program/Hbal.hs
+++ b/src/Ganeti/HTools/Program/Hbal.hs
@@ -92,6 +92,7 @@ options = do
     , oInstMoves
     , oDynuFile
     , oIgnoreDyn 
+    , oMonD
     , oExTags
     , oExInst
     , oSaveCluster
diff --git a/src/Ganeti/HTools/Program/Hinfo.hs 
b/src/Ganeti/HTools/Program/Hinfo.hs
index f15977c..1b45225 100644
--- a/src/Ganeti/HTools/Program/Hinfo.hs
+++ b/src/Ganeti/HTools/Program/Hinfo.hs
@@ -61,6 +61,8 @@ options = do
     , oVerbose
     , oQuiet
     , oOfflineNode
+    , oIgnoreDyn
+    , oMonD
     ]
 
 -- | The list of arguments supported by the program.
-- 
1.7.10.4

Reply via email to