Revision c7003a76 src/Ganeti/Query/Server.hs
b/src/Ganeti/Query/Server.hs | ||
---|---|---|
59 | 59 |
import Ganeti.Query.Query |
60 | 60 |
import Ganeti.Query.Filter (makeSimpleFilter) |
61 | 61 |
import Ganeti.Types |
62 |
import qualified Ganeti.UDSServer as U |
|
62 |
import qualified Ganeti.UDSServer as U (Handler(..), listener)
|
|
63 | 63 |
import Ganeti.Utils (lockFile, exitIfBad, watchFile) |
64 | 64 |
import qualified Ganeti.Version as Version |
65 | 65 |
|
... | ... | |
316 | 316 |
} |
317 | 317 |
|
318 | 318 |
|
319 |
-- | Logs an outgoing message. |
|
320 |
logMsg |
|
321 |
:: (Show e, J.JSON e, MonadLog m) |
|
322 |
=> U.Handler i o |
|
323 |
-> i -- ^ the received request (used for logging) |
|
324 |
-> GenericResult e J.JSValue -- ^ A message to be sent |
|
325 |
-> m () |
|
326 |
logMsg handler req (Bad err) = |
|
327 |
logWarning $ "Failed to execute request " |
|
328 |
++ U.hInputLogLong handler req ++ ": " |
|
329 |
++ show err |
|
330 |
logMsg handler req (Ok result) = do |
|
331 |
-- only log the first 2,000 chars of the result |
|
332 |
logDebug $ "Result (truncated): " ++ take 2000 (J.encode result) |
|
333 |
logInfo $ "Successfully handled " ++ U.hInputLogShort handler req |
|
334 |
|
|
335 |
-- | Prepares an outgoing message. |
|
336 |
prepareMsg |
|
337 |
:: (J.JSON e) |
|
338 |
=> GenericResult e J.JSValue -- ^ A message to be sent |
|
339 |
-> (Bool, J.JSValue) |
|
340 |
prepareMsg (Bad err) = (False, J.showJSON err) |
|
341 |
prepareMsg (Ok result) = (True, result) |
|
342 |
|
|
343 |
handleJsonMessage |
|
344 |
:: (J.JSON o) |
|
345 |
=> U.Handler i o -- ^ handler |
|
346 |
-> i -- ^ parsed input |
|
347 |
-> U.HandlerResult J.JSValue |
|
348 |
handleJsonMessage handler req = do |
|
349 |
(close, call_result) <- U.hExec handler req |
|
350 |
return (close, fmap J.showJSON call_result) |
|
351 |
|
|
352 |
-- | Takes a request as a 'String', parses it, passes it to a handler and |
|
353 |
-- formats its response. |
|
354 |
handleRawMessage |
|
355 |
:: (J.JSON o) |
|
356 |
=> U.Handler i o -- ^ handler |
|
357 |
-> String -- ^ raw unparsed input |
|
358 |
-> IO (Bool, String) |
|
359 |
handleRawMessage handler payload = |
|
360 |
case U.parseCall payload >>= uncurry (U.hParse handler) of |
|
361 |
Bad err -> do |
|
362 |
let errmsg = "Failed to parse request: " ++ err |
|
363 |
logWarning errmsg |
|
364 |
return (False, buildResponse False (J.showJSON errmsg)) |
|
365 |
Ok req -> do |
|
366 |
logDebug $ "Request: " ++ U.hInputLogLong handler req |
|
367 |
(close, call_result_json) <- handleJsonMessage handler req |
|
368 |
logMsg handler req call_result_json |
|
369 |
let (status, response) = prepareMsg call_result_json |
|
370 |
return (close, buildResponse status response) |
|
371 |
|
|
372 |
-- | Reads a request, passes it to a handler and sends a response back to the |
|
373 |
-- client. |
|
374 |
handleClient |
|
375 |
:: (J.JSON o) |
|
376 |
=> U.Handler i o |
|
377 |
-> Client |
|
378 |
-> IO Bool |
|
379 |
handleClient handler client = do |
|
380 |
msg <- recvMsgExt client |
|
381 |
logDebug $ "Received message: " ++ show msg |
|
382 |
case msg of |
|
383 |
RecvConnClosed -> logDebug "Connection closed" >> |
|
384 |
return False |
|
385 |
RecvError err -> logWarning ("Error during message receiving: " ++ err) >> |
|
386 |
return False |
|
387 |
RecvOk payload -> do |
|
388 |
(close, outMsg) <- handleRawMessage handler payload |
|
389 |
sendMsg client outMsg |
|
390 |
return close |
|
391 |
|
|
392 |
-- | Main client loop: runs one loop of 'handleClient', and if that |
|
393 |
-- doesn't report a finished (closed) connection, restarts itself. |
|
394 |
clientLoop |
|
395 |
:: (J.JSON o) |
|
396 |
=> U.Handler i o |
|
397 |
-> Client |
|
398 |
-> IO () |
|
399 |
clientLoop handler client = do |
|
400 |
result <- handleClient handler client |
|
401 |
if result |
|
402 |
then clientLoop handler client |
|
403 |
else closeClient client |
|
404 |
|
|
405 |
-- | Main listener loop: accepts clients, forks an I/O thread to handle |
|
406 |
-- that client. |
|
407 |
listener |
|
408 |
:: (J.JSON o) |
|
409 |
=> U.Handler i o |
|
410 |
-> Server |
|
411 |
-> IO () |
|
412 |
listener handler server = do |
|
413 |
client <- acceptClient server |
|
414 |
_ <- forkIO $ clientLoop handler client |
|
415 |
return () |
|
416 |
|
|
417 |
|
|
418 | 319 |
-- | Type alias for prepMain results |
419 | 320 |
type PrepResult = (Server, IORef (Result ConfigData), JQStatus) |
420 | 321 |
|
... | ... | |
445 | 346 |
qlock <- newMVar () |
446 | 347 |
|
447 | 348 |
finally |
448 |
(forever $ listener (luxiHandler (qlock, jq, creader)) server) |
|
349 |
(forever $ U.listener (luxiHandler (qlock, jq, creader)) server)
|
|
449 | 350 |
(closeServer server) |
Also available in: Unified diff