diff --git a/htools/Ganeti/Confd.hs b/htools/Ganeti/Confd.hs index 6bc0dd1424ff0a68b128b663cb342b6e8fbdac81..8fdf12d7734a2236ea5f04416362d4fc21a5e283 100644 --- a/htools/Ganeti/Confd.hs +++ b/htools/Ganeti/Confd.hs @@ -73,6 +73,7 @@ $(declareIADT "ConfdRequestType" , ("ReqClusterMaster", 'C.confdReqClusterMaster ) , ("ReqMcPipList", 'C.confdReqMcPipList ) , ("ReqInstIpsList", 'C.confdReqInstancesIpsList ) + , ("ReqNodeDrbd", 'C.confdReqNodeDrbd ) ]) $(makeJSONInstance ''ConfdRequestType) diff --git a/htools/Ganeti/Confd/Server.hs b/htools/Ganeti/Confd/Server.hs index 493c8c6ad4615998015b2a379d4b66b368dfa854..f0ef0f290d34fe1280225dfc4eb6297653fe9668 100644 --- a/htools/Ganeti/Confd/Server.hs +++ b/htools/Ganeti/Confd/Server.hs @@ -227,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 diff --git a/htools/Ganeti/Config.hs b/htools/Ganeti/Config.hs index ff22f361860630125bc811ed6b8720e5aefabc2c..aad9a7e0eb4d820073e58befabc1441348c833fc 100644 --- a/htools/Ganeti/Config.hs +++ b/htools/Ganeti/Config.hs @@ -32,6 +32,7 @@ module Ganeti.Config , getNode , getInstance , getInstPrimaryNode + , getInstMinorsForNode , buildLinkIpInstnameMap , instNodes ) where @@ -133,6 +134,43 @@ getInstPrimaryNode :: ConfigData -> String -> Result Node getInstPrimaryNode cfg name = getInstance cfg name >>= return . instPrimaryNode >>= getNode cfg +-- | Filters DRBD minors for a given node. +getDrbdMinorsForNode :: String -> Disk -> [(Int, String)] +getDrbdMinorsForNode node disk = + let child_minors = concatMap (getDrbdMinorsForNode node) (diskChildren disk) + this_minors = + case diskLogicalId disk of + LIDDrbd8 nodeA nodeB _ minorA minorB _ + | nodeA == node -> [(minorA, nodeB)] + | nodeB == node -> [(minorB, nodeA)] + _ -> [] + in this_minors ++ child_minors + +-- | String for primary role. +rolePrimary :: String +rolePrimary = "primary" + +-- | String for secondary role. +roleSecondary :: String +roleSecondary = "secondary" + +-- | Gets the list of DRBD minors for an instance that are related to +-- a given node. +getInstMinorsForNode :: String -> Instance + -> [(String, Int, String, String, String, String)] +getInstMinorsForNode node inst = + let role = if node == instPrimaryNode inst + then rolePrimary + else roleSecondary + iname = instName inst + -- FIXME: the disk/ build there is hack-ish; unify this in a + -- separate place, or reuse the iv_name (but that is deprecated on + -- the Python side) + in concatMap (\(idx, dsk) -> + [(node, minor, iname, "disk/" ++ show idx, role, peer) + | (minor, peer) <- getDrbdMinorsForNode node dsk]) . + zip [(0::Int)..] . instDisks $ inst + -- | Builds link -> ip -> instname map. -- -- TODO: improve this by splitting it into multiple independent functions: