Statistics
| Branch: | Tag: | Revision:

root / hbal.hs @ e0eb63f0

History | View | Annotate | Download (9.9 kB)

1
{-| Solver for N+1 cluster errors
2

    
3
-}
4

    
5
module Main (main) where
6

    
7
import Data.List
8
import Data.Function
9
import Data.Maybe (isJust, fromJust, fromMaybe)
10
import Monad
11
import System
12
import System.IO
13
import System.Console.GetOpt
14
import qualified System
15

    
16
import Text.Printf (printf)
17

    
18
import qualified Ganeti.HTools.Container as Container
19
import qualified Ganeti.HTools.Cluster as Cluster
20
import qualified Ganeti.HTools.Node as Node
21
import qualified Ganeti.HTools.CLI as CLI
22
import Ganeti.HTools.Rapi
23
import Ganeti.HTools.Utils
24

    
25
-- | Command line options structure.
26
data Options = Options
27
    { optShowNodes :: Bool           -- ^ Whether to show node status
28
    , optShowCmds  :: Maybe FilePath -- ^ Whether to show the command list
29
    , optOneline   :: Bool           -- ^ Switch output to a single line
30
    , optNodef     :: FilePath       -- ^ Path to the nodes file
31
    , optInstf     :: FilePath       -- ^ Path to the instances file
32
    , optMaxLength :: Int            -- ^ Stop after this many steps
33
    , optMaster    :: String         -- ^ Collect data from RAPI
34
    , optVerbose   :: Int            -- ^ Verbosity level
35
    , optOffline   :: [String]       -- ^ Names of offline nodes
36
    , optShowVer   :: Bool           -- ^ Just show the program version
37
    , optShowHelp  :: Bool           -- ^ Just show the help
38
    } deriving Show
39

    
40
-- | Default values for the command line options.
41
defaultOptions :: Options
42
defaultOptions  = Options
43
 { optShowNodes = False
44
 , optShowCmds  = Nothing
45
 , optOneline   = False
46
 , optNodef     = "nodes"
47
 , optInstf     = "instances"
48
 , optMaxLength = -1
49
 , optMaster    = ""
50
 , optVerbose   = 0
51
 , optOffline   = []
52
 , optShowVer   = False
53
 , optShowHelp  = False
54
 }
55

    
56
-- | Options list and functions
57
options :: [OptDescr (Options -> Options)]
58
options =
59
    [ Option ['p']     ["print-nodes"]
60
      (NoArg (\ opts -> opts { optShowNodes = True }))
61
      "print the final node list"
62
    , Option ['C']     ["print-commands"]
63
      (OptArg ((\ f opts -> opts { optShowCmds = Just f }) . fromMaybe "-")
64
                  "FILE")
65
      "print the ganeti command list for reaching the solution,\
66
      \if an argument is passed then write the commands to a file named\
67
      \ as such"
68
    , Option ['o']     ["oneline"]
69
      (NoArg (\ opts -> opts { optOneline = True }))
70
      "print the ganeti command list for reaching the solution"
71
    , Option ['n']     ["nodes"]
72
      (ReqArg (\ f opts -> opts { optNodef = f }) "FILE")
73
      "the node list FILE"
74
    , Option ['i']     ["instances"]
75
      (ReqArg (\ f opts -> opts { optInstf =  f }) "FILE")
76
      "the instance list FILE"
77
    , Option ['m']     ["master"]
78
      (ReqArg (\ m opts -> opts { optMaster = m }) "ADDRESS")
79
      "collect data via RAPI at the given ADDRESS"
80
    , Option ['l']     ["max-length"]
81
      (ReqArg (\ i opts -> opts { optMaxLength =  (read i)::Int }) "N")
82
      "cap the solution at this many moves (useful for very unbalanced \
83
      \clusters)"
84
    , Option ['v']     ["verbose"]
85
      (NoArg (\ opts -> opts { optVerbose = (optVerbose opts) + 1 }))
86
      "increase the verbosity level"
87
    , Option ['O']     ["offline"]
88
      (ReqArg (\ n opts -> opts { optOffline = n:optOffline opts }) "NODE")
89
       " set node as offline"
90
    , Option ['V']     ["version"]
91
      (NoArg (\ opts -> opts { optShowVer = True}))
92
      "show the version of the program"
93
    , Option ['h']     ["help"]
94
      (NoArg (\ opts -> opts { optShowHelp = True}))
95
      "show help"
96
    ]
97

    
98
{- | Start computing the solution at the given depth and recurse until
99
we find a valid solution or we exceed the maximum depth.
100

    
101
-}
102
iterateDepth :: Cluster.Table    -- ^ The starting table
103
             -> Int              -- ^ Remaining length
104
             -> Cluster.NameList -- ^ Node idx to name list
105
             -> Cluster.NameList -- ^ Inst idx to name list
106
             -> Int              -- ^ Max node name len
107
             -> Int              -- ^ Max instance name len
108
             -> [[String]]       -- ^ Current command list
109
             -> Bool             -- ^ Wheter to be silent
110
             -> IO (Cluster.Table, [[String]]) -- ^ The resulting table and
111
                                               -- commands
112
iterateDepth ini_tbl max_rounds ktn kti nmlen imlen cmd_strs oneline =
113
    let Cluster.Table ini_nl ini_il ini_cv ini_plc = ini_tbl
114
        all_inst = Container.elems ini_il
115
        node_idx = map Node.idx . filter (not . Node.offline) $
116
                   Container.elems ini_nl
117
        fin_tbl = Cluster.checkMove node_idx ini_tbl all_inst
118
        (Cluster.Table _ _ fin_cv fin_plc) = fin_tbl
119
        ini_plc_len = length ini_plc
120
        fin_plc_len = length fin_plc
121
        allowed_next = (max_rounds < 0 || length fin_plc < max_rounds)
122
    in
123
      do
124
        let
125
            (sol_line, cmds) = Cluster.printSolutionLine ini_il ktn kti
126
                               nmlen imlen (head fin_plc) fin_plc_len
127
            upd_cmd_strs = cmds:cmd_strs
128
        unless (oneline || fin_plc_len == ini_plc_len) $ do
129
          putStrLn sol_line
130
          hFlush stdout
131
        (if fin_cv < ini_cv then -- this round made success, try deeper
132
             if allowed_next
133
             then iterateDepth fin_tbl max_rounds ktn kti
134
                  nmlen imlen upd_cmd_strs oneline
135
             -- don't go deeper, but return the better solution
136
             else return (fin_tbl, upd_cmd_strs)
137
         else
138
             return (ini_tbl, cmd_strs))
139

    
140
-- | Main function.
141
main :: IO ()
142
main = do
143
  cmd_args <- System.getArgs
144
  (opts, _) <- CLI.parseOpts cmd_args "hbal" options defaultOptions optShowHelp
145

    
146
  when (optShowVer opts) $ do
147
         putStr $ CLI.showVersion "hbal"
148
         exitWith ExitSuccess
149

    
150
  let oneline = optOneline opts
151
      verbose = optVerbose opts
152
      (node_data, inst_data) =
153
          case optMaster opts of
154
            "" -> (readFile $ optNodef opts,
155
                   readFile $ optInstf opts)
156
            host -> (readData getNodes host,
157
                     readData getInstances host)
158

    
159
  (loaded_nl, il, csf, ktn, kti) <- liftM2 Cluster.loadData node_data inst_data
160
  let (fix_msgs, fixed_nl) = Cluster.checkData loaded_nl il ktn kti
161

    
162
  unless (null fix_msgs) $ do
163
         putStrLn "Warning: cluster has inconsistent data:"
164
         putStrLn . unlines . map (\s -> printf "  - %s" s) $ fix_msgs
165

    
166
  let offline_names = optOffline opts
167
      all_names = snd . unzip $ ktn
168
      offline_wrong = filter (\n -> not $ elem n all_names) offline_names
169
      offline_indices = fst . unzip .
170
                        filter (\(_, n) -> elem n offline_names) $ ktn
171

    
172
  when (length offline_wrong > 0) $ do
173
         printf "Wrong node name(s) set as offline: %s\n"
174
                (commaJoin offline_wrong)
175
         exitWith $ ExitFailure 1
176

    
177
  let nl = Container.map (\n -> if elem (Node.idx n) offline_indices
178
                                then Node.setOffline n True
179
                                else n) fixed_nl
180

    
181
  unless oneline $ printf "Loaded %d nodes, %d instances\n"
182
             (Container.size nl)
183
             (Container.size il)
184

    
185
  when (length csf > 0 && not oneline && verbose > 0) $ do
186
         printf "Note: Stripping common suffix of '%s' from names\n" csf
187

    
188
  let (bad_nodes, bad_instances) = Cluster.computeBadItems nl il
189
  unless (oneline || verbose == 0) $ printf
190
             "Initial check done: %d bad nodes, %d bad instances.\n"
191
             (length bad_nodes) (length bad_instances)
192

    
193
  when (length bad_nodes > 0) $ do
194
         putStrLn "Cluster is not N+1 happy, continuing but no guarantee \
195
                  \that the cluster will end N+1 happy."
196

    
197
  when (optShowNodes opts) $
198
       do
199
         putStrLn "Initial cluster status:"
200
         putStrLn $ Cluster.printNodes ktn nl
201

    
202
  let ini_cv = Cluster.compCV nl
203
      ini_tbl = Cluster.Table nl il ini_cv []
204
  unless oneline (if verbose > 1 then
205
                      printf "Initial coefficients: overall %.8f, %s\n"
206
                      ini_cv (Cluster.printStats nl)
207
                  else
208
                      printf "Initial score: %.8f\n" ini_cv)
209

    
210
  unless oneline $ putStrLn "Trying to minimize the CV..."
211
  let mlen_fn = maximum . (map length) . snd . unzip
212
      imlen = mlen_fn kti
213
      nmlen = mlen_fn ktn
214

    
215
  (fin_tbl, cmd_strs) <- iterateDepth ini_tbl (optMaxLength opts)
216
                         ktn kti nmlen imlen [] oneline
217
  let (Cluster.Table fin_nl _ fin_cv fin_plc) = fin_tbl
218
      ord_plc = reverse fin_plc
219
      sol_msg = if null fin_plc
220
                then printf "No solution found\n"
221
                else (if verbose > 1
222
                      then printf "Final coefficients:   overall %.8f, %s\n"
223
                           fin_cv (Cluster.printStats fin_nl)
224
                      else printf "Cluster score improved from %.8f to %.8f\n"
225
                           ini_cv fin_cv
226
                     )
227

    
228
  unless oneline $ putStr sol_msg
229

    
230
  unless (oneline || verbose == 0) $
231
         printf "Solution length=%d\n" (length ord_plc)
232

    
233
  let cmd_data = Cluster.formatCmds . reverse $ cmd_strs
234

    
235
  when (isJust $ optShowCmds opts) $
236
       do
237
         let out_path = fromJust $ optShowCmds opts
238
         putStrLn ""
239
         (if out_path == "-" then
240
              printf "Commands to run to reach the above solution:\n%s"
241
                     (unlines . map ("  " ++) .
242
                      filter (/= "check") .
243
                      lines $ cmd_data)
244
          else do
245
            writeFile out_path (CLI.shTemplate ++ cmd_data)
246
            printf "The commands have been written to file '%s'\n" out_path)
247

    
248
  when (optShowNodes opts) $
249
       do
250
         let (orig_mem, orig_disk) = Cluster.totalResources nl
251
             (final_mem, final_disk) = Cluster.totalResources fin_nl
252
         putStrLn ""
253
         putStrLn "Final cluster status:"
254
         putStrLn $ Cluster.printNodes ktn fin_nl
255
         when (verbose > 2) $
256
              do
257
                printf "Original: mem=%d disk=%d\n" orig_mem orig_disk
258
                printf "Final:    mem=%d disk=%d\n" final_mem final_disk
259
  when oneline $ do
260
         printf "%.8f %d %.8f %8.3f\n"
261
                ini_cv (length ord_plc) fin_cv (ini_cv / fin_cv)