Node.hs 9.56 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
{-| Implementation of the Ganeti Query2 node queries.

 -}

{-

Copyright (C) 2012 Google Inc.

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
02110-1301, USA.

-}

module Ganeti.Query.Node
27
  ( NodeRuntime
28
  , nodeFieldsMap
29
  , maybeCollectLiveData
30
31
32
33
34
  ) where

import Control.Applicative
import Data.List
import qualified Data.Map as Map
Agata Murawska's avatar
Agata Murawska committed
35
import qualified Text.JSON as J
36
37
38

import Ganeti.Config
import Ganeti.Objects
Agata Murawska's avatar
Agata Murawska committed
39
import Ganeti.JSON
40
import Ganeti.Rpc
41
import Ganeti.Query.Language
42
43
44
import Ganeti.Query.Common
import Ganeti.Query.Types

45
46
-- | NodeRuntime is the resulting type for NodeInfo call.
type NodeRuntime = Either RpcError RpcResultNodeInfo
47

Agata Murawska's avatar
Agata Murawska committed
48
-- | List of node live fields.
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
nodeLiveFieldsDefs :: [(FieldName, FieldTitle, FieldType, String, FieldDoc)]
nodeLiveFieldsDefs =
  [ ("bootid", "BootID", QFTText, "bootid",
     "Random UUID renewed for each system reboot, can be used\
     \ for detecting reboots by tracking changes")
  , ("cnodes", "CNodes", QFTNumber, "cpu_nodes",
     "Number of NUMA domains on node (if exported by hypervisor)")
  , ("csockets", "CSockets", QFTNumber, "cpu_sockets",
     "Number of physical CPU sockets (if exported by hypervisor)")
  , ("ctotal", "CTotal", QFTNumber, "cpu_total",
     "Number of logical processors")
  , ("dfree", "DFree", QFTUnit, "vg_free",
     "Available disk space in volume group")
  , ("dtotal", "DTotal", QFTUnit, "vg_size",
     "Total disk space in volume group used for instance disk allocation")
  , ("mfree", "MFree", QFTUnit, "memory_free",
     "Memory available for instance allocations")
  , ("mnode", "MNode", QFTUnit, "memory_dom0",
     "Amount of memory used by node (dom0 for Xen)")
  , ("mtotal", "MTotal", QFTUnit, "memory_total",
     "Total amount of memory of physical machine")
  ]

Agata Murawska's avatar
Agata Murawska committed
72
73
-- | Map each name to a function that extracts that value from
-- the RPC result.
Iustin Pop's avatar
Iustin Pop committed
74
nodeLiveFieldExtract :: FieldName -> RpcResultNodeInfo -> J.JSValue
Agata Murawska's avatar
Agata Murawska committed
75
nodeLiveFieldExtract "bootid" res =
Iustin Pop's avatar
Iustin Pop committed
76
77
78
79
80
81
82
83
  J.showJSON $ rpcResNodeInfoBootId res
nodeLiveFieldExtract "cnodes" res =
  jsonHead (rpcResNodeInfoHvInfo res) hvInfoCpuNodes
nodeLiveFieldExtract "csockets" res =
  jsonHead (rpcResNodeInfoHvInfo res) hvInfoCpuSockets
nodeLiveFieldExtract "ctotal" res =
  jsonHead (rpcResNodeInfoHvInfo res) hvInfoCpuTotal
nodeLiveFieldExtract "dfree" res =
84
  getMaybeJsonHead (rpcResNodeInfoVgInfo res) vgInfoVgFree
Iustin Pop's avatar
Iustin Pop committed
85
nodeLiveFieldExtract "dtotal" res =
86
  getMaybeJsonHead (rpcResNodeInfoVgInfo res) vgInfoVgSize
Iustin Pop's avatar
Iustin Pop committed
87
88
89
90
91
92
nodeLiveFieldExtract "mfree" res =
  jsonHead (rpcResNodeInfoHvInfo res) hvInfoMemoryFree
nodeLiveFieldExtract "mnode" res =
  jsonHead (rpcResNodeInfoHvInfo res) hvInfoMemoryDom0
nodeLiveFieldExtract "mtotal" res =
  jsonHead (rpcResNodeInfoHvInfo res) hvInfoMemoryTotal
Agata Murawska's avatar
Agata Murawska committed
93
94
95
96
97
nodeLiveFieldExtract _ _ = J.JSNull

-- | Helper for extracting field from RPC result.
nodeLiveRpcCall :: FieldName -> NodeRuntime -> Node -> ResultEntry
nodeLiveRpcCall fname (Right res) _ =
Iustin Pop's avatar
Iustin Pop committed
98
99
100
  case nodeLiveFieldExtract fname res of
    J.JSNull -> rsNoData
    x -> rsNormal x
Agata Murawska's avatar
Agata Murawska committed
101
102
103
nodeLiveRpcCall _ (Left err) _ =
    ResultEntry (rpcErrorToStatus err) Nothing

104
105
106
107
-- | Builder for node live fields.
nodeLiveFieldBuilder :: (FieldName, FieldTitle, FieldType, String, FieldDoc)
                     -> FieldData Node NodeRuntime
nodeLiveFieldBuilder (fname, ftitle, ftype, _, fdoc) =
Agata Murawska's avatar
Agata Murawska committed
108
  ( FieldDefinition fname ftitle ftype fdoc
109
110
  , FieldRuntime $ nodeLiveRpcCall fname
  , QffNormal)
111
112
113
114
115
116

-- | The docstring for the node role. Note that we use 'reverse in
-- order to keep the same order as Python.
nodeRoleDoc :: String
nodeRoleDoc =
  "Node role; " ++
Iustin Pop's avatar
Iustin Pop committed
117
118
  intercalate ", "
   (map (\role ->
119
120
121
          "\"" ++ nodeRoleToRaw role ++ "\" for " ++ roleDescription role)
   (reverse [minBound..maxBound]))

Iustin Pop's avatar
Iustin Pop committed
122
123
124
125
126
127
128
129
130
-- | Get node powered status.
getNodePower :: ConfigData -> Node -> ResultEntry
getNodePower cfg node =
  case getNodeNdParams cfg node of
    Nothing -> rsNoData
    Just ndp -> if null (ndpOobProgram ndp)
                  then rsUnavail
                  else rsNormal (nodePowered node)

131
132
133
134
-- | List of all node fields.
nodeFields :: FieldList Node NodeRuntime
nodeFields =
  [ (FieldDefinition "drained" "Drained" QFTBool "Whether node is drained",
135
     FieldSimple (rsNormal . nodeDrained), QffNormal)
136
137
  , (FieldDefinition "master_candidate" "MasterC" QFTBool
       "Whether node is a master candidate",
138
     FieldSimple (rsNormal . nodeMasterCandidate), QffNormal)
139
140
  , (FieldDefinition "master_capable" "MasterCapable" QFTBool
       "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
145
  , (FieldDefinition "offline" "Offline" QFTBool
       "Whether node is marked offline",
146
     FieldSimple (rsNormal . nodeOffline), QffNormal)
147
148
  , (FieldDefinition "vm_capable" "VMCapable" QFTBool
       "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
155
156
  , (FieldDefinition "master" "IsMaster" QFTBool "Whether node is master",
     FieldConfig (\cfg node ->
                    rsNormal (nodeName node ==
157
158
                              clusterMasterNode (configCluster cfg))),
     QffNormal)
159
160
  , (FieldDefinition "group" "Group" QFTText "Node group",
     FieldConfig (\cfg node ->
161
162
                    rsMaybe (groupName <$> getGroupOfNode cfg node)),
     QffNormal)
163
  , (FieldDefinition "group.uuid" "GroupUUID" QFTText "UUID of node group",
164
     FieldSimple (rsNormal . nodeGroup), QffNormal)
165
166
  ,  (FieldDefinition "ndparams" "NodeParameters" QFTOther
        "Merged node parameters",
167
      FieldConfig ((rsMaybe .) . getNodeNdParams), QffNormal)
168
169
  , (FieldDefinition "custom_ndparams" "CustomNodeParameters" QFTOther
                       "Custom node parameters",
170
     FieldSimple (rsNormal . nodeNdparams), QffNormal)
171
172
173
174
  -- FIXME: the below could be generalised a bit, like in Python
  , (FieldDefinition "pinst_cnt" "Pinst" QFTNumber
       "Number of instances with this node as primary",
     FieldConfig (\cfg ->
175
176
                    rsNormal . length . fst . getNodeInstances cfg . nodeName),
     QffNormal)
177
178
179
  , (FieldDefinition "sinst_cnt" "Sinst" QFTNumber
       "Number of instances with this node as secondary",
     FieldConfig (\cfg ->
180
181
                    rsNormal . length . snd . getNodeInstances cfg . nodeName),
     QffNormal)
182
  , (FieldDefinition "pinst_list" "PriInstances" QFTOther
183
184
       "List of instances with this node as primary",
     FieldConfig (\cfg -> rsNormal . map instName . fst .
185
                          getNodeInstances cfg . nodeName), QffNormal)
186
  , (FieldDefinition "sinst_list" "SecInstances" QFTOther
187
188
       "List of instances with this node as secondary",
     FieldConfig (\cfg -> rsNormal . map instName . snd .
189
                          getNodeInstances cfg . nodeName), QffNormal)
190
  , (FieldDefinition "role" "Role" QFTText nodeRoleDoc,
191
     FieldConfig ((rsNormal .) . getNodeRole), QffNormal)
192
193
  , (FieldDefinition "powered" "Powered" QFTBool
       "Whether node is thought to be powered on",
194
     FieldConfig getNodePower, QffNormal)
195
196
197
198
  -- FIXME: the two fields below are incomplete in Python, part of the
  -- non-implemented node resource model; they are declared just for
  -- parity, but are not functional
  , (FieldDefinition "hv_state" "HypervisorState" QFTOther "Hypervisor state",
199
     missingRuntime, QffNormal)
200
  , (FieldDefinition "disk_state" "DiskState" QFTOther "Disk state",
201
     missingRuntime, QffNormal)
202
203
204
205
206
207
208
209
210
211
  ] ++
  map nodeLiveFieldBuilder nodeLiveFieldsDefs ++
  map buildNdParamField allNDParamFields ++
  timeStampFields ++
  uuidFields "Node" ++
  serialFields "Node" ++
  tagsFields

-- | The node fields map.
nodeFieldsMap :: FieldMap Node NodeRuntime
212
213
nodeFieldsMap =
  Map.fromList $ map (\v@(f, _, _) -> (fdefName f, v)) nodeFields
214
215
216
217
218
219
220
221
222
223
224
225

-- | Collect live data from RPC query if enabled.
--
-- FIXME: Check which fields we actually need and possibly send empty
-- hvs/vgs if no info from hypervisor/volume group respectively is
-- required
maybeCollectLiveData:: Bool -> ConfigData -> [Node] -> IO [(Node, NodeRuntime)]
maybeCollectLiveData False _ nodes =
  return $ zip nodes (repeat $ Left (RpcResultError "Live data disabled"))
maybeCollectLiveData True cfg nodes = do
  let vgs = [clusterVolumeGroupName $ configCluster cfg]
      hvs = [getDefaultHypervisor cfg]
226
227
228
229
230
231
232
233
234
235
236
      step n (bn, gn, em) =
        let ndp' = getNodeNdParams cfg n
        in case ndp' of
             Just ndp -> (bn, n : gn,
                          (nodeName n, ndpExclusiveStorage ndp) : em)
             Nothing -> (n : bn, gn, em)
      (bnodes, gnodes, emap) = foldr step ([], [], []) nodes
  rpcres <- executeRpcCall gnodes (RpcCallNodeInfo vgs hvs (Map.fromList emap))
  -- FIXME: The order of nodes in the result could be different from the input
  return $ zip bnodes (repeat $ Left (RpcResultError "Broken configuration"))
           ++ rpcres