Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / Query / Node.hs @ 96e3dfa7

History | View | Annotate | Download (12.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
  ( 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 -> rsNormal . getNumInstances fst cfg), QffNormal)
222
  , (FieldDefinition "sinst_cnt" "Sinst" QFTNumber
223
       "Number of instances with this node as secondary",
224
     FieldConfig (\cfg -> rsNormal . getNumInstances snd cfg), QffNormal)
225
  , (FieldDefinition "pinst_list" "PriInstances" QFTOther
226
       "List of instances with this node as primary",
227
     FieldConfig (\cfg -> rsNormal . niceSort . map instName . fst .
228
                          getNodeInstances cfg . nodeUuid), QffNormal)
229
  , (FieldDefinition "sinst_list" "SecInstances" QFTOther
230
       "List of instances with this node as secondary",
231
     FieldConfig (\cfg -> rsNormal . niceSort . map instName . snd .
232
                          getNodeInstances cfg . nodeUuid), QffNormal)
233
  , (FieldDefinition "role" "Role" QFTText nodeRoleDoc,
234
     FieldConfig ((rsNormal .) . getNodeRole), QffNormal)
235
  , (FieldDefinition "powered" "Powered" QFTBool
236
       "Whether node is thought to be powered on",
237
     FieldConfig getNodePower, QffNormal)
238
  -- FIXME: the two fields below are incomplete in Python, part of the
239
  -- non-implemented node resource model; they are declared just for
240
  -- parity, but are not functional
241
  , (FieldDefinition "hv_state" "HypervisorState" QFTOther "Hypervisor state",
242
     FieldSimple (const rsUnavail), QffNormal)
243
  , (FieldDefinition "disk_state" "DiskState" QFTOther "Disk state",
244
     FieldSimple (const rsUnavail), QffNormal)
245
  ] ++
246
  map nodeLiveFieldBuilder nodeLiveFieldsDefs ++
247
  map buildNdParamField allNDParamFields ++
248
  timeStampFields ++
249
  uuidFields "Node" ++
250
  serialFields "Node" ++
251
  tagsFields
252

    
253
-- | Helper function to retrieve the number of (primary or secondary) instances
254
getNumInstances :: (([Instance], [Instance]) -> [Instance])
255
                -> ConfigData -> Node -> Int
256
getNumInstances get_fn cfg = length . get_fn . getNodeInstances cfg . nodeUuid
257

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

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

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

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

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

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