Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / Query / Node.hs @ 3e02cd3c

History | View | Annotate | Download (9.6 kB)

1
{-| Implementation of the Ganeti Query2 node queries.
2

    
3
 -}
4

    
5
{-
6

    
7
Copyright (C) 2012, 2013 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 Data.Maybe
35
import qualified Data.Map as Map
36
import qualified Text.JSON as J
37

    
38
import Ganeti.Config
39
import Ganeti.Objects
40
import Ganeti.JSON
41
import Ganeti.Rpc
42
import Ganeti.Query.Language
43
import Ganeti.Query.Common
44
import Ganeti.Query.Types
45

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

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

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

    
96
-- | Helper for extracting field from RPC result.
97
nodeLiveRpcCall :: FieldName -> NodeRuntime -> Node -> ResultEntry
98
nodeLiveRpcCall fname (Right res) _ =
99
  case nodeLiveFieldExtract fname res of
100
    J.JSNull -> rsNoData
101
    x -> rsNormal x
102
nodeLiveRpcCall _ (Left err) _ =
103
    ResultEntry (rpcErrorToStatus err) Nothing
104

    
105
-- | Builder for node live fields.
106
nodeLiveFieldBuilder :: (FieldName, FieldTitle, FieldType, String, FieldDoc)
107
                     -> FieldData Node NodeRuntime
108
nodeLiveFieldBuilder (fname, ftitle, ftype, _, fdoc) =
109
  ( FieldDefinition fname ftitle ftype fdoc
110
  , FieldRuntime $ nodeLiveRpcCall fname
111
  , QffNormal)
112

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

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

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

    
211
-- | The node fields map.
212
nodeFieldsMap :: FieldMap Node NodeRuntime
213
nodeFieldsMap =
214
  Map.fromList $ map (\v@(f, _, _) -> (fdefName f, v)) nodeFields
215

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