Statistics
| Branch: | Tag: | Revision:

root / htools / Ganeti / Config.hs @ 84835174

History | View | Annotate | Download (7 kB)

1
{-| Implementation of the Ganeti configuration database.
2

    
3
-}
4

    
5
{-
6

    
7
Copyright (C) 2011, 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.Config
27
    ( LinkIpMap
28
    , loadConfig
29
    , getNodeInstances
30
    , getDefaultNicLink
31
    , getInstancesIpByLink
32
    , getNode
33
    , getInstance
34
    , getInstPrimaryNode
35
    , getInstMinorsForNode
36
    , buildLinkIpInstnameMap
37
    , instNodes
38
    ) where
39

    
40
import Data.List (foldl')
41
import qualified Data.Map as M
42
import qualified Data.Set as S
43
import qualified Text.JSON as J
44

    
45
import Ganeti.HTools.JSON
46
import Ganeti.BasicTypes
47

    
48
import qualified Ganeti.Constants as C
49
import Ganeti.Objects
50

    
51
-- | Type alias for the link and ip map.
52
type LinkIpMap = M.Map String (M.Map String String)
53

    
54
-- | Reads the config file.
55
readConfig :: FilePath -> IO String
56
readConfig = readFile
57

    
58
-- | Parses the configuration file.
59
parseConfig :: String -> Result ConfigData
60
parseConfig = fromJResult "parsing configuration" . J.decodeStrict
61

    
62
-- | Wrapper over 'readConfig' and 'parseConfig'.
63
loadConfig :: FilePath -> IO (Result ConfigData)
64
loadConfig = fmap parseConfig . readConfig
65

    
66
-- * Query functions
67

    
68
-- | Computes the nodes covered by a disk.
69
computeDiskNodes :: Disk -> S.Set String
70
computeDiskNodes dsk =
71
  case diskLogicalId dsk of
72
    LIDDrbd8 nodeA nodeB _ _ _ _ -> S.fromList [nodeA, nodeB]
73
    _ -> S.empty
74

    
75
-- | Computes all disk-related nodes of an instance. For non-DRBD,
76
-- this will be empty, for DRBD it will contain both the primary and
77
-- the secondaries.
78
instDiskNodes :: Instance -> S.Set String
79
instDiskNodes = S.unions . map computeDiskNodes . instDisks
80

    
81
-- | Computes all nodes of an instance.
82
instNodes :: Instance -> S.Set String
83
instNodes inst = instPrimaryNode inst `S.insert` instDiskNodes inst
84

    
85
-- | Computes the secondary nodes of an instance. Since this is valid
86
-- only for DRBD, we call directly 'instDiskNodes', skipping over the
87
-- extra primary insert.
88
instSecondaryNodes :: Instance -> S.Set String
89
instSecondaryNodes inst =
90
  instPrimaryNode inst `S.delete` instDiskNodes inst
91

    
92
-- | Get instances of a given node.
93
getNodeInstances :: ConfigData -> String -> ([Instance], [Instance])
94
getNodeInstances cfg nname =
95
    let all_inst = M.elems . fromContainer . configInstances $ cfg
96
        pri_inst = filter ((== nname) . instPrimaryNode) all_inst
97
        sec_inst = filter ((nname `S.member`) . instSecondaryNodes) all_inst
98
    in (pri_inst, sec_inst)
99

    
100
-- | Returns the default cluster link.
101
getDefaultNicLink :: ConfigData -> String
102
getDefaultNicLink =
103
  nicpLink . (M.! C.ppDefault) . fromContainer .
104
  clusterNicparams . configCluster
105

    
106
-- | Returns instances of a given link.
107
getInstancesIpByLink :: LinkIpMap -> String -> [String]
108
getInstancesIpByLink linkipmap link =
109
  M.keys $ M.findWithDefault M.empty link linkipmap
110

    
111
-- | Generic lookup function that converts from a possible abbreviated
112
-- name to a full name.
113
getItem :: String -> String -> M.Map String a -> Result a
114
getItem kind name allitems = do
115
  let lresult = lookupName (M.keys allitems) name
116
      err = \details -> Bad $ kind ++ " name " ++ name ++ " " ++ details
117
  fullname <- case lrMatchPriority lresult of
118
                PartialMatch -> Ok $ lrContent lresult
119
                ExactMatch -> Ok $ lrContent lresult
120
                MultipleMatch -> err "has multiple matches"
121
                FailMatch -> err "not found"
122
  maybe (err "not found after successfull match?!") Ok $
123
        M.lookup fullname allitems
124

    
125
-- | Looks up a node.
126
getNode :: ConfigData -> String -> Result Node
127
getNode cfg name = getItem "Node" name (fromContainer $ configNodes cfg)
128

    
129
-- | Looks up an instance.
130
getInstance :: ConfigData -> String -> Result Instance
131
getInstance cfg name =
132
  getItem "Instance" name (fromContainer $ configInstances cfg)
133

    
134
-- | Looks up an instance's primary node.
135
getInstPrimaryNode :: ConfigData -> String -> Result Node
136
getInstPrimaryNode cfg name =
137
  getInstance cfg name >>= return . instPrimaryNode >>= getNode cfg
138

    
139
-- | Filters DRBD minors for a given node.
140
getDrbdMinorsForNode :: String -> Disk -> [(Int, String)]
141
getDrbdMinorsForNode node disk =
142
  let child_minors = concatMap (getDrbdMinorsForNode node) (diskChildren disk)
143
      this_minors =
144
        case diskLogicalId disk of
145
          LIDDrbd8 nodeA nodeB _ minorA minorB _
146
            | nodeA == node -> [(minorA, nodeB)]
147
            | nodeB == node -> [(minorB, nodeA)]
148
          _ -> []
149
  in this_minors ++ child_minors
150

    
151
-- | String for primary role.
152
rolePrimary :: String
153
rolePrimary = "primary"
154

    
155
-- | String for secondary role.
156
roleSecondary :: String
157
roleSecondary = "secondary"
158

    
159
-- | Gets the list of DRBD minors for an instance that are related to
160
-- a given node.
161
getInstMinorsForNode :: String -> Instance
162
                     -> [(String, Int, String, String, String, String)]
163
getInstMinorsForNode node inst =
164
  let role = if node == instPrimaryNode inst
165
               then rolePrimary
166
               else roleSecondary
167
      iname = instName inst
168
  -- FIXME: the disk/ build there is hack-ish; unify this in a
169
  -- separate place, or reuse the iv_name (but that is deprecated on
170
  -- the Python side)
171
  in concatMap (\(idx, dsk) ->
172
            [(node, minor, iname, "disk/" ++ show idx, role, peer)
173
               | (minor, peer) <- getDrbdMinorsForNode node dsk]) .
174
     zip [(0::Int)..] . instDisks $ inst
175

    
176
-- | Builds link -> ip -> instname map.
177
--
178
-- TODO: improve this by splitting it into multiple independent functions:
179
--
180
-- * abstract the \"fetch instance with filled params\" functionality
181
--
182
-- * abstsract the [instance] -> [(nic, instance_name)] part
183
--
184
-- * etc.
185
buildLinkIpInstnameMap :: ConfigData -> LinkIpMap
186
buildLinkIpInstnameMap cfg =
187
  let cluster = configCluster cfg
188
      instances = M.elems . fromContainer . configInstances $ cfg
189
      defparams = (M.!) (fromContainer $ clusterNicparams cluster) C.ppDefault
190
      nics = concatMap (\i -> [(instName i, nic) | nic <- instNics i])
191
             instances
192
  in foldl' (\accum (iname, nic) ->
193
               let pparams = nicNicparams nic
194
                   fparams = fillNICParams defparams pparams
195
                   link = nicpLink fparams
196
               in case nicIp nic of
197
                    Nothing -> accum
198
                    Just ip -> let oldipmap = M.findWithDefault (M.empty)
199
                                              link accum
200
                                   newipmap = M.insert ip iname oldipmap
201
                               in M.insert link newipmap accum
202
            ) M.empty nics