This is the beginning of the implementation of network queries. This includes establishing all infrastructure to run the network queries and implement querying of some simpler fields and the node group listing.
Signed-off-by: Helga Velroyen <[email protected]> --- Makefile.am | 1 + src/Ganeti/Config.hs | 46 ++++++++++++++++++++++++++++ src/Ganeti/Query/Language.hs | 1 + src/Ganeti/Query/Network.hs | 72 ++++++++++++++++++++++++++++++++++++++++++++ src/Ganeti/Query/Query.hs | 18 ++++++++++- 5 files changed, 137 insertions(+), 1 deletion(-) create mode 100644 src/Ganeti/Query/Network.hs diff --git a/Makefile.am b/Makefile.am index 792c526..e4f0f0d 100644 --- a/Makefile.am +++ b/Makefile.am @@ -529,6 +529,7 @@ HS_LIB_SRCS = \ src/Ganeti/Query/Group.hs \ src/Ganeti/Query/Job.hs \ src/Ganeti/Query/Language.hs \ + src/Ganeti/Query/Network.hs \ src/Ganeti/Query/Node.hs \ src/Ganeti/Query/Query.hs \ src/Ganeti/Query/Server.hs \ diff --git a/src/Ganeti/Config.hs b/src/Ganeti/Config.hs index 2561cb0..0b32a51 100644 --- a/src/Ganeti/Config.hs +++ b/src/Ganeti/Config.hs @@ -42,14 +42,17 @@ module Ganeti.Config , getGroupNodes , getGroupInstances , getGroupOfNode + , getGroupConnections , getInstPrimaryNode , getInstMinorsForNode + , getNetwork , buildLinkIpInstnameMap , instNodes ) where import Control.Monad (liftM) import Data.List (foldl') +import Data.Maybe (fromMaybe, mapMaybe) import qualified Data.Map as M import qualified Data.Set as S import qualified Text.JSON as J @@ -210,6 +213,49 @@ getGroupInstances cfg gname = ginsts = map (getNodeInstances cfg) gnodes in (concatMap fst ginsts, concatMap snd ginsts) +-- | Looks up a network. If looking up by uuid fails, we look up +-- by name. +getNetwork :: ConfigData -> String -> ErrorResult Network +getNetwork cfg name = + let networks = fromContainer (configNetworks cfg) + in case getItem "Network" name networks of + Ok net -> Ok net + Bad _ -> let by_name = M.mapKeys + (fromNonEmpty . networkName . (M.!) networks) + networks + in getItem "Network" name by_name + +-- | Given a network's UUID, this function lists all connections from +-- the network to nodegroups including the respective mode and links. +getGroupConnections :: ConfigData -> String -> [(String, String, String)] +getGroupConnections cfg network_uuid = + mapMaybe (getGroupConnection network_uuid) + ((M.elems . fromContainer . configNodegroups) cfg) + +-- | Given a network's UUID and a node group, this function assembles +-- a tuple of the group's name, the mode and the link by which the +-- network is connected to the group. Returns 'Nothing' if the network +-- is not connected to the group. +getGroupConnection :: String -> NodeGroup -> Maybe (String, String, String) +getGroupConnection network_uuid group = + let networks = fromContainer . groupNetworks $ group + in case M.lookup network_uuid networks of + Nothing -> Nothing + Just network -> Just (groupName group, getMode network, getLink network) + +-- | Retrieves the network's mode and formats it human-readable, +-- also in case it is not available. +getMode :: PartialNicParams -> String +getMode nic_params = + case nicpModeP nic_params of + Just mode -> nICModeToRaw mode + Nothing -> "-" + +-- | Retrieves the network's link and formats it human-readable, also in +-- case it it not available. +getLink :: PartialNicParams -> String +getLink nic_params = fromMaybe "-" (nicpLinkP nic_params) + -- | Looks up an instance's primary node. getInstPrimaryNode :: ConfigData -> String -> ErrorResult Node getInstPrimaryNode cfg name = diff --git a/src/Ganeti/Query/Language.hs b/src/Ganeti/Query/Language.hs index ae88dfd..7cc52db 100644 --- a/src/Ganeti/Query/Language.hs +++ b/src/Ganeti/Query/Language.hs @@ -113,6 +113,7 @@ $(declareSADT "QueryTypeOp" , ("QRGroup", 'C.qrGroup ) , ("QROs", 'C.qrOs ) , ("QRExport", 'C.qrExport ) + , ("QRNetwork", 'C.qrNetwork ) ]) $(makeJSONInstance ''QueryTypeOp) diff --git a/src/Ganeti/Query/Network.hs b/src/Ganeti/Query/Network.hs new file mode 100644 index 0000000..0724155 --- /dev/null +++ b/src/Ganeti/Query/Network.hs @@ -0,0 +1,72 @@ +{-| Implementation of the Ganeti Query2 node group 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.Network + ( NetworkRuntime(..) + , networkFieldsMap + ) where + +import qualified Data.Map as Map + +import Ganeti.Config +import Ganeti.Objects +import Ganeti.Query.Language +import Ganeti.Query.Common +import Ganeti.Query.Types + +data NetworkRuntime = NetworkRuntime + +networkFields :: FieldList Network NetworkRuntime +networkFields = + [ (FieldDefinition "name" "Name" QFTText "Network name", + FieldSimple (rsNormal . networkName), QffNormal) + , (FieldDefinition "network" "Subnet" QFTText "IPv4 subnet", + FieldSimple (rsNormal . networkNetwork), QffNormal) + , (FieldDefinition "gateway" "Gateway" QFTOther "IPv4 gateway", + FieldSimple (rsMaybeUnavail . networkGateway), QffNormal) + , (FieldDefinition "network6" "IPv6Subnet" QFTOther "IPv6 subnet", + FieldSimple (rsMaybeUnavail . networkNetwork6), QffNormal) + , (FieldDefinition "gateway6" "IPv6Gateway" QFTOther "IPv6 gateway", + FieldSimple (rsMaybeUnavail . networkGateway6), QffNormal) + , (FieldDefinition "mac_prefix" "MacPrefix" QFTOther "MAC address prefix", + FieldSimple (rsMaybeUnavail . networkMacPrefix), QffNormal) + , (FieldDefinition "network_type" "NetworkType" QFTOther "Network type", + FieldSimple (rsMaybeUnavail . networkNetworkType), QffNormal) + , (FieldDefinition "group_list" "GroupList" QFTOther "List of node groups", + FieldConfig (\cfg -> rsNormal . getGroupConnections cfg . networkUuid), + QffNormal) + ] ++ + uuidFields "Network" ++ + serialFields "Network" ++ + tagsFields + +-- | The group fields map. +networkFieldsMap :: FieldMap Network NetworkRuntime +networkFieldsMap = + Map.fromList $ map (\v@(f, _, _) -> (fdefName f, v)) networkFields + +-- TODO: the following fields are not implemented yet: external_reservations, +-- free_count, group_cnt, inst_cnt, inst_list, map, reserved_count, serial_no, +-- tags, uuid diff --git a/src/Ganeti/Query/Query.hs b/src/Ganeti/Query/Query.hs index ffdebf8..515d6d4 100644 --- a/src/Ganeti/Query/Query.hs +++ b/src/Ganeti/Query/Query.hs @@ -71,6 +71,7 @@ import Ganeti.Query.Filter import qualified Ganeti.Query.Job as Query.Job import Ganeti.Query.Group import Ganeti.Query.Language +import Ganeti.Query.Network import Ganeti.Query.Node import Ganeti.Query.Types import Ganeti.Path @@ -197,7 +198,22 @@ queryInner cfg _ (Query (ItemTypeOpCode QRGroup) fields qfilter) wanted = fgroups <- filterM (\n -> evaluateFilter cfg Nothing n cfilter) groups let fdata = map (\node -> map (execGetter cfg GroupRuntime node) fgetters) fgroups - return QueryResult {qresFields = fdefs, qresData = fdata } + return QueryResult { qresFields = fdefs, qresData = fdata } + +queryInner cfg _ (Query (ItemTypeOpCode QRNetwork) fields qfilter) wanted = + return $ do + cfilter <- compileFilter networkFieldsMap qfilter + let selected = getSelectedFields networkFieldsMap fields + (fdefs, fgetters, _) = unzip3 selected + networks <- case wanted of + [] -> Ok . niceSortKey (fromNonEmpty . networkName) . + Map.elems . fromContainer $ configNetworks cfg + _ -> mapM (getNetwork cfg) wanted + fnetworks <- filterM (\n -> evaluateFilter cfg Nothing n cfilter) networks + let fdata = map (\network -> + map (execGetter cfg NetworkRuntime network) fgetters) + fnetworks + return QueryResult { qresFields = fdefs, qresData = fdata } queryInner _ _ (Query qkind _ _) _ = return . Bad . GenericError $ "Query '" ++ show qkind ++ "' not supported" -- 1.8.1
