diff --git a/Makefile.am b/Makefile.am
index b94c0e3ddbcf8f56959cd3d2dd6a93393339d28c..3e2eba4f7dc98003ece96c4acef94a65c0968dac 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -416,7 +416,10 @@ HS_LIB_SRCS = \
htools/Ganeti/OpCodes.hs \
htools/Ganeti/Rpc.hs \
htools/Ganeti/Qlang.hs \
+ htools/Ganeti/Query/Common.hs \
+ htools/Ganeti/Query/Node.hs \
htools/Ganeti/Query/Query.hs \
+ htools/Ganeti/Query/Types.hs \
htools/Ganeti/Queryd.hs \
htools/Ganeti/Runtime.hs \
htools/Ganeti/Ssconf.hs \
diff --git a/htools/Ganeti/Qlang.hs b/htools/Ganeti/Qlang.hs
index 9ff43e74534984e3db227882f881e68b1161a12e..1a7a6f77a4dac172e2a1b27c37375049a4e1f79d 100644
--- a/htools/Ganeti/Qlang.hs
+++ b/htools/Ganeti/Qlang.hs
@@ -33,10 +33,14 @@ module Ganeti.Qlang
, QueryResult(..)
, QueryFields(..)
, QueryFieldsResult(..)
+ , FieldName
+ , FieldTitle
, FieldType(..)
+ , FieldDoc
, FieldDefinition(..)
, ResultEntry(..)
, ResultStatus(..)
+ , ResultValue
, ItemType(..)
, checkRS
) where
diff --git a/htools/Ganeti/Query/Common.hs b/htools/Ganeti/Query/Common.hs
new file mode 100644
index 0000000000000000000000000000000000000000..76fe9fa8d2965abbb3ad5f27bfebbbddfda07317
--- /dev/null
+++ b/htools/Ganeti/Query/Common.hs
@@ -0,0 +1,158 @@
+{-| Implementation of the Ganeti Query2 common objects.
+
+ -}
+
+{-
+
+Copyright (C) 2012 Google Inc.
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+02110-1301, USA.
+
+-}
+
+module Ganeti.Query.Common
+ ( rsNoData
+ , rsNormal
+ , rsMaybe
+ , rsUnknown
+ , missingRuntime
+ , timeStampFields
+ , uuidFields
+ , serialFields
+ , tagsFields
+ , dictFieldGetter
+ , buildQFTLookup
+ , buildNdParamField
+ ) where
+
+import qualified Data.Map as Map
+import Data.Maybe (fromMaybe)
+import Text.JSON (JSON, showJSON)
+
+import qualified Ganeti.Constants as C
+import Ganeti.Config
+import Ganeti.Objects
+import Ganeti.Qlang
+import Ganeti.Query.Types
+
+-- * Generic functions
+
+-- | Conversion from 'VType' to 'FieldType'.
+vTypeToQFT :: VType -> FieldType
+vTypeToQFT VTypeString = QFTOther
+vTypeToQFT VTypeMaybeString = QFTOther
+vTypeToQFT VTypeBool = QFTBool
+vTypeToQFT VTypeSize = QFTUnit
+vTypeToQFT VTypeInt = QFTNumber
+
+-- * Result helpers
+
+-- | Helper for a result with no data.
+rsNoData :: ResultEntry
+rsNoData = ResultEntry RSNoData Nothing
+
+-- | Helper to declare a normal result.
+rsNormal :: (JSON a) => a -> ResultEntry
+rsNormal a = ResultEntry RSNormal $ Just (showJSON a)
+
+-- | Helper to declare a result from a 'Maybe' (the item might be
+-- missing, in which case we return no data). Note that there's some
+-- ambiguity here: in some cases, we mean 'RSNoData', but in other
+-- 'RSUnavail'; this is easy to solve in simple cases, but not in
+-- nested dicts.
+rsMaybe :: (JSON a) => Maybe a -> ResultEntry
+rsMaybe = maybe rsNoData rsNormal
+
+-- | Helper for unknown field result.
+rsUnknown :: ResultEntry
+rsUnknown = ResultEntry RSUnknown Nothing
+
+-- | Helper for a missing runtime parameter.
+missingRuntime :: FieldGetter a b
+missingRuntime = FieldRuntime (\_ _ -> ResultEntry RSNoData Nothing)
+
+-- * Common fields
+
+-- | The list of timestamp fields.
+timeStampFields :: (TimeStampObject a) => FieldList a b
+timeStampFields =
+ [ (FieldDefinition "ctime" "CTime" QFTTimestamp "Creation timestamp",
+ FieldSimple (rsNormal . cTimeOf))
+ , (FieldDefinition "mtime" "MTime" QFTTimestamp "Modification timestamp",
+ FieldSimple (rsNormal . mTimeOf))
+ ]
+
+-- | The list of UUID fields.
+uuidFields :: (UuidObject a) => String -> FieldList a b
+uuidFields name =
+ [ (FieldDefinition "uuid" "UUID" QFTText (name ++ " UUID"),
+ FieldSimple (rsNormal . uuidOf)) ]
+
+-- | The list of serial number fields.
+serialFields :: (SerialNoObject a) => String -> FieldList a b
+serialFields name =
+ [ (FieldDefinition "serial_no" "SerialNo" QFTNumber
+ (name ++ " object serial number, incremented on each modification"),
+ FieldSimple (rsNormal . serialOf)) ]
+
+-- | The list of tag fields.
+tagsFields :: (TagsObject a) => FieldList a b
+tagsFields =
+ [ (FieldDefinition "tags" "Tags" QFTOther "Tags",
+ FieldSimple (rsNormal . tagsOf)) ]
+
+-- * Generic parameter functions
+
+-- | Returns a field from a (possibly missing) 'DictObject'. This is
+-- used by parameter dictionaries, usually. Note that we have two
+-- levels of maybe: the top level dict might be missing, or one key in
+-- the dictionary might be.
+dictFieldGetter :: (DictObject a) => String -> Maybe a -> ResultEntry
+dictFieldGetter k = maybe rsNoData (rsMaybe . lookup k . toDict)
+
+-- | Build an optimised lookup map from a Python _PARAMETER_TYPES
+-- association list.
+buildQFTLookup :: [(String, String)] -> Map.Map String FieldType
+buildQFTLookup =
+ Map.fromList .
+ map (\(k, v) -> (k, maybe QFTOther vTypeToQFT (vTypeFromRaw v)))
+
+-- | Ndparams optimised lookup map.
+ndParamTypes :: Map.Map String FieldType
+ndParamTypes = buildQFTLookup C.ndsParameterTypes
+
+-- | Ndparams title map.
+ndParamTitles :: Map.Map String FieldTitle
+ndParamTitles = Map.fromList C.ndsParameterTitles
+
+-- | Ndparam getter builder: given a field, it returns a FieldConfig
+-- getter, that is a function that takes the config and the object and
+-- returns the Ndparam field specified when the getter was built.
+ndParamGetter :: (NdParamObject a) =>
+ String -- ^ The field we're building the getter for
+ -> ConfigData -> a -> ResultEntry
+ndParamGetter field config =
+ dictFieldGetter field . getNdParamsOf config
+
+-- | Builds the ndparam fields for an object.
+buildNdParamField :: (NdParamObject a) => String -> FieldData a b
+buildNdParamField field =
+ let full_name = "ndp/" ++ field
+ title = fromMaybe field $ field `Map.lookup` ndParamTitles
+ qft = fromMaybe QFTOther $ field `Map.lookup` ndParamTypes
+ desc = "The \"" ++ field ++ "\" node parameter"
+ in (FieldDefinition full_name title qft desc,
+ FieldConfig (ndParamGetter field))
diff --git a/htools/Ganeti/Query/Node.hs b/htools/Ganeti/Query/Node.hs
new file mode 100644
index 0000000000000000000000000000000000000000..77fcc882d4e44184ea08732330ebdb5aa5920859
--- /dev/null
+++ b/htools/Ganeti/Query/Node.hs
@@ -0,0 +1,163 @@
+{-| Implementation of the Ganeti Query2 node queries.
+
+ -}
+
+{-
+
+Copyright (C) 2012 Google Inc.
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+02110-1301, USA.
+
+-}
+
+module Ganeti.Query.Node
+ ( NodeRuntime(..)
+ , nodeFieldsMap
+ ) where
+
+import Control.Applicative
+import Data.List
+import qualified Data.Map as Map
+
+import Ganeti.Config
+import Ganeti.Objects
+import Ganeti.Qlang
+import Ganeti.Query.Common
+import Ganeti.Query.Types
+
+-- | Stub data type until we integrate the RPC.
+data NodeRuntime = NodeRuntime
+
+-- | List of node live fields, all ignored for now (no RPC).
+nodeLiveFieldsDefs :: [(FieldName, FieldTitle, FieldType, String, FieldDoc)]
+nodeLiveFieldsDefs =
+ [ ("bootid", "BootID", QFTText, "bootid",
+ "Random UUID renewed for each system reboot, can be used\
+ \ for detecting reboots by tracking changes")
+ , ("cnodes", "CNodes", QFTNumber, "cpu_nodes",
+ "Number of NUMA domains on node (if exported by hypervisor)")
+ , ("csockets", "CSockets", QFTNumber, "cpu_sockets",
+ "Number of physical CPU sockets (if exported by hypervisor)")
+ , ("ctotal", "CTotal", QFTNumber, "cpu_total",
+ "Number of logical processors")
+ , ("dfree", "DFree", QFTUnit, "vg_free",
+ "Available disk space in volume group")
+ , ("dtotal", "DTotal", QFTUnit, "vg_size",
+ "Total disk space in volume group used for instance disk allocation")
+ , ("mfree", "MFree", QFTUnit, "memory_free",
+ "Memory available for instance allocations")
+ , ("mnode", "MNode", QFTUnit, "memory_dom0",
+ "Amount of memory used by node (dom0 for Xen)")
+ , ("mtotal", "MTotal", QFTUnit, "memory_total",
+ "Total amount of memory of physical machine")
+ ]
+
+-- | Builder for node live fields.
+nodeLiveFieldBuilder :: (FieldName, FieldTitle, FieldType, String, FieldDoc)
+ -> FieldData Node NodeRuntime
+nodeLiveFieldBuilder (fname, ftitle, ftype, _, fdoc) =
+ (FieldDefinition fname ftitle ftype fdoc, missingRuntime)
+
+-- | The docstring for the node role. Note that we use 'reverse in
+-- order to keep the same order as Python.
+nodeRoleDoc :: String
+nodeRoleDoc =
+ "Node role; " ++
+ (intercalate ", " $
+ map (\role ->
+ "\"" ++ nodeRoleToRaw role ++ "\" for " ++ roleDescription role)
+ (reverse [minBound..maxBound]))
+
+-- | List of all node fields.
+nodeFields :: FieldList Node NodeRuntime
+nodeFields =
+ [ (FieldDefinition "drained" "Drained" QFTBool "Whether node is drained",
+ FieldSimple (rsNormal . nodeDrained))
+ , (FieldDefinition "master_candidate" "MasterC" QFTBool
+ "Whether node is a master candidate",
+ FieldSimple (rsNormal . nodeMasterCandidate))
+ , (FieldDefinition "master_capable" "MasterCapable" QFTBool
+ "Whether node can become a master candidate",
+ FieldSimple (rsNormal . nodeMasterCapable))
+ , (FieldDefinition "name" "Node" QFTText "Node name",
+ FieldSimple (rsNormal . nodeName))
+ , (FieldDefinition "offline" "Offline" QFTBool
+ "Whether node is marked offline",
+ FieldSimple (rsNormal . nodeOffline))
+ , (FieldDefinition "vm_capable" "VMCapable" QFTBool
+ "Whether node can host instances",
+ FieldSimple (rsNormal . nodeVmCapable))
+ , (FieldDefinition "pip" "PrimaryIP" QFTText "Primary IP address",
+ FieldSimple (rsNormal . nodePrimaryIp))
+ , (FieldDefinition "sip" "SecondaryIP" QFTText "Secondary IP address",
+ FieldSimple (rsNormal . nodeSecondaryIp))
+ , (FieldDefinition "master" "IsMaster" QFTBool "Whether node is master",
+ FieldConfig (\cfg node ->
+ rsNormal (nodeName node ==
+ clusterMasterNode (configCluster cfg))))
+ , (FieldDefinition "group" "Group" QFTText "Node group",
+ FieldConfig (\cfg node ->
+ rsMaybe (groupName <$> getGroupOfNode cfg node)))
+ , (FieldDefinition "group.uuid" "GroupUUID" QFTText "UUID of node group",
+ FieldSimple (rsNormal . nodeGroup))
+ , (FieldDefinition "ndparams" "NodeParameters" QFTOther
+ "Merged node parameters",
+ FieldConfig ((rsMaybe .) . getNodeNdParams))
+ , (FieldDefinition "custom_ndparams" "CustomNodeParameters" QFTOther
+ "Custom node parameters",
+ FieldSimple (rsNormal . nodeNdparams))
+ -- FIXME: the below could be generalised a bit, like in Python
+ , (FieldDefinition "pinst_cnt" "Pinst" QFTNumber
+ "Number of instances with this node as primary",
+ FieldConfig (\cfg ->
+ rsNormal . length . fst . getNodeInstances cfg . nodeName))
+ , (FieldDefinition "sinst_cnt" "Sinst" QFTNumber
+ "Number of instances with this node as secondary",
+ FieldConfig (\cfg ->
+ rsNormal . length . snd . getNodeInstances cfg . nodeName))
+ , (FieldDefinition "pinst_list" "PriInstances" QFTNumber
+ "List of instances with this node as primary",
+ FieldConfig (\cfg -> rsNormal . map instName . fst .
+ getNodeInstances cfg . nodeName))
+ , (FieldDefinition "sinst_list" "SecInstances" QFTNumber
+ "List of instances with this node as secondary",
+ FieldConfig (\cfg -> rsNormal . map instName . snd .
+ getNodeInstances cfg . nodeName))
+ , (FieldDefinition "role" "Role" QFTText nodeRoleDoc,
+ FieldConfig ((rsNormal .) . getNodeRole))
+ -- FIXME: the powered state is special (has an different context,
+ -- not runtime) in Python
+ , (FieldDefinition "powered" "Powered" QFTBool
+ "Whether node is thought to be powered on",
+ missingRuntime)
+ -- FIXME: the two fields below are incomplete in Python, part of the
+ -- non-implemented node resource model; they are declared just for
+ -- parity, but are not functional
+ , (FieldDefinition "hv_state" "HypervisorState" QFTOther "Hypervisor state",
+ missingRuntime)
+ , (FieldDefinition "disk_state" "DiskState" QFTOther "Disk state",
+ missingRuntime)
+ ] ++
+ map nodeLiveFieldBuilder nodeLiveFieldsDefs ++
+ map buildNdParamField allNDParamFields ++
+ timeStampFields ++
+ uuidFields "Node" ++
+ serialFields "Node" ++
+ tagsFields
+
+-- | The node fields map.
+nodeFieldsMap :: FieldMap Node NodeRuntime
+nodeFieldsMap = Map.fromList $ map (\v -> (fdefName (fst v), v)) nodeFields
diff --git a/htools/Ganeti/Query/Query.hs b/htools/Ganeti/Query/Query.hs
index 6cf7093cdf9d8a615e29445f8560ede56be517a5..3df39a3a1df7d698df248a51d1bbb894df9d86b1 100644
--- a/htools/Ganeti/Query/Query.hs
+++ b/htools/Ganeti/Query/Query.hs
@@ -27,13 +27,55 @@ module Ganeti.Query.Query
( query
) where
+import Data.Maybe (fromMaybe)
+import qualified Data.Map as Map
+
import Ganeti.BasicTypes
+import Ganeti.HTools.JSON
import Ganeti.Qlang
+import Ganeti.Query.Common
+import Ganeti.Query.Types
+import Ganeti.Query.Node
import Ganeti.Objects
+-- * Helper functions
+
+-- | Builds an unknown field definition.
+mkUnknownFDef :: String -> FieldData a b
+mkUnknownFDef name =
+ ( FieldDefinition name name QFTUnknown ("Unknown field '" ++ name ++ "'")
+ , FieldUnknown )
+
+-- | Runs a field getter on the existing contexts.
+execGetter :: ConfigData -> b -> a -> FieldGetter a b -> ResultEntry
+execGetter _ _ item (FieldSimple getter) = getter item
+execGetter cfg _ item (FieldConfig getter) = getter cfg item
+execGetter _ rt item (FieldRuntime getter) = getter rt item
+execGetter _ _ _ FieldUnknown = rsUnknown
+
+-- * Main query execution
+
+-- | Helper to build the list of requested fields. This transforms the
+-- list of string fields to a list of field defs and getters, with
+-- some of them possibly being unknown fields.
+getSelectedFields :: FieldMap a b -- ^ Defined fields
+ -> [String] -- ^ Requested fields
+ -> FieldList a b -- ^ Selected fields
+getSelectedFields defined =
+ map (\name -> fromMaybe (mkUnknownFDef name) $ name `Map.lookup` defined)
+
-- | Main query execution function.
query :: ConfigData -- ^ The current configuration
-> Query -- ^ The query (item, fields, filter)
-> IO (Result QueryResult) -- ^ Result
+
+query cfg (Query QRNode fields _) = return $ do
+ let selected = getSelectedFields nodeFieldsMap fields
+ (fdefs, fgetters) = unzip selected
+ nodes = Map.elems . fromContainer $ configNodes cfg
+ fdata = map (\node -> map (execGetter cfg NodeRuntime node) fgetters)
+ nodes
+ return QueryResult { qresFields = fdefs, qresData = fdata }
+
query _ (Query qkind _ _) =
return . Bad $ "Query '" ++ show qkind ++ "' not supported"
diff --git a/htools/Ganeti/Query/Types.hs b/htools/Ganeti/Query/Types.hs
new file mode 100644
index 0000000000000000000000000000000000000000..b3bfde7b367030748f47a122bcf5fc5487cb6657
--- /dev/null
+++ b/htools/Ganeti/Query/Types.hs
@@ -0,0 +1,54 @@
+{-| Implementation of the Ganeti Query2 basic types.
+
+These are types internal to the library, and for example clients that
+use the library should not need to import it.
+
+ -}
+
+{-
+
+Copyright (C) 2012 Google Inc.
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+02110-1301, USA.
+
+-}
+
+module Ganeti.Query.Types where
+
+import qualified Data.Map as Map
+
+import Ganeti.Qlang
+import Ganeti.Objects
+
+-- | The type of field getters. The \"a\" type represents the type
+-- we're querying, whereas the \"b\" type represents the \'runtime\'
+-- data for that type (if any). Note that we don't support multiple
+-- runtime sources, and we always consider the entire configuration as
+-- a given (so no equivalent for Python's /*_CONFIG/ and /*_GROUP/;
+-- configuration accesses are cheap for us).
+data FieldGetter a b = FieldSimple (a -> ResultEntry)
+ | FieldRuntime (b -> a -> ResultEntry)
+ | FieldConfig (ConfigData -> a -> ResultEntry)
+ | FieldUnknown
+
+-- | Alias for a field data (definition and getter).
+type FieldData a b = (FieldDefinition, FieldGetter a b)
+
+-- | Alias for a field data list.
+type FieldList a b = [FieldData a b]
+
+-- | Alias for field maps.
+type FieldMap a b = Map.Map String (FieldData a b)