Implement a node to drbd minors query function

This can be queried remotely since it's a pure configuration query.

Signed-off-by: Iustin Pop <iustin@google.com>
Reviewed-by: René Nussbaumer <rn@google.com>

htools/Ganeti/Confd.hs

@@ -73,6 +73,7 @@ $(declareIADT "ConfdRequestType"
   , ("ReqClusterMaster",    'C.confdReqClusterMaster )
   , ("ReqMcPipList",        'C.confdReqMcPipList )
   , ("ReqInstIpsList",      'C.confdReqInstancesIpsList )
+  , ("ReqNodeDrbd",         'C.confdReqNodeDrbd )
   ])
 $(makeJSONInstance ''ConfdRequestType)
 

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

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: