Statistics
| Branch: | Tag: | Revision:

root / hbal.hs @ a2e90275

History | View | Annotate | Download (8.4 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 Data.List
29
import Data.Function
30
import Data.Maybe (isJust, fromJust)
31
import Monad
32
import System
33
import System.IO
34
import qualified System
35

    
36
import Text.Printf (printf, hPrintf)
37

    
38
import qualified Ganeti.HTools.Container as Container
39
import qualified Ganeti.HTools.Cluster as Cluster
40
import qualified Ganeti.HTools.Node as Node
41

    
42
import Ganeti.HTools.CLI
43
import Ganeti.HTools.ExtLoader
44
import Ganeti.HTools.Utils
45
import Ganeti.HTools.Types
46

    
47
-- | Options list and functions
48
options :: [OptType]
49
options =
50
    [ oPrintNodes
51
    , oPrintCommands
52
    , oOneline
53
    , oNodeFile
54
    , oInstFile
55
    , oRapiMaster
56
    , oLuxiSocket
57
    , oMaxSolLength
58
    , oVerbose
59
    , oQuiet
60
    , oOfflineNode
61
    , oMinScore
62
    , oMaxCpu
63
    , oMinDisk
64
    , oDiskMoves
65
    , oShowVer
66
    , oShowHelp
67
    ]
68

    
69
{- | Start computing the solution at the given depth and recurse until
70
we find a valid solution or we exceed the maximum depth.
71

    
72
-}
73
iterateDepth :: Cluster.Table    -- ^ The starting table
74
             -> Int              -- ^ Remaining length
75
             -> Bool             -- ^ Allow disk moves
76
             -> Int              -- ^ Max node name len
77
             -> Int              -- ^ Max instance name len
78
             -> [MoveJob]        -- ^ Current command list
79
             -> Bool             -- ^ Whether to be silent
80
             -> Score            -- ^ Score at which to stop
81
             -> IO (Cluster.Table, [MoveJob]) -- ^ The resulting table
82
                                              -- and commands
83
iterateDepth ini_tbl max_rounds disk_moves nmlen imlen
84
             cmd_strs oneline min_score =
85
    let Cluster.Table ini_nl ini_il _ _ = ini_tbl
86
        m_fin_tbl = Cluster.tryBalance ini_tbl max_rounds disk_moves min_score
87
    in
88
      case m_fin_tbl of
89
        Just fin_tbl ->
90
            do
91
              let
92
                  (Cluster.Table _ _ _ fin_plc) = fin_tbl
93
                  fin_plc_len = length fin_plc
94
                  cur_plc@(_, _, _, move, _) = head fin_plc
95
                  (sol_line, cmds) = Cluster.printSolutionLine ini_nl ini_il
96
                                     nmlen imlen cur_plc fin_plc_len
97
                  afn = Cluster.involvedNodes ini_il cur_plc
98
                  upd_cmd_strs = (afn, move, cmds):cmd_strs
99
              unless oneline $ do
100
                       putStrLn sol_line
101
                       hFlush stdout
102
              iterateDepth fin_tbl max_rounds disk_moves
103
                           nmlen imlen upd_cmd_strs oneline min_score
104
        Nothing -> return (ini_tbl, cmd_strs)
105

    
106
-- | Formats the solution for the oneline display
107
formatOneline :: Double -> Int -> Double -> String
108
formatOneline ini_cv plc_len fin_cv =
109
    printf "%.8f %d %.8f %8.3f" ini_cv plc_len fin_cv
110
               (if fin_cv == 0 then 1 else ini_cv / fin_cv)
111

    
112
-- | Main function.
113
main :: IO ()
114
main = do
115
  cmd_args <- System.getArgs
116
  (opts, args) <- parseOpts cmd_args "hbal" options
117

    
118
  unless (null args) $ do
119
         hPutStrLn stderr "Error: this program doesn't take any arguments."
120
         exitWith $ ExitFailure 1
121

    
122
  let oneline = optOneline opts
123
      verbose = optVerbose opts
124

    
125
  (fixed_nl, il, csf) <- loadExternalData opts
126

    
127
  let offline_names = optOffline opts
128
      all_nodes = Container.elems fixed_nl
129
      all_names = map Node.name all_nodes
130
      offline_wrong = filter (flip notElem all_names) offline_names
131
      offline_indices = map Node.idx $
132
                        filter (\n -> elem (Node.name n) offline_names)
133
                               all_nodes
134
      m_cpu = optMcpu opts
135
      m_dsk = optMdsk opts
136

    
137
  when (length offline_wrong > 0) $ do
138
         hPrintf stderr "Wrong node name(s) set as offline: %s\n"
139
                     (commaJoin offline_wrong)
140
         exitWith $ ExitFailure 1
141

    
142
  let nm = Container.map (\n -> if elem (Node.idx n) offline_indices
143
                                then Node.setOffline n True
144
                                else n) fixed_nl
145
      nl = Container.map (flip Node.setMdsk m_dsk . flip Node.setMcpu m_cpu)
146
           nm
147

    
148
  when (Container.size il == 0) $ do
149
         (if oneline then putStrLn $ formatOneline 0 0 0
150
          else printf "Cluster is empty, exiting.\n")
151
         exitWith ExitSuccess
152

    
153
  unless oneline $ printf "Loaded %d nodes, %d instances\n"
154
             (Container.size nl)
155
             (Container.size il)
156

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

    
160
  let (bad_nodes, bad_instances) = Cluster.computeBadItems nl il
161
  unless (oneline || verbose == 0) $ printf
162
             "Initial check done: %d bad nodes, %d bad instances.\n"
163
             (length bad_nodes) (length bad_instances)
164

    
165
  when (length bad_nodes > 0) $
166
         putStrLn "Cluster is not N+1 happy, continuing but no guarantee \
167
                  \that the cluster will end N+1 happy."
168

    
169
  when (optShowNodes opts) $
170
       do
171
         putStrLn "Initial cluster status:"
172
         putStrLn $ Cluster.printNodes nl
173

    
174
  let ini_cv = Cluster.compCV nl
175
      ini_tbl = Cluster.Table nl il ini_cv []
176
      min_cv = optMinScore opts
177

    
178
  when (ini_cv < min_cv) $ do
179
         (if oneline then
180
              putStrLn $ formatOneline ini_cv 0 ini_cv
181
          else printf "Cluster is already well balanced (initial score %.6g,\n\
182
                      \minimum score %.6g).\nNothing to do, exiting\n"
183
                      ini_cv min_cv)
184
         exitWith ExitSuccess
185

    
186
  unless oneline (if verbose > 2 then
187
                      printf "Initial coefficients: overall %.8f, %s\n"
188
                      ini_cv (Cluster.printStats nl)
189
                  else
190
                      printf "Initial score: %.8f\n" ini_cv)
191

    
192
  unless oneline $ putStrLn "Trying to minimize the CV..."
193
  let imlen = Container.maxNameLen il
194
      nmlen = Container.maxNameLen nl
195

    
196
  (fin_tbl, cmd_strs) <- iterateDepth ini_tbl (optMaxLength opts)
197
                         (optDiskMoves opts)
198
                         nmlen imlen [] oneline min_cv
199
  let (Cluster.Table fin_nl _ fin_cv fin_plc) = fin_tbl
200
      ord_plc = reverse fin_plc
201
      sol_msg = if null fin_plc
202
                then printf "No solution found\n"
203
                else if verbose > 2
204
                     then printf "Final coefficients:   overall %.8f, %s\n"
205
                          fin_cv (Cluster.printStats fin_nl)
206
                     else printf "Cluster score improved from %.8f to %.8f\n"
207
                          ini_cv fin_cv
208
                              ::String
209

    
210
  unless oneline $ putStr sol_msg
211

    
212
  unless (oneline || verbose == 0) $
213
         printf "Solution length=%d\n" (length ord_plc)
214

    
215
  let cmd_data = Cluster.formatCmds . Cluster.splitJobs $ cmd_strs
216

    
217
  when (isJust $ optShowCmds opts) $
218
       do
219
         let out_path = fromJust $ optShowCmds opts
220
         putStrLn ""
221
         (if out_path == "-" then
222
              printf "Commands to run to reach the above solution:\n%s"
223
                     (unlines . map ("  " ++) .
224
                      filter (/= "  check") .
225
                      lines $ cmd_data)
226
          else do
227
            writeFile out_path (shTemplate ++ cmd_data)
228
            printf "The commands have been written to file '%s'\n" out_path)
229

    
230
  when (optShowNodes opts) $
231
       do
232
         let ini_cs = Cluster.totalResources nl
233
             fin_cs = Cluster.totalResources fin_nl
234
         putStrLn ""
235
         putStrLn "Final cluster status:"
236
         putStrLn $ Cluster.printNodes fin_nl
237
         when (verbose > 3) $
238
              do
239
                printf "Original: mem=%d disk=%d\n"
240
                       (Cluster.cs_fmem ini_cs) (Cluster.cs_fdsk ini_cs)
241
                printf "Final:    mem=%d disk=%d\n"
242
                       (Cluster.cs_fmem fin_cs) (Cluster.cs_fdsk fin_cs)
243
  when oneline $
244
         putStrLn $ formatOneline ini_cv (length ord_plc) fin_cv