Il mar 12 ago 2014 17:04 'Aaron Karper' via ganeti-devel < [email protected]> ha scritto:
> The ConfdRequestType is ReqConfigQuery with a plain query of the RFC6901 > path. This responds with the complete JSON object at that location. > > Fixes issue 564 > > Signed-off-by: Aaron Karper <[email protected]> > --- > src/Ganeti/Confd/Server.hs | 13 ++++++++++ > src/Ganeti/Confd/Types.hs | 21 +++++++-------- > src/Ganeti/Confd/Utils.hs | 64 ++++++++++++++++++++++++++++++ > ++++++++++++++++ > src/Ganeti/Constants.hs | 3 +++ > 4 files changed, 91 insertions(+), 10 deletions(-) > > diff --git a/src/Ganeti/Confd/Server.hs b/src/Ganeti/Confd/Server.hs > index 795681d..3fbdc26 100644 > --- a/src/Ganeti/Confd/Server.hs > +++ b/src/Ganeti/Confd/Server.hs > @@ -232,6 +232,19 @@ 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 _ -> return queryArgumentError > + > -- | 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..6e8584b 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,62 @@ signMessage key salt msg = > , signedMsgHmac = hmac > } > where hmac = computeMac key (Just salt) msg > + > +data Pointer = Pointer [String] > + deriving (Show, Eq) > + > +-- | Parse a fixed size Int. > +readInteger :: String -> J.Result Int > +readInteger = either J.Error J.Ok . P.parseOnly P.decimal . pack > + > +-- | Parse a path for a JSON structure. > +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 = > + 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 any 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 > + > +-- | Extract a JSValue from an object at the position defined by the path. > +-- > +-- The path syntax follows RCF6901. Error is returned if the path doesn't > +-- exist, Ok if the path leads to an valid value. > +-- > +-- 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}] } > +extractJSONPath :: J.JSON a => String -> a -> J.Result J.JSValue > +extractJSONPath path obj = do > + pointer <- pointerFromString path > + extractValue pointer obj > 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.1.0.rc2.206.gedb03e5 > > LGTM to the re-sent patch as well. Cheers, Michele
