Implement a node to drbd minors query function

[ganeti-local] / htools / Ganeti / Confd / Server.hs

diff --git a/htools/Ganeti/Confd/Server.hs b/htools/Ganeti/Confd/Server.hs
index 743f54d..f0ef0f2 100644 (file)
--- a/htools/Ganeti/Confd/Server.hs
+++ b/htools/Ganeti/Confd/Server.hs
@@ -6,7 +6,7 @@
 
 {-
 
-Copyright (C) 2011 Google Inc.
+Copyright (C) 2011, 2012 Google Inc.
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -30,12 +30,14 @@ module Ganeti.Confd.Server
   ) where
 
 import Control.Concurrent
+import Control.Exception
 import Control.Monad (forever)
 import qualified Data.ByteString as B
 import Data.IORef
 import Data.List
 import qualified Data.Map as M
 import qualified Network.Socket as S
+import Prelude hiding (catch)
 import System.Posix.Files
 import System.Posix.Types
 import System.Time
@@ -225,6 +227,19 @@ buildResponse cdata (ConfdRequest { confdRqType = ReqNodePipByInstPip
 buildResponse _ (ConfdRequest { confdRqType = ReqNodePipByInstPip }) =
   return queryArgumentError
 
+buildResponse cdata req@(ConfdRequest { confdRqType = ReqNodeDrbd }) = do
+  let cfg = fst cdata
+  node_name <- case confdRqQuery req of
+                 PlainQuery str -> return str
+                 _ -> fail $ "Invalid query type " ++ show (confdRqQuery req)
+  node <- getNode cfg node_name
+  let minors = concatMap (getInstMinorsForNode (nodeName node)) .
+               M.elems . configInstances $ cfg
+      encoded = [J.JSArray [J.showJSON a, J.showJSON b, J.showJSON c,
+                             J.showJSON d, J.showJSON e, J.showJSON f] |
+                 (a, b, c, d, e, f) <- minors]
+  return (ReplyStatusOk, J.showJSON encoded)
+
 -- | Parses a signed request.
 parseRequest :: HashKey -> String -> Result (String, String, ConfdRequest)
 parseRequest key str = do
@@ -300,7 +315,8 @@ safeUpdateConfig path oldfstat cref = do
                     updateConfig path cref
                     return (nt', ConfigReloaded)
         ) (\e -> do
-             let msg = "Failure during configuration update: " ++ show e
+             let msg = "Failure during configuration update: " ++
+                       show (e::IOError)
              writeIORef cref (Bad msg)
              return (nullFStat, ConfigIOError)
           )
@@ -416,7 +432,7 @@ addNotifier :: INotify -> FilePath -> CRef -> MVar ServerState -> IO Bool
 addNotifier inotify path cref mstate = do
   catch (addWatch inotify [CloseWrite] path
                     (onInotify inotify path cref mstate) >> return True)
-        (const $ return False)
+        (\e -> const (return False) (e::IOError))
 
 -- | Inotify event handler.
 onInotify :: INotify -> String -> CRef -> MVar ServerState -> Event -> IO ()
@@ -502,9 +518,10 @@ listener s hmac resp = do
 -- | Main function.
 main :: DaemonOptions -> IO ()
 main opts = do
-  s <- S.socket S.AF_INET S.Datagram S.defaultProtocol
-  let port = maybe C.defaultConfdPort fromIntegral $ optPort opts
-  S.bindSocket s (S.SockAddrInet (fromIntegral port) S.iNADDR_ANY)
+  parseresult <- parseAddress opts C.defaultConfdPort
+  (af_family, bindaddr) <- exitIfBad "parsing bind address" parseresult
+  s <- S.socket af_family S.Datagram S.defaultProtocol
+  S.bindSocket s bindaddr
   cref <- newIORef (Bad "Configuration not yet loaded")
   statemvar <- newMVar initialState
   hmac <- getClusterHmac