root / htools / Ganeti / Rpc.hs @ 599239ad
History | View | Annotate | Download (9.1 kB)
1 |
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, CPP, |
---|---|
2 |
BangPatterns, TemplateHaskell #-} |
3 |
|
4 |
{-| Implementation of the RPC client. |
5 |
|
6 |
-} |
7 |
|
8 |
{- |
9 |
|
10 |
Copyright (C) 2012 Google Inc. |
11 |
|
12 |
This program is free software; you can redistribute it and/or modify |
13 |
it under the terms of the GNU General Public License as published by |
14 |
the Free Software Foundation; either version 2 of the License, or |
15 |
(at your option) any later version. |
16 |
|
17 |
This program is distributed in the hope that it will be useful, but |
18 |
WITHOUT ANY WARRANTY; without even the implied warranty of |
19 |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
20 |
General Public License for more details. |
21 |
|
22 |
You should have received a copy of the GNU General Public License |
23 |
along with this program; if not, write to the Free Software |
24 |
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
25 |
02110-1301, USA. |
26 |
|
27 |
-} |
28 |
|
29 |
module Ganeti.Rpc |
30 |
( RpcCall |
31 |
, RpcResult |
32 |
, Rpc |
33 |
, RpcError(..) |
34 |
, ERpcError |
35 |
, executeRpcCall |
36 |
|
37 |
, rpcCallName |
38 |
, rpcCallTimeout |
39 |
, rpcCallData |
40 |
, rpcCallAcceptOffline |
41 |
|
42 |
, rpcResultFill |
43 |
|
44 |
, InstanceInfo(..) |
45 |
, RpcCallAllInstancesInfo(..) |
46 |
, RpcResultAllInstancesInfo(..) |
47 |
|
48 |
, RpcCallInstanceList(..) |
49 |
, RpcResultInstanceList(..) |
50 |
|
51 |
, HvInfo(..) |
52 |
, VgInfo(..) |
53 |
, RpcCallNodeInfo(..) |
54 |
, RpcResultNodeInfo(..) |
55 |
|
56 |
, rpcTimeoutFromRaw -- FIXME: Not used anywhere |
57 |
) where |
58 |
|
59 |
import qualified Text.JSON as J |
60 |
import Text.JSON (makeObj) |
61 |
|
62 |
#ifndef NO_CURL |
63 |
import Network.Curl |
64 |
import qualified Ganeti.Path as P |
65 |
#endif |
66 |
|
67 |
import qualified Ganeti.Constants as C |
68 |
import Ganeti.Objects |
69 |
import Ganeti.THH |
70 |
import Ganeti.Compat |
71 |
import Ganeti.JSON |
72 |
|
73 |
#ifndef NO_CURL |
74 |
-- | The curl options used for RPC. |
75 |
curlOpts :: [CurlOption] |
76 |
curlOpts = [ CurlFollowLocation False |
77 |
, CurlCAInfo P.nodedCertFile |
78 |
, CurlSSLVerifyHost 0 |
79 |
, CurlSSLVerifyPeer True |
80 |
, CurlSSLCertType "PEM" |
81 |
, CurlSSLCert P.nodedCertFile |
82 |
, CurlSSLKeyType "PEM" |
83 |
, CurlSSLKey P.nodedCertFile |
84 |
, CurlConnectTimeout (fromIntegral C.rpcConnectTimeout) |
85 |
] |
86 |
#endif |
87 |
|
88 |
-- | Data type for RPC error reporting. |
89 |
data RpcError |
90 |
= CurlDisabledError |
91 |
| CurlLayerError Node String |
92 |
| JsonDecodeError String |
93 |
| RpcResultError String |
94 |
| OfflineNodeError Node |
95 |
deriving Eq |
96 |
|
97 |
instance Show RpcError where |
98 |
show CurlDisabledError = |
99 |
"RPC/curl backend disabled at compile time" |
100 |
show (CurlLayerError node code) = |
101 |
"Curl error for " ++ nodeName node ++ ", " ++ code |
102 |
show (JsonDecodeError msg) = |
103 |
"Error while decoding JSON from HTTP response: " ++ msg |
104 |
show (RpcResultError msg) = |
105 |
"Error reponse received from RPC server: " ++ msg |
106 |
show (OfflineNodeError node) = |
107 |
"Node " ++ nodeName node ++ " is marked as offline" |
108 |
|
109 |
type ERpcError = Either RpcError |
110 |
|
111 |
rpcErrorJsonReport :: (Monad m) => J.Result a -> m (ERpcError a) |
112 |
rpcErrorJsonReport (J.Error x) = return . Left $ JsonDecodeError x |
113 |
rpcErrorJsonReport (J.Ok x) = return $ Right x |
114 |
|
115 |
-- | Basic timeouts for RPC calls. |
116 |
$(declareIADT "RpcTimeout" |
117 |
[ ( "Urgent", 'C.rpcTmoUrgent ) |
118 |
, ( "Fast", 'C.rpcTmoFast ) |
119 |
, ( "Normal", 'C.rpcTmoNormal ) |
120 |
, ( "Slow", 'C.rpcTmoSlow ) |
121 |
, ( "FourHours", 'C.rpcTmo4hrs ) |
122 |
, ( "OneDay", 'C.rpcTmo1day ) |
123 |
]) |
124 |
|
125 |
-- | A generic class for RPC calls. |
126 |
class (J.JSON a) => RpcCall a where |
127 |
-- | Give the (Python) name of the procedure. |
128 |
rpcCallName :: a -> String |
129 |
-- | Calculate the timeout value for the call execution. |
130 |
rpcCallTimeout :: a -> Int |
131 |
-- | Prepare arguments of the call to be send as POST. |
132 |
rpcCallData :: Node -> a -> String |
133 |
-- | Whether we accept offline nodes when making a call. |
134 |
rpcCallAcceptOffline :: a -> Bool |
135 |
|
136 |
rpcCallData _ = J.encode |
137 |
|
138 |
-- | A generic class for RPC results with default implementation. |
139 |
class (J.JSON a) => RpcResult a where |
140 |
-- | Create a result based on the received HTTP response. |
141 |
rpcResultFill :: (Monad m) => String -> m (ERpcError a) |
142 |
|
143 |
rpcResultFill res = rpcErrorJsonReport $ J.decode res |
144 |
|
145 |
-- | Generic class that ensures matching RPC call with its respective |
146 |
-- result. |
147 |
class (RpcCall a, RpcResult b) => Rpc a b | a -> b |
148 |
|
149 |
-- | Http Request definition. |
150 |
data HttpClientRequest = HttpClientRequest |
151 |
{ requestTimeout :: Int |
152 |
, requestUrl :: String |
153 |
, requestPostData :: String |
154 |
} |
155 |
|
156 |
-- | Execute the request and return the result as a plain String. When |
157 |
-- curl reports an error, we propagate it. |
158 |
executeHttpRequest :: Node -> ERpcError HttpClientRequest |
159 |
-> IO (ERpcError String) |
160 |
|
161 |
executeHttpRequest _ (Left rpc_err) = return $ Left rpc_err |
162 |
#ifdef NO_CURL |
163 |
executeHttpRequest _ _ = return $ Left CurlDisabledError |
164 |
#else |
165 |
executeHttpRequest node (Right request) = do |
166 |
let reqOpts = [ CurlTimeout (fromIntegral $ requestTimeout request) |
167 |
, CurlPostFields [requestPostData request] |
168 |
] |
169 |
url = requestUrl request |
170 |
-- FIXME: This is very similar to getUrl in Htools/Rapi.hs |
171 |
(code, !body) <- curlGetString url $ curlOpts ++ reqOpts |
172 |
return $ case code of |
173 |
CurlOK -> Right body |
174 |
_ -> Left $ CurlLayerError node (show code) |
175 |
#endif |
176 |
|
177 |
-- | Prepare url for the HTTP request. |
178 |
prepareUrl :: (RpcCall a) => Node -> a -> String |
179 |
prepareUrl node call = |
180 |
let node_ip = nodePrimaryIp node |
181 |
port = snd C.daemonsPortsGanetiNoded |
182 |
path_prefix = "https://" ++ node_ip ++ ":" ++ show port |
183 |
in path_prefix ++ "/" ++ rpcCallName call |
184 |
|
185 |
-- | Create HTTP request for a given node provided it is online, |
186 |
-- otherwise create empty response. |
187 |
prepareHttpRequest :: (RpcCall a) => Node -> a |
188 |
-> ERpcError HttpClientRequest |
189 |
prepareHttpRequest node call |
190 |
| rpcCallAcceptOffline call || not (nodeOffline node) = |
191 |
Right HttpClientRequest { requestTimeout = rpcCallTimeout call |
192 |
, requestUrl = prepareUrl node call |
193 |
, requestPostData = rpcCallData node call |
194 |
} |
195 |
| otherwise = Left $ OfflineNodeError node |
196 |
|
197 |
-- | Parse the response or propagate the error. |
198 |
parseHttpResponse :: (Monad m, RpcResult a) => ERpcError String |
199 |
-> m (ERpcError a) |
200 |
parseHttpResponse (Left err) = return $ Left err |
201 |
parseHttpResponse (Right response) = rpcResultFill response |
202 |
|
203 |
-- | Execute RPC call for a sigle node. |
204 |
executeSingleRpcCall :: (Rpc a b) => Node -> a -> IO (Node, ERpcError b) |
205 |
executeSingleRpcCall node call = do |
206 |
let request = prepareHttpRequest node call |
207 |
response <- executeHttpRequest node request |
208 |
result <- parseHttpResponse response |
209 |
return (node, result) |
210 |
|
211 |
-- | Execute RPC call for many nodes in parallel. |
212 |
executeRpcCall :: (Rpc a b) => [Node] -> a -> IO [(Node, ERpcError b)] |
213 |
executeRpcCall nodes call = |
214 |
sequence $ parMap rwhnf (uncurry executeSingleRpcCall) |
215 |
(zip nodes $ repeat call) |
216 |
|
217 |
-- * RPC calls and results |
218 |
|
219 |
-- | AllInstancesInfo |
220 |
-- Returns information about all instances on the given nodes |
221 |
$(buildObject "RpcCallAllInstancesInfo" "rpcCallAllInstInfo" |
222 |
[ simpleField "hypervisors" [t| [Hypervisor] |] ]) |
223 |
|
224 |
$(buildObject "InstanceInfo" "instInfo" |
225 |
[ simpleField "name" [t| String |] |
226 |
, simpleField "memory" [t| Int|] |
227 |
, simpleField "state" [t| AdminState |] |
228 |
, simpleField "vcpus" [t| Int |] |
229 |
, simpleField "time" [t| Int |] |
230 |
]) |
231 |
|
232 |
$(buildObject "RpcResultAllInstancesInfo" "rpcResAllInstInfo" |
233 |
[ simpleField "instances" [t| [InstanceInfo] |] ]) |
234 |
|
235 |
instance RpcCall RpcCallAllInstancesInfo where |
236 |
rpcCallName _ = "all_instances_info" |
237 |
rpcCallTimeout _ = rpcTimeoutToRaw Urgent |
238 |
rpcCallAcceptOffline _ = False |
239 |
|
240 |
instance RpcResult RpcResultAllInstancesInfo |
241 |
|
242 |
instance Rpc RpcCallAllInstancesInfo RpcResultAllInstancesInfo |
243 |
|
244 |
-- | InstanceList |
245 |
-- Returns the list of running instances on the given nodes. |
246 |
$(buildObject "RpcCallInstanceList" "rpcCallInstList" |
247 |
[ simpleField "hypervisors" [t| [Hypervisor] |] ]) |
248 |
|
249 |
$(buildObject "RpcResultInstanceList" "rpcResInstList" |
250 |
[ simpleField "node" [t| Node |] |
251 |
, simpleField "instances" [t| [String] |] |
252 |
]) |
253 |
|
254 |
instance RpcCall RpcCallInstanceList where |
255 |
rpcCallName _ = "instance_list" |
256 |
rpcCallTimeout _ = rpcTimeoutToRaw Urgent |
257 |
rpcCallAcceptOffline _ = False |
258 |
|
259 |
instance RpcResult RpcResultInstanceList |
260 |
|
261 |
instance Rpc RpcCallInstanceList RpcResultInstanceList |
262 |
|
263 |
-- | NodeInfo |
264 |
-- Return node information. |
265 |
$(buildObject "RpcCallNodeInfo" "rpcCallNodeInfo" |
266 |
[ simpleField "hypervisors" [t| [Hypervisor] |] |
267 |
, simpleField "volume_groups" [t| [String] |] |
268 |
]) |
269 |
|
270 |
$(buildObject "VgInfo" "vgInfo" |
271 |
[ simpleField "name" [t| String |] |
272 |
, simpleField "free" [t| Int |] |
273 |
, simpleField "size" [t| Int |] |
274 |
]) |
275 |
|
276 |
-- | We only provide common fields as described in hv_base.py. |
277 |
$(buildObject "HvInfo" "hvInfo" |
278 |
[ simpleField "memory_total" [t| Int |] |
279 |
, simpleField "memory_free" [t| Int |] |
280 |
, simpleField "memory_dom0" [t| Int |] |
281 |
, simpleField "cpu_total" [t| Int |] |
282 |
, simpleField "cpu_nodes" [t| Int |] |
283 |
, simpleField "cpu_sockets" [t| Int |] |
284 |
]) |
285 |
|
286 |
$(buildObject "RpcResultNodeInfo" "rpcResNodeInfo" |
287 |
[ simpleField "boot_id" [t| String |] |
288 |
, simpleField "vg_info" [t| [VgInfo] |] |
289 |
, simpleField "hv_info" [t| [HvInfo] |] |
290 |
]) |
291 |
|
292 |
instance RpcCall RpcCallNodeInfo where |
293 |
rpcCallName _ = "node_info" |
294 |
rpcCallTimeout _ = rpcTimeoutToRaw Urgent |
295 |
rpcCallAcceptOffline _ = False |
296 |
|
297 |
instance RpcResult RpcResultNodeInfo |
298 |
|
299 |
instance Rpc RpcCallNodeInfo RpcResultNodeInfo |