Revision 670e954a src/Ganeti/Query/Server.hs

b/src/Ganeti/Query/Server.hs
26 26
-}
27 27

  
28 28
module Ganeti.Query.Server
29
  ( prepQueryD
30
  , runQueryD
29
  ( main
30
  , checkMain
31
  , prepMain
31 32
  ) where
32 33

  
33 34
import Control.Applicative
34 35
import Control.Concurrent
35 36
import Control.Exception
37
import Control.Monad (forever)
36 38
import Data.Bits (bitSize)
37
import Data.Maybe
39
import Data.IORef
38 40
import qualified Network.Socket as S
39 41
import qualified Text.JSON as J
40 42
import Text.JSON (showJSON, JSValue(..))
......
226 228
    then clientLoop client creader
227 229
    else closeClient client
228 230

  
229
-- | Main loop: accepts clients, forks an I/O thread to handle that
230
-- client, and then restarts.
231
mainLoop :: ConfigReader -> S.Socket -> IO ()
232
mainLoop creader socket = do
231
-- | Main listener loop: accepts clients, forks an I/O thread to handle
232
-- that client.
233
listener :: ConfigReader -> S.Socket -> IO ()
234
listener creader socket = do
233 235
  client <- acceptClient socket
234 236
  _ <- forkIO $ clientLoop client creader
235
  mainLoop creader socket
237
  return ()
236 238

  
237
-- | Function that prepares the server socket.
238
prepQueryD :: Maybe FilePath -> IO (FilePath, S.Socket)
239
prepQueryD fpath = do
240
  def_socket <- Path.defaultQuerySocket
241
  let socket_path = fromMaybe def_socket fpath
239
-- | Type alias for prepMain results
240
type PrepResult = (FilePath, S.Socket, IORef (Result ConfigData))
241

  
242
-- | Check function for queryd.
243
checkMain :: CheckFn ()
244
checkMain _ = return $ Right ()
245

  
246
-- | Prepare function for queryd.
247
prepMain :: PrepFn () PrepResult
248
prepMain _ _ = do
249
  socket_path <- Path.defaultQuerySocket
242 250
  cleanupSocket socket_path
243 251
  s <- describeError "binding to the Luxi socket"
244 252
         Nothing (Just socket_path) $ getServer socket_path
245
  return (socket_path, s)
253
  cref <- newIORef (Bad "Configuration not yet loaded")
254
  return (socket_path, s, cref)
255

  
256
-- | Main function.
257
main :: MainFn () PrepResult
258
main _ _ (socket_path, server, cref) = do
259
  initConfigReader id cref
260
  let creader = readIORef cref
246 261

  
247
-- | Main function that runs the query endpoint.
248
runQueryD :: (FilePath, S.Socket) -> ConfigReader -> IO ()
249
runQueryD (socket_path, server) creader =
250 262
  finally
251
    (mainLoop creader server)
263
    (forever $ listener creader server)
252 264
    (closeServer socket_path server)

Also available in: Unified diff