The confd protocol heavily relies on the serial number to filter out outdated responses. However, the current implementation always returned 0 as serial number. Fix this and return a serial number that is bumped with every change that affects the answer.
Signed-off-by: Klaus Aehlig <[email protected]> --- src/Ganeti/Confd/Server.hs | 51 ++++++++++++++++++++++++++++------------------ 1 file changed, 31 insertions(+), 20 deletions(-) diff --git a/src/Ganeti/Confd/Server.hs b/src/Ganeti/Confd/Server.hs index f401e5e..7af7f0a 100644 --- a/src/Ganeti/Confd/Server.hs +++ b/src/Ganeti/Confd/Server.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE TupleSections #-} + {-| Implementation of the Ganeti confd server functionality. -} @@ -71,11 +73,11 @@ import Ganeti.Utils type CRef = IORef (Result (ConfigData, LinkIpMap)) -- | A small type alias for readability. -type StatusAnswer = (ConfdReplyStatus, J.JSValue) +type StatusAnswer = (ConfdReplyStatus, J.JSValue, Int) -- | Unknown entry standard response. queryUnknownEntry :: StatusAnswer -queryUnknownEntry = (ReplyStatusError, J.showJSON ConfdErrorUnknownEntry) +queryUnknownEntry = (ReplyStatusError, J.showJSON ConfdErrorUnknownEntry, 0) {- not used yet -- | Internal error standard response. @@ -85,7 +87,7 @@ queryInternalError = (ReplyStatusError, J.showJSON ConfdErrorInternal) -- | Argument error standard response. queryArgumentError :: StatusAnswer -queryArgumentError = (ReplyStatusError, J.showJSON ConfdErrorArgument) +queryArgumentError = (ReplyStatusError, J.showJSON ConfdErrorArgument, 0) -- | Converter from specific error to a string format. gntErrorToResult :: ErrorResult a -> Result a @@ -94,7 +96,7 @@ gntErrorToResult (Ok x) = Ok x -- * Confd base functionality --- | Computes the node role. +-- | Computes the node role nodeRole :: ConfigData -> String -> Result ConfdNodeRole nodeRole cfg name = do cmaster <- errToResult $ QCluster.clusterMasterNodeName cfg @@ -120,7 +122,8 @@ getNodePipByInstanceIp cfg linkipmap link instip = Just instname -> case getInstPrimaryNode cfg instname of Bad _ -> queryUnknownEntry -- either instance or node not found - Ok node -> (ReplyStatusOk, J.showJSON (nodePrimaryIp node)) + Ok node -> (ReplyStatusOk, J.showJSON (nodePrimaryIp node), + clusterSerial $ configCluster cfg) -- | Returns a node name for a given UUID uuidToNodeName :: ConfigData -> String -> Result String @@ -139,11 +142,11 @@ encodeMinors cfg (node_uuid, a, b, c, d, peer_uuid) = do -- | Builds the response to a given query. buildResponse :: (ConfigData, LinkIpMap) -> ConfdRequest -> Result StatusAnswer buildResponse (cfg, _) (ConfdRequest { confdRqType = ReqPing }) = - return (ReplyStatusOk, J.showJSON (configVersion cfg)) + return (ReplyStatusOk, J.showJSON (configVersion cfg), 0) buildResponse cdata req@(ConfdRequest { confdRqType = ReqClusterMaster }) = case confdRqQuery req of - EmptyQuery -> liftM ((,) ReplyStatusOk . J.showJSON) master_name + EmptyQuery -> liftM ((ReplyStatusOk,,serial) . J.showJSON) master_name PlainQuery _ -> return queryArgumentError DictQuery reqq -> do mnode <- gntErrorToResult $ getNode cfg master_uuid @@ -153,25 +156,28 @@ buildResponse cdata req@(ConfdRequest { confdRqType = ReqClusterMaster }) = ReqFieldIp -> clusterMasterIp cluster ReqFieldMNodePip -> nodePrimaryIp mnode ) (confdReqQFields reqq) - return (ReplyStatusOk, J.showJSON fvals) + return (ReplyStatusOk, J.showJSON fvals, serial) where master_uuid = clusterMasterNode cluster master_name = errToResult $ QCluster.clusterMasterNodeName cfg cluster = configCluster cfg cfg = fst cdata + serial = clusterSerial $ configCluster cfg buildResponse cdata req@(ConfdRequest { confdRqType = ReqNodeRoleByName }) = do node_name <- case confdRqQuery req of PlainQuery str -> return str _ -> fail $ "Invalid query type " ++ show (confdRqQuery req) role <- nodeRole (fst cdata) node_name - return (ReplyStatusOk, J.showJSON role) + return (ReplyStatusOk, J.showJSON role, + clusterSerial . configCluster $ fst cdata) buildResponse cdata (ConfdRequest { confdRqType = ReqNodePipList }) = -- note: we use foldlWithKey because that's present accross more -- versions of the library return (ReplyStatusOk, J.showJSON $ M.foldlWithKey (\accu _ n -> nodePrimaryIp n:accu) [] - (fromContainer . configNodes . fst $ cdata)) + (fromContainer . configNodes . fst $ cdata), + clusterSerial . configCluster $ fst cdata) buildResponse cdata (ConfdRequest { confdRqType = ReqMcPipList }) = -- note: we use foldlWithKey because that's present accross more @@ -180,7 +186,8 @@ buildResponse cdata (ConfdRequest { confdRqType = ReqMcPipList }) = M.foldlWithKey (\accu _ n -> if nodeMasterCandidate n then nodePrimaryIp n:accu else accu) [] - (fromContainer . configNodes . fst $ cdata)) + (fromContainer . configNodes . fst $ cdata), + clusterSerial . configCluster $ fst cdata) buildResponse (cfg, linkipmap) req@(ConfdRequest { confdRqType = ReqInstIpsList }) = do @@ -188,7 +195,8 @@ buildResponse (cfg, linkipmap) PlainQuery str -> return str EmptyQuery -> return (getDefaultNicLink cfg) _ -> fail "Invalid query type" - return (ReplyStatusOk, J.showJSON $ getInstancesIpByLink linkipmap link) + return (ReplyStatusOk, J.showJSON $ getInstancesIpByLink linkipmap link, + clusterSerial $ configCluster cfg) buildResponse cdata (ConfdRequest { confdRqType = ReqNodePipByInstPip , confdRqQuery = DictQuery query}) = @@ -199,7 +207,8 @@ buildResponse cdata (ConfdRequest { confdRqType = ReqNodePipByInstPip Nothing -> return (ReplyStatusOk, J.showJSON $ map (getNodePipByInstanceIp cfg linkipmap link) - (confdReqQIpList query)) + (confdReqQIpList query), + clusterSerial . configCluster $ fst cdata) buildResponse _ (ConfdRequest { confdRqType = ReqNodePipByInstPip }) = return queryArgumentError @@ -213,7 +222,7 @@ buildResponse cdata req@(ConfdRequest { confdRqType = ReqNodeDrbd }) = do let minors = concatMap (getInstMinorsForNode cfg (nodeUuid node)) . M.elems . fromContainer . configInstances $ cfg encoded <- mapM (encodeMinors cfg) minors - return (ReplyStatusOk, J.showJSON encoded) + return (ReplyStatusOk, J.showJSON encoded, nodeSerial node) -- | Return the list of instances for a node (as ([primary], [secondary])) given -- the node name. @@ -228,7 +237,7 @@ buildResponse cdata req@(ConfdRequest { confdRqType = ReqNodeInstances }) = do Bad e -> fail $ "Node not found in the configuration: " ++ show e let node_uuid = nodeUuid node instances = getNodeInstances cfg node_uuid - return (ReplyStatusOk, J.showJSON instances) + return (ReplyStatusOk, J.showJSON instances, nodeSerial node) -- | Return the list of disks for an instance given the instance uuid. buildResponse cdata req@(ConfdRequest { confdRqType = ReqInstanceDisks }) = do @@ -237,20 +246,22 @@ buildResponse cdata req@(ConfdRequest { confdRqType = ReqInstanceDisks }) = do case confdRqQuery req of PlainQuery str -> return str _ -> fail $ "Invalid query type " ++ show (confdRqQuery req) + inst <- lookupContainer (Bad $ "unknown instance: " ++ inst_uuid) + inst_uuid $ configInstances cfg case getInstDisks cfg inst_uuid of - Ok disks -> return (ReplyStatusOk, J.showJSON disks) + Ok disks -> return (ReplyStatusOk, J.showJSON disks, instSerial inst) Bad e -> fail $ "Could not retrieve disks: " ++ show e -- | Creates a ConfdReply from a given answer. serializeResponse :: Result StatusAnswer -> ConfdReply serializeResponse r = - let (status, result) = case r of - Bad err -> (ReplyStatusError, J.showJSON err) - Ok (code, val) -> (code, val) + let (status, result, serial) = case r of + Bad err -> (ReplyStatusError, J.showJSON err, 0) + Ok (code, val, ser) -> (code, val, ser) in ConfdReply { confdReplyProtocol = 1 , confdReplyStatus = status , confdReplyAnswer = result - , confdReplySerial = 0 } + , confdReplySerial = serial } -- ** Client input/output handlers -- 2.5.0.rc2.392.g76e840b
