code.grnet.gr Git - ganeti-local/blob - src/Ganeti/Query/Network.hs

   1 {-| Implementation of the Ganeti Query2 node group queries.
   2
   3  -}
   4
   5 {-
   6
   7 Copyright (C) 2012, 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.Network
  27   ( getGroupConnection
  28   , getNetworkUuid
  29   , instIsConnected
  30   , Runtime
  31   , fieldsMap
  32   , collectLiveData
  33   ) where
  34
  35 -- FIXME: everything except Runtime(..) and fieldsMap
  36 -- is only exported for testing.
  37
  38 import qualified Data.Map as Map
  39 import Data.Maybe (fromMaybe, mapMaybe)
  40 import Data.List (find, foldl', intercalate)
  41
  42 import Ganeti.JSON
  43 import Ganeti.Network
  44 import Ganeti.Objects
  45 import Ganeti.Query.Language
  46 import Ganeti.Query.Common
  47 import Ganeti.Query.Types
  48 import Ganeti.Types
  49
  50 -- | There is no actual runtime.
  51 data Runtime = Runtime
  52
  53 networkFields :: FieldList Network Runtime
  54 networkFields =
  55   [ (FieldDefinition "name" "Network" QFTText "Name",
  56      FieldSimple (rsNormal . networkName), QffNormal)
  57   , (FieldDefinition "network" "Subnet" QFTText "IPv4 subnet",
  58      FieldSimple (rsNormal . networkNetwork), QffNormal)
  59   , (FieldDefinition "gateway" "Gateway" QFTOther "IPv4 gateway",
  60      FieldSimple (rsMaybeUnavail . networkGateway), QffNormal)
  61   , (FieldDefinition "network6" "IPv6Subnet" QFTOther "IPv6 subnet",
  62      FieldSimple (rsMaybeUnavail . networkNetwork6), QffNormal)
  63   , (FieldDefinition "gateway6" "IPv6Gateway" QFTOther "IPv6 gateway",
  64      FieldSimple (rsMaybeUnavail . networkGateway6), QffNormal)
  65   , (FieldDefinition "mac_prefix" "MacPrefix" QFTOther "MAC address prefix",
  66      FieldSimple (rsMaybeUnavail . networkMacPrefix), QffNormal)
  67   , (FieldDefinition "free_count" "FreeCount" QFTNumber "Number of available\
  68                                                        \ addresses",
  69      FieldSimple (rsMaybeNoData . fmap getFreeCount . createAddressPool),
  70      QffNormal)
  71   , (FieldDefinition "map" "Map" QFTText "Actual mapping",
  72      FieldSimple (rsMaybeNoData . fmap getMap . createAddressPool),
  73      QffNormal)
  74   , (FieldDefinition "reserved_count" "ReservedCount" QFTNumber
  75        "Number of reserved addresses",
  76      FieldSimple (rsMaybeNoData . fmap getReservedCount . createAddressPool),
  77      QffNormal)
  78   , (FieldDefinition "group_list" "GroupList" QFTOther
  79        "List of nodegroups (group name, NIC mode, NIC link)",
  80      FieldConfig (\cfg -> rsNormal . getGroupConnections cfg . networkUuid),
  81      QffNormal)
  82   , (FieldDefinition "group_cnt" "NodeGroups" QFTNumber "Number of nodegroups",
  83      FieldConfig (\cfg -> rsNormal . length . getGroupConnections cfg
  84        . networkUuid), QffNormal)
  85   , (FieldDefinition "inst_list" "InstanceList" QFTOther "List of instances",
  86      FieldConfig (\cfg -> rsNormal . getInstances cfg . networkUuid),
  87      QffNormal)
  88   , (FieldDefinition "inst_cnt" "Instances" QFTNumber "Number of instances",
  89      FieldConfig (\cfg -> rsNormal . length . getInstances cfg
  90        . networkUuid), QffNormal)
  91   , (FieldDefinition "external_reservations" "ExternalReservations" QFTText
  92      "External reservations",
  93      FieldSimple getExtReservationsString, QffNormal)
  94   ] ++
  95   uuidFields "Network" ++
  96   serialFields "Network" ++
  97   tagsFields
  98
  99 -- | The group fields map.
 100 fieldsMap :: FieldMap Network Runtime
 101 fieldsMap =
 102   Map.fromList $ map (\v@(f, _, _) -> (fdefName f, v)) networkFields
 103
 104 -- TODO: the following fields are not implemented yet: external_reservations
 105
 106 -- | Given a network's UUID, this function lists all connections from
 107 -- the network to nodegroups including the respective mode and links.
 108 getGroupConnections :: ConfigData -> String -> [(String, String, String)]
 109 getGroupConnections cfg network_uuid =
 110   mapMaybe (getGroupConnection network_uuid)
 111   ((Map.elems . fromContainer . configNodegroups) cfg)
 112
 113 -- | Given a network's UUID and a node group, this function assembles
 114 -- a tuple of the group's name, the mode and the link by which the
 115 -- network is connected to the group. Returns 'Nothing' if the network
 116 -- is not connected to the group.
 117 getGroupConnection :: String -> NodeGroup -> Maybe (String, String, String)
 118 getGroupConnection network_uuid group =
 119   let networks = fromContainer . groupNetworks $ group
 120   in case Map.lookup network_uuid networks of
 121     Nothing -> Nothing
 122     Just net ->
 123       Just (groupName group, getNicMode net, getNicLink net)
 124
 125 -- | Retrieves the network's mode and formats it human-readable,
 126 -- also in case it is not available.
 127 getNicMode :: PartialNicParams -> String
 128 getNicMode nic_params =
 129   maybe "-" nICModeToRaw $ nicpModeP nic_params
 130
 131 -- | Retrieves the network's link and formats it human-readable, also in
 132 -- case it it not available.
 133 getNicLink :: PartialNicParams -> String
 134 getNicLink nic_params = fromMaybe "-" (nicpLinkP nic_params)
 135
 136 -- | Retrieves the network's instances' names.
 137 getInstances :: ConfigData -> String -> [String]
 138 getInstances cfg network_uuid =
 139   map instName (filter (instIsConnected cfg network_uuid)
 140     ((Map.elems . fromContainer . configInstances) cfg))
 141
 142 -- | Helper function that checks if an instance is linked to the given network.
 143 instIsConnected :: ConfigData -> String -> Instance -> Bool
 144 instIsConnected cfg network_uuid inst =
 145   network_uuid `elem` mapMaybe (getNetworkUuid cfg)
 146     (mapMaybe nicNetwork (instNics inst))
 147
 148 -- | Helper function to look up a network's UUID by its name
 149 getNetworkUuid :: ConfigData -> String -> Maybe String
 150 getNetworkUuid cfg name =
 151   let net = find (\n -> name == fromNonEmpty (networkName n))
 152                ((Map.elems . fromContainer . configNetworks) cfg)
 153   in fmap networkUuid net
 154
 155 -- | Computes the reservations list for a network.
 156 --
 157 -- This doesn't use the netmask for validation of the length, instead
 158 -- simply iterating over the reservations string.
 159 getReservations :: Ip4Network -> String -> [Ip4Address]
 160 getReservations (Ip4Network net _) =
 161   reverse .
 162   fst .
 163   foldl' (\(accu, addr) c ->
 164             let addr' = nextIp4Address addr
 165                 accu' = case c of
 166                           '1' -> addr:accu
 167                           '0' -> accu
 168                           _ -> -- FIXME: the reservations string
 169                                -- should be a proper type
 170                                accu
 171             in (accu', addr')) ([], net)
 172
 173 -- | Computes the external reservations as string for a network.
 174 getExtReservationsString :: Network -> ResultEntry
 175 getExtReservationsString net =
 176   let addrs = getReservations (networkNetwork net)
 177               (fromMaybe "" $ networkExtReservations net)
 178   in rsNormal . intercalate ", " $ map show addrs
 179
 180 -- | Dummy function for collecting live data (which networks don't have).
 181 collectLiveData :: Bool -> ConfigData -> [Network] -> IO [(Network, Runtime)]
 182 collectLiveData _ _ = return . map (\n -> (n, Runtime))