Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / Query / Node.hs @ e86c9deb

History | View | Annotate | Download (12.4 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
  ( Runtime
28
  , fieldsMap
29
  , collectLiveData
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.Common
40
import Ganeti.Objects
41
import Ganeti.JSON
42
import Ganeti.Rpc
43
import Ganeti.Types
44
import Ganeti.Query.Language
45
import Ganeti.Query.Common
46
import Ganeti.Query.Types
47
import Ganeti.Storage.Utils
48
import Ganeti.Utils (niceSort)
49

    
50
-- | Runtime is the resulting type for NodeInfo call.
51
type Runtime = Either RpcError RpcResultNodeInfo
52

    
53
-- | List of node live fields.
54
nodeLiveFieldsDefs :: [(FieldName, FieldTitle, FieldType, String, FieldDoc)]
55
nodeLiveFieldsDefs =
56
  [ ("bootid", "BootID", QFTText, "bootid",
57
     "Random UUID renewed for each system reboot, can be used\
58
     \ for detecting reboots by tracking changes")
59
  , ("cnodes", "CNodes", QFTNumber, "cpu_nodes",
60
     "Number of NUMA domains on node (if exported by hypervisor)")
61
  , ("cnos", "CNOs", QFTNumber, "cpu_dom0",
62
     "Number of logical processors used by the node OS (dom0 for Xen)")
63
  , ("csockets", "CSockets", QFTNumber, "cpu_sockets",
64
     "Number of physical CPU sockets (if exported by hypervisor)")
65
  , ("ctotal", "CTotal", QFTNumber, "cpu_total",
66
     "Number of logical processors")
67
  , ("dfree", "DFree", QFTUnit, "storage_free",
68
     "Available storage space on storage unit")
69
  , ("dtotal", "DTotal", QFTUnit, "storage_size",
70
     "Total storage space on storage unit for instance disk allocation")
71
  , ("spfree", "SpFree", QFTNumber, "spindles_free",
72
     "Available spindles in volume group (exclusive storage only)")
73
  , ("sptotal", "SpTotal", QFTNumber, "spindles_total",
74
     "Total spindles in volume group (exclusive storage only)")
75
  , ("mfree", "MFree", QFTUnit, "memory_free",
76
     "Memory available for instance allocations")
77
  , ("mnode", "MNode", QFTUnit, "memory_dom0",
78
     "Amount of memory used by node (dom0 for Xen)")
79
  , ("mtotal", "MTotal", QFTUnit, "memory_total",
80
     "Total amount of memory of physical machine")
81
  ]
82

    
83
-- | Helper function to extract an attribute from a maybe StorageType
84
getAttrFromStorageInfo :: (J.JSON a) => (StorageInfo -> Maybe a)
85
                       -> Maybe StorageInfo -> J.JSValue
86
getAttrFromStorageInfo attr_fn (Just info) =
87
  case attr_fn info of
88
    Just val -> J.showJSON val
89
    Nothing -> J.JSNull
90
getAttrFromStorageInfo _ Nothing = J.JSNull
91

    
92
-- | Check whether the given storage info fits to the given storage type
93
isStorageInfoOfType :: StorageType -> StorageInfo -> Bool
94
isStorageInfoOfType stype sinfo = storageInfoType sinfo ==
95
    storageTypeToRaw stype
96

    
97
-- | Get storage info for the default storage unit
98
getStorageInfoForDefault :: [StorageInfo] -> Maybe StorageInfo
99
getStorageInfoForDefault sinfos = listToMaybe $ filter
100
    (not . isStorageInfoOfType StorageLvmPv) sinfos
101

    
102
-- | Gets the storage info for a storage type
103
-- FIXME: This needs to be extended when storage pools are implemented,
104
-- because storage types are not necessarily unique then
105
getStorageInfoForType :: [StorageInfo] -> StorageType -> Maybe StorageInfo
106
getStorageInfoForType sinfos stype = listToMaybe $ filter
107
    (isStorageInfoOfType stype) sinfos
108

    
109
-- | Map each name to a function that extracts that value from
110
-- the RPC result.
111
nodeLiveFieldExtract :: FieldName -> RpcResultNodeInfo -> J.JSValue
112
nodeLiveFieldExtract "bootid" res =
113
  J.showJSON $ rpcResNodeInfoBootId res
114
nodeLiveFieldExtract "cnodes" res =
115
  jsonHead (rpcResNodeInfoHvInfo res) hvInfoCpuNodes
116
nodeLiveFieldExtract "cnos" res =
117
  jsonHead (rpcResNodeInfoHvInfo res) hvInfoCpuDom0
118
nodeLiveFieldExtract "csockets" res =
119
  jsonHead (rpcResNodeInfoHvInfo res) hvInfoCpuSockets
120
nodeLiveFieldExtract "ctotal" res =
121
  jsonHead (rpcResNodeInfoHvInfo res) hvInfoCpuTotal
122
nodeLiveFieldExtract "dfree" res =
123
  getAttrFromStorageInfo storageInfoStorageFree (getStorageInfoForDefault
124
      (rpcResNodeInfoStorageInfo res))
125
nodeLiveFieldExtract "dtotal" res =
126
  getAttrFromStorageInfo storageInfoStorageSize (getStorageInfoForDefault
127
      (rpcResNodeInfoStorageInfo res))
128
nodeLiveFieldExtract "spfree" res =
129
  getAttrFromStorageInfo storageInfoStorageFree (getStorageInfoForType
130
      (rpcResNodeInfoStorageInfo res) StorageLvmPv)
131
nodeLiveFieldExtract "sptotal" res =
132
  getAttrFromStorageInfo storageInfoStorageSize (getStorageInfoForType
133
      (rpcResNodeInfoStorageInfo res) StorageLvmPv)
134
nodeLiveFieldExtract "mfree" res =
135
  jsonHead (rpcResNodeInfoHvInfo res) hvInfoMemoryFree
136
nodeLiveFieldExtract "mnode" res =
137
  jsonHead (rpcResNodeInfoHvInfo res) hvInfoMemoryDom0
138
nodeLiveFieldExtract "mtotal" res =
139
  jsonHead (rpcResNodeInfoHvInfo res) hvInfoMemoryTotal
140
nodeLiveFieldExtract _ _ = J.JSNull
141

    
142
-- | Helper for extracting field from RPC result.
143
nodeLiveRpcCall :: FieldName -> Runtime -> Node -> ResultEntry
144
nodeLiveRpcCall fname (Right res) _ =
145
  case nodeLiveFieldExtract fname res of
146
    J.JSNull -> rsNoData
147
    x -> rsNormal x
148
nodeLiveRpcCall _ (Left err) _ =
149
    ResultEntry (rpcErrorToStatus err) Nothing
150

    
151
-- | Builder for node live fields.
152
nodeLiveFieldBuilder :: (FieldName, FieldTitle, FieldType, String, FieldDoc)
153
                     -> FieldData Node Runtime
154
nodeLiveFieldBuilder (fname, ftitle, ftype, _, fdoc) =
155
  ( FieldDefinition fname ftitle ftype fdoc
156
  , FieldRuntime $ nodeLiveRpcCall fname
157
  , QffNormal)
158

    
159
-- | The docstring for the node role. Note that we use 'reverse' in
160
-- order to keep the same order as Python.
161
nodeRoleDoc :: String
162
nodeRoleDoc =
163
  "Node role; " ++
164
  intercalate ", "
165
   (map (\role ->
166
          "\"" ++ nodeRoleToRaw role ++ "\" for " ++ roleDescription role)
167
   (reverse [minBound..maxBound]))
168

    
169
-- | Get node powered status.
170
getNodePower :: ConfigData -> Node -> ResultEntry
171
getNodePower cfg node =
172
  case getNodeNdParams cfg node of
173
    Nothing -> rsNoData
174
    Just ndp -> if null (ndpOobProgram ndp)
175
                  then rsUnavail
176
                  else rsNormal (nodePowered node)
177

    
178
-- | List of all node fields.
179
nodeFields :: FieldList Node Runtime
180
nodeFields =
181
  [ (FieldDefinition "drained" "Drained" QFTBool "Whether node is drained",
182
     FieldSimple (rsNormal . nodeDrained), QffNormal)
183
  , (FieldDefinition "master_candidate" "MasterC" QFTBool
184
       "Whether node is a master candidate",
185
     FieldSimple (rsNormal . nodeMasterCandidate), QffNormal)
186
  , (FieldDefinition "master_capable" "MasterCapable" QFTBool
187
       "Whether node can become a master candidate",
188
     FieldSimple (rsNormal . nodeMasterCapable), QffNormal)
189
  , (FieldDefinition "name" "Node" QFTText "Node name",
190
     FieldSimple (rsNormal . nodeName), QffHostname)
191
  , (FieldDefinition "offline" "Offline" QFTBool
192
       "Whether node is marked offline",
193
     FieldSimple (rsNormal . nodeOffline), QffNormal)
194
  , (FieldDefinition "vm_capable" "VMCapable" QFTBool
195
       "Whether node can host instances",
196
     FieldSimple (rsNormal . nodeVmCapable), QffNormal)
197
  , (FieldDefinition "pip" "PrimaryIP" QFTText "Primary IP address",
198
     FieldSimple (rsNormal . nodePrimaryIp), QffNormal)
199
  , (FieldDefinition "sip" "SecondaryIP" QFTText "Secondary IP address",
200
     FieldSimple (rsNormal . nodeSecondaryIp), QffNormal)
201
  , (FieldDefinition "master" "IsMaster" QFTBool "Whether node is master",
202
     FieldConfig (\cfg node ->
203
                    rsNormal (nodeUuid node ==
204
                              clusterMasterNode (configCluster cfg))),
205
     QffNormal)
206
  , (FieldDefinition "group" "Group" QFTText "Node group",
207
     FieldConfig (\cfg node ->
208
                    rsMaybeNoData (groupName <$> getGroupOfNode cfg node)),
209
     QffNormal)
210
  , (FieldDefinition "group.uuid" "GroupUUID" QFTText "UUID of node group",
211
     FieldSimple (rsNormal . nodeGroup), QffNormal)
212
  ,  (FieldDefinition "ndparams" "NodeParameters" QFTOther
213
        "Merged node parameters",
214
      FieldConfig ((rsMaybeNoData .) . getNodeNdParams), QffNormal)
215
  , (FieldDefinition "custom_ndparams" "CustomNodeParameters" QFTOther
216
                       "Custom node parameters",
217
     FieldSimple (rsNormal . nodeNdparams), QffNormal)
218
  -- FIXME: the below could be generalised a bit, like in Python
219
  , (FieldDefinition "pinst_cnt" "Pinst" QFTNumber
220
       "Number of instances with this node as primary",
221
     FieldConfig (\cfg ->
222
                    rsNormal . length . fst . getNodeInstances cfg . nodeUuid),
223
     QffNormal)
224
  , (FieldDefinition "sinst_cnt" "Sinst" QFTNumber
225
       "Number of instances with this node as secondary",
226
     FieldConfig (\cfg ->
227
                    rsNormal . length . snd . getNodeInstances cfg . nodeUuid),
228
     QffNormal)
229
  , (FieldDefinition "pinst_list" "PriInstances" QFTOther
230
       "List of instances with this node as primary",
231
     FieldConfig (\cfg -> rsNormal . niceSort . map instName . fst .
232
                          getNodeInstances cfg . nodeUuid), QffNormal)
233
  , (FieldDefinition "sinst_list" "SecInstances" QFTOther
234
       "List of instances with this node as secondary",
235
     FieldConfig (\cfg -> rsNormal . niceSort . map instName . snd .
236
                          getNodeInstances cfg . nodeUuid), QffNormal)
237
  , (FieldDefinition "role" "Role" QFTText nodeRoleDoc,
238
     FieldConfig ((rsNormal .) . getNodeRole), QffNormal)
239
  , (FieldDefinition "powered" "Powered" QFTBool
240
       "Whether node is thought to be powered on",
241
     FieldConfig getNodePower, QffNormal)
242
  -- FIXME: the two fields below are incomplete in Python, part of the
243
  -- non-implemented node resource model; they are declared just for
244
  -- parity, but are not functional
245
  , (FieldDefinition "hv_state" "HypervisorState" QFTOther "Hypervisor state",
246
     FieldSimple (const rsUnavail), QffNormal)
247
  , (FieldDefinition "disk_state" "DiskState" QFTOther "Disk state",
248
     FieldSimple (const rsUnavail), QffNormal)
249
  ] ++
250
  map nodeLiveFieldBuilder nodeLiveFieldsDefs ++
251
  map buildNdParamField allNDParamFields ++
252
  timeStampFields ++
253
  uuidFields "Node" ++
254
  serialFields "Node" ++
255
  tagsFields
256

    
257
-- | The node fields map.
258
fieldsMap :: FieldMap Node Runtime
259
fieldsMap =
260
  Map.fromList $ map (\v@(f, _, _) -> (fdefName f, v)) nodeFields
261

    
262
-- | Create an RPC result for a broken node
263
rpcResultNodeBroken :: Node -> (Node, Runtime)
264
rpcResultNodeBroken node = (node, Left (RpcResultError "Broken configuration"))
265

    
266
-- | Storage-related query fields
267
storageFields :: [String]
268
storageFields = ["dtotal", "dfree", "spfree", "sptotal"]
269

    
270
-- | Hypervisor-related query fields
271
hypervisorFields :: [String]
272
hypervisorFields = ["mnode", "mfree", "mtotal",
273
                    "cnodes", "csockets", "cnos", "ctotal"]
274

    
275
-- | Check if it is required to include domain-specific entities (for example
276
-- storage units for storage info, hypervisor specs for hypervisor info)
277
-- in the node_info call
278
queryDomainRequired :: -- domain-specific fields to look for (storage, hv)
279
                      [String]
280
                      -- list of requested fields
281
                   -> [String]
282
                   -> Bool
283
queryDomainRequired domain_fields fields = any (`elem` fields) domain_fields
284

    
285
-- | Collect live data from RPC query if enabled.
286
collectLiveData :: Bool
287
                -> ConfigData
288
                -> [String]
289
                -> [Node]
290
                -> IO [(Node, Runtime)]
291
collectLiveData False _ _ nodes =
292
  return $ zip nodes (repeat $ Left (RpcResultError "Live data disabled"))
293
collectLiveData True cfg fields nodes = do
294
  let hvs = [getDefaultHypervisorSpec cfg |
295
             queryDomainRequired hypervisorFields fields]
296
      good_nodes = nodesWithValidConfig cfg nodes
297
      storage_units = if queryDomainRequired storageFields fields
298
                        then getStorageUnitsOfNodes cfg good_nodes
299
                        else Map.fromList
300
                          (map (\n -> (nodeUuid n, [])) good_nodes)
301
  rpcres <- executeRpcCall good_nodes (RpcCallNodeInfo storage_units hvs)
302
  return $ fillUpList (fillPairFromMaybe rpcResultNodeBroken pickPairUnique)
303
      nodes rpcres