Statistics
| Branch: | Tag: | Revision:

root / hbal.hs @ f9acea10

History | View | Annotate | Download (11.6 kB)

1
{-| Cluster rebalancer
2

    
3
-}
4

    
5
{-
6

    
7
Copyright (C) 2009 Google Inc.
8

    
9
This program is free software; you can redistribute it and/or modify
10
it under the terms of the GNU General Public License as published by
11
the Free Software Foundation; either version 2 of the License, or
12
(at your option) any later version.
13

    
14
This program is distributed in the hope that it will be useful, but
15
WITHOUT ANY WARRANTY; without even the implied warranty of
16
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
17
General Public License for more details.
18

    
19
You should have received a copy of the GNU General Public License
20
along with this program; if not, write to the Free Software
21
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
22
02110-1301, USA.
23

    
24
-}
25

    
26
module Main (main) where
27

    
28
import Control.Concurrent (threadDelay)
29
import Control.Exception (bracket)
30
import Data.List
31
import Data.Maybe (isJust, fromJust)
32
import Monad
33
import System (exitWith, ExitCode(..))
34
import System.IO
35
import qualified System
36

    
37
import Text.Printf (printf, hPrintf)
38

    
39
import qualified Ganeti.HTools.Container as Container
40
import qualified Ganeti.HTools.Cluster as Cluster
41
import qualified Ganeti.HTools.Node as Node
42
import qualified Ganeti.HTools.Instance as Instance
43

    
44
import Ganeti.HTools.CLI
45
import Ganeti.HTools.ExtLoader
46
import Ganeti.HTools.Utils
47
import Ganeti.HTools.Types
48

    
49
import qualified Ganeti.Luxi as L
50
import Ganeti.Jobs
51

    
52
-- | Options list and functions
53
options :: [OptType]
54
options =
55
    [ oPrintNodes
56
    , oPrintInsts
57
    , oPrintCommands
58
    , oOneline
59
    , oDataFile
60
    , oEvacMode
61
    , oRapiMaster
62
    , oLuxiSocket
63
    , oExecJobs
64
    , oMaxSolLength
65
    , oVerbose
66
    , oQuiet
67
    , oOfflineNode
68
    , oMinScore
69
    , oMaxCpu
70
    , oMinDisk
71
    , oDiskMoves
72
    , oDynuFile
73
    , oExTags
74
    , oExInst
75
    , oShowVer
76
    , oShowHelp
77
    ]
78

    
79
{- | Start computing the solution at the given depth and recurse until
80
we find a valid solution or we exceed the maximum depth.
81

    
82
-}
83
iterateDepth :: Cluster.Table    -- ^ The starting table
84
             -> Int              -- ^ Remaining length
85
             -> Bool             -- ^ Allow disk moves
86
             -> Int              -- ^ Max node name len
87
             -> Int              -- ^ Max instance name len
88
             -> [MoveJob]        -- ^ Current command list
89
             -> Bool             -- ^ Whether to be silent
90
             -> Score            -- ^ Score at which to stop
91
             -> Bool             -- ^ Enable evacuation mode
92
             -> IO (Cluster.Table, [MoveJob]) -- ^ The resulting table
93
                                              -- and commands
94
iterateDepth ini_tbl max_rounds disk_moves nmlen imlen
95
             cmd_strs oneline min_score evac_mode =
96
    let Cluster.Table ini_nl ini_il _ _ = ini_tbl
97
        allowed_next = Cluster.doNextBalance ini_tbl max_rounds min_score
98
        m_fin_tbl = if allowed_next
99
                    then Cluster.tryBalance ini_tbl disk_moves evac_mode
100
                    else Nothing
101
    in
102
      case m_fin_tbl of
103
        Just fin_tbl ->
104
            do
105
              let
106
                  (Cluster.Table _ _ _ fin_plc) = fin_tbl
107
                  fin_plc_len = length fin_plc
108
                  cur_plc@(idx, _, _, move, _) = head fin_plc
109
                  (sol_line, cmds) = Cluster.printSolutionLine ini_nl ini_il
110
                                     nmlen imlen cur_plc fin_plc_len
111
                  afn = Cluster.involvedNodes ini_il cur_plc
112
                  upd_cmd_strs = (afn, idx, move, cmds):cmd_strs
113
              unless oneline $ do
114
                       putStrLn sol_line
115
                       hFlush stdout
116
              iterateDepth fin_tbl max_rounds disk_moves
117
                           nmlen imlen upd_cmd_strs oneline min_score
118
                           evac_mode
119
        Nothing -> return (ini_tbl, cmd_strs)
120

    
121
-- | Formats the solution for the oneline display
122
formatOneline :: Double -> Int -> Double -> String
123
formatOneline ini_cv plc_len fin_cv =
124
    printf "%.8f %d %.8f %8.3f" ini_cv plc_len fin_cv
125
               (if fin_cv == 0 then 1 else ini_cv / fin_cv)
126

    
127
-- | Polls a set of jobs at a fixed interval until all are finished
128
-- one way or another
129
waitForJobs :: L.Client -> [String] -> IO (Result [JobStatus])
130
waitForJobs client jids = do
131
  sts <- L.queryJobsStatus client jids
132
  case sts of
133
    Bad x -> return $ Bad x
134
    Ok s -> if any (<= JOB_STATUS_RUNNING) s
135
            then do
136
              -- TODO: replace hardcoded value with a better thing
137
              threadDelay (1000000 * 15)
138
              waitForJobs client jids
139
            else return $ Ok s
140

    
141
-- | Check that a set of job statuses is all success
142
checkJobsStatus :: [JobStatus] -> Bool
143
checkJobsStatus = all (== JOB_STATUS_SUCCESS)
144

    
145
-- | Execute an entire jobset
146
execJobSet :: String -> Node.List
147
           -> Instance.List -> [JobSet] -> IO ()
148
execJobSet _      _  _  [] = return ()
149
execJobSet master nl il (js:jss) = do
150
  -- map from jobset (htools list of positions) to [[opcodes]]
151
  let jobs = map (\(_, idx, move, _) ->
152
                      Cluster.iMoveToJob nl il idx move) js
153
  let descr = map (\(_, idx, _, _) -> Container.nameOf il idx) js
154
  putStrLn $ "Executing jobset for instances " ++ commaJoin descr
155
  jrs <- bracket (L.getClient master) L.closeClient
156
         (\client -> do
157
            jids <- L.submitManyJobs client jobs
158
            case jids of
159
              Bad x -> return $ Bad x
160
              Ok x -> do
161
                putStrLn $ "Got job IDs " ++ commaJoin x
162
                waitForJobs client x
163
         )
164
  (case jrs of
165
     Bad x -> do
166
       hPutStrLn stderr $ "Cannot compute job status, aborting: " ++ show x
167
       return ()
168
     Ok x -> if checkJobsStatus x
169
             then execJobSet master nl il jss
170
             else do
171
               hPutStrLn stderr $ "Not all jobs completed successfully: " ++
172
                         show x
173
               hPutStrLn stderr "Aborting.")
174

    
175
-- | Main function.
176
main :: IO ()
177
main = do
178
  cmd_args <- System.getArgs
179
  (opts, args) <- parseOpts cmd_args "hbal" options
180

    
181
  unless (null args) $ do
182
         hPutStrLn stderr "Error: this program doesn't take any arguments."
183
         exitWith $ ExitFailure 1
184

    
185
  let oneline = optOneline opts
186
      verbose = optVerbose opts
187
      shownodes = optShowNodes opts
188

    
189
  (fixed_nl, il, ctags) <- loadExternalData opts
190

    
191
  let offline_names = optOffline opts
192
      all_nodes = Container.elems fixed_nl
193
      all_names = concatMap allNames all_nodes
194
      offline_wrong = filter (`notElem` all_names) offline_names
195
      offline_indices = map Node.idx $
196
                        filter (\n ->
197
                                 Node.name n `elem` offline_names ||
198
                                 Node.alias n `elem` offline_names)
199
                               all_nodes
200
      m_cpu = optMcpu opts
201
      m_dsk = optMdsk opts
202
      csf = commonSuffix fixed_nl il
203

    
204
  when (length offline_wrong > 0) $ do
205
         hPrintf stderr "Wrong node name(s) set as offline: %s\n"
206
                     (commaJoin offline_wrong) :: IO ()
207
         exitWith $ ExitFailure 1
208

    
209
  let nm = Container.map (\n -> if Node.idx n `elem` offline_indices
210
                                then Node.setOffline n True
211
                                else n) fixed_nl
212
      nl = Container.map (flip Node.setMdsk m_dsk . flip Node.setMcpu m_cpu)
213
           nm
214

    
215
  when (not oneline && verbose > 1) $
216
       putStrLn $ "Loaded cluster tags: " ++ intercalate "," ctags
217

    
218
  when (Container.size il == 0) $ do
219
         (if oneline then putStrLn $ formatOneline 0 0 0
220
          else printf "Cluster is empty, exiting.\n")
221
         exitWith ExitSuccess
222

    
223
  unless oneline $ printf "Loaded %d nodes, %d instances\n"
224
             (Container.size nl)
225
             (Container.size il)
226

    
227
  when (length csf > 0 && not oneline && verbose > 1) $
228
       printf "Note: Stripping common suffix of '%s' from names\n" csf
229

    
230
  let (bad_nodes, bad_instances) = Cluster.computeBadItems nl il
231
  unless (oneline || verbose == 0) $ printf
232
             "Initial check done: %d bad nodes, %d bad instances.\n"
233
             (length bad_nodes) (length bad_instances)
234

    
235
  when (length bad_nodes > 0) $
236
         putStrLn "Cluster is not N+1 happy, continuing but no guarantee \
237
                  \that the cluster will end N+1 happy."
238

    
239
  when (optShowInsts opts) $ do
240
         putStrLn ""
241
         putStrLn "Initial instance map:"
242
         putStrLn $ Cluster.printInsts nl il
243

    
244
  when (isJust shownodes) $
245
       do
246
         putStrLn "Initial cluster status:"
247
         putStrLn $ Cluster.printNodes nl (fromJust shownodes)
248

    
249
  let ini_cv = Cluster.compCV nl
250
      ini_tbl = Cluster.Table nl il ini_cv []
251
      min_cv = optMinScore opts
252

    
253
  when (ini_cv < min_cv) $ do
254
         (if oneline then
255
              putStrLn $ formatOneline ini_cv 0 ini_cv
256
          else printf "Cluster is already well balanced (initial score %.6g,\n\
257
                      \minimum score %.6g).\nNothing to do, exiting\n"
258
                      ini_cv min_cv)
259
         exitWith ExitSuccess
260

    
261
  unless oneline (if verbose > 2 then
262
                      printf "Initial coefficients: overall %.8f, %s\n"
263
                      ini_cv (Cluster.printStats nl)
264
                  else
265
                      printf "Initial score: %.8f\n" ini_cv)
266

    
267
  unless oneline $ putStrLn "Trying to minimize the CV..."
268
  let imlen = Container.maxNameLen il
269
      nmlen = Container.maxNameLen nl
270

    
271
  (fin_tbl, cmd_strs) <- iterateDepth ini_tbl (optMaxLength opts)
272
                         (optDiskMoves opts)
273
                         nmlen imlen [] oneline min_cv (optEvacMode opts)
274
  let (Cluster.Table fin_nl fin_il fin_cv fin_plc) = fin_tbl
275
      ord_plc = reverse fin_plc
276
      sol_msg = if null fin_plc
277
                then printf "No solution found\n"
278
                else if verbose > 2
279
                     then printf "Final coefficients:   overall %.8f, %s\n"
280
                          fin_cv (Cluster.printStats fin_nl)
281
                     else printf "Cluster score improved from %.8f to %.8f\n"
282
                          ini_cv fin_cv
283
                              ::String
284

    
285
  unless oneline $ putStr sol_msg
286

    
287
  unless (oneline || verbose == 0) $
288
         printf "Solution length=%d\n" (length ord_plc)
289

    
290
  let cmd_jobs = Cluster.splitJobs cmd_strs
291
      cmd_data = Cluster.formatCmds cmd_jobs
292

    
293
  when (isJust $ optShowCmds opts) $
294
       do
295
         let out_path = fromJust $ optShowCmds opts
296
         putStrLn ""
297
         (if out_path == "-" then
298
              printf "Commands to run to reach the above solution:\n%s"
299
                     (unlines . map ("  " ++) .
300
                      filter (/= "  check") .
301
                      lines $ cmd_data)
302
          else do
303
            writeFile out_path (shTemplate ++ cmd_data)
304
            printf "The commands have been written to file '%s'\n" out_path)
305

    
306
  when (optExecJobs opts && not (null ord_plc))
307
           (case optLuxi opts of
308
              Nothing -> do
309
                hPutStrLn stderr "Execution of commands possible only on LUXI"
310
                exitWith $ ExitFailure 1
311
              Just master -> execJobSet master fin_nl il cmd_jobs)
312

    
313
  when (optShowInsts opts) $ do
314
         putStrLn ""
315
         putStrLn "Final instance map:"
316
         putStr $ Cluster.printInsts fin_nl fin_il
317

    
318
  when (isJust shownodes) $
319
       do
320
         let ini_cs = Cluster.totalResources nl
321
             fin_cs = Cluster.totalResources fin_nl
322
         putStrLn ""
323
         putStrLn "Final cluster status:"
324
         putStrLn $ Cluster.printNodes fin_nl (fromJust shownodes)
325
         when (verbose > 3) $
326
              do
327
                printf "Original: mem=%d disk=%d\n"
328
                       (Cluster.csFmem ini_cs) (Cluster.csFdsk ini_cs) :: IO ()
329
                printf "Final:    mem=%d disk=%d\n"
330
                       (Cluster.csFmem fin_cs) (Cluster.csFdsk fin_cs)
331
  when oneline $
332
         putStrLn $ formatOneline ini_cv (length ord_plc) fin_cv