root / src / Ganeti / Query / Instance.hs @ df583eaf
History | View | Annotate | Download (10.9 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.Objects |
43 |
import Ganeti.Query.Common |
44 |
import Ganeti.Query.Language |
45 |
import Ganeti.Query.Types |
46 |
import Ganeti.Rpc |
47 |
import Ganeti.Storage.Utils |
48 |
import Ganeti.Types |
49 |
|
50 |
-- | The LiveInfo structure packs additional information beside the |
51 |
-- 'InstanceInfo'. We also need to know whether the instance information was |
52 |
-- found on the primary node, and encode this as a Bool. |
53 |
type LiveInfo = (InstanceInfo, Bool) |
54 |
|
55 |
-- | Runtime possibly containing the 'LiveInfo'. See the genericQuery function |
56 |
-- in the Query.hs file for an explanation of the terms used. |
57 |
type Runtime = Either RpcError (Maybe LiveInfo) |
58 |
|
59 |
-- | The instance fields map. |
60 |
fieldsMap :: FieldMap Instance Runtime |
61 |
fieldsMap = Map.fromList [(fdefName f, v) | v@(f, _, _) <- instanceFields] |
62 |
|
63 |
-- | The instance fields |
64 |
instanceFields :: FieldList Instance Runtime |
65 |
instanceFields = |
66 |
-- Simple fields |
67 |
[ (FieldDefinition "disk_template" "Disk_template" QFTText |
68 |
"Instance disk template", |
69 |
FieldSimple (rsNormal . instDiskTemplate), QffNormal) |
70 |
, (FieldDefinition "name" "Instance" QFTText |
71 |
"Instance name", |
72 |
FieldSimple (rsNormal . instName), QffHostname) |
73 |
, (FieldDefinition "hypervisor" "Hypervisor" QFTText |
74 |
"Hypervisor name", |
75 |
FieldSimple (rsNormal . instHypervisor), QffNormal) |
76 |
, (FieldDefinition "network_port" "Network_port" QFTOther |
77 |
"Instance network port if available (e.g. for VNC console)", |
78 |
FieldSimple (rsMaybeUnavail . instNetworkPort), QffNormal) |
79 |
, (FieldDefinition "os" "OS" QFTText |
80 |
"Operating system", |
81 |
FieldSimple (rsNormal . instOs), QffNormal) |
82 |
] ++ |
83 |
|
84 |
-- Live fields using special getters |
85 |
[ (FieldDefinition "status" "Status" QFTText |
86 |
statusDocText, |
87 |
FieldConfigRuntime statusExtract, QffNormal) |
88 |
, (FieldDefinition "oper_state" "Running" QFTBool |
89 |
"Actual state of instance", |
90 |
FieldRuntime operStatusExtract, QffNormal) |
91 |
] ++ |
92 |
|
93 |
-- Simple live fields |
94 |
map instanceLiveFieldBuilder instanceLiveFieldsDefs ++ |
95 |
|
96 |
-- Generated fields |
97 |
serialFields "Instance" ++ |
98 |
uuidFields "Instance" ++ |
99 |
tagsFields |
100 |
|
101 |
-- * Live fields functionality |
102 |
|
103 |
-- | List of node live fields. |
104 |
instanceLiveFieldsDefs :: [(FieldName, FieldTitle, FieldType, String, FieldDoc)] |
105 |
instanceLiveFieldsDefs = |
106 |
[ ("oper_ram", "Memory", QFTUnit, "oper_ram", |
107 |
"Actual memory usage as seen by hypervisor") |
108 |
, ("oper_vcpus", "VCPUs", QFTNumber, "oper_vcpus", |
109 |
"Actual number of VCPUs as seen by hypervisor") |
110 |
] |
111 |
|
112 |
-- | Map each name to a function that extracts that value from the RPC result. |
113 |
instanceLiveFieldExtract :: FieldName -> InstanceInfo -> Instance -> J.JSValue |
114 |
instanceLiveFieldExtract "oper_ram" info _ = J.showJSON $ instInfoMemory info |
115 |
instanceLiveFieldExtract "oper_vcpus" info _ = J.showJSON $ instInfoVcpus info |
116 |
instanceLiveFieldExtract n _ _ = J.showJSON $ |
117 |
"The field " ++ n ++ " is not an expected or extractable live field!" |
118 |
|
119 |
-- | Helper for extracting field from RPC result. |
120 |
instanceLiveRpcCall :: FieldName -> Runtime -> Instance -> ResultEntry |
121 |
instanceLiveRpcCall fname (Right (Just (res, _))) inst = |
122 |
case instanceLiveFieldExtract fname res inst of |
123 |
J.JSNull -> rsNoData |
124 |
x -> rsNormal x |
125 |
instanceLiveRpcCall _ (Right Nothing) _ = rsUnavail |
126 |
instanceLiveRpcCall _ (Left err) _ = |
127 |
ResultEntry (rpcErrorToStatus err) Nothing |
128 |
|
129 |
-- | Builder for node live fields. |
130 |
instanceLiveFieldBuilder :: (FieldName, FieldTitle, FieldType, String, FieldDoc) |
131 |
-> FieldData Instance Runtime |
132 |
instanceLiveFieldBuilder (fname, ftitle, ftype, _, fdoc) = |
133 |
( FieldDefinition fname ftitle ftype fdoc |
134 |
, FieldRuntime $ instanceLiveRpcCall fname |
135 |
, QffNormal) |
136 |
|
137 |
|
138 |
-- Functionality related to status and operational status extraction |
139 |
|
140 |
-- | The documentation text for the instance status field |
141 |
statusDocText :: String |
142 |
statusDocText = |
143 |
let si = show . instanceStatusToRaw :: InstanceStatus -> String |
144 |
in "Instance status; " ++ |
145 |
si Running ++ |
146 |
" if instance is set to be running and actually is, " ++ |
147 |
si StatusDown ++ |
148 |
" if instance is stopped and is not running, " ++ |
149 |
si WrongNode ++ |
150 |
" if instance running, but not on its designated primary node, " ++ |
151 |
si ErrorUp ++ |
152 |
" if instance should be stopped, but is actually running, " ++ |
153 |
si ErrorDown ++ |
154 |
" if instance should run, but doesn't, " ++ |
155 |
si NodeDown ++ |
156 |
" if instance's primary node is down, " ++ |
157 |
si NodeOffline ++ |
158 |
" if instance's primary node is marked offline, " ++ |
159 |
si StatusOffline ++ |
160 |
" if instance is offline and does not use dynamic resources" |
161 |
|
162 |
-- | Checks if the primary node of an instance is offline |
163 |
isPrimaryOffline :: ConfigData -> Instance -> Bool |
164 |
isPrimaryOffline cfg inst = |
165 |
let pNode = optimisticUnwrapper . getNode cfg $ instPrimaryNode inst |
166 |
in nodeOffline pNode |
167 |
|
168 |
-- | Determines the status of a live instance |
169 |
liveInstanceStatus :: LiveInfo -> Instance -> InstanceStatus |
170 |
liveInstanceStatus (_, foundOnPrimary) inst |
171 |
| not foundOnPrimary = WrongNode |
172 |
| adminState == AdminUp = Running |
173 |
| otherwise = ErrorUp |
174 |
where adminState = instAdminState inst |
175 |
|
176 |
-- | Determines the status of a dead instance. |
177 |
deadInstanceStatus :: Instance -> InstanceStatus |
178 |
deadInstanceStatus inst = |
179 |
case instAdminState inst of |
180 |
AdminUp -> ErrorDown |
181 |
AdminDown -> StatusDown |
182 |
AdminOffline -> StatusOffline |
183 |
|
184 |
-- | Determines the status of the instance, depending on whether it is possible |
185 |
-- | to communicate with its primary node, on which node it is, and its |
186 |
-- | configuration. |
187 |
determineInstanceStatus :: ConfigData -- ^ The configuration data |
188 |
-> Runtime -- ^ All the data from the live call |
189 |
-> Instance -- ^ The static instance configuration |
190 |
-> InstanceStatus -- ^ Result |
191 |
determineInstanceStatus cfg res inst = |
192 |
if isPrimaryOffline cfg inst |
193 |
then NodeOffline |
194 |
else case res of |
195 |
Left _ -> NodeDown |
196 |
Right (Just liveData) -> liveInstanceStatus liveData inst |
197 |
Right Nothing -> deadInstanceStatus inst |
198 |
|
199 |
-- | Extracts the status, doing necessary transformations but once |
200 |
statusExtract :: ConfigData -> Runtime -> Instance -> ResultEntry |
201 |
statusExtract cfg res inst = |
202 |
rsNormal . J.showJSON . instanceStatusToRaw $ |
203 |
determineInstanceStatus cfg res inst |
204 |
|
205 |
-- | Extracts the operational status |
206 |
operStatusExtract :: Runtime -> Instance -> ResultEntry |
207 |
operStatusExtract res _ = |
208 |
rsMaybeNoData $ J.showJSON <$> case res of |
209 |
Left _ -> Nothing |
210 |
Right x -> Just $ isJust x |
211 |
|
212 |
|
213 |
-- Helper functions extracting information as necessary for the generic query |
214 |
-- interfaces |
215 |
|
216 |
-- | A function removing the GenericResult wrapper from assuredly OK values |
217 |
optimisticUnwrapper :: GenericResult a b -> b |
218 |
optimisticUnwrapper (Ok x) = x |
219 |
optimisticUnwrapper (Bad _) = error "Programmer error: assumptions are wrong!" |
220 |
|
221 |
-- | Simple filter of OK results only |
222 |
okNodesOnly :: [GenericResult a Node] -> [Node] |
223 |
okNodesOnly = map optimisticUnwrapper . filter isOk |
224 |
|
225 |
-- | Finds information about the instance in the info delivered by a node |
226 |
findInstanceInfo :: Instance |
227 |
-> ERpcError RpcResultAllInstancesInfo |
228 |
-> Maybe InstanceInfo |
229 |
findInstanceInfo inst nodeResponse = |
230 |
case nodeResponse of |
231 |
Left _err -> Nothing |
232 |
Right allInfo -> |
233 |
let instances = rpcResAllInstInfoInstances allInfo |
234 |
maybeMatch = pickPairUnique (instName inst) instances |
235 |
in snd <$> maybeMatch |
236 |
|
237 |
-- | Finds the node information ('RPCResultError') or the instance information |
238 |
-- (Maybe 'LiveInfo'). |
239 |
extractLiveInfo :: [(Node, ERpcError RpcResultAllInstancesInfo)] |
240 |
-> Instance |
241 |
-> Runtime |
242 |
extractLiveInfo nodeResultList inst = |
243 |
let uuidResultList = [(nodeUuid x, y) | (x, y) <- nodeResultList] |
244 |
pNodeUuid = instPrimaryNode inst |
245 |
maybeRPCError = getNodeStatus uuidResultList pNodeUuid |
246 |
in case maybeRPCError of |
247 |
Just err -> Left err |
248 |
Nothing -> Right $ getInstanceStatus uuidResultList pNodeUuid inst |
249 |
|
250 |
-- | Tries to find out if the node given by the uuid is bad - unreachable or |
251 |
-- returning errors, does not mather for the purpose of this call. |
252 |
getNodeStatus :: [(String, ERpcError RpcResultAllInstancesInfo)] |
253 |
-> String |
254 |
-> Maybe RpcError |
255 |
getNodeStatus uuidList uuid = |
256 |
case snd <$> pickPairUnique uuid uuidList of |
257 |
Just (Left err) -> Just err |
258 |
Just (Right _) -> Nothing |
259 |
Nothing -> Just . RpcResultError $ |
260 |
"Primary node response not present" |
261 |
|
262 |
-- | Retrieves the instance information if it is present anywhere in the all |
263 |
-- instances RPC result. Notes if it originates from the primary node. |
264 |
-- All nodes are represented as UUID's for ease of use. |
265 |
getInstanceStatus :: [(String, ERpcError RpcResultAllInstancesInfo)] |
266 |
-> String |
267 |
-> Instance |
268 |
-> Maybe LiveInfo |
269 |
getInstanceStatus uuidList pNodeUuid inst = |
270 |
let primarySearchResult = |
271 |
snd <$> pickPairUnique pNodeUuid uuidList >>= findInstanceInfo inst |
272 |
in case primarySearchResult of |
273 |
Just instInfo -> Just (instInfo, True) |
274 |
Nothing -> |
275 |
let allSearchResult = |
276 |
getFirst . mconcat $ map |
277 |
(First . findInstanceInfo inst . snd) uuidList |
278 |
in case allSearchResult of |
279 |
Just liveInfo -> Just (liveInfo, False) |
280 |
Nothing -> Nothing |
281 |
|
282 |
-- | Collect live data from RPC query if enabled. |
283 |
collectLiveData :: Bool -> ConfigData -> [Instance] -> IO [(Instance, Runtime)] |
284 |
collectLiveData liveDataEnabled cfg instances |
285 |
| not liveDataEnabled = return . zip instances . repeat . Left . |
286 |
RpcResultError $ "Live data disabled" |
287 |
| otherwise = do |
288 |
let hvSpec = getDefaultHypervisorSpec cfg |
289 |
instance_nodes = nub . okNodesOnly $ |
290 |
map (getNode cfg . instPrimaryNode) instances |
291 |
good_nodes = nodesWithValidConfig cfg instance_nodes |
292 |
rpcres <- executeRpcCall good_nodes $ RpcCallAllInstancesInfo [hvSpec] |
293 |
return . zip instances . map (extractLiveInfo rpcres) $ instances |