The ConfdRequestType is ReqConfigQuery with a plain query of the RFC6901 path. This responds with the complete JSON object at that location.
Signed-off-by: Aaron Karper <[email protected]> --- src/Ganeti/Confd/Server.hs | 12 +++++++++++ src/Ganeti/Confd/Types.hs | 21 +++++++++--------- src/Ganeti/Confd/Utils.hs | 53 ++++++++++++++++++++++++++++++++++++++++++++++ src/Ganeti/Constants.hs | 3 +++ 4 files changed, 79 insertions(+), 10 deletions(-) diff --git a/src/Ganeti/Confd/Server.hs b/src/Ganeti/Confd/Server.hs index 795681d..855d1fc 100644 --- a/src/Ganeti/Confd/Server.hs +++ b/src/Ganeti/Confd/Server.hs @@ -232,6 +232,18 @@ buildResponse cdata req@(ConfdRequest { confdRqType = ReqInstanceDisks }) = do Ok disks -> return (ReplyStatusOk, J.showJSON disks) Bad e -> fail $ "Could not retrieve disks: " ++ show e +-- | Return arbitrary configuration value given by a path. +buildResponse cdata req@(ConfdRequest { confdRqType = ReqConfigQuery, confdRqQuery = pathQ }) = do + let cfg = fst cdata + path <- + case pathQ of + PlainQuery path -> return path + _ -> fail $ "Invalid query type " ++ show (confdRqQuery req) + let configValue = extractJSONPath path cfg + case configValue of + J.Ok jsvalue -> return (ReplyStatusOk, jsvalue) + J.Error e -> fail $ "Couldn't retrieve value: " ++ show e + -- | Creates a ConfdReply from a given answer. serializeResponse :: Result StatusAnswer -> ConfdReply serializeResponse r = diff --git a/src/Ganeti/Confd/Types.hs b/src/Ganeti/Confd/Types.hs index acf4b26..8eed390 100644 --- a/src/Ganeti/Confd/Types.hs +++ b/src/Ganeti/Confd/Types.hs @@ -54,16 +54,17 @@ import Ganeti.THH import Ganeti.Utils (newUUID) $(declareILADT "ConfdRequestType" - [ ("ReqPing", 0) - , ("ReqNodeRoleByName", 1) - , ("ReqNodePipByInstPip", 2) - , ("ReqClusterMaster", 3) - , ("ReqNodePipList", 4) - , ("ReqMcPipList", 5) - , ("ReqInstIpsList", 6) - , ("ReqNodeDrbd", 7) - , ("ReqNodeInstances", 8) - , ("ReqInstanceDisks", 9) + [ ("ReqPing", 0) + , ("ReqNodeRoleByName", 1) + , ("ReqNodePipByInstPip", 2) + , ("ReqClusterMaster", 3) + , ("ReqNodePipList", 4) + , ("ReqMcPipList", 5) + , ("ReqInstIpsList", 6) + , ("ReqNodeDrbd", 7) + , ("ReqNodeInstances", 8) + , ("ReqInstanceDisks", 9) + , ("ReqConfigQuery", 10) ]) $(makeJSONInstance ''ConfdRequestType) diff --git a/src/Ganeti/Confd/Utils.hs b/src/Ganeti/Confd/Utils.hs index 41454ce..b09340b 100644 --- a/src/Ganeti/Confd/Utils.hs +++ b/src/Ganeti/Confd/Utils.hs @@ -33,9 +33,14 @@ module Ganeti.Confd.Utils , parseReply , signMessage , getCurrentTime + , extractJSONPath ) where +import qualified Data.Attoparsec.Text as P + +import Control.Applicative ((*>)) import qualified Data.ByteString as B +import Data.Text (pack) import qualified Text.JSON as J import Ganeti.BasicTypes @@ -95,3 +100,51 @@ signMessage key salt msg = , signedMsgHmac = hmac } where hmac = computeMac key (Just salt) msg + +data Pointer = Pointer [String] + deriving (Show, Eq) + +extractJSONPath :: J.JSON a => String -> a -> J.Result J.JSValue +extractJSONPath path obj = do + pointer <- pointerFromString path + extractValue pointer obj + +readInteger :: String -> J.Result Int +readInteger = either J.Error J.Ok . P.parseOnly P.decimal . pack + +-- | JSON pointer syntax according to RFC6901: +-- "/path/0/x" => Pointer ["path", "0", "x"] +-- This accesses 1 in the following JSON: +-- { "path": { "0": { "x": 1 } } } +-- +-- or the following: +-- +-- { "path": [{"x": 1}] } +pointerFromString :: String -> J.Result Pointer +pointerFromString s = either J.Error J.Ok $ P.parseOnly parser $ pack s + where + parser = do + tokens <- token `P.manyTill` P.endOfInput + return $ Pointer tokens + token = do + P.char '/' *> (P.many' $ P.choice [escaped, P.satisfy $ P.notInClass "~/"]) + escaped = P.choice [escapedSlash, escapedTilde] + escapedSlash = P.string (pack "~1") *> return '/' + escapedTilde = P.string (pack "~0") *> return '~' + +-- | Use a Pointer to access an arbitrary value nested in a JSON object. +extractValue :: J.JSON a => Pointer -> a -> J.Result J.JSValue +extractValue (Pointer l) json = getJSValue l $ J.showJSON json + where + indexWithString x (J.JSObject object) = J.valFromObj x object + indexWithString x (J.JSArray list) = do + i <- readInteger x + if 0 <= i && i < length list + then return $ list !! i + else J.Error ("list index " ++ show i ++ " out of bounds") + indexWithString _ _ = J.Error "Atomic value was indexed" + getJSValue :: [String] -> J.JSValue -> J.Result J.JSValue + getJSValue [] js = J.Ok js + getJSValue (x:xs) js = do + value <- indexWithString x js + getJSValue xs value diff --git a/src/Ganeti/Constants.hs b/src/Ganeti/Constants.hs index 89459f6..eb33ba8 100644 --- a/src/Ganeti/Constants.hs +++ b/src/Ganeti/Constants.hs @@ -4217,6 +4217,9 @@ confdReqNodeInstances = Types.confdRequestTypeToRaw ReqNodeInstances confdReqInstanceDisks :: Int confdReqInstanceDisks = Types.confdRequestTypeToRaw ReqInstanceDisks +confdReqConfigQuery :: Int +confdReqConfigQuery = Types.confdRequestTypeToRaw ReqConfigQuery + confdReqs :: FrozenSet Int confdReqs = ConstantUtils.mkSet . -- 2.0.0.526.g5318336
