Update NEWS file for the 0.1.0 release
[ganeti-local] / hbal.hs
diff --git a/hbal.hs b/hbal.hs
index 7424b3d..325543a 100644 (file)
--- a/hbal.hs
+++ b/hbal.hs
@@ -28,11 +28,14 @@ data Options = Options
     , optShowCmds  :: Maybe FilePath -- ^ Whether to show the command list
     , optOneline   :: Bool           -- ^ Switch output to a single line
     , optNodef     :: FilePath       -- ^ Path to the nodes file
+    , optNodeSet   :: Bool           -- ^ The nodes have been set by options
     , optInstf     :: FilePath       -- ^ Path to the instances file
+    , optInstSet   :: Bool           -- ^ The insts have been set by options
     , optMaxLength :: Int            -- ^ Stop after this many steps
     , optMaster    :: String         -- ^ Collect data from RAPI
     , optVerbose   :: Int            -- ^ Verbosity level
     , optOffline   :: [String]       -- ^ Names of offline nodes
+    , optMinScore  :: Cluster.Score  -- ^ The minimum score we aim for
     , optShowVer   :: Bool           -- ^ Just show the program version
     , optShowHelp  :: Bool           -- ^ Just show the help
     } deriving Show
@@ -44,11 +47,14 @@ defaultOptions  = Options
  , optShowCmds  = Nothing
  , optOneline   = False
  , optNodef     = "nodes"
+ , optNodeSet   = False
  , optInstf     = "instances"
+ , optInstSet   = False
  , optMaxLength = -1
  , optMaster    = ""
- , optVerbose   = 0
+ , optVerbose   = 1
  , optOffline   = []
+ , optMinScore  = 1e-9
  , optShowVer   = False
  , optShowHelp  = False
  }
@@ -69,10 +75,10 @@ options =
       (NoArg (\ opts -> opts { optOneline = True }))
       "print the ganeti command list for reaching the solution"
     , Option ['n']     ["nodes"]
-      (ReqArg (\ f opts -> opts { optNodef = f }) "FILE")
+      (ReqArg (\ f opts -> opts { optNodef = f, optNodeSet = True }) "FILE")
       "the node list FILE"
     , Option ['i']     ["instances"]
-      (ReqArg (\ f opts -> opts { optInstf =  f }) "FILE")
+      (ReqArg (\ f opts -> opts { optInstf =  f, optInstSet = True }) "FILE")
       "the instance list FILE"
     , Option ['m']     ["master"]
       (ReqArg (\ m opts -> opts { optMaster = m }) "ADDRESS")
@@ -84,9 +90,15 @@ options =
     , Option ['v']     ["verbose"]
       (NoArg (\ opts -> opts { optVerbose = (optVerbose opts) + 1 }))
       "increase the verbosity level"
+    , Option ['q']     ["quiet"]
+      (NoArg (\ opts -> opts { optVerbose = (optVerbose opts) - 1 }))
+      "decrease the verbosity level"
     , Option ['O']     ["offline"]
       (ReqArg (\ n opts -> opts { optOffline = n:optOffline opts }) "NODE")
-       " set node as offline"
+      " set node as offline"
+    , Option ['e']     ["min-score"]
+      (ReqArg (\ e opts -> opts { optMinScore = read e }) "EPSILON")
+      " mininum score to aim for"
     , Option ['V']     ["version"]
       (NoArg (\ opts -> opts { optShowVer = True}))
       "show the version of the program"
@@ -107,9 +119,11 @@ iterateDepth :: Cluster.Table    -- ^ The starting table
              -> Int              -- ^ Max instance name len
              -> [[String]]       -- ^ Current command list
              -> Bool             -- ^ Wheter to be silent
+             -> Cluster.Score    -- ^ Score at which to stop
              -> IO (Cluster.Table, [[String]]) -- ^ The resulting table and
                                                -- commands
-iterateDepth ini_tbl max_rounds ktn kti nmlen imlen cmd_strs oneline =
+iterateDepth ini_tbl max_rounds ktn kti nmlen imlen
+             cmd_strs oneline min_score =
     let Cluster.Table ini_nl ini_il ini_cv ini_plc = ini_tbl
         all_inst = Container.elems ini_il
         node_idx = map Node.idx . filter (not . Node.offline) $
@@ -129,14 +143,20 @@ iterateDepth ini_tbl max_rounds ktn kti nmlen imlen cmd_strs oneline =
           putStrLn sol_line
           hFlush stdout
         (if fin_cv < ini_cv then -- this round made success, try deeper
-             if allowed_next
+             if allowed_next && fin_cv > min_score
              then iterateDepth fin_tbl max_rounds ktn kti
-                  nmlen imlen upd_cmd_strs oneline
+                  nmlen imlen upd_cmd_strs oneline min_score
              -- don't go deeper, but return the better solution
              else return (fin_tbl, upd_cmd_strs)
          else
              return (ini_tbl, cmd_strs))
 
+-- | Formats the solution for the oneline display
+formatOneline :: Double -> Int -> Double -> String
+formatOneline ini_cv plc_len fin_cv =
+    printf "%.8f %d %.8f %8.3f" ini_cv plc_len fin_cv
+               (if fin_cv == 0 then 1 else (ini_cv / fin_cv))
+
 -- | Main function.
 main :: IO ()
 main = do
@@ -152,19 +172,24 @@ main = do
          putStr $ CLI.showVersion "hbal"
          exitWith ExitSuccess
 
-  let oneline = optOneline opts
+  (env_node, env_inst) <- CLI.parseEnv ()
+  let nodef = if optNodeSet opts then optNodef opts
+              else env_node
+      instf = if optInstSet opts then optInstf opts
+              else env_inst
+      oneline = optOneline opts
       verbose = optVerbose opts
       (node_data, inst_data) =
           case optMaster opts of
-            "" -> (readFile $ optNodef opts,
-                   readFile $ optInstf opts)
+            "" -> (readFile nodef,
+                   readFile instf)
             host -> (readData getNodes host,
                      readData getInstances host)
 
   (loaded_nl, il, csf, ktn, kti) <- liftM2 Cluster.loadData node_data inst_data
   let (fix_msgs, fixed_nl) = Cluster.checkData loaded_nl il ktn kti
 
-  unless (null fix_msgs) $ do
+  unless (null fix_msgs || verbose == 0) $ do
          putStrLn "Warning: cluster has inconsistent data:"
          putStrLn . unlines . map (\s -> printf "  - %s" s) $ fix_msgs
 
@@ -183,11 +208,19 @@ main = do
                                 then Node.setOffline n True
                                 else n) fixed_nl
 
+  when (Container.size il == 0) $ do
+         (if oneline then
+              putStrLn $ formatOneline 0 0 0
+          else
+              printf "Cluster is empty, exiting.\n")
+         exitWith ExitSuccess
+
+
   unless oneline $ printf "Loaded %d nodes, %d instances\n"
              (Container.size nl)
              (Container.size il)
 
-  when (length csf > 0 && not oneline && verbose > 0) $ do
+  when (length csf > 0 && not oneline && verbose > 1) $ do
          printf "Note: Stripping common suffix of '%s' from names\n" csf
 
   let (bad_nodes, bad_instances) = Cluster.computeBadItems nl il
@@ -206,7 +239,17 @@ main = do
 
   let ini_cv = Cluster.compCV nl
       ini_tbl = Cluster.Table nl il ini_cv []
-  unless oneline (if verbose > 1 then
+      min_cv = optMinScore opts
+
+  when (ini_cv < min_cv) $ do
+         (if oneline then
+              putStrLn $ formatOneline ini_cv 0 ini_cv
+          else printf "Cluster is already well balanced (initial score %.6g,\n\
+                      \minimum score %.6g).\nNothing to do, exiting\n"
+                      ini_cv min_cv)
+         exitWith ExitSuccess
+
+  unless oneline (if verbose > 2 then
                       printf "Initial coefficients: overall %.8f, %s\n"
                       ini_cv (Cluster.printStats nl)
                   else
@@ -218,12 +261,12 @@ main = do
       nmlen = mlen_fn ktn
 
   (fin_tbl, cmd_strs) <- iterateDepth ini_tbl (optMaxLength opts)
-                         ktn kti nmlen imlen [] oneline
+                         ktn kti nmlen imlen [] oneline min_cv
   let (Cluster.Table fin_nl _ fin_cv fin_plc) = fin_tbl
       ord_plc = reverse fin_plc
       sol_msg = if null fin_plc
                 then printf "No solution found\n"
-                else (if verbose > 1
+                else (if verbose > 2
                       then printf "Final coefficients:   overall %.8f, %s\n"
                            fin_cv (Cluster.printStats fin_nl)
                       else printf "Cluster score improved from %.8f to %.8f\n"
@@ -257,10 +300,9 @@ main = do
          putStrLn ""
          putStrLn "Final cluster status:"
          putStrLn $ Cluster.printNodes ktn fin_nl
-         when (verbose > 2) $
+         when (verbose > 3) $
               do
                 printf "Original: mem=%d disk=%d\n" orig_mem orig_disk
                 printf "Final:    mem=%d disk=%d\n" final_mem final_disk
-  when oneline $ do
-         printf "%.8f %d %.8f %8.3f\n"
-                ini_cv (length ord_plc) fin_cv (ini_cv / fin_cv)
+  when oneline $
+         putStrLn $ formatOneline ini_cv (length ord_plc) fin_cv