code.grnet.gr Git - ganeti-local/blob - src/Ganeti/Query/Node.hs

   1 {-| Implementation of the Ganeti Query2 node queries.
   2
   3  -}
   4
   5 {-
   6
   7 Copyright (C) 2012 Google Inc.
   8
   9 This program is free software; you can redistribute it and/or modify
  10 it under the terms of the GNU General Public License as published by
  11 the Free Software Foundation; either version 2 of the License, or
  12 (at your option) any later version.
  13
  14 This program is distributed in the hope that it will be useful, but
  15 WITHOUT ANY WARRANTY; without even the implied warranty of
  16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17 General Public License for more details.
  18
  19 You should have received a copy of the GNU General Public License
  20 along with this program; if not, write to the Free Software
  21 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  22 02110-1301, USA.
  23
  24 -}
  25
  26 module Ganeti.Query.Node
  27   ( NodeRuntime
  28   , nodeFieldsMap
  29   , maybeCollectLiveData
  30   ) where
  31
  32 import Control.Applicative
  33 import Data.List
  34 import qualified Data.Map as Map
  35 import qualified Text.JSON as J
  36
  37 import Ganeti.Config
  38 import Ganeti.Objects
  39 import Ganeti.JSON
  40 import Ganeti.Rpc
  41 import Ganeti.Query.Language
  42 import Ganeti.Query.Common
  43 import Ganeti.Query.Types
  44
  45 -- | NodeRuntime is the resulting type for NodeInfo call.
  46 type NodeRuntime = Either RpcError RpcResultNodeInfo
  47
  48 -- | List of node live fields.
  49 nodeLiveFieldsDefs :: [(FieldName, FieldTitle, FieldType, String, FieldDoc)]
  50 nodeLiveFieldsDefs =
  51   [ ("bootid", "BootID", QFTText, "bootid",
  52      "Random UUID renewed for each system reboot, can be used\
  53      \ for detecting reboots by tracking changes")
  54   , ("cnodes", "CNodes", QFTNumber, "cpu_nodes",
  55      "Number of NUMA domains on node (if exported by hypervisor)")
  56   , ("csockets", "CSockets", QFTNumber, "cpu_sockets",
  57      "Number of physical CPU sockets (if exported by hypervisor)")
  58   , ("ctotal", "CTotal", QFTNumber, "cpu_total",
  59      "Number of logical processors")
  60   , ("dfree", "DFree", QFTUnit, "vg_free",
  61      "Available disk space in volume group")
  62   , ("dtotal", "DTotal", QFTUnit, "vg_size",
  63      "Total disk space in volume group used for instance disk allocation")
  64   , ("mfree", "MFree", QFTUnit, "memory_free",
  65      "Memory available for instance allocations")
  66   , ("mnode", "MNode", QFTUnit, "memory_dom0",
  67      "Amount of memory used by node (dom0 for Xen)")
  68   , ("mtotal", "MTotal", QFTUnit, "memory_total",
  69      "Total amount of memory of physical machine")
  70   ]
  71
  72 -- | Map each name to a function that extracts that value from
  73 -- the RPC result.
  74 nodeLiveFieldExtract :: FieldName -> RpcResultNodeInfo -> J.JSValue
  75 nodeLiveFieldExtract "bootid" res =
  76   J.showJSON $ rpcResNodeInfoBootId res
  77 nodeLiveFieldExtract "cnodes" res =
  78   jsonHead (rpcResNodeInfoHvInfo res) hvInfoCpuNodes
  79 nodeLiveFieldExtract "csockets" res =
  80   jsonHead (rpcResNodeInfoHvInfo res) hvInfoCpuSockets
  81 nodeLiveFieldExtract "ctotal" res =
  82   jsonHead (rpcResNodeInfoHvInfo res) hvInfoCpuTotal
  83 nodeLiveFieldExtract "dfree" res =
  84   getMaybeJsonHead (rpcResNodeInfoVgInfo res) vgInfoVgFree
  85 nodeLiveFieldExtract "dtotal" res =
  86   getMaybeJsonHead (rpcResNodeInfoVgInfo res) vgInfoVgSize
  87 nodeLiveFieldExtract "mfree" res =
  88   jsonHead (rpcResNodeInfoHvInfo res) hvInfoMemoryFree
  89 nodeLiveFieldExtract "mnode" res =
  90   jsonHead (rpcResNodeInfoHvInfo res) hvInfoMemoryDom0
  91 nodeLiveFieldExtract "mtotal" res =
  92   jsonHead (rpcResNodeInfoHvInfo res) hvInfoMemoryTotal
  93 nodeLiveFieldExtract _ _ = J.JSNull
  94
  95 -- | Helper for extracting field from RPC result.
  96 nodeLiveRpcCall :: FieldName -> NodeRuntime -> Node -> ResultEntry
  97 nodeLiveRpcCall fname (Right res) _ =
  98   case nodeLiveFieldExtract fname res of
  99     J.JSNull -> rsNoData
 100     x -> rsNormal x
 101 nodeLiveRpcCall _ (Left err) _ =
 102     ResultEntry (rpcErrorToStatus err) Nothing
 103
 104 -- | Builder for node live fields.
 105 nodeLiveFieldBuilder :: (FieldName, FieldTitle, FieldType, String, FieldDoc)
 106                      -> FieldData Node NodeRuntime
 107 nodeLiveFieldBuilder (fname, ftitle, ftype, _, fdoc) =
 108   ( FieldDefinition fname ftitle ftype fdoc
 109   , FieldRuntime $ nodeLiveRpcCall fname
 110   , QffNormal)
 111
 112 -- | The docstring for the node role. Note that we use 'reverse in
 113 -- order to keep the same order as Python.
 114 nodeRoleDoc :: String
 115 nodeRoleDoc =
 116   "Node role; " ++
 117   intercalate ", "
 118    (map (\role ->
 119           "\"" ++ nodeRoleToRaw role ++ "\" for " ++ roleDescription role)
 120    (reverse [minBound..maxBound]))
 121
 122 -- | Get node powered status.
 123 getNodePower :: ConfigData -> Node -> ResultEntry
 124 getNodePower cfg node =
 125   case getNodeNdParams cfg node of
 126     Nothing -> rsNoData
 127     Just ndp -> if null (ndpOobProgram ndp)
 128                   then rsUnavail
 129                   else rsNormal (nodePowered node)
 130
 131 -- | List of all node fields.
 132 nodeFields :: FieldList Node NodeRuntime
 133 nodeFields =
 134   [ (FieldDefinition "drained" "Drained" QFTBool "Whether node is drained",
 135      FieldSimple (rsNormal . nodeDrained), QffNormal)
 136   , (FieldDefinition "master_candidate" "MasterC" QFTBool
 137        "Whether node is a master candidate",
 138      FieldSimple (rsNormal . nodeMasterCandidate), QffNormal)
 139   , (FieldDefinition "master_capable" "MasterCapable" QFTBool
 140        "Whether node can become a master candidate",
 141      FieldSimple (rsNormal . nodeMasterCapable), QffNormal)
 142   , (FieldDefinition "name" "Node" QFTText "Node name",
 143      FieldSimple (rsNormal . nodeName), QffNormal)
 144   , (FieldDefinition "offline" "Offline" QFTBool
 145        "Whether node is marked offline",
 146      FieldSimple (rsNormal . nodeOffline), QffNormal)
 147   , (FieldDefinition "vm_capable" "VMCapable" QFTBool
 148        "Whether node can host instances",
 149      FieldSimple (rsNormal . nodeVmCapable), QffNormal)
 150   , (FieldDefinition "pip" "PrimaryIP" QFTText "Primary IP address",
 151      FieldSimple (rsNormal . nodePrimaryIp), QffNormal)
 152   , (FieldDefinition "sip" "SecondaryIP" QFTText "Secondary IP address",
 153      FieldSimple (rsNormal . nodeSecondaryIp), QffNormal)
 154   , (FieldDefinition "master" "IsMaster" QFTBool "Whether node is master",
 155      FieldConfig (\cfg node ->
 156                     rsNormal (nodeName node ==
 157                               clusterMasterNode (configCluster cfg))),
 158      QffNormal)
 159   , (FieldDefinition "group" "Group" QFTText "Node group",
 160      FieldConfig (\cfg node ->
 161                     rsMaybe (groupName <$> getGroupOfNode cfg node)),
 162      QffNormal)
 163   , (FieldDefinition "group.uuid" "GroupUUID" QFTText "UUID of node group",
 164      FieldSimple (rsNormal . nodeGroup), QffNormal)
 165   ,  (FieldDefinition "ndparams" "NodeParameters" QFTOther
 166         "Merged node parameters",
 167       FieldConfig ((rsMaybe .) . getNodeNdParams), QffNormal)
 168   , (FieldDefinition "custom_ndparams" "CustomNodeParameters" QFTOther
 169                        "Custom node parameters",
 170      FieldSimple (rsNormal . nodeNdparams), QffNormal)
 171   -- FIXME: the below could be generalised a bit, like in Python
 172   , (FieldDefinition "pinst_cnt" "Pinst" QFTNumber
 173        "Number of instances with this node as primary",
 174      FieldConfig (\cfg ->
 175                     rsNormal . length . fst . getNodeInstances cfg . nodeName),
 176      QffNormal)
 177   , (FieldDefinition "sinst_cnt" "Sinst" QFTNumber
 178        "Number of instances with this node as secondary",
 179      FieldConfig (\cfg ->
 180                     rsNormal . length . snd . getNodeInstances cfg . nodeName),
 181      QffNormal)
 182   , (FieldDefinition "pinst_list" "PriInstances" QFTOther
 183        "List of instances with this node as primary",
 184      FieldConfig (\cfg -> rsNormal . map instName . fst .
 185                           getNodeInstances cfg . nodeName), QffNormal)
 186   , (FieldDefinition "sinst_list" "SecInstances" QFTOther
 187        "List of instances with this node as secondary",
 188      FieldConfig (\cfg -> rsNormal . map instName . snd .
 189                           getNodeInstances cfg . nodeName), QffNormal)
 190   , (FieldDefinition "role" "Role" QFTText nodeRoleDoc,
 191      FieldConfig ((rsNormal .) . getNodeRole), QffNormal)
 192   , (FieldDefinition "powered" "Powered" QFTBool
 193        "Whether node is thought to be powered on",
 194      FieldConfig getNodePower, QffNormal)
 195   -- FIXME: the two fields below are incomplete in Python, part of the
 196   -- non-implemented node resource model; they are declared just for
 197   -- parity, but are not functional
 198   , (FieldDefinition "hv_state" "HypervisorState" QFTOther "Hypervisor state",
 199      missingRuntime, QffNormal)
 200   , (FieldDefinition "disk_state" "DiskState" QFTOther "Disk state",
 201      missingRuntime, QffNormal)
 202   ] ++
 203   map nodeLiveFieldBuilder nodeLiveFieldsDefs ++
 204   map buildNdParamField allNDParamFields ++
 205   timeStampFields ++
 206   uuidFields "Node" ++
 207   serialFields "Node" ++
 208   tagsFields
 209
 210 -- | The node fields map.
 211 nodeFieldsMap :: FieldMap Node NodeRuntime
 212 nodeFieldsMap =
 213   Map.fromList $ map (\v@(f, _, _) -> (fdefName f, v)) nodeFields
 214
 215 -- | Collect live data from RPC query if enabled.
 216 --
 217 -- FIXME: Check which fields we actually need and possibly send empty
 218 -- hvs/vgs if no info from hypervisor/volume group respectively is
 219 -- required
 220 maybeCollectLiveData:: Bool -> ConfigData -> [Node] -> IO [(Node, NodeRuntime)]
 221 maybeCollectLiveData False _ nodes =
 222   return $ zip nodes (repeat $ Left (RpcResultError "Live data disabled"))
 223 maybeCollectLiveData True cfg nodes = do
 224   let vgs = [clusterVolumeGroupName $ configCluster cfg]
 225       hvs = [getDefaultHypervisor cfg]
 226       step n (bn, gn, em) =
 227         let ndp' = getNodeNdParams cfg n
 228         in case ndp' of
 229              Just ndp -> (bn, n : gn,
 230                           (nodeName n, ndpExclusiveStorage ndp) : em)
 231              Nothing -> (n : bn, gn, em)
 232       (bnodes, gnodes, emap) = foldr step ([], [], []) nodes
 233   rpcres <- executeRpcCall gnodes (RpcCallNodeInfo vgs hvs (Map.fromList emap))
 234   -- FIXME: The order of nodes in the result could be different from the input
 235   return $ zip bnodes (repeat $ Left (RpcResultError "Broken configuration"))
 236            ++ rpcres