Due to memory over-commitment forthcoming support obtaining memory_dom0
as an amount of actively-used memory becomes incorrect. This patch
enables hv_state CLI option iand updates default values for hv_state
parameters. Value of 1024M is typical amount of memory required by KVM
hypervizor itself. Python query module is unchanged because we don't
need to query hv_state from python code.

Signed-off-by: Oleg Ponomarev <[email protected]>
---
 Makefile.am                    |  1 +
 src/Ganeti/Config.hs           | 32 ++++++++++++++++++++++
 src/Ganeti/ConstantUtils.hs    | 17 ++++++++++++
 src/Ganeti/Constants.hs        | 11 ++++----
 src/Ganeti/HTools/Node.hs      |  5 ++++
 src/Ganeti/Objects.hs          | 33 ++++++++++++-----------
 src/Ganeti/Objects/HvState.hs  | 60 ++++++++++++++++++++++++++++++++++++++++++
 src/Ganeti/Query/Group.hs      |  3 +++
 src/Ganeti/Query/Node.hs       | 12 ++++++---
 src/Ganeti/Query/Server.hs     |  2 ++
 test/hs/Test/Ganeti/Objects.hs | 30 ++++++++++++++++++---
 11 files changed, 179 insertions(+), 27 deletions(-)
 create mode 100644 src/Ganeti/Objects/HvState.hs

diff --git a/Makefile.am b/Makefile.am
index a506296..4aede70 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -996,6 +996,7 @@ HS_LIB_SRCS = \
        src/Ganeti/Objects/BitArray.hs \
        src/Ganeti/Objects/Disk.hs \
        src/Ganeti/Objects/Instance.hs \
+       src/Ganeti/Objects/HvState.hs \
        src/Ganeti/Objects/Lens.hs \
        src/Ganeti/Objects/Maintenance.hs \
        src/Ganeti/Objects/Nic.hs \
diff --git a/src/Ganeti/Config.hs b/src/Ganeti/Config.hs
index 92c4c96..d20e128 100644
--- a/src/Ganeti/Config.hs
+++ b/src/Ganeti/Config.hs
@@ -68,6 +68,7 @@ module Ganeti.Config
     , getInstDisksFromObj
     , getDrbdMinorsForDisk
     , getDrbdMinorsForInstance
+    , getFilledHvStateParams
     , getFilledInstHvParams
     , getFilledInstBeParams
     , getFilledInstOsParams
@@ -98,6 +99,7 @@ import System.IO
 
 import Ganeti.BasicTypes
 import qualified Ganeti.Constants as C
+import qualified Ganeti.ConstantUtils as CU
 import Ganeti.Errors
 import Ganeti.JSON
 import Ganeti.Objects
@@ -327,6 +329,36 @@ getGroupInstances cfg gname =
       ginsts = map (getNodeInstances cfg) gnodes in
   (concatMap fst ginsts, concatMap snd ginsts)
 
+-- | default FilledHvStateParams.
+defaultHvStateParams :: FilledHvStateParams
+defaultHvStateParams = FilledHvStateParams
+  { hvstateCpuNode  = CU.hvstDefaultCpuNode
+  , hvstateCpuTotal = CU.hvstDefaultCpuTotal
+  , hvstateMemHv    = CU.hvstDefaultMemoryHv
+  , hvstateMemNode  = CU.hvstDefaultMemoryNode
+  , hvstateMemTotal = CU.hvstDefaultMemoryTotal
+  }
+
+-- | Retrieves the node's static hypervisor state parameters, missing values
+-- filled with group's parameters, missing group parameters are filled
+-- with cluster's parameters. Currently, returns hvstate parameters only for
+-- the default hypervisor.
+getFilledHvStateParams :: ConfigData -> Node -> FilledHvState
+getFilledHvStateParams cfg n =
+  let cluster_hv_state =
+        fromContainer . clusterHvStateStatic $ configCluster cfg
+      def_hv = getDefaultHypervisor cfg
+      cluster_fv = fromMaybe defaultHvStateParams $ M.lookup def_hv
+                                                    cluster_hv_state
+      group_fv = case getGroupOfNode cfg n >>=
+                      M.lookup def_hv . fromContainer . groupHvStateStatic of
+                   Just pv -> fillParams cluster_fv pv
+                   Nothing -> cluster_fv
+      node_fv = case M.lookup def_hv . fromContainer $ nodeHvStateStatic n of
+                      Just pv -> fillParams group_fv pv
+                      Nothing -> group_fv
+  in GenericContainer $ M.fromList [(def_hv, node_fv)]
+
 -- | Retrieves the instance hypervisor params, missing values filled with
 -- cluster defaults.
 getFilledInstHvParams :: [String] -> ConfigData -> Instance -> HvParams
diff --git a/src/Ganeti/ConstantUtils.hs b/src/Ganeti/ConstantUtils.hs
index ddbbd75..dc966d6 100644
--- a/src/Ganeti/ConstantUtils.hs
+++ b/src/Ganeti/ConstantUtils.hs
@@ -217,3 +217,20 @@ ipolicyDefaultsSpindleRatio = 32.0
 
 ipolicyDefaultsMemoryRatio :: Double
 ipolicyDefaultsMemoryRatio = 1.0
+
+-- * Hypervisor state default parameters
+
+hvstDefaultCpuNode :: Int
+hvstDefaultCpuNode = 1
+
+hvstDefaultCpuTotal :: Int
+hvstDefaultCpuTotal = 1
+
+hvstDefaultMemoryHv :: Int
+hvstDefaultMemoryHv = 1024
+
+hvstDefaultMemoryTotal :: Int
+hvstDefaultMemoryTotal = 1024
+
+hvstDefaultMemoryNode :: Int
+hvstDefaultMemoryNode = 4096
diff --git a/src/Ganeti/Constants.hs b/src/Ganeti/Constants.hs
index 038b2f3..9fd7ad4 100644
--- a/src/Ganeti/Constants.hs
+++ b/src/Ganeti/Constants.hs
@@ -2027,11 +2027,12 @@ hvstsParameters =
 hvstDefaults :: Map String Int
 hvstDefaults =
   Map.fromList
-  [(hvstCpuNode, 1),
-   (hvstCpuTotal, 1),
-   (hvstMemoryHv, 0),
-   (hvstMemoryTotal, 0),
-   (hvstMemoryNode, 0)]
+  [ (hvstCpuNode    , ConstantUtils.hvstDefaultCpuNode    )
+  , (hvstCpuTotal   , ConstantUtils.hvstDefaultCpuTotal   )
+  , (hvstMemoryHv   , ConstantUtils.hvstDefaultMemoryHv   )
+  , (hvstMemoryTotal, ConstantUtils.hvstDefaultMemoryTotal)
+  , (hvstMemoryNode , ConstantUtils.hvstDefaultMemoryNode )
+  ]
 
 hvstsParameterTypes :: Map String VType
 hvstsParameterTypes =
diff --git a/src/Ganeti/HTools/Node.hs b/src/Ganeti/HTools/Node.hs
index 6907b29..1cb85e4 100644
--- a/src/Ganeti/HTools/Node.hs
+++ b/src/Ganeti/HTools/Node.hs
@@ -47,6 +47,7 @@ module Ganeti.HTools.Node
   , setIdx
   , setAlias
   , setOffline
+  , setNmem
   , setXmem
   , setPri
   , calcFmemOfflineOrForthcoming
@@ -439,6 +440,10 @@ setLocationTags t val = t { locationTags = val }
 setXmem :: Node -> Int -> Node
 setXmem t val = t { xMem = val }
 
+-- | Sets the memory used by the node.
+setNmem :: Node -> Int -> Node
+setNmem t val = t { nMem = val }
+
 -- | Sets the max disk usage ratio.
 setMdsk :: Node -> Double -> Node
 setMdsk t val = t { mDsk = val, loDsk = mDskToloDsk val (tDsk t) }
diff --git a/src/Ganeti/Objects.hs b/src/Ganeti/Objects.hs
index 98f0ac9..1d1ba06 100644
--- a/src/Ganeti/Objects.hs
+++ b/src/Ganeti/Objects.hs
@@ -104,7 +104,11 @@ module Ganeti.Objects
   , module Ganeti.Objects.Disk
   , module Ganeti.Objects.Instance
   , module Ganeti.Objects.Maintenance
-  ) where
+  , FilledHvStateParams(..)
+  , PartialHvStateParams(..)
+  , allHvStateParamFields
+  , FilledHvState
+  , PartialHvState ) where
 
 import Prelude ()
 import Ganeti.Prelude
@@ -131,6 +135,7 @@ import Ganeti.Objects.Disk
 import Ganeti.Objects.Maintenance
 import Ganeti.Objects.Nic
 import Ganeti.Objects.Instance
+import Ganeti.Objects.HvState
 import Ganeti.Query.Language
 import Ganeti.PartialParams
 import Ganeti.Types
@@ -414,6 +419,8 @@ $(buildObject "Node" "node" $
   , simpleField "vm_capable"       [t| Bool   |]
   , simpleField "ndparams"         [t| PartialNDParams |]
   , simpleField "powered"          [t| Bool   |]
+  , defaultField [| emptyContainer |] $
+    simpleField "hv_state_static"  [t| PartialHvState |]
   ]
   ++ timeStampFields
   ++ uuidFields
@@ -442,13 +449,15 @@ type GroupDiskParams = Container DiskParams
 type Networks = Container PartialNicParams
 
 $(buildObject "NodeGroup" "group" $
-  [ simpleField "name"         [t| String |]
+  [ simpleField "name"            [t| String |]
   , defaultField [| [] |] $ simpleField "members" [t| [String] |]
-  , simpleField "ndparams"     [t| PartialNDParams |]
-  , simpleField "alloc_policy" [t| AllocPolicy     |]
-  , simpleField "ipolicy"      [t| PartialIPolicy  |]
-  , simpleField "diskparams"   [t| GroupDiskParams |]
-  , simpleField "networks"     [t| Networks        |]
+  , simpleField "ndparams"        [t| PartialNDParams |]
+  , simpleField "alloc_policy"    [t| AllocPolicy     |]
+  , simpleField "ipolicy"         [t| PartialIPolicy  |]
+  , simpleField "diskparams"      [t| GroupDiskParams |]
+  , simpleField "networks"        [t| Networks        |]
+  , defaultField [| emptyContainer |] $
+    simpleField "hv_state_static" [t| PartialHvState  |]
   ]
   ++ timeStampFields
   ++ uuidFields
@@ -620,12 +629,6 @@ type CandidateCertificates = Container String
 -- the content is just a 'JSValue'.
 type DiskState = Container JSValue
 
--- | Hypervisor state parameters.
---
--- As according to the documentation this option is unused by Ganeti,
--- the content is just a 'JSValue'.
-type HypervisorState = Container JSValue
-
 -- * Cluster definitions
 $(buildObject "Cluster" "cluster" $
   [ simpleField "rsahostkeypub"                  [t| String                  |]
@@ -670,9 +673,9 @@ $(buildObject "Cluster" "cluster" $
   , simpleField "prealloc_wipe_disks"            [t| Bool                    |]
   , simpleField "ipolicy"                        [t| FilledIPolicy           |]
   , defaultField [| emptyContainer |] $
-    simpleField "hv_state_static"                [t| HypervisorState        |]
+    simpleField "hv_state_static"                [t| FilledHvState           |]
   , defaultField [| emptyContainer |] $
-    simpleField "disk_state_static"              [t| DiskState              |]
+    simpleField "disk_state_static"              [t| DiskState               |]
   , simpleField "enabled_disk_templates"         [t| [DiskTemplate]          |]
   , simpleField "candidate_certs"                [t| CandidateCertificates   |]
   , simpleField "max_running_jobs"               [t| Int                     |]
diff --git a/src/Ganeti/Objects/HvState.hs b/src/Ganeti/Objects/HvState.hs
new file mode 100644
index 0000000..de2599f
--- /dev/null
+++ b/src/Ganeti/Objects/HvState.hs
@@ -0,0 +1,60 @@
+{-# LANGUAGE TemplateHaskell, FunctionalDependencies #-}
+
+{-| Implementation of the Ganeti HvState config object.
+
+-}
+
+{-
+
+Copyright (C) 2015 Google Inc.
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+1. Redistributions of source code must retain the above copyright notice,
+this list of conditions and the following disclaimer.
+
+2. Redistributions in binary form must reproduce the above copyright
+notice, this list of conditions and the following disclaimer in the
+documentation and/or other materials provided with the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR
+CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+-}
+
+module Ganeti.Objects.HvState
+  ( FilledHvStateParams(..)
+  , PartialHvStateParams(..)
+  , allHvStateParamFields
+  , FilledHvState
+  , PartialHvState ) where
+
+import Ganeti.THH
+import Ganeti.JSON
+import Ganeti.Types
+
+$(buildParam "HvState" "hvstate"
+  [ simpleField "cpu_node"  [t| Int |]
+  , simpleField "cpu_total" [t| Int |]
+  , simpleField "mem_hv"    [t| Int |]
+  , simpleField "mem_node"  [t| Int |]
+  , simpleField "mem_total" [t| Int |]
+  ])
+
+-- | Static filled hypervisor state (hvtype to hvstate mapping)
+type FilledHvState = GenericContainer Hypervisor FilledHvStateParams
+
+-- | Static partial hypervisor state (hvtype to hvstate mapping)
+type PartialHvState = GenericContainer Hypervisor PartialHvStateParams
diff --git a/src/Ganeti/Query/Group.hs b/src/Ganeti/Query/Group.hs
index c15906c..54849e0 100644
--- a/src/Ganeti/Query/Group.hs
+++ b/src/Ganeti/Query/Group.hs
@@ -83,6 +83,9 @@ groupFields =
        "List of primary instances",
      FieldConfig (\cfg -> rsNormal . niceSort . mapMaybe instName . fst .
                           getGroupInstances cfg . groupUuid), QffNormal)
+  , (FieldDefinition "hv_state" "HypervisorState" QFTOther
+       "Custom static hypervisor state",
+     FieldSimple (rsNormal . groupHvStateStatic), QffNormal)
   ] ++
   map buildNdParamField allNDParamFields ++
   timeStampFields ++
diff --git a/src/Ganeti/Query/Node.hs b/src/Ganeti/Query/Node.hs
index ecf5dc2..91a2c7b 100644
--- a/src/Ganeti/Query/Node.hs
+++ b/src/Ganeti/Query/Node.hs
@@ -246,11 +246,15 @@ nodeFields =
   , (FieldDefinition "powered" "Powered" QFTBool
        "Whether node is thought to be powered on",
      FieldConfig getNodePower, QffNormal)
-  -- FIXME: the two fields below are incomplete in Python, part of the
-  -- non-implemented node resource model; they are declared just for
+  , (FieldDefinition "hv_state" "HypervisorState" QFTOther
+       "Static hypervisor state for default hypervisor only",
+     FieldConfig $ (rsNormal .) . getFilledHvStateParams, QffNormal)
+  , (FieldDefinition "custom_hv_state" "CustomHypervisorState" QFTOther
+       "Custom static hypervisor state",
+     FieldSimple $ rsNormal . nodeHvStateStatic, QffNormal)
+  -- FIXME: the field below is incomplete in Python, part of the
+  -- non-implemented node resource model; It's declared just for
   -- parity, but are not functional
-  , (FieldDefinition "hv_state" "HypervisorState" QFTOther "Hypervisor state",
-     FieldSimple (const rsUnavail), QffNormal)
   , (FieldDefinition "disk_state" "DiskState" QFTOther "Disk state",
      FieldSimple (const rsUnavail), QffNormal)
   ] ++
diff --git a/src/Ganeti/Query/Server.hs b/src/Ganeti/Query/Server.hs
index df5da87..58abc03 100644
--- a/src/Ganeti/Query/Server.hs
+++ b/src/Ganeti/Query/Server.hs
@@ -280,6 +280,8 @@ handleCall _ _ cdata QueryClusterInfo =
                showJSON . maintBalance $ configMaintenance cdata)
             , ("maint_balance_threshold",
                showJSON . maintBalanceThreshold $ configMaintenance cdata)
+            , ("hv_state",
+               showJSON $ clusterHvStateStatic cluster)
             ]
 
   in case master of
diff --git a/test/hs/Test/Ganeti/Objects.hs b/test/hs/Test/Ganeti/Objects.hs
index db43835..07cb060 100644
--- a/test/hs/Test/Ganeti/Objects.hs
+++ b/test/hs/Test/Ganeti/Objects.hs
@@ -91,14 +91,37 @@ instance Arbitrary (Container DataCollectorConfig) where
     return GenericContainer {
       fromContainer = Map.fromList $ zip names configs }
 
+-- FYI: Currently only memory node value is used
+instance Arbitrary PartialHvStateParams where
+  arbitrary = PartialHvStateParams <$> pure Nothing <*> pure Nothing
+              <*> pure Nothing <*> (genMaybe $ fromPositive <$> arbitrary)
+              <*> pure Nothing
+
+instance Arbitrary PartialHvState where
+  arbitrary = do
+    hv_params <- arbitrary
+    return GenericContainer {
+      fromContainer = Map.fromList $ [ hv_params ] }
+
+-- FYI: Currently only memory node value is used
+instance Arbitrary FilledHvStateParams where
+  arbitrary = FilledHvStateParams <$> pure 0 <*> pure 0 <*> pure 0
+              <*> (fromPositive <$> arbitrary) <*> pure 0
+
+instance Arbitrary FilledHvState where
+  arbitrary = do
+    hv_params <- arbitrary
+    return GenericContainer {
+      fromContainer = Map.fromList $ [ hv_params ] }
+
 $(genArbitrary ''PartialNDParams)
 
 instance Arbitrary Node where
   arbitrary = Node <$> genFQDN <*> genFQDN <*> genFQDN
               <*> arbitrary <*> arbitrary <*> arbitrary <*> genFQDN
               <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
-              <*> arbitrary <*> arbitrary <*> genFQDN <*> arbitrary
-              <*> (Set.fromList <$> genTags)
+              <*> arbitrary <*> arbitrary <*> arbitrary <*> genFQDN
+              <*> arbitrary <*> (Set.fromList <$> genTags)
 
 $(genArbitrary ''BlockDriver)
 
@@ -662,6 +685,7 @@ genNodeGroup = do
   nic_param_list <- vectorOf num_networks (arbitrary::Gen PartialNicParams)
   net_map <- pure (GenericContainer . Map.fromList $
     zip net_uuid_list nic_param_list)
+  hv_state <- arbitrary
   -- timestamp fields
   ctime <- arbitrary
   mtime <- arbitrary
@@ -669,7 +693,7 @@ genNodeGroup = do
   serial <- arbitrary
   tags <- Set.fromList <$> genTags
   let group = NodeGroup name members ndparams alloc_policy ipolicy diskparams
-              net_map ctime mtime uuid serial tags
+              net_map hv_state ctime mtime uuid serial tags
   return group
 
 instance Arbitrary NodeGroup where
-- 
2.6.0.rc2.230.g3dd15c0

Reply via email to