Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / Query / Instance.hs @ 9491766c

History | View | Annotate | Download (14 kB)

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

    
3
-}
4

    
5
{-
6

    
7
Copyright (C) 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.Instance
27
  ( Runtime
28
  , fieldsMap
29
  , collectLiveData
30
  ) where
31

    
32
import Control.Applicative
33
import Data.List
34
import Data.Maybe
35
import Data.Monoid
36
import qualified Data.Map as Map
37
import qualified Text.JSON as J
38

    
39
import Ganeti.BasicTypes
40
import Ganeti.Common
41
import Ganeti.Config
42
import Ganeti.Errors
43
import Ganeti.Objects
44
import Ganeti.Query.Common
45
import Ganeti.Query.Language
46
import Ganeti.Query.Types
47
import Ganeti.Rpc
48
import Ganeti.Storage.Utils
49
import Ganeti.Types
50

    
51
-- | The LiveInfo structure packs additional information beside the
52
-- 'InstanceInfo'. We also need to know whether the instance information was
53
-- found on the primary node, and encode this as a Bool.
54
type LiveInfo = (InstanceInfo, Bool)
55

    
56
-- | Runtime possibly containing the 'LiveInfo'. See the genericQuery function
57
-- in the Query.hs file for an explanation of the terms used.
58
type Runtime = Either RpcError (Maybe LiveInfo)
59

    
60
-- | The instance fields map.
61
fieldsMap :: FieldMap Instance Runtime
62
fieldsMap = Map.fromList [(fdefName f, v) | v@(f, _, _) <- instanceFields]
63

    
64
-- | The instance fields
65
instanceFields :: FieldList Instance Runtime
66
instanceFields =
67
  -- Simple fields
68
  [ (FieldDefinition "admin_state" "InstanceState" QFTText
69
     "Desired state of instance",
70
     FieldSimple (rsNormal . adminStateToRaw . instAdminState), QffNormal)
71
  , (FieldDefinition "admin_up" "Autostart" QFTBool
72
     "Desired state of instance",
73
     FieldSimple (rsNormal . (== AdminUp) . instAdminState), QffNormal)
74
  , (FieldDefinition "disk_template" "Disk_template" QFTText
75
     "Instance disk template",
76
     FieldSimple (rsNormal . instDiskTemplate), QffNormal)
77
  , (FieldDefinition "disks_active" "DisksActive" QFTBool
78
     "Desired state of instance disks",
79
     FieldSimple (rsNormal . instDisksActive), QffNormal)
80
  , (FieldDefinition "name" "Instance" QFTText
81
     "Instance name",
82
     FieldSimple (rsNormal . instName), QffHostname)
83
  , (FieldDefinition "hypervisor" "Hypervisor" QFTText
84
     "Hypervisor name",
85
     FieldSimple (rsNormal . instHypervisor), QffNormal)
86
  , (FieldDefinition "network_port" "Network_port" QFTOther
87
     "Instance network port if available (e.g. for VNC console)",
88
     FieldSimple (rsMaybeUnavail . instNetworkPort), QffNormal)
89
  , (FieldDefinition "os" "OS" QFTText
90
     "Operating system",
91
     FieldSimple (rsNormal . instOs), QffNormal)
92
  , (FieldDefinition "pnode" "Primary_node" QFTText
93
     "Primary node",
94
     FieldConfig getPrimaryNodeName, QffHostname)
95
  , (FieldDefinition "pnode.group" "PrimaryNodeGroup" QFTText
96
     "Primary node's group",
97
     FieldConfig getPrimaryNodeGroup, QffNormal)
98
  , (FieldDefinition "snodes" "Secondary_Nodes" QFTOther
99
     "Secondary nodes; usually this will just be one node",
100
     FieldConfig (getSecondaryNodeAttribute nodeName), QffNormal)
101
  , (FieldDefinition "snodes.group" "SecondaryNodesGroups" QFTOther
102
     "Node groups of secondary nodes",
103
     FieldConfig (getSecondaryNodeGroupAttribute groupName), QffNormal)
104
  , (FieldDefinition "snodes.group.uuid" "SecondaryNodesGroupsUUID" QFTOther
105
     "Node group UUIDs of secondary nodes",
106
     FieldConfig (getSecondaryNodeGroupAttribute groupUuid), QffNormal)
107
  ] ++
108

    
109
  -- Live fields using special getters
110
  [ (FieldDefinition "status" "Status" QFTText
111
     statusDocText,
112
     FieldConfigRuntime statusExtract, QffNormal)
113
  , (FieldDefinition "oper_state" "Running" QFTBool
114
     "Actual state of instance",
115
     FieldRuntime operStatusExtract, QffNormal)
116
  ] ++
117

    
118
  -- Simple live fields
119
  map instanceLiveFieldBuilder instanceLiveFieldsDefs ++
120

    
121
  -- Generated fields
122
  serialFields "Instance" ++
123
  uuidFields "Instance" ++
124
  tagsFields
125

    
126
-- * Helper functions for node property retrieval
127

    
128
-- | Helper function for primary node retrieval
129
getPrimaryNode :: ConfigData -> Instance -> ErrorResult Node
130
getPrimaryNode cfg = getInstPrimaryNode cfg . instName
131

    
132
-- | Get primary node hostname
133
getPrimaryNodeName :: ConfigData -> Instance -> ResultEntry
134
getPrimaryNodeName cfg inst =
135
  rsErrorNoData $ (J.showJSON . nodeName) <$> getPrimaryNode cfg inst
136

    
137
-- | Get primary node hostname
138
getPrimaryNodeGroup :: ConfigData -> Instance -> ResultEntry
139
getPrimaryNodeGroup cfg inst =
140
  rsErrorNoData $ (J.showJSON . groupName) <$>
141
    (getPrimaryNode cfg inst >>=
142
    maybeToError "Configuration missing" . getGroupOfNode cfg)
143

    
144
-- | Get secondary nodes - the configuration objects themselves
145
getSecondaryNodes :: ConfigData -> Instance -> ErrorResult [Node]
146
getSecondaryNodes cfg inst = do
147
  pNode <- getPrimaryNode cfg inst
148
  allNodes <- getInstAllNodes cfg $ instName inst
149
  return $ delete pNode allNodes
150

    
151
-- | Get attributes of the secondary nodes
152
getSecondaryNodeAttribute :: (J.JSON a)
153
                          => (Node -> a)
154
                          -> ConfigData
155
                          -> Instance
156
                          -> ResultEntry
157
getSecondaryNodeAttribute getter cfg inst =
158
  rsErrorNoData $ map (J.showJSON . getter) <$> getSecondaryNodes cfg inst
159

    
160
-- | Get secondary node groups
161
getSecondaryNodeGroups :: ConfigData -> Instance -> ErrorResult [NodeGroup]
162
getSecondaryNodeGroups cfg inst = do
163
  sNodes <- getSecondaryNodes cfg inst
164
  return . catMaybes $ map (getGroupOfNode cfg) sNodes
165

    
166
-- | Get attributes of secondary node groups
167
getSecondaryNodeGroupAttribute :: (J.JSON a)
168
                               => (NodeGroup -> a)
169
                               -> ConfigData
170
                               -> Instance
171
                               -> ResultEntry
172
getSecondaryNodeGroupAttribute getter cfg inst =
173
  rsErrorNoData $ map (J.showJSON . getter) <$> getSecondaryNodeGroups cfg inst
174

    
175
-- * Live fields functionality
176

    
177
-- | List of node live fields.
178
instanceLiveFieldsDefs :: [(FieldName, FieldTitle, FieldType, String, FieldDoc)]
179
instanceLiveFieldsDefs =
180
  [ ("oper_ram", "Memory", QFTUnit, "oper_ram",
181
     "Actual memory usage as seen by hypervisor")
182
  , ("oper_vcpus", "VCPUs", QFTNumber, "oper_vcpus",
183
     "Actual number of VCPUs as seen by hypervisor")
184
  ]
185

    
186
-- | Map each name to a function that extracts that value from the RPC result.
187
instanceLiveFieldExtract :: FieldName -> InstanceInfo -> Instance -> J.JSValue
188
instanceLiveFieldExtract "oper_ram"   info _ = J.showJSON $ instInfoMemory info
189
instanceLiveFieldExtract "oper_vcpus" info _ = J.showJSON $ instInfoVcpus info
190
instanceLiveFieldExtract n _ _ = J.showJSON $
191
  "The field " ++ n ++ " is not an expected or extractable live field!"
192

    
193
-- | Helper for extracting field from RPC result.
194
instanceLiveRpcCall :: FieldName -> Runtime -> Instance -> ResultEntry
195
instanceLiveRpcCall fname (Right (Just (res, _))) inst =
196
  case instanceLiveFieldExtract fname res inst of
197
    J.JSNull -> rsNoData
198
    x        -> rsNormal x
199
instanceLiveRpcCall _ (Right Nothing) _ = rsUnavail
200
instanceLiveRpcCall _ (Left err) _ =
201
  ResultEntry (rpcErrorToStatus err) Nothing
202

    
203
-- | Builder for node live fields.
204
instanceLiveFieldBuilder :: (FieldName, FieldTitle, FieldType, String, FieldDoc)
205
                         -> FieldData Instance Runtime
206
instanceLiveFieldBuilder (fname, ftitle, ftype, _, fdoc) =
207
  ( FieldDefinition fname ftitle ftype fdoc
208
  , FieldRuntime $ instanceLiveRpcCall fname
209
  , QffNormal)
210

    
211
-- * Functionality related to status and operational status extraction
212

    
213
-- | The documentation text for the instance status field
214
statusDocText :: String
215
statusDocText =
216
  let si = show . instanceStatusToRaw :: InstanceStatus -> String
217
  in  "Instance status; " ++
218
      si Running ++
219
      " if instance is set to be running and actually is, " ++
220
      si StatusDown ++
221
      " if instance is stopped and is not running, " ++
222
      si WrongNode ++
223
      " if instance running, but not on its designated primary node, " ++
224
      si ErrorUp ++
225
      " if instance should be stopped, but is actually running, " ++
226
      si ErrorDown ++
227
      " if instance should run, but doesn't, " ++
228
      si NodeDown ++
229
      " if instance's primary node is down, " ++
230
      si NodeOffline ++
231
      " if instance's primary node is marked offline, " ++
232
      si StatusOffline ++
233
      " if instance is offline and does not use dynamic resources"
234

    
235
-- | Checks if the primary node of an instance is offline
236
isPrimaryOffline :: ConfigData -> Instance -> Bool
237
isPrimaryOffline cfg inst =
238
  let pNodeResult = getNode cfg $ instPrimaryNode inst
239
  in case pNodeResult of
240
     Ok pNode -> nodeOffline pNode
241
     Bad    _ -> error "Programmer error - result assumed to be OK is Bad!"
242

    
243
-- | Determines the status of a live instance
244
liveInstanceStatus :: LiveInfo -> Instance -> InstanceStatus
245
liveInstanceStatus (_, foundOnPrimary) inst
246
  | not foundOnPrimary    = WrongNode
247
  | adminState == AdminUp = Running
248
  | otherwise             = ErrorUp
249
  where adminState = instAdminState inst
250

    
251
-- | Determines the status of a dead instance.
252
deadInstanceStatus :: Instance -> InstanceStatus
253
deadInstanceStatus inst =
254
  case instAdminState inst of
255
    AdminUp      -> ErrorDown
256
    AdminDown    -> StatusDown
257
    AdminOffline -> StatusOffline
258

    
259
-- | Determines the status of the instance, depending on whether it is possible
260
-- to communicate with its primary node, on which node it is, and its
261
-- configuration.
262
determineInstanceStatus :: ConfigData      -- ^ The configuration data
263
                        -> Runtime         -- ^ All the data from the live call
264
                        -> Instance        -- ^ Static instance configuration
265
                        -> InstanceStatus  -- ^ Result
266
determineInstanceStatus cfg res inst
267
  | isPrimaryOffline cfg inst = NodeOffline
268
  | otherwise = case res of
269
                  Left _                -> NodeDown
270
                  Right (Just liveData) -> liveInstanceStatus liveData inst
271
                  Right Nothing         -> deadInstanceStatus inst
272

    
273
-- | Extracts the instance status, retrieving it using the functions above and
274
-- transforming it into a 'ResultEntry'.
275
statusExtract :: ConfigData -> Runtime -> Instance -> ResultEntry
276
statusExtract cfg res inst =
277
  rsNormal . J.showJSON . instanceStatusToRaw $
278
    determineInstanceStatus cfg res inst
279

    
280
-- | Extracts the operational status of the instance.
281
operStatusExtract :: Runtime -> Instance -> ResultEntry
282
operStatusExtract res _ =
283
  rsMaybeNoData $ J.showJSON <$>
284
    case res of
285
      Left  _ -> Nothing
286
      Right x -> Just $ isJust x
287

    
288
-- * Helper functions extracting information as necessary for the generic query
289
-- interfaces
290

    
291
-- | Finds information about the instance in the info delivered by a node
292
findInstanceInfo :: Instance
293
                 -> ERpcError RpcResultAllInstancesInfo
294
                 -> Maybe InstanceInfo
295
findInstanceInfo inst nodeResponse =
296
  case nodeResponse of
297
    Left  _err    -> Nothing
298
    Right allInfo ->
299
      let instances = rpcResAllInstInfoInstances allInfo
300
          maybeMatch = pickPairUnique (instName inst) instances
301
      in snd <$> maybeMatch
302

    
303
-- | Finds the node information ('RPCResultError') or the instance information
304
-- (Maybe 'LiveInfo').
305
extractLiveInfo :: [(Node, ERpcError RpcResultAllInstancesInfo)]
306
                -> Instance
307
                -> Runtime
308
extractLiveInfo nodeResultList inst =
309
  let uuidResultList = [(nodeUuid x, y) | (x, y) <- nodeResultList]
310
      pNodeUuid = instPrimaryNode inst
311
      maybeRPCError = getNodeStatus uuidResultList pNodeUuid
312
  in case maybeRPCError of
313
       Just err -> Left err
314
       Nothing  -> Right $ getInstanceStatus uuidResultList pNodeUuid inst
315

    
316
-- | Tries to find out if the node given by the uuid is bad - unreachable or
317
-- returning errors, does not mather for the purpose of this call.
318
getNodeStatus :: [(String, ERpcError RpcResultAllInstancesInfo)]
319
              -> String
320
              -> Maybe RpcError
321
getNodeStatus uuidList uuid =
322
  case snd <$> pickPairUnique uuid uuidList of
323
    Just (Left err) -> Just err
324
    Just (Right _)  -> Nothing
325
    Nothing         -> Just . RpcResultError $
326
                         "Primary node response not present"
327

    
328
-- | Retrieves the instance information if it is present anywhere in the all
329
-- instances RPC result. Notes if it originates from the primary node.
330
-- All nodes are represented as UUID's for ease of use.
331
getInstanceStatus :: [(String, ERpcError RpcResultAllInstancesInfo)]
332
                  -> String
333
                  -> Instance
334
                  -> Maybe LiveInfo
335
getInstanceStatus uuidList pNodeUuid inst =
336
  let primarySearchResult =
337
        snd <$> pickPairUnique pNodeUuid uuidList >>= findInstanceInfo inst
338
  in case primarySearchResult of
339
       Just instInfo -> Just (instInfo, True)
340
       Nothing       ->
341
         let allSearchResult =
342
               getFirst . mconcat $ map
343
               (First . findInstanceInfo inst . snd) uuidList
344
         in case allSearchResult of
345
              Just liveInfo -> Just (liveInfo, False)
346
              Nothing       -> Nothing
347

    
348
-- | Collect live data from RPC query if enabled.
349
collectLiveData :: Bool -> ConfigData -> [Instance] -> IO [(Instance, Runtime)]
350
collectLiveData liveDataEnabled cfg instances
351
  | not liveDataEnabled = return . zip instances . repeat . Left .
352
                            RpcResultError $ "Live data disabled"
353
  | otherwise = do
354
      let hvSpec = getDefaultHypervisorSpec cfg
355
          instance_nodes = nub . justOk $
356
                             map (getNode cfg . instPrimaryNode) instances
357
          good_nodes = nodesWithValidConfig cfg instance_nodes
358
      rpcres <- executeRpcCall good_nodes $ RpcCallAllInstancesInfo [hvSpec]
359
      return . zip instances . map (extractLiveInfo rpcres) $ instances