Revision c4bf507b

b/Makefile.am
540 540
	src/Ganeti/OpParams.hs \
541 541
	src/Ganeti/Path.hs \
542 542
	src/Ganeti/Query/Common.hs \
543
	src/Ganeti/Query/Export.hs \
543 544
	src/Ganeti/Query/Filter.hs \
544 545
	src/Ganeti/Query/Group.hs \
545 546
	src/Ganeti/Query/Job.hs \
b/src/Ganeti/Query/Export.hs
1
{-| Implementation of the Ganeti Query2 export queries.
2

  
3
 -}
4

  
5
{-
6

  
7
Copyright (C) 2013 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.Export
27
  ( Runtime
28
  , fieldsMap
29
  , collectLiveData
30
  ) where
31

  
32
import Control.Monad (liftM)
33
import qualified Data.Map as Map
34

  
35
import Ganeti.Objects
36
import Ganeti.Rpc
37
import Ganeti.Query.Language
38
import Ganeti.Query.Common
39
import Ganeti.Query.Types
40

  
41
-- | The parsed result of the ExportList. This is a bit tricky, in
42
-- that we already do parsing of the results in the RPC calls, so the
43
-- runtime type is a plain 'ResultEntry', as we have just one type.
44
type Runtime = ResultEntry
45

  
46
-- | Small helper for rpc to rs.
47
rpcErrToRs :: RpcError -> ResultEntry
48
rpcErrToRs err = ResultEntry (rpcErrorToStatus err) Nothing
49

  
50
-- | Helper for extracting fields from RPC result.
51
rpcExtractor :: Node -> Either RpcError RpcResultExportList
52
             -> [(Node, ResultEntry)]
53
rpcExtractor node (Right res) =
54
  [(node, rsNormal path) | path <- rpcResExportListExports res]
55
rpcExtractor node (Left err)  = [(node, rpcErrToRs err)]
56

  
57
-- | List of all node fields.
58
exportFields :: FieldList Node Runtime
59
exportFields =
60
  [ (FieldDefinition "node" "Node" QFTText "Node name",
61
     FieldSimple (rsNormal . nodeName), QffNormal)
62
  , (FieldDefinition "export" "Export" QFTText "Export name",
63
     FieldRuntime (curry fst), QffNormal)
64
  ]
65

  
66
-- | The node fields map.
67
fieldsMap :: FieldMap Node Runtime
68
fieldsMap =
69
  Map.fromList $ map (\v@(f, _, _) -> (fdefName f, v)) exportFields
70

  
71
-- | Collect live data from RPC query if enabled.
72
--
73
-- Note that this function is \"funny\": the returned rows will not be
74
-- 1:1 with the input, as nodes without exports will be pruned,
75
-- whereas nodes with multiple exports will be listed multiple times.
76
collectLiveData:: Bool -> ConfigData -> [Node] -> IO [(Node, Runtime)]
77
collectLiveData False _ nodes =
78
  return [(n, rpcErrToRs $ RpcResultError "Live data disabled") | n <- nodes]
79
collectLiveData True _ nodes =
80
  concatMap (uncurry rpcExtractor) `liftM`
81
    executeRpcCall nodes RpcCallExportList
b/src/Ganeti/Query/Query.hs
4 4

  
5 5
{-
6 6

  
7
Copyright (C) 2012 Google Inc.
7
Copyright (C) 2012, 2013 Google Inc.
8 8

  
9 9
This program is free software; you can redistribute it and/or modify
10 10
it under the terms of the GNU General Public License as published by
......
67 67
import Ganeti.JSON
68 68
import Ganeti.Objects
69 69
import Ganeti.Query.Common
70
import qualified Ganeti.Query.Export as Export
70 71
import Ganeti.Query.Filter
71 72
import qualified Ganeti.Query.Job as Query.Job
72 73
import Ganeti.Query.Group
......
117 118
-- | Computes the name field for different query types.
118 119
nameField :: ItemType -> FilterField
119 120
nameField (ItemTypeLuxi QRJob) = "id"
121
nameField (ItemTypeOpCode QRExport) = "node"
120 122
nameField _ = "name"
121 123

  
122 124
-- | Extracts all quoted strings from a list, ignoring the
......
215 217
                   fnetworks
216 218
  return QueryResult { qresFields = fdefs, qresData = fdata }
217 219

  
220
queryInner cfg live (Query (ItemTypeOpCode QRExport) fields qfilter) wanted =
221
  runResultT $ do
222
  cfilter <- resultT $ compileFilter Export.fieldsMap qfilter
223
  let selected = getSelectedFields Export.fieldsMap fields
224
      (fdefs, fgetters, _) = unzip3 selected
225
      -- we alwyas have live queries in exports, but we keep this for
226
      -- standard style (in case we add static fields in the future)
227
      live' = live && needsLiveData fgetters
228
  nodes <- resultT $ case wanted of
229
             [] -> Ok . niceSortKey nodeName .
230
                   Map.elems . fromContainer $ configNodes cfg
231
             _  -> mapM (getNode cfg) wanted
232
  -- runs first pass of the filter, without a runtime context; this
233
  -- will limit the nodes that we'll contact for exports
234
  fnodes <- resultT $ filterM (\n -> evaluateFilter cfg Nothing n cfilter)
235
                      nodes
236
  -- here we would run the runtime data gathering...
237
  nruntimes <- lift $ Export.collectLiveData live' cfg fnodes
238
  -- ... then filter again the results, based on existing export
239
  -- names, but note that no client sends filters on the export list
240
  -- today, so it's likely a no-oop
241
  let fdata = map (\(node, nrt) -> map (execGetter cfg nrt node) fgetters)
242
              nruntimes
243
  return QueryResult { qresFields = fdefs, qresData = fdata }
244

  
218 245
queryInner _ _ (Query qkind _ _) _ =
219 246
  return . Bad . GenericError $ "Query '" ++ show qkind ++ "' not supported"
220 247

  
......
289 316
queryFields (QueryFields (ItemTypeLuxi QRJob) fields) =
290 317
  Ok $ fieldsExtractor Query.Job.fieldsMap fields
291 318

  
319
queryFields (QueryFields (ItemTypeOpCode QRExport) fields) =
320
  Ok $ fieldsExtractor Export.fieldsMap fields
321

  
292 322
queryFields (QueryFields qkind _) =
293 323
  Bad . GenericError $ "QueryFields '" ++ show qkind ++ "' not supported"
294 324

  

Also available in: Unified diff