Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / Query / Network.hs @ bac48afe

History | View | Annotate | Download (7.1 kB)

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))