Statistics
| Branch: | Tag: | Revision:

root / Ganeti / HTools / Cluster.hs @ 5aa48dbe

History | View | Annotate | Download (30.5 kB)

1 e4f08c46 Iustin Pop
{-| Implementation of cluster-wide logic.
2 e4f08c46 Iustin Pop
3 e4f08c46 Iustin Pop
This module holds all pure cluster-logic; I\/O related functionality
4 7ae514ba Iustin Pop
goes into the "Main" module for the individual binaries.
5 e4f08c46 Iustin Pop
6 e4f08c46 Iustin Pop
-}
7 e4f08c46 Iustin Pop
8 669d7e3d Iustin Pop
module Ganeti.HTools.Cluster
9 e4f08c46 Iustin Pop
    (
10 e4f08c46 Iustin Pop
     -- * Types
11 e4f08c46 Iustin Pop
     NodeList
12 e4f08c46 Iustin Pop
    , InstanceList
13 740ec004 Iustin Pop
    , NameList
14 e4f08c46 Iustin Pop
    , Placement
15 e4f08c46 Iustin Pop
    , Solution(..)
16 e4f08c46 Iustin Pop
    , Table(..)
17 e4f08c46 Iustin Pop
    , Removal
18 b0517d61 Iustin Pop
    , Score
19 e4f08c46 Iustin Pop
    -- * Generic functions
20 e4f08c46 Iustin Pop
    , totalResources
21 e4f08c46 Iustin Pop
    -- * First phase functions
22 e4f08c46 Iustin Pop
    , computeBadItems
23 e4f08c46 Iustin Pop
    -- * Second phase functions
24 e4f08c46 Iustin Pop
    , computeSolution
25 e4f08c46 Iustin Pop
    , applySolution
26 e4f08c46 Iustin Pop
    , printSolution
27 7dfaafb1 Iustin Pop
    , printSolutionLine
28 142538ff Iustin Pop
    , formatCmds
29 e4f08c46 Iustin Pop
    , printNodes
30 e4f08c46 Iustin Pop
    -- * Balacing functions
31 e4f08c46 Iustin Pop
    , checkMove
32 e4f08c46 Iustin Pop
    , compCV
33 e4f08c46 Iustin Pop
    , printStats
34 e4f08c46 Iustin Pop
    -- * Loading functions
35 e4f08c46 Iustin Pop
    , loadData
36 5d1baf63 Iustin Pop
    , checkData
37 e4f08c46 Iustin Pop
    ) where
38 e4f08c46 Iustin Pop
39 e4f08c46 Iustin Pop
import Data.List
40 e4f08c46 Iustin Pop
import Data.Maybe (isNothing, fromJust)
41 e4f08c46 Iustin Pop
import Text.Printf (printf)
42 e4f08c46 Iustin Pop
import Data.Function
43 e4f08c46 Iustin Pop
44 669d7e3d Iustin Pop
import qualified Ganeti.HTools.Container as Container
45 669d7e3d Iustin Pop
import qualified Ganeti.HTools.Instance as Instance
46 669d7e3d Iustin Pop
import qualified Ganeti.HTools.Node as Node
47 669d7e3d Iustin Pop
import Ganeti.HTools.Utils
48 e4f08c46 Iustin Pop
49 e4f08c46 Iustin Pop
type NodeList = Container.Container Node.Node
50 e4f08c46 Iustin Pop
type InstanceList = Container.Container Instance.Instance
51 740ec004 Iustin Pop
-- | The type used to hold idx-to-name mappings
52 740ec004 Iustin Pop
type NameList = [(Int, String)]
53 7ae514ba Iustin Pop
-- | A separate name for the cluster score type
54 e4f08c46 Iustin Pop
type Score = Double
55 e4f08c46 Iustin Pop
56 e4f08c46 Iustin Pop
-- | The description of an instance placement.
57 c5c295bc Iustin Pop
type Placement = (Int, Int, Int, Score)
58 e4f08c46 Iustin Pop
59 e4f08c46 Iustin Pop
{- | A cluster solution described as the solution delta and the list
60 e4f08c46 Iustin Pop
of placements.
61 e4f08c46 Iustin Pop
62 e4f08c46 Iustin Pop
-}
63 e4f08c46 Iustin Pop
data Solution = Solution Int [Placement]
64 e4f08c46 Iustin Pop
                deriving (Eq, Ord, Show)
65 e4f08c46 Iustin Pop
66 e4f08c46 Iustin Pop
-- | Returns the delta of a solution or -1 for Nothing
67 e4f08c46 Iustin Pop
solutionDelta :: Maybe Solution -> Int
68 e4f08c46 Iustin Pop
solutionDelta sol = case sol of
69 e4f08c46 Iustin Pop
                      Just (Solution d _) -> d
70 e4f08c46 Iustin Pop
                      _ -> -1
71 e4f08c46 Iustin Pop
72 e4f08c46 Iustin Pop
-- | A removal set.
73 e4f08c46 Iustin Pop
data Removal = Removal NodeList [Instance.Instance]
74 e4f08c46 Iustin Pop
75 e4f08c46 Iustin Pop
-- | An instance move definition
76 00b51a14 Iustin Pop
data IMove = Failover                -- ^ Failover the instance (f)
77 19493d33 Iustin Pop
           | ReplacePrimary Int      -- ^ Replace primary (f, r:np, f)
78 19493d33 Iustin Pop
           | ReplaceSecondary Int    -- ^ Replace secondary (r:ns)
79 19493d33 Iustin Pop
           | ReplaceAndFailover Int  -- ^ Replace secondary, failover (r:np, f)
80 19493d33 Iustin Pop
           | FailoverAndReplace Int  -- ^ Failover, replace secondary (f, r:ns)
81 e4f08c46 Iustin Pop
             deriving (Show)
82 e4f08c46 Iustin Pop
83 e4f08c46 Iustin Pop
-- | The complete state for the balancing solution
84 e4f08c46 Iustin Pop
data Table = Table NodeList InstanceList Score [Placement]
85 e4f08c46 Iustin Pop
             deriving (Show)
86 e4f08c46 Iustin Pop
87 e4f08c46 Iustin Pop
-- General functions
88 e4f08c46 Iustin Pop
89 e4f08c46 Iustin Pop
-- | Cap the removal list if needed.
90 e4f08c46 Iustin Pop
capRemovals :: [a] -> Int -> [a]
91 e4f08c46 Iustin Pop
capRemovals removals max_removals =
92 e4f08c46 Iustin Pop
    if max_removals > 0 then
93 e4f08c46 Iustin Pop
        take max_removals removals
94 e4f08c46 Iustin Pop
    else
95 e4f08c46 Iustin Pop
        removals
96 e4f08c46 Iustin Pop
97 e4f08c46 Iustin Pop
-- | Check if the given node list fails the N+1 check.
98 e4f08c46 Iustin Pop
verifyN1Check :: [Node.Node] -> Bool
99 e4f08c46 Iustin Pop
verifyN1Check nl = any Node.failN1 nl
100 e4f08c46 Iustin Pop
101 e4f08c46 Iustin Pop
-- | Verifies the N+1 status and return the affected nodes.
102 e4f08c46 Iustin Pop
verifyN1 :: [Node.Node] -> [Node.Node]
103 e4f08c46 Iustin Pop
verifyN1 nl = filter Node.failN1 nl
104 e4f08c46 Iustin Pop
105 e4f08c46 Iustin Pop
{-| Add an instance and return the new node and instance maps. -}
106 e4f08c46 Iustin Pop
addInstance :: NodeList -> Instance.Instance ->
107 e4f08c46 Iustin Pop
               Node.Node -> Node.Node -> Maybe NodeList
108 e4f08c46 Iustin Pop
addInstance nl idata pri sec =
109 e4f08c46 Iustin Pop
  let pdx = Node.idx pri
110 e4f08c46 Iustin Pop
      sdx = Node.idx sec
111 e4f08c46 Iustin Pop
  in do
112 e4f08c46 Iustin Pop
      pnode <- Node.addPri pri idata
113 e4f08c46 Iustin Pop
      snode <- Node.addSec sec idata pdx
114 e4f08c46 Iustin Pop
      new_nl <- return $ Container.addTwo sdx snode
115 e4f08c46 Iustin Pop
                         pdx pnode nl
116 e4f08c46 Iustin Pop
      return new_nl
117 e4f08c46 Iustin Pop
118 e4f08c46 Iustin Pop
-- | Remove an instance and return the new node and instance maps.
119 e4f08c46 Iustin Pop
removeInstance :: NodeList -> Instance.Instance -> NodeList
120 e4f08c46 Iustin Pop
removeInstance nl idata =
121 e4f08c46 Iustin Pop
  let pnode = Instance.pnode idata
122 e4f08c46 Iustin Pop
      snode = Instance.snode idata
123 e4f08c46 Iustin Pop
      pn = Container.find pnode nl
124 e4f08c46 Iustin Pop
      sn = Container.find snode nl
125 e4f08c46 Iustin Pop
      new_nl = Container.addTwo
126 e4f08c46 Iustin Pop
               pnode (Node.removePri pn idata)
127 e4f08c46 Iustin Pop
               snode (Node.removeSec sn idata) nl in
128 e4f08c46 Iustin Pop
  new_nl
129 e4f08c46 Iustin Pop
130 e4f08c46 Iustin Pop
-- | Remove an instance and return the new node map.
131 e4f08c46 Iustin Pop
removeInstances :: NodeList -> [Instance.Instance] -> NodeList
132 e4f08c46 Iustin Pop
removeInstances = foldl' removeInstance
133 e4f08c46 Iustin Pop
134 e4f08c46 Iustin Pop
-- | Compute the total free disk and memory in the cluster.
135 e4f08c46 Iustin Pop
totalResources :: Container.Container Node.Node -> (Int, Int)
136 e4f08c46 Iustin Pop
totalResources nl =
137 e4f08c46 Iustin Pop
    foldl'
138 962367fe Iustin Pop
    (\ (mem, dsk) node -> (mem + (Node.f_mem node),
139 962367fe Iustin Pop
                           dsk + (Node.f_dsk node)))
140 e4f08c46 Iustin Pop
    (0, 0) (Container.elems nl)
141 e4f08c46 Iustin Pop
142 e4f08c46 Iustin Pop
{- | Compute a new version of a cluster given a solution.
143 e4f08c46 Iustin Pop
144 e4f08c46 Iustin Pop
This is not used for computing the solutions, but for applying a
145 e4f08c46 Iustin Pop
(known-good) solution to the original cluster for final display.
146 e4f08c46 Iustin Pop
147 e4f08c46 Iustin Pop
It first removes the relocated instances after which it places them on
148 e4f08c46 Iustin Pop
their new nodes.
149 e4f08c46 Iustin Pop
150 e4f08c46 Iustin Pop
 -}
151 e4f08c46 Iustin Pop
applySolution :: NodeList -> InstanceList -> [Placement] -> NodeList
152 e4f08c46 Iustin Pop
applySolution nl il sol =
153 c5c295bc Iustin Pop
    let odxes = map (\ (a, b, c, _) -> (Container.find a il,
154 c5c295bc Iustin Pop
                                        Node.idx (Container.find b nl),
155 c5c295bc Iustin Pop
                                        Node.idx (Container.find c nl))
156 e4f08c46 Iustin Pop
                    ) sol
157 e4f08c46 Iustin Pop
        idxes = (\ (x, _, _) -> x) (unzip3 odxes)
158 e4f08c46 Iustin Pop
        nc = removeInstances nl idxes
159 e4f08c46 Iustin Pop
    in
160 e4f08c46 Iustin Pop
      foldl' (\ nz (a, b, c) ->
161 e4f08c46 Iustin Pop
                 let new_p = Container.find b nz
162 e4f08c46 Iustin Pop
                     new_s = Container.find c nz in
163 e4f08c46 Iustin Pop
                 fromJust (addInstance nz a new_p new_s)
164 e4f08c46 Iustin Pop
           ) nc odxes
165 e4f08c46 Iustin Pop
166 e4f08c46 Iustin Pop
167 e4f08c46 Iustin Pop
-- First phase functions
168 e4f08c46 Iustin Pop
169 e4f08c46 Iustin Pop
{- | Given a list 1,2,3..n build a list of pairs [(1, [2..n]), (2,
170 e4f08c46 Iustin Pop
    [3..n]), ...]
171 e4f08c46 Iustin Pop
172 e4f08c46 Iustin Pop
-}
173 e4f08c46 Iustin Pop
genParts :: [a] -> Int -> [(a, [a])]
174 e4f08c46 Iustin Pop
genParts l count =
175 e4f08c46 Iustin Pop
    case l of
176 e4f08c46 Iustin Pop
      [] -> []
177 e4f08c46 Iustin Pop
      x:xs ->
178 e4f08c46 Iustin Pop
          if length l < count then
179 e4f08c46 Iustin Pop
              []
180 e4f08c46 Iustin Pop
          else
181 e4f08c46 Iustin Pop
              (x, xs) : (genParts xs count)
182 e4f08c46 Iustin Pop
183 e4f08c46 Iustin Pop
-- | Generates combinations of count items from the names list.
184 e4f08c46 Iustin Pop
genNames :: Int -> [b] -> [[b]]
185 e4f08c46 Iustin Pop
genNames count1 names1 =
186 e4f08c46 Iustin Pop
  let aux_fn count names current =
187 e4f08c46 Iustin Pop
          case count of
188 e4f08c46 Iustin Pop
            0 -> [current]
189 e4f08c46 Iustin Pop
            _ ->
190 e4f08c46 Iustin Pop
                concatMap
191 e4f08c46 Iustin Pop
                (\ (x, xs) -> aux_fn (count - 1) xs (x:current))
192 e4f08c46 Iustin Pop
                (genParts names count)
193 e4f08c46 Iustin Pop
  in
194 e4f08c46 Iustin Pop
    aux_fn count1 names1 []
195 e4f08c46 Iustin Pop
196 e4f08c46 Iustin Pop
{- | Computes the pair of bad nodes and instances.
197 e4f08c46 Iustin Pop
198 e4f08c46 Iustin Pop
The bad node list is computed via a simple 'verifyN1' check, and the
199 e4f08c46 Iustin Pop
bad instance list is the list of primary and secondary instances of
200 e4f08c46 Iustin Pop
those nodes.
201 e4f08c46 Iustin Pop
202 e4f08c46 Iustin Pop
-}
203 e4f08c46 Iustin Pop
computeBadItems :: NodeList -> InstanceList ->
204 e4f08c46 Iustin Pop
                   ([Node.Node], [Instance.Instance])
205 e4f08c46 Iustin Pop
computeBadItems nl il =
206 234d8af0 Iustin Pop
  let bad_nodes = verifyN1 $ filter (not . Node.offline) $ Container.elems nl
207 e4f08c46 Iustin Pop
      bad_instances = map (\idx -> Container.find idx il) $
208 e4f08c46 Iustin Pop
                      sort $ nub $ concat $
209 e4f08c46 Iustin Pop
                      map (\ n -> (Node.slist n) ++ (Node.plist n)) bad_nodes
210 e4f08c46 Iustin Pop
  in
211 e4f08c46 Iustin Pop
    (bad_nodes, bad_instances)
212 e4f08c46 Iustin Pop
213 e4f08c46 Iustin Pop
214 e4f08c46 Iustin Pop
{- | Checks if removal of instances results in N+1 pass.
215 e4f08c46 Iustin Pop
216 e4f08c46 Iustin Pop
Note: the check removal cannot optimize by scanning only the affected
217 e4f08c46 Iustin Pop
nodes, since the cluster is known to be not healthy; only the check
218 e4f08c46 Iustin Pop
placement can make this shortcut.
219 e4f08c46 Iustin Pop
220 e4f08c46 Iustin Pop
-}
221 e4f08c46 Iustin Pop
checkRemoval :: NodeList -> [Instance.Instance] -> Maybe Removal
222 e4f08c46 Iustin Pop
checkRemoval nl victims =
223 e4f08c46 Iustin Pop
  let nx = removeInstances nl victims
224 e4f08c46 Iustin Pop
      failN1 = verifyN1Check (Container.elems nx)
225 e4f08c46 Iustin Pop
  in
226 e4f08c46 Iustin Pop
    if failN1 then
227 e4f08c46 Iustin Pop
      Nothing
228 e4f08c46 Iustin Pop
    else
229 e4f08c46 Iustin Pop
      Just $ Removal nx victims
230 e4f08c46 Iustin Pop
231 e4f08c46 Iustin Pop
232 e4f08c46 Iustin Pop
-- | Computes the removals list for a given depth
233 669d7e3d Iustin Pop
computeRemovals :: NodeList
234 e4f08c46 Iustin Pop
                 -> [Instance.Instance]
235 e4f08c46 Iustin Pop
                 -> Int
236 669d7e3d Iustin Pop
                 -> [Maybe Removal]
237 e4f08c46 Iustin Pop
computeRemovals nl bad_instances depth =
238 e4f08c46 Iustin Pop
    map (checkRemoval nl) $ genNames depth bad_instances
239 e4f08c46 Iustin Pop
240 e4f08c46 Iustin Pop
-- Second phase functions
241 e4f08c46 Iustin Pop
242 e4f08c46 Iustin Pop
-- | Single-node relocation cost
243 e4f08c46 Iustin Pop
nodeDelta :: Int -> Int -> Int -> Int
244 e4f08c46 Iustin Pop
nodeDelta i p s =
245 e4f08c46 Iustin Pop
    if i == p || i == s then
246 e4f08c46 Iustin Pop
        0
247 e4f08c46 Iustin Pop
    else
248 e4f08c46 Iustin Pop
        1
249 e4f08c46 Iustin Pop
250 e4f08c46 Iustin Pop
{-| Compute best solution.
251 e4f08c46 Iustin Pop
252 e4f08c46 Iustin Pop
    This function compares two solutions, choosing the minimum valid
253 e4f08c46 Iustin Pop
    solution.
254 e4f08c46 Iustin Pop
-}
255 e4f08c46 Iustin Pop
compareSolutions :: Maybe Solution -> Maybe Solution -> Maybe Solution
256 e4f08c46 Iustin Pop
compareSolutions a b = case (a, b) of
257 e4f08c46 Iustin Pop
  (Nothing, x) -> x
258 e4f08c46 Iustin Pop
  (x, Nothing) -> x
259 e4f08c46 Iustin Pop
  (x, y) -> min x y
260 e4f08c46 Iustin Pop
261 e4f08c46 Iustin Pop
-- | Compute best table. Note that the ordering of the arguments is important.
262 e4f08c46 Iustin Pop
compareTables :: Table -> Table -> Table
263 e4f08c46 Iustin Pop
compareTables a@(Table _ _ a_cv _) b@(Table _ _ b_cv _ ) =
264 e4f08c46 Iustin Pop
    if a_cv > b_cv then b else a
265 e4f08c46 Iustin Pop
266 e4f08c46 Iustin Pop
-- | Check if a given delta is worse then an existing solution.
267 e4f08c46 Iustin Pop
tooHighDelta :: Maybe Solution -> Int -> Int -> Bool
268 e4f08c46 Iustin Pop
tooHighDelta sol new_delta max_delta =
269 e4f08c46 Iustin Pop
    if new_delta > max_delta && max_delta >=0 then
270 e4f08c46 Iustin Pop
        True
271 e4f08c46 Iustin Pop
    else
272 e4f08c46 Iustin Pop
        case sol of
273 e4f08c46 Iustin Pop
          Nothing -> False
274 e4f08c46 Iustin Pop
          Just (Solution old_delta _) -> old_delta <= new_delta
275 e4f08c46 Iustin Pop
276 e4f08c46 Iustin Pop
{-| Check if placement of instances still keeps the cluster N+1 compliant.
277 e4f08c46 Iustin Pop
278 e4f08c46 Iustin Pop
    This is the workhorse of the allocation algorithm: given the
279 e4f08c46 Iustin Pop
    current node and instance maps, the list of instances to be
280 e4f08c46 Iustin Pop
    placed, and the current solution, this will return all possible
281 e4f08c46 Iustin Pop
    solution by recursing until all target instances are placed.
282 e4f08c46 Iustin Pop
283 e4f08c46 Iustin Pop
-}
284 e4f08c46 Iustin Pop
checkPlacement :: NodeList            -- ^ The current node list
285 e4f08c46 Iustin Pop
               -> [Instance.Instance] -- ^ List of instances still to place
286 e4f08c46 Iustin Pop
               -> [Placement]         -- ^ Partial solution until now
287 e4f08c46 Iustin Pop
               -> Int                 -- ^ The delta of the partial solution
288 e4f08c46 Iustin Pop
               -> Maybe Solution      -- ^ The previous solution
289 e4f08c46 Iustin Pop
               -> Int                 -- ^ Abort if the we go above this delta
290 e4f08c46 Iustin Pop
               -> Maybe Solution      -- ^ The new solution
291 e4f08c46 Iustin Pop
checkPlacement nl victims current current_delta prev_sol max_delta =
292 e4f08c46 Iustin Pop
  let target = head victims
293 e4f08c46 Iustin Pop
      opdx = Instance.pnode target
294 e4f08c46 Iustin Pop
      osdx = Instance.snode target
295 e4f08c46 Iustin Pop
      vtail = tail victims
296 e4f08c46 Iustin Pop
      have_tail = (length vtail) > 0
297 e4f08c46 Iustin Pop
      nodes = Container.elems nl
298 c5c295bc Iustin Pop
      iidx = Instance.idx target
299 e4f08c46 Iustin Pop
  in
300 e4f08c46 Iustin Pop
    foldl'
301 e4f08c46 Iustin Pop
    (\ accu_p pri ->
302 e4f08c46 Iustin Pop
         let
303 e4f08c46 Iustin Pop
             pri_idx = Node.idx pri
304 e4f08c46 Iustin Pop
             upri_delta = current_delta + nodeDelta pri_idx opdx osdx
305 e4f08c46 Iustin Pop
             new_pri = Node.addPri pri target
306 e4f08c46 Iustin Pop
             fail_delta1 = tooHighDelta accu_p upri_delta max_delta
307 e4f08c46 Iustin Pop
         in
308 e4f08c46 Iustin Pop
           if fail_delta1 || isNothing(new_pri) then accu_p
309 e4f08c46 Iustin Pop
           else let pri_nl = Container.add pri_idx (fromJust new_pri) nl in
310 e4f08c46 Iustin Pop
                foldl'
311 e4f08c46 Iustin Pop
                (\ accu sec ->
312 e4f08c46 Iustin Pop
                     let
313 e4f08c46 Iustin Pop
                         sec_idx = Node.idx sec
314 e4f08c46 Iustin Pop
                         upd_delta = upri_delta +
315 e4f08c46 Iustin Pop
                                     nodeDelta sec_idx opdx osdx
316 e4f08c46 Iustin Pop
                         fail_delta2 = tooHighDelta accu upd_delta max_delta
317 e4f08c46 Iustin Pop
                         new_sec = Node.addSec sec target pri_idx
318 e4f08c46 Iustin Pop
                     in
319 e4f08c46 Iustin Pop
                       if sec_idx == pri_idx || fail_delta2 ||
320 e4f08c46 Iustin Pop
                          isNothing new_sec then accu
321 e4f08c46 Iustin Pop
                       else let
322 e4f08c46 Iustin Pop
                           nx = Container.add sec_idx (fromJust new_sec) pri_nl
323 c5c295bc Iustin Pop
                           upd_cv = compCV nx
324 c5c295bc Iustin Pop
                           plc = (iidx, pri_idx, sec_idx, upd_cv)
325 e4f08c46 Iustin Pop
                           c2 = plc:current
326 e4f08c46 Iustin Pop
                           result =
327 e4f08c46 Iustin Pop
                               if have_tail then
328 e4f08c46 Iustin Pop
                                   checkPlacement nx vtail c2 upd_delta
329 e4f08c46 Iustin Pop
                                                  accu max_delta
330 e4f08c46 Iustin Pop
                               else
331 e4f08c46 Iustin Pop
                                   Just (Solution upd_delta c2)
332 e4f08c46 Iustin Pop
                      in compareSolutions accu result
333 e4f08c46 Iustin Pop
                ) accu_p nodes
334 e4f08c46 Iustin Pop
    ) prev_sol nodes
335 e4f08c46 Iustin Pop
336 e4f08c46 Iustin Pop
-- | Apply a move
337 e4f08c46 Iustin Pop
applyMove :: NodeList -> Instance.Instance
338 e4f08c46 Iustin Pop
          -> IMove -> (Maybe NodeList, Instance.Instance, Int, Int)
339 00b51a14 Iustin Pop
-- Failover (f)
340 e4f08c46 Iustin Pop
applyMove nl inst Failover =
341 e4f08c46 Iustin Pop
    let old_pdx = Instance.pnode inst
342 e4f08c46 Iustin Pop
        old_sdx = Instance.snode inst
343 e4f08c46 Iustin Pop
        old_p = Container.find old_pdx nl
344 e4f08c46 Iustin Pop
        old_s = Container.find old_sdx nl
345 e4f08c46 Iustin Pop
        int_p = Node.removePri old_p inst
346 e4f08c46 Iustin Pop
        int_s = Node.removeSec old_s inst
347 b161386d Iustin Pop
        new_nl = do -- Maybe monad
348 b161386d Iustin Pop
          new_p <- Node.addPri int_s inst
349 b161386d Iustin Pop
          new_s <- Node.addSec int_p inst old_sdx
350 b161386d Iustin Pop
          return $ Container.addTwo old_pdx new_s old_sdx new_p nl
351 e4f08c46 Iustin Pop
    in (new_nl, Instance.setBoth inst old_sdx old_pdx, old_sdx, old_pdx)
352 e4f08c46 Iustin Pop
353 00b51a14 Iustin Pop
-- Replace the primary (f:, r:np, f)
354 e4f08c46 Iustin Pop
applyMove nl inst (ReplacePrimary new_pdx) =
355 e4f08c46 Iustin Pop
    let old_pdx = Instance.pnode inst
356 e4f08c46 Iustin Pop
        old_sdx = Instance.snode inst
357 e4f08c46 Iustin Pop
        old_p = Container.find old_pdx nl
358 e4f08c46 Iustin Pop
        old_s = Container.find old_sdx nl
359 e4f08c46 Iustin Pop
        tgt_n = Container.find new_pdx nl
360 e4f08c46 Iustin Pop
        int_p = Node.removePri old_p inst
361 e4f08c46 Iustin Pop
        int_s = Node.removeSec old_s inst
362 b161386d Iustin Pop
        new_nl = do -- Maybe monad
363 b161386d Iustin Pop
          new_p <- Node.addPri tgt_n inst
364 b161386d Iustin Pop
          new_s <- Node.addSec int_s inst new_pdx
365 b161386d Iustin Pop
          return $ Container.add new_pdx new_p $
366 b161386d Iustin Pop
                 Container.addTwo old_pdx int_p old_sdx new_s nl
367 e4f08c46 Iustin Pop
    in (new_nl, Instance.setPri inst new_pdx, new_pdx, old_sdx)
368 e4f08c46 Iustin Pop
369 00b51a14 Iustin Pop
-- Replace the secondary (r:ns)
370 e4f08c46 Iustin Pop
applyMove nl inst (ReplaceSecondary new_sdx) =
371 e4f08c46 Iustin Pop
    let old_pdx = Instance.pnode inst
372 e4f08c46 Iustin Pop
        old_sdx = Instance.snode inst
373 e4f08c46 Iustin Pop
        old_s = Container.find old_sdx nl
374 e4f08c46 Iustin Pop
        tgt_n = Container.find new_sdx nl
375 e4f08c46 Iustin Pop
        int_s = Node.removeSec old_s inst
376 b161386d Iustin Pop
        new_nl = Node.addSec tgt_n inst old_pdx >>=
377 b161386d Iustin Pop
                 \new_s -> return $ Container.addTwo new_sdx
378 b161386d Iustin Pop
                           new_s old_sdx int_s nl
379 e4f08c46 Iustin Pop
    in (new_nl, Instance.setSec inst new_sdx, old_pdx, new_sdx)
380 e4f08c46 Iustin Pop
381 00b51a14 Iustin Pop
-- Replace the secondary and failover (r:np, f)
382 79ac6b6f Iustin Pop
applyMove nl inst (ReplaceAndFailover new_pdx) =
383 79ac6b6f Iustin Pop
    let old_pdx = Instance.pnode inst
384 79ac6b6f Iustin Pop
        old_sdx = Instance.snode inst
385 79ac6b6f Iustin Pop
        old_p = Container.find old_pdx nl
386 79ac6b6f Iustin Pop
        old_s = Container.find old_sdx nl
387 79ac6b6f Iustin Pop
        tgt_n = Container.find new_pdx nl
388 79ac6b6f Iustin Pop
        int_p = Node.removePri old_p inst
389 79ac6b6f Iustin Pop
        int_s = Node.removeSec old_s inst
390 b161386d Iustin Pop
        new_nl = do -- Maybe monad
391 b161386d Iustin Pop
          new_p <- Node.addPri tgt_n inst
392 b161386d Iustin Pop
          new_s <- Node.addSec int_p inst new_pdx
393 b161386d Iustin Pop
          return $ Container.add new_pdx new_p $
394 b161386d Iustin Pop
                 Container.addTwo old_pdx new_s old_sdx int_s nl
395 79ac6b6f Iustin Pop
    in (new_nl, Instance.setBoth inst new_pdx old_pdx, new_pdx, old_pdx)
396 79ac6b6f Iustin Pop
397 19493d33 Iustin Pop
-- Failver and replace the secondary (f, r:ns)
398 19493d33 Iustin Pop
applyMove nl inst (FailoverAndReplace new_sdx) =
399 19493d33 Iustin Pop
    let old_pdx = Instance.pnode inst
400 19493d33 Iustin Pop
        old_sdx = Instance.snode inst
401 19493d33 Iustin Pop
        old_p = Container.find old_pdx nl
402 19493d33 Iustin Pop
        old_s = Container.find old_sdx nl
403 19493d33 Iustin Pop
        tgt_n = Container.find new_sdx nl
404 19493d33 Iustin Pop
        int_p = Node.removePri old_p inst
405 19493d33 Iustin Pop
        int_s = Node.removeSec old_s inst
406 b161386d Iustin Pop
        new_nl = do -- Maybe monad
407 b161386d Iustin Pop
          new_p <- Node.addPri int_s inst
408 b161386d Iustin Pop
          new_s <- Node.addSec tgt_n inst old_sdx
409 b161386d Iustin Pop
          return $ Container.add new_sdx new_s $
410 b161386d Iustin Pop
                 Container.addTwo old_sdx new_p old_pdx int_p nl
411 19493d33 Iustin Pop
    in (new_nl, Instance.setBoth inst old_sdx new_sdx, old_sdx, new_sdx)
412 19493d33 Iustin Pop
413 e4f08c46 Iustin Pop
checkSingleStep :: Table -- ^ The original table
414 e4f08c46 Iustin Pop
                -> Instance.Instance -- ^ The instance to move
415 e4f08c46 Iustin Pop
                -> Table -- ^ The current best table
416 e4f08c46 Iustin Pop
                -> IMove -- ^ The move to apply
417 e4f08c46 Iustin Pop
                -> Table -- ^ The final best table
418 e4f08c46 Iustin Pop
checkSingleStep ini_tbl target cur_tbl move =
419 e4f08c46 Iustin Pop
    let
420 e4f08c46 Iustin Pop
        Table ini_nl ini_il _ ini_plc = ini_tbl
421 0a0f2533 Iustin Pop
        (tmp_nl, new_inst, pri_idx, sec_idx) = applyMove ini_nl target move
422 e4f08c46 Iustin Pop
    in
423 e4f08c46 Iustin Pop
      if isNothing tmp_nl then cur_tbl
424 e4f08c46 Iustin Pop
      else
425 e4f08c46 Iustin Pop
          let tgt_idx = Instance.idx target
426 e4f08c46 Iustin Pop
              upd_nl = fromJust tmp_nl
427 e4f08c46 Iustin Pop
              upd_cvar = compCV upd_nl
428 e4f08c46 Iustin Pop
              upd_il = Container.add tgt_idx new_inst ini_il
429 0a0f2533 Iustin Pop
              upd_plc = (tgt_idx, pri_idx, sec_idx, upd_cvar):ini_plc
430 e4f08c46 Iustin Pop
              upd_tbl = Table upd_nl upd_il upd_cvar upd_plc
431 e4f08c46 Iustin Pop
          in
432 e4f08c46 Iustin Pop
            compareTables cur_tbl upd_tbl
433 e4f08c46 Iustin Pop
434 40d4eba0 Iustin Pop
-- | Given the status of the current secondary as a valid new node
435 40d4eba0 Iustin Pop
-- and the current candidate target node,
436 40d4eba0 Iustin Pop
-- generate the possible moves for a instance.
437 40d4eba0 Iustin Pop
possibleMoves :: Bool -> Int -> [IMove]
438 40d4eba0 Iustin Pop
possibleMoves True tdx =
439 40d4eba0 Iustin Pop
    [ReplaceSecondary tdx,
440 40d4eba0 Iustin Pop
     ReplaceAndFailover tdx,
441 40d4eba0 Iustin Pop
     ReplacePrimary tdx,
442 40d4eba0 Iustin Pop
     FailoverAndReplace tdx]
443 40d4eba0 Iustin Pop
444 40d4eba0 Iustin Pop
possibleMoves False tdx =
445 40d4eba0 Iustin Pop
    [ReplaceSecondary tdx,
446 40d4eba0 Iustin Pop
     ReplaceAndFailover tdx]
447 40d4eba0 Iustin Pop
448 40d4eba0 Iustin Pop
-- | Compute the best move for a given instance.
449 256810de Iustin Pop
checkInstanceMove :: [Int]             -- Allowed target node indices
450 256810de Iustin Pop
                  -> Table             -- Original table
451 256810de Iustin Pop
                  -> Instance.Instance -- Instance to move
452 256810de Iustin Pop
                  -> Table             -- Best new table for this instance
453 256810de Iustin Pop
checkInstanceMove nodes_idx ini_tbl target =
454 4e25d1c2 Iustin Pop
    let
455 4e25d1c2 Iustin Pop
        opdx = Instance.pnode target
456 4e25d1c2 Iustin Pop
        osdx = Instance.snode target
457 9dc6023f Iustin Pop
        nodes = filter (\idx -> idx /= opdx && idx /= osdx) nodes_idx
458 40d4eba0 Iustin Pop
        use_secondary = elem osdx nodes_idx
459 40d4eba0 Iustin Pop
        aft_failover = if use_secondary -- if allowed to failover
460 40d4eba0 Iustin Pop
                       then checkSingleStep ini_tbl target ini_tbl Failover
461 40d4eba0 Iustin Pop
                       else ini_tbl
462 40d4eba0 Iustin Pop
        all_moves = concatMap (possibleMoves use_secondary) nodes
463 4e25d1c2 Iustin Pop
    in
464 4e25d1c2 Iustin Pop
      -- iterate over the possible nodes for this instance
465 9dc6023f Iustin Pop
      foldl' (checkSingleStep ini_tbl target) aft_failover all_moves
466 4e25d1c2 Iustin Pop
467 e4f08c46 Iustin Pop
-- | Compute the best next move.
468 256810de Iustin Pop
checkMove :: [Int]               -- ^ Allowed target node indices
469 256810de Iustin Pop
          -> Table               -- ^ The current solution
470 e4f08c46 Iustin Pop
          -> [Instance.Instance] -- ^ List of instances still to move
471 256810de Iustin Pop
          -> Table               -- ^ The new solution
472 256810de Iustin Pop
checkMove nodes_idx ini_tbl victims =
473 4e25d1c2 Iustin Pop
    let Table _ _ _ ini_plc = ini_tbl
474 4e25d1c2 Iustin Pop
        -- iterate over all instances, computing the best move
475 256810de Iustin Pop
        best_tbl =
476 256810de Iustin Pop
            foldl'
477 256810de Iustin Pop
            (\ step_tbl elem -> compareTables step_tbl $
478 256810de Iustin Pop
                                checkInstanceMove nodes_idx ini_tbl elem)
479 256810de Iustin Pop
            ini_tbl victims
480 aaaa0e43 Iustin Pop
        Table _ _ _ best_plc = best_tbl
481 0a0f2533 Iustin Pop
    in
482 0a0f2533 Iustin Pop
      if length best_plc == length ini_plc then -- no advancement
483 0a0f2533 Iustin Pop
          ini_tbl
484 0a0f2533 Iustin Pop
      else
485 7dfaafb1 Iustin Pop
          best_tbl
486 e4f08c46 Iustin Pop
487 e4f08c46 Iustin Pop
{- | Auxiliary function for solution computation.
488 e4f08c46 Iustin Pop
489 e4f08c46 Iustin Pop
We write this in an explicit recursive fashion in order to control
490 e4f08c46 Iustin Pop
early-abort in case we have met the min delta. We can't use foldr
491 e4f08c46 Iustin Pop
instead of explicit recursion since we need the accumulator for the
492 e4f08c46 Iustin Pop
abort decision.
493 e4f08c46 Iustin Pop
494 e4f08c46 Iustin Pop
-}
495 e4f08c46 Iustin Pop
advanceSolution :: [Maybe Removal] -- ^ The removal to process
496 e4f08c46 Iustin Pop
                -> Int             -- ^ Minimum delta parameter
497 e4f08c46 Iustin Pop
                -> Int             -- ^ Maximum delta parameter
498 e4f08c46 Iustin Pop
                -> Maybe Solution  -- ^ Current best solution
499 e4f08c46 Iustin Pop
                -> Maybe Solution  -- ^ New best solution
500 e4f08c46 Iustin Pop
advanceSolution [] _ _ sol = sol
501 e4f08c46 Iustin Pop
advanceSolution (Nothing:xs) m n sol = advanceSolution xs m n sol
502 e4f08c46 Iustin Pop
advanceSolution ((Just (Removal nx removed)):xs) min_d max_d prev_sol =
503 e4f08c46 Iustin Pop
    let new_sol = checkPlacement nx removed [] 0 prev_sol max_d
504 e4f08c46 Iustin Pop
        new_delta = solutionDelta $! new_sol
505 e4f08c46 Iustin Pop
    in
506 e4f08c46 Iustin Pop
      if new_delta >= 0 && new_delta <= min_d then
507 e4f08c46 Iustin Pop
          new_sol
508 e4f08c46 Iustin Pop
      else
509 e4f08c46 Iustin Pop
          advanceSolution xs min_d max_d new_sol
510 e4f08c46 Iustin Pop
511 e4f08c46 Iustin Pop
-- | Computes the placement solution.
512 e4f08c46 Iustin Pop
solutionFromRemovals :: [Maybe Removal] -- ^ The list of (possible) removals
513 e4f08c46 Iustin Pop
                     -> Int             -- ^ Minimum delta parameter
514 e4f08c46 Iustin Pop
                     -> Int             -- ^ Maximum delta parameter
515 e4f08c46 Iustin Pop
                     -> Maybe Solution  -- ^ The best solution found
516 e4f08c46 Iustin Pop
solutionFromRemovals removals min_delta max_delta =
517 e4f08c46 Iustin Pop
    advanceSolution removals min_delta max_delta Nothing
518 e4f08c46 Iustin Pop
519 e4f08c46 Iustin Pop
{- | Computes the solution at the given depth.
520 e4f08c46 Iustin Pop
521 e4f08c46 Iustin Pop
This is a wrapper over both computeRemovals and
522 e4f08c46 Iustin Pop
solutionFromRemovals. In case we have no solution, we return Nothing.
523 e4f08c46 Iustin Pop
524 e4f08c46 Iustin Pop
-}
525 e4f08c46 Iustin Pop
computeSolution :: NodeList        -- ^ The original node data
526 e4f08c46 Iustin Pop
                -> [Instance.Instance] -- ^ The list of /bad/ instances
527 e4f08c46 Iustin Pop
                -> Int             -- ^ The /depth/ of removals
528 e4f08c46 Iustin Pop
                -> Int             -- ^ Maximum number of removals to process
529 e4f08c46 Iustin Pop
                -> Int             -- ^ Minimum delta parameter
530 e4f08c46 Iustin Pop
                -> Int             -- ^ Maximum delta parameter
531 e4f08c46 Iustin Pop
                -> Maybe Solution  -- ^ The best solution found (or Nothing)
532 e4f08c46 Iustin Pop
computeSolution nl bad_instances depth max_removals min_delta max_delta =
533 e4f08c46 Iustin Pop
  let
534 e4f08c46 Iustin Pop
      removals = computeRemovals nl bad_instances depth
535 e4f08c46 Iustin Pop
      removals' = capRemovals removals max_removals
536 e4f08c46 Iustin Pop
  in
537 e4f08c46 Iustin Pop
    solutionFromRemovals removals' min_delta max_delta
538 e4f08c46 Iustin Pop
539 e4f08c46 Iustin Pop
-- Solution display functions (pure)
540 e4f08c46 Iustin Pop
541 e4f08c46 Iustin Pop
-- | Given the original and final nodes, computes the relocation description.
542 e4f08c46 Iustin Pop
computeMoves :: String -- ^ The instance name
543 e4f08c46 Iustin Pop
             -> String -- ^ Original primary
544 e4f08c46 Iustin Pop
             -> String -- ^ Original secondary
545 e4f08c46 Iustin Pop
             -> String -- ^ New primary
546 e4f08c46 Iustin Pop
             -> String -- ^ New secondary
547 e4f08c46 Iustin Pop
             -> (String, [String])
548 e4f08c46 Iustin Pop
                -- ^ Tuple of moves and commands list; moves is containing
549 e4f08c46 Iustin Pop
                -- either @/f/@ for failover or @/r:name/@ for replace
550 e4f08c46 Iustin Pop
                -- secondary, while the command list holds gnt-instance
551 e4f08c46 Iustin Pop
                -- commands (without that prefix), e.g \"@failover instance1@\"
552 e4f08c46 Iustin Pop
computeMoves i a b c d =
553 e4f08c46 Iustin Pop
    if c == a then {- Same primary -}
554 e4f08c46 Iustin Pop
        if d == b then {- Same sec??! -}
555 e4f08c46 Iustin Pop
            ("-", [])
556 e4f08c46 Iustin Pop
        else {- Change of secondary -}
557 e4f08c46 Iustin Pop
            (printf "r:%s" d,
558 e4f08c46 Iustin Pop
             [printf "replace-disks -n %s %s" d i])
559 e4f08c46 Iustin Pop
    else
560 e4f08c46 Iustin Pop
        if c == b then {- Failover and ... -}
561 e4f08c46 Iustin Pop
            if d == a then {- that's all -}
562 e0eb63f0 Iustin Pop
                ("f", [printf "migrate -f %s" i])
563 e4f08c46 Iustin Pop
            else
564 e4f08c46 Iustin Pop
                (printf "f r:%s" d,
565 e0eb63f0 Iustin Pop
                 [printf "migrate -f %s" i,
566 e4f08c46 Iustin Pop
                  printf "replace-disks -n %s %s" d i])
567 e4f08c46 Iustin Pop
        else
568 e4f08c46 Iustin Pop
            if d == a then {- ... and keep primary as secondary -}
569 e4f08c46 Iustin Pop
                (printf "r:%s f" c,
570 e4f08c46 Iustin Pop
                 [printf "replace-disks -n %s %s" c i,
571 e0eb63f0 Iustin Pop
                  printf "migrate -f %s" i])
572 e4f08c46 Iustin Pop
            else
573 e4f08c46 Iustin Pop
                if d == b then {- ... keep same secondary -}
574 e4f08c46 Iustin Pop
                    (printf "f r:%s f" c,
575 e0eb63f0 Iustin Pop
                     [printf "migrate -f %s" i,
576 e4f08c46 Iustin Pop
                      printf "replace-disks -n %s %s" c i,
577 e0eb63f0 Iustin Pop
                      printf "migrate -f %s" i])
578 e4f08c46 Iustin Pop
579 e4f08c46 Iustin Pop
                else {- Nothing in common -}
580 e4f08c46 Iustin Pop
                    (printf "r:%s f r:%s" c d,
581 e4f08c46 Iustin Pop
                     [printf "replace-disks -n %s %s" c i,
582 e0eb63f0 Iustin Pop
                      printf "migrate -f %s" i,
583 e4f08c46 Iustin Pop
                      printf "replace-disks -n %s %s" d i])
584 e4f08c46 Iustin Pop
585 ca8258d9 Iustin Pop
{-| Converts a placement to string format -}
586 ca8258d9 Iustin Pop
printSolutionLine :: InstanceList
587 740ec004 Iustin Pop
              -> NameList
588 740ec004 Iustin Pop
              -> NameList
589 ca8258d9 Iustin Pop
              -> Int
590 ca8258d9 Iustin Pop
              -> Int
591 ca8258d9 Iustin Pop
              -> Placement
592 ab271fc1 Iustin Pop
              -> Int
593 ca8258d9 Iustin Pop
              -> (String, [String])
594 ab271fc1 Iustin Pop
printSolutionLine il ktn kti nmlen imlen plc pos =
595 ca8258d9 Iustin Pop
    let
596 ca8258d9 Iustin Pop
        pmlen = (2*nmlen + 1)
597 ca8258d9 Iustin Pop
        (i, p, s, c) = plc
598 ca8258d9 Iustin Pop
        inst = Container.find i il
599 ca8258d9 Iustin Pop
        inam = fromJust $ lookup (Instance.idx inst) kti
600 ca8258d9 Iustin Pop
        npri = fromJust $ lookup p ktn
601 ca8258d9 Iustin Pop
        nsec = fromJust $ lookup s ktn
602 ca8258d9 Iustin Pop
        opri = fromJust $ lookup (Instance.pnode inst) ktn
603 ca8258d9 Iustin Pop
        osec = fromJust $ lookup (Instance.snode inst) ktn
604 ca8258d9 Iustin Pop
        (moves, cmds) =  computeMoves inam opri osec npri nsec
605 ca8258d9 Iustin Pop
        ostr = (printf "%s:%s" opri osec)::String
606 ca8258d9 Iustin Pop
        nstr = (printf "%s:%s" npri nsec)::String
607 ca8258d9 Iustin Pop
    in
608 ab271fc1 Iustin Pop
      (printf "  %3d. %-*s %-*s => %-*s %.8f a=%s"
609 ab271fc1 Iustin Pop
       pos imlen inam pmlen ostr
610 ca8258d9 Iustin Pop
       pmlen nstr c moves,
611 ca8258d9 Iustin Pop
       cmds)
612 ca8258d9 Iustin Pop
613 142538ff Iustin Pop
formatCmds :: [[String]] -> String
614 142538ff Iustin Pop
formatCmds cmd_strs =
615 e0eb63f0 Iustin Pop
    unlines $
616 142538ff Iustin Pop
    concat $ map (\(a, b) ->
617 e0eb63f0 Iustin Pop
        (printf "echo step %d" (a::Int)):
618 e0eb63f0 Iustin Pop
        (printf "check"):
619 e0eb63f0 Iustin Pop
        (map ("gnt-instance " ++) b)) $
620 142538ff Iustin Pop
        zip [1..] cmd_strs
621 142538ff Iustin Pop
622 e4f08c46 Iustin Pop
{-| Converts a solution to string format -}
623 e4f08c46 Iustin Pop
printSolution :: InstanceList
624 740ec004 Iustin Pop
              -> NameList
625 740ec004 Iustin Pop
              -> NameList
626 e4f08c46 Iustin Pop
              -> [Placement]
627 e4f08c46 Iustin Pop
              -> ([String], [[String]])
628 e4f08c46 Iustin Pop
printSolution il ktn kti sol =
629 671b85b9 Iustin Pop
    let
630 671b85b9 Iustin Pop
        mlen_fn = maximum . (map length) . snd . unzip
631 671b85b9 Iustin Pop
        imlen = mlen_fn kti
632 671b85b9 Iustin Pop
        nmlen = mlen_fn ktn
633 671b85b9 Iustin Pop
    in
634 ab271fc1 Iustin Pop
      unzip $ map (uncurry $ printSolutionLine il ktn kti nmlen imlen) $
635 ab271fc1 Iustin Pop
            zip sol [1..]
636 e4f08c46 Iustin Pop
637 e4f08c46 Iustin Pop
-- | Print the node list.
638 740ec004 Iustin Pop
printNodes :: NameList -> NodeList -> String
639 e4f08c46 Iustin Pop
printNodes ktn nl =
640 e4f08c46 Iustin Pop
    let snl = sortBy (compare `on` Node.idx) (Container.elems nl)
641 e4f08c46 Iustin Pop
        snl' = map (\ n -> ((fromJust $ lookup (Node.idx n) ktn), n)) snl
642 af53a5c4 Iustin Pop
        m_name = maximum . (map length) . fst . unzip $ snl'
643 af53a5c4 Iustin Pop
        helper = Node.list m_name
644 a1c6212e Iustin Pop
        header = printf
645 a1c6212e Iustin Pop
                 "%2s %-*s %5s %5s %5s %5s %5s %5s %5s %5s %3s %3s %7s %7s"
646 a1c6212e Iustin Pop
                 " F" m_name "Name"
647 a1c6212e Iustin Pop
                 "t_mem" "n_mem" "i_mem" "x_mem" "f_mem" "r_mem"
648 ced859f3 Iustin Pop
                 "t_dsk" "f_dsk"
649 ced859f3 Iustin Pop
                 "pri" "sec" "p_fmem" "p_fdsk"
650 ced859f3 Iustin Pop
    in unlines $ (header:map (uncurry helper) snl')
651 e4f08c46 Iustin Pop
652 e4f08c46 Iustin Pop
-- | Compute the mem and disk covariance.
653 19777638 Iustin Pop
compDetailedCV :: NodeList -> (Double, Double, Double, Double, Double)
654 e4f08c46 Iustin Pop
compDetailedCV nl =
655 0335fe4a Iustin Pop
    let
656 19777638 Iustin Pop
        all_nodes = Container.elems nl
657 19777638 Iustin Pop
        (offline, nodes) = partition Node.offline all_nodes
658 0335fe4a Iustin Pop
        mem_l = map Node.p_mem nodes
659 0335fe4a Iustin Pop
        dsk_l = map Node.p_dsk nodes
660 e4f08c46 Iustin Pop
        mem_cv = varianceCoeff mem_l
661 e4f08c46 Iustin Pop
        dsk_cv = varianceCoeff dsk_l
662 34a6e127 Iustin Pop
        n1_l = length $ filter Node.failN1 nodes
663 34a6e127 Iustin Pop
        n1_score = (fromIntegral n1_l) / (fromIntegral $ length nodes)
664 d6be0775 Iustin Pop
        res_l = map Node.p_rem nodes
665 d6be0775 Iustin Pop
        res_cv = varianceCoeff res_l
666 19777638 Iustin Pop
        offline_inst = sum . map (\n -> (length . Node.plist $ n) +
667 19777638 Iustin Pop
                                        (length . Node.slist $ n)) $ offline
668 19777638 Iustin Pop
        online_inst = sum . map (\n -> (length . Node.plist $ n) +
669 19777638 Iustin Pop
                                       (length . Node.slist $ n)) $ nodes
670 19777638 Iustin Pop
        off_score = (fromIntegral offline_inst) /
671 19777638 Iustin Pop
                    (fromIntegral $ online_inst + offline_inst)
672 19777638 Iustin Pop
    in (mem_cv, dsk_cv, n1_score, res_cv, off_score)
673 e4f08c46 Iustin Pop
674 e4f08c46 Iustin Pop
-- | Compute the 'total' variance.
675 e4f08c46 Iustin Pop
compCV :: NodeList -> Double
676 e4f08c46 Iustin Pop
compCV nl =
677 19777638 Iustin Pop
    let (mem_cv, dsk_cv, n1_score, res_cv, off_score) = compDetailedCV nl
678 19777638 Iustin Pop
    in mem_cv + dsk_cv + n1_score + res_cv + off_score
679 e4f08c46 Iustin Pop
680 e4f08c46 Iustin Pop
printStats :: NodeList -> String
681 e4f08c46 Iustin Pop
printStats nl =
682 19777638 Iustin Pop
    let (mem_cv, dsk_cv, n1_score, res_cv, off_score) = compDetailedCV nl
683 19777638 Iustin Pop
    in printf "f_mem=%.8f, r_mem=%.8f, f_dsk=%.8f, n1=%.3f, uf=%.3f"
684 19777638 Iustin Pop
       mem_cv res_cv dsk_cv n1_score off_score
685 e4f08c46 Iustin Pop
686 e4f08c46 Iustin Pop
-- Balancing functions
687 e4f08c46 Iustin Pop
688 e4f08c46 Iustin Pop
-- Loading functions
689 e4f08c46 Iustin Pop
690 e4f08c46 Iustin Pop
{- | Convert newline and delimiter-separated text.
691 e4f08c46 Iustin Pop
692 e4f08c46 Iustin Pop
This function converts a text in tabular format as generated by
693 e4f08c46 Iustin Pop
@gnt-instance list@ and @gnt-node list@ to a list of objects using a
694 e4f08c46 Iustin Pop
supplied conversion function.
695 e4f08c46 Iustin Pop
696 e4f08c46 Iustin Pop
-}
697 e4f08c46 Iustin Pop
loadTabular :: String -> ([String] -> (String, a))
698 e4f08c46 Iustin Pop
            -> (a -> Int -> a) -> ([(String, Int)], [(Int, a)])
699 e4f08c46 Iustin Pop
loadTabular text_data convert_fn set_fn =
700 e4f08c46 Iustin Pop
    let lines_data = lines text_data
701 e4f08c46 Iustin Pop
        rows = map (sepSplit '|') lines_data
702 e4f08c46 Iustin Pop
        kerows = (map convert_fn rows)
703 e4f08c46 Iustin Pop
        idxrows = map (\ (idx, (k, v)) -> ((k, idx), (idx, set_fn v idx)))
704 e4f08c46 Iustin Pop
                  (zip [0..] kerows)
705 e4f08c46 Iustin Pop
    in unzip idxrows
706 e4f08c46 Iustin Pop
707 01f6a5d2 Iustin Pop
-- | For each instance, add its index to its primary and secondary nodes
708 01f6a5d2 Iustin Pop
fixNodes :: [(Int, Node.Node)]
709 01f6a5d2 Iustin Pop
         -> [(Int, Instance.Instance)]
710 01f6a5d2 Iustin Pop
         -> [(Int, Node.Node)]
711 01f6a5d2 Iustin Pop
fixNodes nl il =
712 d4f62d4e Iustin Pop
    foldl' (\accu (idx, inst) ->
713 d4f62d4e Iustin Pop
                let
714 d4f62d4e Iustin Pop
                    assocEqual = (\ (i, _) (j, _) -> i == j)
715 d4f62d4e Iustin Pop
                    pdx = Instance.pnode inst
716 d4f62d4e Iustin Pop
                    sdx = Instance.snode inst
717 d4f62d4e Iustin Pop
                    pold = fromJust $ lookup pdx accu
718 d4f62d4e Iustin Pop
                    sold = fromJust $ lookup sdx accu
719 d4f62d4e Iustin Pop
                    pnew = Node.setPri pold idx
720 d4f62d4e Iustin Pop
                    snew = Node.setSec sold idx
721 d4f62d4e Iustin Pop
                    ac1 = deleteBy assocEqual (pdx, pold) accu
722 d4f62d4e Iustin Pop
                    ac2 = deleteBy assocEqual (sdx, sold) ac1
723 d4f62d4e Iustin Pop
                    ac3 = (pdx, pnew):(sdx, snew):ac2
724 d4f62d4e Iustin Pop
                in ac3) nl il
725 01f6a5d2 Iustin Pop
726 740ec004 Iustin Pop
-- | Compute the longest common suffix of a NameList list that
727 a0529a64 Iustin Pop
-- | starts with a dot
728 740ec004 Iustin Pop
longestDomain :: NameList -> String
729 a0529a64 Iustin Pop
longestDomain [] = ""
730 a0529a64 Iustin Pop
longestDomain ((_,x):xs) =
731 a0529a64 Iustin Pop
    let
732 a0529a64 Iustin Pop
        onlyStrings = snd $ unzip xs
733 a0529a64 Iustin Pop
    in
734 a0529a64 Iustin Pop
      foldr (\ suffix accu -> if all (isSuffixOf suffix) onlyStrings
735 a0529a64 Iustin Pop
                              then suffix
736 a0529a64 Iustin Pop
                              else accu)
737 a0529a64 Iustin Pop
      "" $ filter (isPrefixOf ".") (tails x)
738 a0529a64 Iustin Pop
739 a0529a64 Iustin Pop
-- | Remove tails from the (Int, String) lists
740 740ec004 Iustin Pop
stripSuffix :: String -> NameList -> NameList
741 a0529a64 Iustin Pop
stripSuffix suffix lst =
742 a0529a64 Iustin Pop
    let sflen = length suffix in
743 a0529a64 Iustin Pop
    map (\ (key, name) -> (key, take ((length name) - sflen) name)) lst
744 e4f08c46 Iustin Pop
745 e4f08c46 Iustin Pop
{-| Initializer function that loads the data from a node and list file
746 e4f08c46 Iustin Pop
    and massages it into the correct format. -}
747 e4f08c46 Iustin Pop
loadData :: String -- ^ Node data in text format
748 e4f08c46 Iustin Pop
         -> String -- ^ Instance data in text format
749 e4f08c46 Iustin Pop
         -> (Container.Container Node.Node,
750 e4f08c46 Iustin Pop
             Container.Container Instance.Instance,
751 740ec004 Iustin Pop
             String, NameList, NameList)
752 e4f08c46 Iustin Pop
loadData ndata idata =
753 01f6a5d2 Iustin Pop
    let
754 04be800a Iustin Pop
    {- node file: name t_mem n_mem f_mem t_disk f_disk -}
755 e4f08c46 Iustin Pop
        (ktn, nl) = loadTabular ndata
756 00b15752 Iustin Pop
                    (\ (name:tm:nm:fm:td:fd:fo:[]) ->
757 47a8bade Iustin Pop
                         (name,
758 00b15752 Iustin Pop
                          if any (== "?") [tm,nm,fm,td,fd] || fo == "Y" then
759 00b15752 Iustin Pop
                              Node.create 0 0 0 0 0 True
760 00b15752 Iustin Pop
                          else
761 00b15752 Iustin Pop
                              Node.create (read tm) (read nm) (read fm)
762 00b15752 Iustin Pop
                                      (read td) (read fd) False
763 00b15752 Iustin Pop
                         ))
764 e4f08c46 Iustin Pop
                    Node.setIdx
765 f82f1f39 Iustin Pop
    {- instance file: name mem disk status pnode snode -}
766 01f6a5d2 Iustin Pop
        (kti, il) = loadTabular idata
767 f82f1f39 Iustin Pop
                    (\ (name:mem:dsk:status:pnode:snode:[]) ->
768 47a8bade Iustin Pop
                         (name,
769 47a8bade Iustin Pop
                          Instance.create (read mem) (read dsk)
770 f82f1f39 Iustin Pop
                              status
771 47a8bade Iustin Pop
                              (fromJust $ lookup pnode ktn)
772 47a8bade Iustin Pop
                              (fromJust $ lookup snode ktn)))
773 01f6a5d2 Iustin Pop
                    Instance.setIdx
774 01f6a5d2 Iustin Pop
        nl2 = fixNodes nl il
775 01f6a5d2 Iustin Pop
        il3 = Container.fromAssocList il
776 e4f08c46 Iustin Pop
        nl3 = Container.fromAssocList
777 01f6a5d2 Iustin Pop
             (map (\ (k, v) -> (k, Node.buildPeers v il3 (length nl2))) nl2)
778 a0529a64 Iustin Pop
        xtn = swapPairs ktn
779 a0529a64 Iustin Pop
        xti = swapPairs kti
780 a0529a64 Iustin Pop
        common_suffix = longestDomain (xti ++ xtn)
781 a0529a64 Iustin Pop
        stn = stripSuffix common_suffix xtn
782 a0529a64 Iustin Pop
        sti = stripSuffix common_suffix xti
783 e4f08c46 Iustin Pop
    in
784 a0529a64 Iustin Pop
      (nl3, il3, common_suffix, stn, sti)
785 5d1baf63 Iustin Pop
786 5d1baf63 Iustin Pop
-- | Compute the amount of memory used by primary instances on a node.
787 5d1baf63 Iustin Pop
nodeImem :: Node.Node -> InstanceList -> Int
788 5d1baf63 Iustin Pop
nodeImem node il =
789 5d1baf63 Iustin Pop
    let rfind = flip Container.find $ il
790 5d1baf63 Iustin Pop
    in sum . map Instance.mem .
791 5d1baf63 Iustin Pop
       map rfind $ Node.plist node
792 5d1baf63 Iustin Pop
793 9cded5d3 Iustin Pop
-- | Compute the amount of disk used by instances on a node (either primary
794 9cded5d3 Iustin Pop
-- or secondary).
795 9cded5d3 Iustin Pop
nodeIdsk :: Node.Node -> InstanceList -> Int
796 9cded5d3 Iustin Pop
nodeIdsk node il =
797 9cded5d3 Iustin Pop
    let rfind = flip Container.find $ il
798 9cded5d3 Iustin Pop
    in sum . map Instance.dsk .
799 9cded5d3 Iustin Pop
       map rfind $ (Node.plist node) ++ (Node.slist node)
800 9cded5d3 Iustin Pop
801 5d1baf63 Iustin Pop
802 5d1baf63 Iustin Pop
-- | Check cluster data for consistency
803 5d1baf63 Iustin Pop
checkData :: NodeList -> InstanceList -> NameList -> NameList
804 5d1baf63 Iustin Pop
          -> ([String], NodeList)
805 53f00b20 Iustin Pop
checkData nl il ktn _ =
806 5d1baf63 Iustin Pop
    Container.mapAccum
807 5d1baf63 Iustin Pop
        (\ msgs node ->
808 5d1baf63 Iustin Pop
             let nname = fromJust $ lookup (Node.idx node) ktn
809 53f00b20 Iustin Pop
                 nilst = map (flip Container.find $ il) (Node.plist node)
810 53f00b20 Iustin Pop
                 dilst = filter (not . Instance.running) nilst
811 53f00b20 Iustin Pop
                 adj_mem = sum . map Instance.mem $ dilst
812 53f00b20 Iustin Pop
                 delta_mem = (truncate $ Node.t_mem node)
813 53f00b20 Iustin Pop
                             - (Node.n_mem node)
814 53f00b20 Iustin Pop
                             - (Node.f_mem node)
815 53f00b20 Iustin Pop
                             - (nodeImem node il)
816 53f00b20 Iustin Pop
                             + adj_mem
817 9cded5d3 Iustin Pop
                 delta_dsk = (truncate $ Node.t_dsk node)
818 9cded5d3 Iustin Pop
                             - (Node.f_dsk node)
819 9cded5d3 Iustin Pop
                             - (nodeIdsk node il)
820 53f00b20 Iustin Pop
                 newn = Node.setFmem (Node.setXmem node delta_mem)
821 53f00b20 Iustin Pop
                        (Node.f_mem node - adj_mem)
822 8930eef2 Iustin Pop
                 umsg1 = if delta_mem > 512 || delta_dsk > 1024
823 9cded5d3 Iustin Pop
                         then [printf "node %s is missing %d MB ram \
824 9cded5d3 Iustin Pop
                                     \and %d GB disk"
825 9cded5d3 Iustin Pop
                                     nname delta_mem (delta_dsk `div` 1024)]
826 9cded5d3 Iustin Pop
                         else []
827 9cded5d3 Iustin Pop
             in (msgs ++ umsg1, newn)
828 5d1baf63 Iustin Pop
        ) [] nl