Loader.hs 8.98 KB
Newer Older
1
{-| Generic data loader
Iustin Pop's avatar
Iustin Pop committed
2

3
4
This module holds the common code for parsing the input data after it
has been loaded from external sources.
Iustin Pop's avatar
Iustin Pop committed
5
6
7

-}

Iustin Pop's avatar
Iustin Pop committed
8
9
{-

10
Copyright (C) 2009, 2010 Google Inc.
Iustin Pop's avatar
Iustin Pop committed
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28

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.

-}

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

Iustin Pop's avatar
Iustin Pop committed
43
import Data.List
44
import qualified Data.Map as M
45
import Text.Printf (printf)
Iustin Pop's avatar
Iustin Pop committed
46
47
48
49

import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Instance as Instance
import qualified Ganeti.HTools.Node as Node
50
import qualified Ganeti.HTools.Group as Group
Iustin Pop's avatar
Iustin Pop committed
51
52
53

import Ganeti.HTools.Types

54
55
56
57
58
59
-- * Constants

-- | The exclusion tag prefix
exTagsPrefix :: String
exTagsPrefix = "htools:iextags:"

60
61
-- * Types

62
{-| The iallocator request type.
63
64
65
66
67
68
69
70
71

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

-}
data RqType
    = Allocate Instance.Instance Int -- ^ A new instance allocation
    | Relocate Idx Int [Ndx]         -- ^ Move an instance to a new
                                     -- secondary node
72
    | Evacuate [Ndx]                 -- ^ Evacuate nodes
73
    deriving (Show, Read)
74
75

-- | A complete request, as received from Ganeti.
76
data Request = Request RqType ClusterData
77
    deriving (Show, Read)
78

Iustin Pop's avatar
Iustin Pop committed
79
80
81
82
83
84
-- | The cluster state.
data ClusterData = ClusterData
    { cdGroups    :: Group.List    -- ^ The node group list
    , cdNodes     :: Node.List     -- ^ The node list
    , cdInstances :: Instance.List -- ^ The instance list
    , cdTags      :: [String]      -- ^ The cluster tags
85
    } deriving (Show, Read)
Iustin Pop's avatar
Iustin Pop committed
86
87
88
89
90

-- | An empty cluster.
emptyCluster :: ClusterData
emptyCluster = ClusterData Container.empty Container.empty Container.empty []

91
92
-- * Functions

Iustin Pop's avatar
Iustin Pop committed
93
-- | Lookups a node into an assoc list.
94
lookupNode :: (Monad m) => NameAssoc -> String -> String -> m Ndx
Iustin Pop's avatar
Iustin Pop committed
95
lookupNode ktn inst node =
96
    case M.lookup node ktn of
Iustin Pop's avatar
Iustin Pop committed
97
98
99
      Nothing -> fail $ "Unknown node '" ++ node ++ "' for instance " ++ inst
      Just idx -> return idx

Iustin Pop's avatar
Iustin Pop committed
100
-- | Lookups an instance into an assoc list.
101
lookupInstance :: (Monad m) => NameAssoc -> String -> m Idx
102
lookupInstance kti inst =
103
    case M.lookup inst kti of
104
105
106
      Nothing -> fail $ "Unknown instance '" ++ inst ++ "'"
      Just idx -> return idx

Iustin Pop's avatar
Iustin Pop committed
107
108
109
110
111
112
113
-- | Lookups a group into an assoc list.
lookupGroup :: (Monad m) => NameAssoc -> String -> String -> m Gdx
lookupGroup ktg nname gname =
    case M.lookup gname ktg of
      Nothing -> fail $ "Unknown group '" ++ gname ++ "' for node " ++ nname
      Just idx -> return idx

Iustin Pop's avatar
Iustin Pop committed
114
-- | Given a list of elements (and their names), assign indices to them.
115
116
assignIndices :: (Element a) =>
                 [(String, a)]
117
              -> (NameAssoc, Container.Container a)
118
119
120
121
assignIndices nodes =
  let (na, idx_node) =
          unzip . map (\ (idx, (k, v)) -> ((k, idx), (idx, setIdx v idx)))
          . zip [0..] $ nodes
Iustin Pop's avatar
Iustin Pop committed
122
  in (M.fromList na, Container.fromList idx_node)
123

Iustin Pop's avatar
Iustin Pop committed
124
-- | For each instance, add its index to its primary and secondary nodes.
125
fixNodes :: Node.List
126
         -> Instance.Instance
127
         -> Node.List
128
fixNodes accu inst =
129
    let
130
131
        pdx = Instance.pNode inst
        sdx = Instance.sNode inst
132
        pold = Container.find pdx accu
133
        pnew = Node.setPri pold inst
134
        ac2 = Container.add pdx pnew accu
135
136
    in
      if sdx /= Node.noSecondary
137
      then let sold = Container.find sdx accu
138
               snew = Node.setSec sold inst
139
           in Container.add sdx snew ac2
140
      else ac2
Iustin Pop's avatar
Iustin Pop committed
141

142
143
144
145
-- | Remove non-selected tags from the exclusion list
filterExTags :: [String] -> Instance.Instance -> Instance.Instance
filterExTags tl inst =
    let old_tags = Instance.tags inst
146
        new_tags = filter (\tag -> any (`isPrefixOf` tag) tl)
147
148
149
                   old_tags
    in inst { Instance.tags = new_tags }

150
151
152
153
154
155
156
157
-- | Update the movable attribute
updateMovable :: [String] -> Instance.Instance -> Instance.Instance
updateMovable exinst inst =
    if Instance.sNode inst == Node.noSecondary ||
       Instance.name inst `elem` exinst
    then Instance.setMovable inst False
    else inst

Iustin Pop's avatar
Iustin Pop committed
158
-- | Compute the longest common suffix of a list of strings that
Iustin Pop's avatar
Iustin Pop committed
159
-- | starts with a dot.
160
longestDomain :: [String] -> String
Iustin Pop's avatar
Iustin Pop committed
161
longestDomain [] = ""
162
163
longestDomain (x:xs) =
      foldr (\ suffix accu -> if all (isSuffixOf suffix) xs
Iustin Pop's avatar
Iustin Pop committed
164
165
166
167
                              then suffix
                              else accu)
      "" $ filter (isPrefixOf ".") (tails x)

168
169
170
171
172
173
-- | Extracts the exclusion tags from the cluster configuration
extractExTags :: [String] -> [String]
extractExTags =
    map (drop (length exTagsPrefix)) .
    filter (isPrefixOf exTagsPrefix)

Iustin Pop's avatar
Iustin Pop committed
174
-- | Extracts the common suffix from node\/instance names
175
176
177
178
179
180
commonSuffix :: Node.List -> Instance.List -> String
commonSuffix nl il =
    let node_names = map Node.name $ Container.elems nl
        inst_names = map Instance.name $ Container.elems il
    in longestDomain (node_names ++ inst_names)

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

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

-- | Compute the amount of memory used by primary instances on a node.
241
nodeImem :: Node.Node -> Instance.List -> Int
242
nodeImem node il =
Iustin Pop's avatar
Iustin Pop committed
243
244
    let rfind = flip Container.find il
    in sum . map (Instance.mem . rfind)
245
           $ Node.pList node
246
247
248

-- | Compute the amount of disk used by instances on a node (either primary
-- or secondary).
249
nodeIdsk :: Node.Node -> Instance.List -> Int
250
nodeIdsk node il =
Iustin Pop's avatar
Iustin Pop committed
251
252
    let rfind = flip Container.find il
    in sum . map (Instance.dsk . rfind)
253
           $ Node.pList node ++ Node.sList node