Statistics
| Branch: | Tag: | Revision:

root / Ganeti / HTools / Loader.hs @ e7724ccc

History | View | Annotate | Download (6.8 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 Control.Monad (foldM)
41
import Data.Function (on)
42
import Data.List
43
import Data.Maybe (fromJust)
44
import Text.Printf (printf)
45

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

    
50
import Ganeti.HTools.Types
51

    
52
-- * Types
53

    
54
{-| The request type.
55

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

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

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

    
70
-- * Functions
71

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

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

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

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

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

    
118
-- | Compute the longest common suffix of a list of strings that
119
-- | starts with a dot.
120
longestDomain :: [String] -> String
121
longestDomain [] = ""
122
longestDomain (x:xs) =
123
      foldr (\ suffix accu -> if all (isSuffixOf suffix) xs
124
                              then suffix
125
                              else accu)
126
      "" $ filter (isPrefixOf ".") (tails x)
127

    
128
-- | Remove tail suffix from a string.
129
stripSuffix :: Int -> String -> String
130
stripSuffix sflen name = take (length name - sflen) name
131

    
132
-- | Initializer function that loads the data from a node and instance
133
-- list and massages it into the correct format.
134
mergeData :: [(String, DynUtil)]  -- ^ Instance utilisation data
135
          -> (Node.AssocList,
136
              Instance.AssocList) -- ^ Data from either Text.loadData
137
                                  -- or Rapi.loadData
138
          -> Result (Node.List, Instance.List, String)
139
mergeData um (nl, il) = do
140
  let il2 = Container.fromAssocList il
141
  il3 <- foldM (\im (name, n_util) -> do
142
                  inst <- Container.findByName im name
143
                  let new_i = inst { Instance.util = n_util }
144
                  return $ Container.add (Instance.idx inst) new_i im
145
               ) il2 um
146
  let nl2 = foldl' fixNodes nl (Container.elems il3)
147
  let nl3 = Container.fromAssocList
148
            (map (\ (k, v) -> (k, Node.buildPeers v il3)) nl2)
149
      node_names = map Node.name $ Container.elems nl3
150
      inst_names = map Instance.name $ Container.elems il3
151
      common_suffix = longestDomain (node_names ++ inst_names)
152
      csl = length common_suffix
153
      snl = Container.map (\n -> setName n (stripSuffix csl $ nameOf n)) nl3
154
      sil = Container.map (\i -> setName i (stripSuffix csl $ nameOf i)) il3
155
  return (snl, sil, common_suffix)
156

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

    
184
-- | Compute the amount of memory used by primary instances on a node.
185
nodeImem :: Node.Node -> Instance.List -> Int
186
nodeImem node il =
187
    let rfind = flip Container.find il
188
    in sum . map (Instance.mem . rfind)
189
           $ Node.pList node
190

    
191
-- | Compute the amount of disk used by instances on a node (either primary
192
-- or secondary).
193
nodeIdsk :: Node.Node -> Instance.List -> Int
194
nodeIdsk node il =
195
    let rfind = flip Container.find il
196
    in sum . map (Instance.dsk . rfind)
197
           $ Node.pList node ++ Node.sList node