On Fri, Sep 27, 2013 at 12:02 PM, Spyros Trigazis <[email protected]>wrote:

> 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..ec55cd5 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)
>
> +-- | Gets the category name and returns it as a string.
>

Nitpicking: descriptions of functions have to be written in imperative
form, not using the third person singular.
So, "get" and "return" instead of "gets" and "returns".


> +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..a294033 100644
> --- a/src/Ganeti/HTools/ExtLoader.hs
> +++ b/src/Ganeti/HTools/ExtLoader.hs
> @@ -27,31 +27,46 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor,
> Boston, MA
>
>  -}
>
> +{-# LANGUAGE BangPatterns #-}
>

Usually we put the "LANGUAGE" directives in the first line of the file,
before all the comments.


>  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
>

The final period is missing.


> +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
>
>
Rest LGTM, thanks.

-- 
Google Germany GmbH
Dienerstr. 12
80331 München

Registergericht und -nummer: Hamburg, HRB 86891
Sitz der Gesellschaft: Hamburg
Geschäftsführer: Graham Law, Christine Elizabeth Flores

Reply via email to