Loader.hs 8.46 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(..)
39
    ) where
Iustin Pop's avatar
Iustin Pop committed
40

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

import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Instance as Instance
import qualified Ganeti.HTools.Node as Node

import Ganeti.HTools.Types

51
52
53
54
55
56
-- * Constants

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

57
58
-- * Types

59
{-| The iallocator request type.
60
61
62
63
64
65
66
67
68

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
69
    | Evacuate [Ndx]                 -- ^ Evacuate nodes
70
71
72
    deriving (Show)

-- | A complete request, as received from Ganeti.
73
data Request = Request RqType Node.List Instance.List [String]
74
75
76
77
    deriving (Show)

-- * Functions

Iustin Pop's avatar
Iustin Pop committed
78
-- | Lookups a node into an assoc list.
79
lookupNode :: (Monad m) => NameAssoc -> String -> String -> m Ndx
Iustin Pop's avatar
Iustin Pop committed
80
lookupNode ktn inst node =
81
    case M.lookup node ktn of
Iustin Pop's avatar
Iustin Pop committed
82
83
84
      Nothing -> fail $ "Unknown node '" ++ node ++ "' for instance " ++ inst
      Just idx -> return idx

Iustin Pop's avatar
Iustin Pop committed
85
-- | Lookups an instance into an assoc list.
86
lookupInstance :: (Monad m) => NameAssoc -> String -> m Idx
87
lookupInstance kti inst =
88
    case M.lookup inst kti of
89
90
91
      Nothing -> fail $ "Unknown instance '" ++ inst ++ "'"
      Just idx -> return idx

Iustin Pop's avatar
Iustin Pop committed
92
93
94
95
96
97
98
-- | 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
99
-- | Given a list of elements (and their names), assign indices to them.
100
101
assignIndices :: (Element a) =>
                 [(String, a)]
102
              -> (NameAssoc, Container.Container a)
103
104
105
106
assignIndices nodes =
  let (na, idx_node) =
          unzip . map (\ (idx, (k, v)) -> ((k, idx), (idx, setIdx v idx)))
          . zip [0..] $ nodes
107
  in (M.fromList na, Container.fromAssocList idx_node)
108

Iustin Pop's avatar
Iustin Pop committed
109
-- | For each instance, add its index to its primary and secondary nodes.
110
fixNodes :: Node.List
111
         -> Instance.Instance
112
         -> Node.List
113
fixNodes accu inst =
114
    let
115
116
        pdx = Instance.pNode inst
        sdx = Instance.sNode inst
117
        pold = Container.find pdx accu
118
        pnew = Node.setPri pold inst
119
        ac2 = Container.add pdx pnew accu
120
121
    in
      if sdx /= Node.noSecondary
122
      then let sold = Container.find sdx accu
123
               snew = Node.setSec sold inst
124
           in Container.add sdx snew ac2
125
      else ac2
Iustin Pop's avatar
Iustin Pop committed
126

127
128
129
130
-- | Remove non-selected tags from the exclusion list
filterExTags :: [String] -> Instance.Instance -> Instance.Instance
filterExTags tl inst =
    let old_tags = Instance.tags inst
131
        new_tags = filter (\tag -> any (`isPrefixOf` tag) tl)
132
133
134
                   old_tags
    in inst { Instance.tags = new_tags }

135
136
137
138
139
140
141
142
-- | 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
143
-- | Compute the longest common suffix of a list of strings that
Iustin Pop's avatar
Iustin Pop committed
144
-- | starts with a dot.
145
longestDomain :: [String] -> String
Iustin Pop's avatar
Iustin Pop committed
146
longestDomain [] = ""
147
148
longestDomain (x:xs) =
      foldr (\ suffix accu -> if all (isSuffixOf suffix) xs
Iustin Pop's avatar
Iustin Pop committed
149
150
151
152
                              then suffix
                              else accu)
      "" $ filter (isPrefixOf ".") (tails x)

153
154
155
156
157
158
-- | 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
159
-- | Extracts the common suffix from node\/instance names
160
161
162
163
164
165
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
166
167
-- | Initializer function that loads the data from a node and instance
-- list and massages it into the correct format.
168
mergeData :: [(String, DynUtil)]  -- ^ Instance utilisation data
169
          -> [String]             -- ^ Exclusion tags
170
          -> [String]             -- ^ Untouchable instances
171
          -> (Node.List, Instance.List, [String])
172
          -- ^ Data from backends
173
          -> Result (Node.List, Instance.List, [String])
174
175
mergeData um extags exinsts (nl, il2, tags) =
  let il = Container.elems il2
176
177
178
179
180
181
182
      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
183
      allextags = extags ++ extractExTags tags
184
185
      il4 = Container.map (filterExTags allextags .
                           updateMovable exinsts) il3
186
      nl2 = foldl' fixNodes nl (Container.elems il4)
187
188
189
      nl3 = Container.map (\node -> Node.buildPeers node il4) nl2
      node_names = map Node.name (Container.elems nl)
      inst_names = map Instance.name il
190
      common_suffix = longestDomain (node_names ++ inst_names)
191
192
      snl = Container.map (computeAlias common_suffix) nl3
      sil = Container.map (computeAlias common_suffix) il4
193
194
      all_inst_names = concatMap allNames $ Container.elems sil
  in if not $ all (`elem` all_inst_names) exinsts
195
     then Bad $ "Some of the excluded instances are unknown: " ++
196
          show (exinsts \\ all_inst_names)
197
     else Ok (snl, sil, tags)
198

Iustin Pop's avatar
Iustin Pop committed
199
-- | Checks the cluster data for consistency.
200
201
checkData :: Node.List -> Instance.List
          -> ([String], Node.List)
202
checkData nl il =
203
204
    Container.mapAccum
        (\ msgs node ->
205
             let nname = Node.name node
206
                 nilst = map (`Container.find` il) (Node.pList node)
207
208
                 dilst = filter (not . Instance.running) nilst
                 adj_mem = sum . map Instance.mem $ dilst
209
210
211
                 delta_mem = truncate (Node.tMem node)
                             - Node.nMem node
                             - Node.fMem node
Iustin Pop's avatar
Iustin Pop committed
212
                             - nodeImem node il
213
                             + adj_mem
214
215
                 delta_dsk = truncate (Node.tDsk node)
                             - Node.fDsk node
Iustin Pop's avatar
Iustin Pop committed
216
                             - nodeIdsk node il
217
                 newn = Node.setFmem (Node.setXmem node delta_mem)
218
                        (Node.fMem node - adj_mem)
Iustin Pop's avatar
Iustin Pop committed
219
220
221
222
                 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]
223
224
225
226
             in (msgs ++ umsg1, newn)
        ) [] nl

-- | Compute the amount of memory used by primary instances on a node.
227
nodeImem :: Node.Node -> Instance.List -> Int
228
nodeImem node il =
Iustin Pop's avatar
Iustin Pop committed
229
230
    let rfind = flip Container.find il
    in sum . map (Instance.mem . rfind)
231
           $ Node.pList node
232
233
234

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