Statistics
| Branch: | Tag: | Revision:

root / Ganeti / HTools / Loader.hs @ 94e05c32

History | View | Annotate | Download (7.3 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 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
    , stripSuffix
36
    , RqType(..)
37
    , Request(..)
38
    ) where
39

    
40
import Data.Function (on)
41
import Data.List
42
import Data.Maybe (fromJust)
43
import Text.Printf (printf)
44

    
45
import qualified Ganeti.HTools.Container as Container
46
import qualified Ganeti.HTools.Instance as Instance
47
import qualified Ganeti.HTools.Node as Node
48

    
49
import Ganeti.HTools.Types
50

    
51
-- * Types
52

    
53
{-| The request type.
54

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

    
58
-}
59
data RqType
60
    = Allocate Instance.Instance Int -- ^ A new instance allocation
61
    | Relocate Idx Int [Ndx]         -- ^ Move an instance to a new
62
                                     -- secondary node
63
    deriving (Show)
64

    
65
-- | A complete request, as received from Ganeti.
66
data Request = Request RqType Node.List Instance.List String
67
    deriving (Show)
68

    
69
-- * Functions
70

    
71
-- | Lookups a node into an assoc list.
72
lookupNode :: (Monad m) => [(String, Ndx)] -> String -> String -> m Ndx
73
lookupNode ktn inst node =
74
    case lookup node ktn of
75
      Nothing -> fail $ "Unknown node '" ++ node ++ "' for instance " ++ inst
76
      Just idx -> return idx
77

    
78
-- | Lookups an instance into an assoc list.
79
lookupInstance :: (Monad m) => [(String, Idx)] -> String -> m Idx
80
lookupInstance kti inst =
81
    case lookup inst kti of
82
      Nothing -> fail $ "Unknown instance '" ++ inst ++ "'"
83
      Just idx -> return idx
84

    
85
-- | Given a list of elements (and their names), assign indices to them.
86
assignIndices :: (Element a) =>
87
                 [(String, a)]
88
              -> (NameAssoc, [(Int, a)])
89
assignIndices =
90
    unzip . map (\ (idx, (k, v)) -> ((k, idx), (idx, setIdx v idx)))
91
          . zip [0..]
92

    
93
-- | Assoc element comparator
94
assocEqual :: (Eq a) => (a, b) -> (a, b) -> Bool
95
assocEqual = (==) `on` fst
96

    
97
-- | For each instance, add its index to its primary and secondary nodes.
98
fixNodes :: [(Ndx, Node.Node)]
99
         -> Instance.Instance
100
         -> [(Ndx, Node.Node)]
101
fixNodes accu inst =
102
    let
103
        pdx = Instance.pNode inst
104
        sdx = Instance.sNode inst
105
        pold = fromJust $ lookup pdx accu
106
        pnew = Node.setPri pold inst
107
        ac1 = deleteBy assocEqual (pdx, pold) accu
108
        ac2 = (pdx, pnew):ac1
109
    in
110
      if sdx /= Node.noSecondary
111
      then let sold = fromJust $ lookup sdx accu
112
               snew = Node.setSec sold inst
113
               ac3 = deleteBy assocEqual (sdx, sold) ac2
114
           in (sdx, snew):ac3
115
      else ac2
116

    
117
-- | Remove non-selected tags from the exclusion list
118
filterExTags :: [String] -> Instance.Instance -> Instance.Instance
119
filterExTags tl inst =
120
    let old_tags = Instance.tags inst
121
        new_tags = filter (\tag -> any (\extag -> isPrefixOf extag tag) tl)
122
                   old_tags
123
    in inst { Instance.tags = new_tags }
124

    
125
-- | Compute the longest common suffix of a list of strings that
126
-- | starts with a dot.
127
longestDomain :: [String] -> String
128
longestDomain [] = ""
129
longestDomain (x:xs) =
130
      foldr (\ suffix accu -> if all (isSuffixOf suffix) xs
131
                              then suffix
132
                              else accu)
133
      "" $ filter (isPrefixOf ".") (tails x)
134

    
135
-- | Remove tail suffix from a string.
136
stripSuffix :: Int -> String -> String
137
stripSuffix sflen name = take (length name - sflen) name
138

    
139
-- | Initializer function that loads the data from a node and instance
140
-- list and massages it into the correct format.
141
mergeData :: [(String, DynUtil)]  -- ^ Instance utilisation data
142
          -> [String]             -- ^ Exclusion tags
143
          -> (Node.AssocList, Instance.AssocList, [String])
144
          -- ^ Data from backends
145
          -> Result (Node.List, Instance.List, [String], String)
146
mergeData um extags (nl, il, tags) =
147
  let il2 = Container.fromAssocList il
148
      il3 = foldl' (\im (name, n_util) ->
149
                        case Container.findByName im name of
150
                          Nothing -> im -- skipping unknown instance
151
                          Just inst ->
152
                              let new_i = inst { Instance.util = n_util }
153
                              in Container.add (Instance.idx inst) new_i im
154
                   ) il2 um
155
      il4 = Container.map (filterExTags extags) il3
156
      nl2 = foldl' fixNodes nl (Container.elems il4)
157
      nl3 = Container.fromAssocList
158
            (map (\ (k, v) -> (k, Node.buildPeers v il4)) nl2)
159
      node_names = map (Node.name . snd) nl
160
      inst_names = map (Instance.name . snd) il
161
      common_suffix = longestDomain (node_names ++ inst_names)
162
      csl = length common_suffix
163
      snl = Container.map (\n -> setName n (stripSuffix csl $ nameOf n)) nl3
164
      sil = Container.map (\i -> setName i (stripSuffix csl $ nameOf i)) il4
165
  in Ok (snl, sil, tags, common_suffix)
166

    
167
-- | Checks the cluster data for consistency.
168
checkData :: Node.List -> Instance.List
169
          -> ([String], Node.List)
170
checkData nl il =
171
    Container.mapAccum
172
        (\ msgs node ->
173
             let nname = Node.name node
174
                 nilst = map (flip Container.find il) (Node.pList node)
175
                 dilst = filter (not . Instance.running) nilst
176
                 adj_mem = sum . map Instance.mem $ dilst
177
                 delta_mem = truncate (Node.tMem node)
178
                             - Node.nMem node
179
                             - Node.fMem node
180
                             - nodeImem node il
181
                             + adj_mem
182
                 delta_dsk = truncate (Node.tDsk node)
183
                             - Node.fDsk node
184
                             - nodeIdsk node il
185
                 newn = Node.setFmem (Node.setXmem node delta_mem)
186
                        (Node.fMem node - adj_mem)
187
                 umsg1 = [printf "node %s is missing %d MB ram \
188
                                 \and %d GB disk"
189
                                 nname delta_mem (delta_dsk `div` 1024) |
190
                                 delta_mem > 512 || delta_dsk > 1024]::[String]
191
             in (msgs ++ umsg1, newn)
192
        ) [] nl
193

    
194
-- | Compute the amount of memory used by primary instances on a node.
195
nodeImem :: Node.Node -> Instance.List -> Int
196
nodeImem node il =
197
    let rfind = flip Container.find il
198
    in sum . map (Instance.mem . rfind)
199
           $ Node.pList node
200

    
201
-- | Compute the amount of disk used by instances on a node (either primary
202
-- or secondary).
203
nodeIdsk :: Node.Node -> Instance.List -> Int
204
nodeIdsk node il =
205
    let rfind = flip Container.find il
206
    in sum . map (Instance.dsk . rfind)
207
           $ Node.pList node ++ Node.sList node