Revision 046fe3f5

b/Makefile.am
416 416
	htools/Ganeti/OpCodes.hs \
417 417
	htools/Ganeti/Rpc.hs \
418 418
	htools/Ganeti/Qlang.hs \
419
	htools/Ganeti/Query/Common.hs \
420
	htools/Ganeti/Query/Node.hs \
419 421
	htools/Ganeti/Query/Query.hs \
422
	htools/Ganeti/Query/Types.hs \
420 423
	htools/Ganeti/Queryd.hs \
421 424
	htools/Ganeti/Runtime.hs \
422 425
	htools/Ganeti/Ssconf.hs \
b/htools/Ganeti/Qlang.hs
33 33
    , QueryResult(..)
34 34
    , QueryFields(..)
35 35
    , QueryFieldsResult(..)
36
    , FieldName
37
    , FieldTitle
36 38
    , FieldType(..)
39
    , FieldDoc
37 40
    , FieldDefinition(..)
38 41
    , ResultEntry(..)
39 42
    , ResultStatus(..)
43
    , ResultValue
40 44
    , ItemType(..)
41 45
    , checkRS
42 46
    ) where
b/htools/Ganeti/Query/Common.hs
1
{-| Implementation of the Ganeti Query2 common objects.
2

  
3
 -}
4

  
5
{-
6

  
7
Copyright (C) 2012 Google Inc.
8

  
9
This program is free software; you can redistribute it and/or modify
10
it under the terms of the GNU General Public License as published by
11
the Free Software Foundation; either version 2 of the License, or
12
(at your option) any later version.
13

  
14
This program is distributed in the hope that it will be useful, but
15
WITHOUT ANY WARRANTY; without even the implied warranty of
16
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
17
General Public License for more details.
18

  
19
You should have received a copy of the GNU General Public License
20
along with this program; if not, write to the Free Software
21
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
22
02110-1301, USA.
23

  
24
-}
25

  
26
module Ganeti.Query.Common
27
  ( rsNoData
28
  , rsNormal
29
  , rsMaybe
30
  , rsUnknown
31
  , missingRuntime
32
  , timeStampFields
33
  , uuidFields
34
  , serialFields
35
  , tagsFields
36
  , dictFieldGetter
37
  , buildQFTLookup
38
  , buildNdParamField
39
  ) where
40

  
41
import qualified Data.Map as Map
42
import Data.Maybe (fromMaybe)
43
import Text.JSON (JSON, showJSON)
44

  
45
import qualified Ganeti.Constants as C
46
import Ganeti.Config
47
import Ganeti.Objects
48
import Ganeti.Qlang
49
import Ganeti.Query.Types
50

  
51
-- * Generic functions
52

  
53
-- | Conversion from 'VType' to 'FieldType'.
54
vTypeToQFT :: VType -> FieldType
55
vTypeToQFT VTypeString      = QFTOther
56
vTypeToQFT VTypeMaybeString = QFTOther
57
vTypeToQFT VTypeBool        = QFTBool
58
vTypeToQFT VTypeSize        = QFTUnit
59
vTypeToQFT VTypeInt         = QFTNumber
60

  
61
-- * Result helpers
62

  
63
-- | Helper for a result with no data.
64
rsNoData :: ResultEntry
65
rsNoData = ResultEntry RSNoData Nothing
66

  
67
-- | Helper to declare a normal result.
68
rsNormal :: (JSON a) => a -> ResultEntry
69
rsNormal a = ResultEntry RSNormal $ Just (showJSON a)
70

  
71
-- | Helper to declare a result from a 'Maybe' (the item might be
72
-- missing, in which case we return no data). Note that there's some
73
-- ambiguity here: in some cases, we mean 'RSNoData', but in other
74
-- 'RSUnavail'; this is easy to solve in simple cases, but not in
75
-- nested dicts.
76
rsMaybe :: (JSON a) => Maybe a -> ResultEntry
77
rsMaybe = maybe rsNoData rsNormal
78

  
79
-- | Helper for unknown field result.
80
rsUnknown :: ResultEntry
81
rsUnknown = ResultEntry RSUnknown Nothing
82

  
83
-- | Helper for a missing runtime parameter.
84
missingRuntime :: FieldGetter a b
85
missingRuntime = FieldRuntime (\_ _ -> ResultEntry RSNoData Nothing)
86

  
87
-- * Common fields
88

  
89
-- | The list of timestamp fields.
90
timeStampFields :: (TimeStampObject a) => FieldList a b
91
timeStampFields =
92
  [ (FieldDefinition "ctime" "CTime" QFTTimestamp "Creation timestamp",
93
     FieldSimple (rsNormal . cTimeOf))
94
  , (FieldDefinition "mtime" "MTime" QFTTimestamp "Modification timestamp",
95
     FieldSimple (rsNormal . mTimeOf))
96
  ]
97

  
98
-- | The list of UUID fields.
99
uuidFields :: (UuidObject a) => String -> FieldList a b
100
uuidFields name =
101
  [ (FieldDefinition "uuid" "UUID" QFTText  (name ++ " UUID"),
102
     FieldSimple (rsNormal . uuidOf)) ]
103

  
104
-- | The list of serial number fields.
105
serialFields :: (SerialNoObject a) => String -> FieldList a b
106
serialFields name =
107
  [ (FieldDefinition "serial_no" "SerialNo" QFTNumber
108
     (name ++ " object serial number, incremented on each modification"),
109
     FieldSimple (rsNormal . serialOf)) ]
110

  
111
-- | The list of tag fields.
112
tagsFields :: (TagsObject a) => FieldList a b
113
tagsFields =
114
  [ (FieldDefinition "tags" "Tags" QFTOther "Tags",
115
     FieldSimple (rsNormal . tagsOf)) ]
116

  
117
-- * Generic parameter functions
118

  
119
-- | Returns a field from a (possibly missing) 'DictObject'. This is
120
-- used by parameter dictionaries, usually. Note that we have two
121
-- levels of maybe: the top level dict might be missing, or one key in
122
-- the dictionary might be.
123
dictFieldGetter :: (DictObject a) => String -> Maybe a -> ResultEntry
124
dictFieldGetter k = maybe rsNoData (rsMaybe . lookup k . toDict)
125

  
126
-- | Build an optimised lookup map from a Python _PARAMETER_TYPES
127
-- association list.
128
buildQFTLookup :: [(String, String)] -> Map.Map String FieldType
129
buildQFTLookup =
130
  Map.fromList .
131
  map (\(k, v) -> (k, maybe QFTOther vTypeToQFT (vTypeFromRaw v)))
132

  
133
-- | Ndparams optimised lookup map.
134
ndParamTypes :: Map.Map String FieldType
135
ndParamTypes = buildQFTLookup C.ndsParameterTypes
136

  
137
-- | Ndparams title map.
138
ndParamTitles :: Map.Map String FieldTitle
139
ndParamTitles = Map.fromList C.ndsParameterTitles
140

  
141
-- | Ndparam getter builder: given a field, it returns a FieldConfig
142
-- getter, that is a function that takes the config and the object and
143
-- returns the Ndparam field specified when the getter was built.
144
ndParamGetter :: (NdParamObject a) =>
145
                 String -- ^ The field we're building the getter for
146
              -> ConfigData -> a -> ResultEntry
147
ndParamGetter field config =
148
  dictFieldGetter field . getNdParamsOf config
149

  
150
-- | Builds the ndparam fields for an object.
151
buildNdParamField :: (NdParamObject a) => String -> FieldData a b
152
buildNdParamField field =
153
  let full_name = "ndp/" ++ field
154
      title = fromMaybe field $ field `Map.lookup` ndParamTitles
155
      qft = fromMaybe QFTOther $ field `Map.lookup` ndParamTypes
156
      desc = "The \"" ++ field ++ "\" node parameter"
157
  in (FieldDefinition full_name title qft desc,
158
      FieldConfig (ndParamGetter field))
b/htools/Ganeti/Query/Node.hs
1
{-| Implementation of the Ganeti Query2 node queries.
2

  
3
 -}
4

  
5
{-
6

  
7
Copyright (C) 2012 Google Inc.
8

  
9
This program is free software; you can redistribute it and/or modify
10
it under the terms of the GNU General Public License as published by
11
the Free Software Foundation; either version 2 of the License, or
12
(at your option) any later version.
13

  
14
This program is distributed in the hope that it will be useful, but
15
WITHOUT ANY WARRANTY; without even the implied warranty of
16
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
17
General Public License for more details.
18

  
19
You should have received a copy of the GNU General Public License
20
along with this program; if not, write to the Free Software
21
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
22
02110-1301, USA.
23

  
24
-}
25

  
26
module Ganeti.Query.Node
27
  ( NodeRuntime(..)
28
  , nodeFieldsMap
29
  ) where
30

  
31
import Control.Applicative
32
import Data.List
33
import qualified Data.Map as Map
34

  
35
import Ganeti.Config
36
import Ganeti.Objects
37
import Ganeti.Qlang
38
import Ganeti.Query.Common
39
import Ganeti.Query.Types
40

  
41
-- | Stub data type until we integrate the RPC.
42
data NodeRuntime = NodeRuntime
43

  
44
-- | List of node live fields, all ignored for now (no RPC).
45
nodeLiveFieldsDefs :: [(FieldName, FieldTitle, FieldType, String, FieldDoc)]
46
nodeLiveFieldsDefs =
47
  [ ("bootid", "BootID", QFTText, "bootid",
48
     "Random UUID renewed for each system reboot, can be used\
49
     \ for detecting reboots by tracking changes")
50
  , ("cnodes", "CNodes", QFTNumber, "cpu_nodes",
51
     "Number of NUMA domains on node (if exported by hypervisor)")
52
  , ("csockets", "CSockets", QFTNumber, "cpu_sockets",
53
     "Number of physical CPU sockets (if exported by hypervisor)")
54
  , ("ctotal", "CTotal", QFTNumber, "cpu_total",
55
     "Number of logical processors")
56
  , ("dfree", "DFree", QFTUnit, "vg_free",
57
     "Available disk space in volume group")
58
  , ("dtotal", "DTotal", QFTUnit, "vg_size",
59
     "Total disk space in volume group used for instance disk allocation")
60
  , ("mfree", "MFree", QFTUnit, "memory_free",
61
     "Memory available for instance allocations")
62
  , ("mnode", "MNode", QFTUnit, "memory_dom0",
63
     "Amount of memory used by node (dom0 for Xen)")
64
  , ("mtotal", "MTotal", QFTUnit, "memory_total",
65
     "Total amount of memory of physical machine")
66
  ]
67

  
68
-- | Builder for node live fields.
69
nodeLiveFieldBuilder :: (FieldName, FieldTitle, FieldType, String, FieldDoc)
70
                     -> FieldData Node NodeRuntime
71
nodeLiveFieldBuilder (fname, ftitle, ftype, _, fdoc) =
72
  (FieldDefinition fname ftitle ftype fdoc, missingRuntime)
73

  
74
-- | The docstring for the node role. Note that we use 'reverse in
75
-- order to keep the same order as Python.
76
nodeRoleDoc :: String
77
nodeRoleDoc =
78
  "Node role; " ++
79
  (intercalate ", " $
80
   map (\role ->
81
          "\"" ++ nodeRoleToRaw role ++ "\" for " ++ roleDescription role)
82
   (reverse [minBound..maxBound]))
83

  
84
-- | List of all node fields.
85
nodeFields :: FieldList Node NodeRuntime
86
nodeFields =
87
  [ (FieldDefinition "drained" "Drained" QFTBool "Whether node is drained",
88
     FieldSimple (rsNormal . nodeDrained))
89
  , (FieldDefinition "master_candidate" "MasterC" QFTBool
90
       "Whether node is a master candidate",
91
     FieldSimple (rsNormal . nodeMasterCandidate))
92
  , (FieldDefinition "master_capable" "MasterCapable" QFTBool
93
       "Whether node can become a master candidate",
94
     FieldSimple (rsNormal . nodeMasterCapable))
95
  , (FieldDefinition "name" "Node" QFTText "Node name",
96
     FieldSimple (rsNormal . nodeName))
97
  , (FieldDefinition "offline" "Offline" QFTBool
98
       "Whether node is marked offline",
99
     FieldSimple (rsNormal . nodeOffline))
100
  , (FieldDefinition "vm_capable" "VMCapable" QFTBool
101
       "Whether node can host instances",
102
     FieldSimple (rsNormal . nodeVmCapable))
103
  , (FieldDefinition "pip" "PrimaryIP" QFTText "Primary IP address",
104
     FieldSimple (rsNormal . nodePrimaryIp))
105
  , (FieldDefinition "sip" "SecondaryIP" QFTText "Secondary IP address",
106
     FieldSimple (rsNormal . nodeSecondaryIp))
107
  , (FieldDefinition "master" "IsMaster" QFTBool "Whether node is master",
108
     FieldConfig (\cfg node ->
109
                    rsNormal (nodeName node ==
110
                              clusterMasterNode (configCluster cfg))))
111
  , (FieldDefinition "group" "Group" QFTText "Node group",
112
     FieldConfig (\cfg node ->
113
                    rsMaybe (groupName <$> getGroupOfNode cfg node)))
114
  , (FieldDefinition "group.uuid" "GroupUUID" QFTText "UUID of node group",
115
     FieldSimple (rsNormal . nodeGroup))
116
  ,  (FieldDefinition "ndparams" "NodeParameters" QFTOther
117
        "Merged node parameters",
118
      FieldConfig ((rsMaybe .) . getNodeNdParams))
119
  , (FieldDefinition "custom_ndparams" "CustomNodeParameters" QFTOther
120
                       "Custom node parameters",
121
     FieldSimple (rsNormal . nodeNdparams))
122
  -- FIXME: the below could be generalised a bit, like in Python
123
  , (FieldDefinition "pinst_cnt" "Pinst" QFTNumber
124
       "Number of instances with this node as primary",
125
     FieldConfig (\cfg ->
126
                    rsNormal . length . fst . getNodeInstances cfg . nodeName))
127
  , (FieldDefinition "sinst_cnt" "Sinst" QFTNumber
128
       "Number of instances with this node as secondary",
129
     FieldConfig (\cfg ->
130
                    rsNormal . length . snd . getNodeInstances cfg . nodeName))
131
  , (FieldDefinition "pinst_list" "PriInstances" QFTNumber
132
       "List of instances with this node as primary",
133
     FieldConfig (\cfg -> rsNormal . map instName . fst .
134
                          getNodeInstances cfg . nodeName))
135
  , (FieldDefinition "sinst_list" "SecInstances" QFTNumber
136
       "List of instances with this node as secondary",
137
     FieldConfig (\cfg -> rsNormal . map instName . snd .
138
                          getNodeInstances cfg . nodeName))
139
  , (FieldDefinition "role" "Role" QFTText nodeRoleDoc,
140
     FieldConfig ((rsNormal .) . getNodeRole))
141
  -- FIXME: the powered state is special (has an different context,
142
  -- not runtime) in Python
143
  , (FieldDefinition "powered" "Powered" QFTBool
144
       "Whether node is thought to be powered on",
145
     missingRuntime)
146
  -- FIXME: the two fields below are incomplete in Python, part of the
147
  -- non-implemented node resource model; they are declared just for
148
  -- parity, but are not functional
149
  , (FieldDefinition "hv_state" "HypervisorState" QFTOther "Hypervisor state",
150
     missingRuntime)
151
  , (FieldDefinition "disk_state" "DiskState" QFTOther "Disk state",
152
     missingRuntime)
153
  ] ++
154
  map nodeLiveFieldBuilder nodeLiveFieldsDefs ++
155
  map buildNdParamField allNDParamFields ++
156
  timeStampFields ++
157
  uuidFields "Node" ++
158
  serialFields "Node" ++
159
  tagsFields
160

  
161
-- | The node fields map.
162
nodeFieldsMap :: FieldMap Node NodeRuntime
163
nodeFieldsMap = Map.fromList $ map (\v -> (fdefName (fst v), v)) nodeFields
b/htools/Ganeti/Query/Query.hs
27 27
    ( query
28 28
    ) where
29 29

  
30
import Data.Maybe (fromMaybe)
31
import qualified Data.Map as Map
32

  
30 33
import Ganeti.BasicTypes
34
import Ganeti.HTools.JSON
31 35
import Ganeti.Qlang
36
import Ganeti.Query.Common
37
import Ganeti.Query.Types
38
import Ganeti.Query.Node
32 39
import Ganeti.Objects
33 40

  
41
-- * Helper functions
42

  
43
-- | Builds an unknown field definition.
44
mkUnknownFDef :: String -> FieldData a b
45
mkUnknownFDef name =
46
  ( FieldDefinition name name QFTUnknown ("Unknown field '" ++ name ++ "'")
47
  , FieldUnknown )
48

  
49
-- | Runs a field getter on the existing contexts.
50
execGetter :: ConfigData -> b -> a -> FieldGetter a b -> ResultEntry
51
execGetter _   _ item (FieldSimple getter)  = getter item
52
execGetter cfg _ item (FieldConfig getter)  = getter cfg item
53
execGetter _  rt item (FieldRuntime getter) = getter rt item
54
execGetter _   _ _    FieldUnknown          = rsUnknown
55

  
56
-- * Main query execution
57

  
58
-- | Helper to build the list of requested fields. This transforms the
59
-- list of string fields to a list of field defs and getters, with
60
-- some of them possibly being unknown fields.
61
getSelectedFields :: FieldMap a b  -- ^ Defined fields
62
                  -> [String]      -- ^ Requested fields
63
                  -> FieldList a b -- ^ Selected fields
64
getSelectedFields defined =
65
  map (\name -> fromMaybe (mkUnknownFDef name) $ name `Map.lookup` defined)
66

  
34 67
-- | Main query execution function.
35 68
query :: ConfigData   -- ^ The current configuration
36 69
      -> Query        -- ^ The query (item, fields, filter)
37 70
      -> IO (Result QueryResult) -- ^ Result
71

  
72
query cfg (Query QRNode fields _) = return $ do
73
  let selected = getSelectedFields nodeFieldsMap fields
74
      (fdefs, fgetters) = unzip selected
75
      nodes = Map.elems . fromContainer $ configNodes cfg
76
      fdata = map (\node -> map (execGetter cfg NodeRuntime node) fgetters)
77
              nodes
78
  return QueryResult { qresFields = fdefs, qresData = fdata }
79

  
38 80
query _ (Query qkind _ _) =
39 81
  return . Bad $ "Query '" ++ show qkind ++ "' not supported"
b/htools/Ganeti/Query/Types.hs
1
{-| Implementation of the Ganeti Query2 basic types.
2

  
3
These are types internal to the library, and for example clients that
4
use the library should not need to import it.
5

  
6
 -}
7

  
8
{-
9

  
10
Copyright (C) 2012 Google Inc.
11

  
12
This program is free software; you can redistribute it and/or modify
13
it under the terms of the GNU General Public License as published by
14
the Free Software Foundation; either version 2 of the License, or
15
(at your option) any later version.
16

  
17
This program is distributed in the hope that it will be useful, but
18
WITHOUT ANY WARRANTY; without even the implied warranty of
19
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
20
General Public License for more details.
21

  
22
You should have received a copy of the GNU General Public License
23
along with this program; if not, write to the Free Software
24
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
25
02110-1301, USA.
26

  
27
-}
28

  
29
module Ganeti.Query.Types where
30

  
31
import qualified Data.Map as Map
32

  
33
import Ganeti.Qlang
34
import Ganeti.Objects
35

  
36
-- | The type of field getters. The \"a\" type represents the type
37
-- we're querying, whereas the \"b\" type represents the \'runtime\'
38
-- data for that type (if any). Note that we don't support multiple
39
-- runtime sources, and we always consider the entire configuration as
40
-- a given (so no equivalent for Python's /*_CONFIG/ and /*_GROUP/;
41
-- configuration accesses are cheap for us).
42
data FieldGetter a b = FieldSimple  (a -> ResultEntry)
43
                     | FieldRuntime (b -> a -> ResultEntry)
44
                     | FieldConfig  (ConfigData -> a -> ResultEntry)
45
                     | FieldUnknown
46

  
47
-- | Alias for a field data (definition and getter).
48
type FieldData a b = (FieldDefinition, FieldGetter a b)
49

  
50
-- | Alias for a field data list.
51
type FieldList a b = [FieldData a b]
52

  
53
-- | Alias for field maps.
54
type FieldMap a b = Map.Map String (FieldData a b)

Also available in: Unified diff