Statistics
| Branch: | Tag: | Revision:

root / hail.hs @ 75d1edf8

History | View | Annotate | Download (11.6 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.IAlloc
23
import Ganeti.HTools.Utils
24
import Ganeti.HTools.Types
25

    
26
-- | Command line options structure.
27
data Options = Options
28
    { optShowNodes :: Bool           -- ^ Whether to show node status
29
    , optShowCmds  :: Maybe FilePath -- ^ Whether to show the command list
30
    , optOneline   :: Bool           -- ^ Switch output to a single line
31
    , optNodef     :: FilePath       -- ^ Path to the nodes file
32
    , optNodeSet   :: Bool           -- ^ The nodes have been set by options
33
    , optInstf     :: FilePath       -- ^ Path to the instances file
34
    , optInstSet   :: Bool           -- ^ The insts have been set by options
35
    , optMaxLength :: Int            -- ^ Stop after this many steps
36
    , optMaster    :: String         -- ^ Collect data from RAPI
37
    , optVerbose   :: Int            -- ^ Verbosity level
38
    , optOffline   :: [String]       -- ^ Names of offline nodes
39
    , optMinScore  :: Cluster.Score  -- ^ The minimum score we aim for
40
    , optShowVer   :: Bool           -- ^ Just show the program version
41
    , optShowHelp  :: Bool           -- ^ Just show the help
42
    } deriving Show
43

    
44
instance CLI.CLIOptions Options where
45
    showVersion = optShowVer
46
    showHelp    = optShowHelp
47

    
48
-- | Default values for the command line options.
49
defaultOptions :: Options
50
defaultOptions  = Options
51
 { optShowNodes = False
52
 , optShowCmds  = Nothing
53
 , optOneline   = False
54
 , optNodef     = "nodes"
55
 , optNodeSet   = False
56
 , optInstf     = "instances"
57
 , optInstSet   = False
58
 , optMaxLength = -1
59
 , optMaster    = ""
60
 , optVerbose   = 1
61
 , optOffline   = []
62
 , optMinScore  = 1e-9
63
 , optShowVer   = False
64
 , optShowHelp  = False
65
 }
66

    
67
-- | Options list and functions
68
options :: [OptDescr (Options -> Options)]
69
options =
70
    [ Option ['p']     ["print-nodes"]
71
      (NoArg (\ opts -> opts { optShowNodes = True }))
72
      "print the final node list"
73
    , Option ['C']     ["print-commands"]
74
      (OptArg ((\ f opts -> opts { optShowCmds = Just f }) . fromMaybe "-")
75
                  "FILE")
76
      "print the ganeti command list for reaching the solution,\
77
      \if an argument is passed then write the commands to a file named\
78
      \ as such"
79
    , Option ['o']     ["oneline"]
80
      (NoArg (\ opts -> opts { optOneline = True }))
81
      "print the ganeti command list for reaching the solution"
82
    , Option ['n']     ["nodes"]
83
      (ReqArg (\ f opts -> opts { optNodef = f, optNodeSet = True }) "FILE")
84
      "the node list FILE"
85
    , Option ['i']     ["instances"]
86
      (ReqArg (\ f opts -> opts { optInstf =  f, optInstSet = True }) "FILE")
87
      "the instance list FILE"
88
    , Option ['m']     ["master"]
89
      (ReqArg (\ m opts -> opts { optMaster = m }) "ADDRESS")
90
      "collect data via RAPI at the given ADDRESS"
91
    , Option ['l']     ["max-length"]
92
      (ReqArg (\ i opts -> opts { optMaxLength =  (read i)::Int }) "N")
93
      "cap the solution at this many moves (useful for very unbalanced \
94
      \clusters)"
95
    , Option ['v']     ["verbose"]
96
      (NoArg (\ opts -> opts { optVerbose = (optVerbose opts) + 1 }))
97
      "increase the verbosity level"
98
    , Option ['q']     ["quiet"]
99
      (NoArg (\ opts -> opts { optVerbose = (optVerbose opts) - 1 }))
100
      "decrease the verbosity level"
101
    , Option ['O']     ["offline"]
102
      (ReqArg (\ n opts -> opts { optOffline = n:optOffline opts }) "NODE")
103
      " set node as offline"
104
    , Option ['e']     ["min-score"]
105
      (ReqArg (\ e opts -> opts { optMinScore = read e }) "EPSILON")
106
      " mininum score to aim for"
107
    , Option ['V']     ["version"]
108
      (NoArg (\ opts -> opts { optShowVer = True}))
109
      "show the version of the program"
110
    , Option ['h']     ["help"]
111
      (NoArg (\ opts -> opts { optShowHelp = True}))
112
      "show help"
113
    ]
114

    
115
{- | Start computing the solution at the given depth and recurse until
116
we find a valid solution or we exceed the maximum depth.
117

    
118
-}
119
iterateDepth :: Cluster.Table    -- ^ The starting table
120
             -> Int              -- ^ Remaining length
121
             -> Cluster.NameList -- ^ Node idx to name list
122
             -> Cluster.NameList -- ^ Inst idx to name list
123
             -> Int              -- ^ Max node name len
124
             -> Int              -- ^ Max instance name len
125
             -> [[String]]       -- ^ Current command list
126
             -> Bool             -- ^ Wheter to be silent
127
             -> Cluster.Score    -- ^ Score at which to stop
128
             -> IO (Cluster.Table, [[String]]) -- ^ The resulting table and
129
                                               -- commands
130
iterateDepth ini_tbl max_rounds ktn kti nmlen imlen
131
             cmd_strs oneline min_score =
132
    let Cluster.Table ini_nl ini_il ini_cv ini_plc = ini_tbl
133
        all_inst = Container.elems ini_il
134
        node_idx = map Node.idx . filter (not . Node.offline) $
135
                   Container.elems ini_nl
136
        fin_tbl = Cluster.checkMove node_idx ini_tbl all_inst
137
        (Cluster.Table _ _ fin_cv fin_plc) = fin_tbl
138
        ini_plc_len = length ini_plc
139
        fin_plc_len = length fin_plc
140
        allowed_next = (max_rounds < 0 || length fin_plc < max_rounds)
141
    in
142
      do
143
        let
144
            (sol_line, cmds) = Cluster.printSolutionLine ini_il ktn kti
145
                               nmlen imlen (head fin_plc) fin_plc_len
146
            upd_cmd_strs = cmds:cmd_strs
147
        unless (oneline || fin_plc_len == ini_plc_len) $ do
148
          putStrLn sol_line
149
          hFlush stdout
150
        (if fin_cv < ini_cv then -- this round made success, try deeper
151
             if allowed_next && fin_cv > min_score
152
             then iterateDepth fin_tbl max_rounds ktn kti
153
                  nmlen imlen upd_cmd_strs oneline min_score
154
             -- don't go deeper, but return the better solution
155
             else return (fin_tbl, upd_cmd_strs)
156
         else
157
             return (ini_tbl, cmd_strs))
158

    
159
-- | Formats the solution for the oneline display
160
formatOneline :: Double -> Int -> Double -> String
161
formatOneline ini_cv plc_len fin_cv =
162
    printf "%.8f %d %.8f %8.3f" ini_cv plc_len fin_cv
163
               (if fin_cv == 0 then 1 else (ini_cv / fin_cv))
164

    
165
-- | Main function.
166
main :: IO ()
167
main = do
168
  cmd_args <- System.getArgs
169
  (opts, args) <- CLI.parseOpts cmd_args "hail" options
170
                  defaultOptions
171

    
172
  when (null args) $ do
173
         hPutStrLn stderr "Error: this program needs an input file."
174
         exitWith $ ExitFailure 1
175

    
176
  let input_file = head args
177
  input_data <- readFile input_file
178

    
179
  request <- case (parseData input_data) of
180
               Bad err -> do
181
                 putStrLn $ "Error: " ++ err
182
                 exitWith $ ExitFailure 1
183
               Ok rq -> return rq
184

    
185
  putStrLn $ show request
186
  exitWith ExitSuccess
187
{-
188
  (loaded_nl, il, csf, ktn, kti) <- liftM2 Cluster.loadData node_data inst_data
189
  let (fix_msgs, fixed_nl) = Cluster.checkData loaded_nl il ktn kti
190

    
191
  unless (null fix_msgs || verbose == 0) $ do
192
         putStrLn "Warning: cluster has inconsistent data:"
193
         putStrLn . unlines . map (\s -> printf "  - %s" s) $ fix_msgs
194

    
195
  let offline_names = optOffline opts
196
      all_names = snd . unzip $ ktn
197
      offline_wrong = filter (\n -> not $ elem n all_names) offline_names
198
      offline_indices = fst . unzip .
199
                        filter (\(_, n) -> elem n offline_names) $ ktn
200

    
201
  when (length offline_wrong > 0) $ do
202
         printf "Wrong node name(s) set as offline: %s\n"
203
                (commaJoin offline_wrong)
204
         exitWith $ ExitFailure 1
205

    
206
  let nl = Container.map (\n -> if elem (Node.idx n) offline_indices
207
                                then Node.setOffline n True
208
                                else n) fixed_nl
209

    
210
  when (Container.size il == 0) $ do
211
         (if oneline then
212
              putStrLn $ formatOneline 0 0 0
213
          else
214
              printf "Cluster is empty, exiting.\n")
215
         exitWith ExitSuccess
216

    
217

    
218
  unless oneline $ printf "Loaded %d nodes, %d instances\n"
219
             (Container.size nl)
220
             (Container.size il)
221

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

    
225
  let (bad_nodes, bad_instances) = Cluster.computeBadItems nl il
226
  unless (oneline || verbose == 0) $ printf
227
             "Initial check done: %d bad nodes, %d bad instances.\n"
228
             (length bad_nodes) (length bad_instances)
229

    
230
  when (length bad_nodes > 0) $ do
231
         putStrLn "Cluster is not N+1 happy, continuing but no guarantee \
232
                  \that the cluster will end N+1 happy."
233

    
234
  when (optShowNodes opts) $
235
       do
236
         putStrLn "Initial cluster status:"
237
         putStrLn $ Cluster.printNodes ktn nl
238

    
239
  let ini_cv = Cluster.compCV nl
240
      ini_tbl = Cluster.Table nl il ini_cv []
241
      min_cv = optMinScore opts
242

    
243
  when (ini_cv < min_cv) $ do
244
         (if oneline then
245
              putStrLn $ formatOneline ini_cv 0 ini_cv
246
          else printf "Cluster is already well balanced (initial score %.6g,\n\
247
                      \minimum score %.6g).\nNothing to do, exiting\n"
248
                      ini_cv min_cv)
249
         exitWith ExitSuccess
250

    
251
  unless oneline (if verbose > 2 then
252
                      printf "Initial coefficients: overall %.8f, %s\n"
253
                      ini_cv (Cluster.printStats nl)
254
                  else
255
                      printf "Initial score: %.8f\n" ini_cv)
256

    
257
  unless oneline $ putStrLn "Trying to minimize the CV..."
258
  let mlen_fn = maximum . (map length) . snd . unzip
259
      imlen = mlen_fn kti
260
      nmlen = mlen_fn ktn
261

    
262
  (fin_tbl, cmd_strs) <- iterateDepth ini_tbl (optMaxLength opts)
263
                         ktn kti nmlen imlen [] oneline min_cv
264
  let (Cluster.Table fin_nl _ fin_cv fin_plc) = fin_tbl
265
      ord_plc = reverse fin_plc
266
      sol_msg = if null fin_plc
267
                then printf "No solution found\n"
268
                else (if verbose > 2
269
                      then printf "Final coefficients:   overall %.8f, %s\n"
270
                           fin_cv (Cluster.printStats fin_nl)
271
                      else printf "Cluster score improved from %.8f to %.8f\n"
272
                           ini_cv fin_cv
273
                     )
274

    
275
  unless oneline $ putStr sol_msg
276

    
277
  unless (oneline || verbose == 0) $
278
         printf "Solution length=%d\n" (length ord_plc)
279

    
280
  let cmd_data = Cluster.formatCmds . reverse $ cmd_strs
281

    
282
  when (isJust $ optShowCmds opts) $
283
       do
284
         let out_path = fromJust $ optShowCmds opts
285
         putStrLn ""
286
         (if out_path == "-" then
287
              printf "Commands to run to reach the above solution:\n%s"
288
                     (unlines . map ("  " ++) .
289
                      filter (/= "check") .
290
                      lines $ cmd_data)
291
          else do
292
            writeFile out_path (CLI.shTemplate ++ cmd_data)
293
            printf "The commands have been written to file '%s'\n" out_path)
294

    
295
  when (optShowNodes opts) $
296
       do
297
         let (orig_mem, orig_disk) = Cluster.totalResources nl
298
             (final_mem, final_disk) = Cluster.totalResources fin_nl
299
         putStrLn ""
300
         putStrLn "Final cluster status:"
301
         putStrLn $ Cluster.printNodes ktn fin_nl
302
         when (verbose > 3) $
303
              do
304
                printf "Original: mem=%d disk=%d\n" orig_mem orig_disk
305
                printf "Final:    mem=%d disk=%d\n" final_mem final_disk
306
  when oneline $
307
         putStrLn $ formatOneline ini_cv (length ord_plc) fin_cv
308
-}