Statistics
| Branch: | Tag: | Revision:

root / htools / Ganeti / HTools / Loader.hs @ 2c3273e7

History | View | Annotate | Download (9.2 kB)

1
{-| Generic data loader
2

    
3
This module holds the common code for parsing the input data after it
4
has been loaded from external sources.
5

    
6
-}
7

    
8
{-
9

    
10
Copyright (C) 2009, 2010, 2011 Google Inc.
11

    
12
This program is free software; you can redistribute it and/or modify
13
it under the terms of the GNU General Public License as published by
14
the Free Software Foundation; either version 2 of the License, or
15
(at your option) any later version.
16

    
17
This program is distributed in the hope that it will be useful, but
18
WITHOUT ANY WARRANTY; without even the implied warranty of
19
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
20
General Public License for more details.
21

    
22
You should have received a copy of the GNU General Public License
23
along with this program; if not, write to the Free Software
24
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
25
02110-1301, USA.
26

    
27
-}
28

    
29
module Ganeti.HTools.Loader
30
    ( mergeData
31
    , checkData
32
    , assignIndices
33
    , lookupNode
34
    , lookupInstance
35
    , lookupGroup
36
    , commonSuffix
37
    , RelocMode(..)
38
    , RqType(..)
39
    , Request(..)
40
    , ClusterData(..)
41
    , emptyCluster
42
    ) where
43

    
44
import Data.List
45
import qualified Data.Map as M
46
import Text.Printf (printf)
47

    
48
import qualified Ganeti.HTools.Container as Container
49
import qualified Ganeti.HTools.Instance as Instance
50
import qualified Ganeti.HTools.Node as Node
51
import qualified Ganeti.HTools.Group as Group
52

    
53
import Ganeti.HTools.Types
54

    
55
-- * Constants
56

    
57
-- | The exclusion tag prefix
58
exTagsPrefix :: String
59
exTagsPrefix = "htools:iextags:"
60

    
61
-- * Types
62

    
63
-- | The iallocator multi-evac group mode type.
64
data RelocMode = KeepGroup
65
               | ChangeGroup [Gdx]
66
               | AnyGroup
67
                 deriving (Show, Read)
68

    
69
{-| The iallocator request type.
70

    
71
This type denotes what request we got from Ganeti and also holds
72
request-specific fields.
73

    
74
-}
75
data RqType
76
    = Allocate Instance.Instance Int -- ^ A new instance allocation
77
    | Relocate Idx Int [Ndx]         -- ^ Move an instance to a new
78
                                     -- secondary node
79
    | Evacuate [Ndx]                 -- ^ Evacuate nodes
80
    | MultiReloc [Idx] RelocMode     -- ^ Multi-relocate mode
81
    deriving (Show, Read)
82

    
83
-- | A complete request, as received from Ganeti.
84
data Request = Request RqType ClusterData
85
    deriving (Show, Read)
86

    
87
-- | The cluster state.
88
data ClusterData = ClusterData
89
    { cdGroups    :: Group.List    -- ^ The node group list
90
    , cdNodes     :: Node.List     -- ^ The node list
91
    , cdInstances :: Instance.List -- ^ The instance list
92
    , cdTags      :: [String]      -- ^ The cluster tags
93
    } deriving (Show, Read)
94

    
95
-- | An empty cluster.
96
emptyCluster :: ClusterData
97
emptyCluster = ClusterData Container.empty Container.empty Container.empty []
98

    
99
-- * Functions
100

    
101
-- | Lookups a node into an assoc list.
102
lookupNode :: (Monad m) => NameAssoc -> String -> String -> m Ndx
103
lookupNode ktn inst node =
104
    case M.lookup node ktn of
105
      Nothing -> fail $ "Unknown node '" ++ node ++ "' for instance " ++ inst
106
      Just idx -> return idx
107

    
108
-- | Lookups an instance into an assoc list.
109
lookupInstance :: (Monad m) => NameAssoc -> String -> m Idx
110
lookupInstance kti inst =
111
    case M.lookup inst kti of
112
      Nothing -> fail $ "Unknown instance '" ++ inst ++ "'"
113
      Just idx -> return idx
114

    
115
-- | Lookups a group into an assoc list.
116
lookupGroup :: (Monad m) => NameAssoc -> String -> String -> m Gdx
117
lookupGroup ktg nname gname =
118
    case M.lookup gname ktg of
119
      Nothing -> fail $ "Unknown group '" ++ gname ++ "' for node " ++ nname
120
      Just idx -> return idx
121

    
122
-- | Given a list of elements (and their names), assign indices to them.
123
assignIndices :: (Element a) =>
124
                 [(String, a)]
125
              -> (NameAssoc, Container.Container a)
126
assignIndices nodes =
127
  let (na, idx_node) =
128
          unzip . map (\ (idx, (k, v)) -> ((k, idx), (idx, setIdx v idx)))
129
          . zip [0..] $ nodes
130
  in (M.fromList na, Container.fromList idx_node)
131

    
132
-- | For each instance, add its index to its primary and secondary nodes.
133
fixNodes :: Node.List
134
         -> Instance.Instance
135
         -> Node.List
136
fixNodes accu inst =
137
    let
138
        pdx = Instance.pNode inst
139
        sdx = Instance.sNode inst
140
        pold = Container.find pdx accu
141
        pnew = Node.setPri pold inst
142
        ac2 = Container.add pdx pnew accu
143
    in
144
      if sdx /= Node.noSecondary
145
      then let sold = Container.find sdx accu
146
               snew = Node.setSec sold inst
147
           in Container.add sdx snew ac2
148
      else ac2
149

    
150
-- | Remove non-selected tags from the exclusion list
151
filterExTags :: [String] -> Instance.Instance -> Instance.Instance
152
filterExTags tl inst =
153
    let old_tags = Instance.tags inst
154
        new_tags = filter (\tag -> any (`isPrefixOf` tag) tl)
155
                   old_tags
156
    in inst { Instance.tags = new_tags }
157

    
158
-- | Update the movable attribute
159
updateMovable :: [String] -> Instance.Instance -> Instance.Instance
160
updateMovable exinst inst =
161
    if Instance.sNode inst == Node.noSecondary ||
162
       Instance.name inst `elem` exinst
163
    then Instance.setMovable inst False
164
    else inst
165

    
166
-- | Compute the longest common suffix of a list of strings that
167
-- | starts with a dot.
168
longestDomain :: [String] -> String
169
longestDomain [] = ""
170
longestDomain (x:xs) =
171
      foldr (\ suffix accu -> if all (isSuffixOf suffix) xs
172
                              then suffix
173
                              else accu)
174
      "" $ filter (isPrefixOf ".") (tails x)
175

    
176
-- | Extracts the exclusion tags from the cluster configuration
177
extractExTags :: [String] -> [String]
178
extractExTags =
179
    map (drop (length exTagsPrefix)) .
180
    filter (isPrefixOf exTagsPrefix)
181

    
182
-- | Extracts the common suffix from node\/instance names
183
commonSuffix :: Node.List -> Instance.List -> String
184
commonSuffix nl il =
185
    let node_names = map Node.name $ Container.elems nl
186
        inst_names = map Instance.name $ Container.elems il
187
    in longestDomain (node_names ++ inst_names)
188

    
189
-- | Initializer function that loads the data from a node and instance
190
-- list and massages it into the correct format.
191
mergeData :: [(String, DynUtil)]  -- ^ Instance utilisation data
192
          -> [String]             -- ^ Exclusion tags
193
          -> [String]             -- ^ Untouchable instances
194
          -> ClusterData          -- ^ Data from backends
195
          -> Result ClusterData   -- ^ Fixed cluster data
196
mergeData um extags exinsts cdata@(ClusterData _ nl il2 tags) =
197
  let il = Container.elems il2
198
      il3 = foldl' (\im (name, n_util) ->
199
                        case Container.findByName im name of
200
                          Nothing -> im -- skipping unknown instance
201
                          Just inst ->
202
                              let new_i = inst { Instance.util = n_util }
203
                              in Container.add (Instance.idx inst) new_i im
204
                   ) il2 um
205
      allextags = extags ++ extractExTags tags
206
      il4 = Container.map (filterExTags allextags .
207
                           updateMovable exinsts) il3
208
      nl2 = foldl' fixNodes nl (Container.elems il4)
209
      nl3 = Container.map (flip Node.buildPeers il4) nl2
210
      node_names = map Node.name (Container.elems nl)
211
      inst_names = map Instance.name il
212
      common_suffix = longestDomain (node_names ++ inst_names)
213
      snl = Container.map (computeAlias common_suffix) nl3
214
      sil = Container.map (computeAlias common_suffix) il4
215
      all_inst_names = concatMap allNames $ Container.elems sil
216
  in if not $ all (`elem` all_inst_names) exinsts
217
     then Bad $ "Some of the excluded instances are unknown: " ++
218
          show (exinsts \\ all_inst_names)
219
     else Ok cdata { cdNodes = snl, cdInstances = sil }
220

    
221
-- | Checks the cluster data for consistency.
222
checkData :: Node.List -> Instance.List
223
          -> ([String], Node.List)
224
checkData nl il =
225
    Container.mapAccum
226
        (\ msgs node ->
227
             let nname = Node.name node
228
                 nilst = map (`Container.find` il) (Node.pList node)
229
                 dilst = filter (not . Instance.running) nilst
230
                 adj_mem = sum . map Instance.mem $ dilst
231
                 delta_mem = truncate (Node.tMem node)
232
                             - Node.nMem node
233
                             - Node.fMem node
234
                             - nodeImem node il
235
                             + adj_mem
236
                 delta_dsk = truncate (Node.tDsk node)
237
                             - Node.fDsk node
238
                             - nodeIdsk node il
239
                 newn = Node.setFmem (Node.setXmem node delta_mem)
240
                        (Node.fMem node - adj_mem)
241
                 umsg1 = [printf "node %s is missing %d MB ram \
242
                                 \and %d GB disk"
243
                                 nname delta_mem (delta_dsk `div` 1024) |
244
                                 delta_mem > 512 || delta_dsk > 1024]::[String]
245
             in (msgs ++ umsg1, newn)
246
        ) [] nl
247

    
248
-- | Compute the amount of memory used by primary instances on a node.
249
nodeImem :: Node.Node -> Instance.List -> Int
250
nodeImem node il =
251
    let rfind = flip Container.find il
252
    in sum . map (Instance.mem . rfind)
253
           $ Node.pList node
254

    
255
-- | Compute the amount of disk used by instances on a node (either primary
256
-- or secondary).
257
nodeIdsk :: Node.Node -> Instance.List -> Int
258
nodeIdsk node il =
259
    let rfind = flip Container.find il
260
    in sum . map (Instance.dsk . rfind)
261
           $ Node.pList node ++ Node.sList node