Switch the text file format to single-file

[ganeti-local] / hspace.hs

diff --git a/hspace.hs b/hspace.hs
index bfcbfff..dcaf400 100644 (file)
--- a/hspace.hs
+++ b/hspace.hs
@@ -25,256 +25,322 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
 
 module Main (main) where
 
 
 module Main (main) where
 

+import Data.Char (toUpper, isAlphaNum)

 import Data.List
 import Data.Function
 import Data.List
 import Data.Function

-import Data.Maybe (isJust, fromJust, isNothing)
+import Data.Maybe (isJust, fromJust)

 import Monad
 import System
 import System.IO
 import Monad
 import System
 import System.IO

-import System.Console.GetOpt

 import qualified System
 
 import qualified System
 

-import Text.Printf (printf)
+import Text.Printf (printf, hPrintf)

 
 import qualified Ganeti.HTools.Container as Container
 import qualified Ganeti.HTools.Cluster as Cluster
 import qualified Ganeti.HTools.Node as Node
 import qualified Ganeti.HTools.Instance as Instance
 
 import qualified Ganeti.HTools.Container as Container
 import qualified Ganeti.HTools.Cluster as Cluster
 import qualified Ganeti.HTools.Node as Node
 import qualified Ganeti.HTools.Instance as Instance

-import qualified Ganeti.HTools.CLI as CLI

 
 import Ganeti.HTools.Utils
 
 import Ganeti.HTools.Utils

-
--- | Command line options structure.
-data Options = Options
-    { optShowNodes :: Bool           -- ^ Whether to show node status
-    , 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
-    , optMaster    :: String         -- ^ Collect data from RAPI
-    , optVerbose   :: Int            -- ^ Verbosity level
-    , optOffline   :: [String]       -- ^ Names of offline nodes
-    , optIMem      :: Int            -- ^ Instance memory
-    , optIDsk      :: Int            -- ^ Instance disk
-    , optIVCPUs    :: Int            -- ^ Instance VCPUs
-    , optINodes    :: Int            -- ^ Nodes required for an instance
-    , optShowVer   :: Bool           -- ^ Just show the program version
-    , optShowHelp  :: Bool           -- ^ Just show the help
-    } deriving Show
-
-instance CLI.CLIOptions Options where
-    showVersion = optShowVer
-    showHelp    = optShowHelp
-
-instance CLI.EToolOptions Options where
-    nodeFile   = optNodef
-    nodeSet    = optNodeSet
-    instFile   = optInstf
-    instSet    = optInstSet
-    masterName = optMaster
-    silent a   = (optVerbose a) == 0
-
--- | Default values for the command line options.
-defaultOptions :: Options
-defaultOptions  = Options
- { optShowNodes = False
- , optNodef     = "nodes"
- , optNodeSet   = False
- , optInstf     = "instances"
- , optInstSet   = False
- , optMaster    = ""
- , optVerbose   = 1
- , optOffline   = []
- , optIMem      = 4096
- , optIDsk      = 102400
- , optIVCPUs    = 1
- , optINodes    = 2
- , optShowVer   = False
- , optShowHelp  = False
- }
+import Ganeti.HTools.Types
+import Ganeti.HTools.CLI
+import Ganeti.HTools.ExtLoader

 
 -- | Options list and functions
 
 -- | Options list and functions

-options :: [OptDescr (Options -> Options)]
+options :: [OptType]

 options =
 options =

-    [ Option ['p']     ["print-nodes"]
-      (NoArg (\ opts -> opts { optShowNodes = True }))
-      "print the final node list"
-    , Option ['n']     ["nodes"]
-      (ReqArg (\ f opts -> opts { optNodef = f, optNodeSet = True }) "FILE")
-      "the node list FILE"
-    , Option ['i']     ["instances"]
-      (ReqArg (\ f opts -> opts { optInstf =  f, optInstSet = True }) "FILE")
-      "the instance list FILE"
-    , Option ['m']     ["master"]
-      (ReqArg (\ m opts -> opts { optMaster = m }) "ADDRESS")
-      "collect data via RAPI at the given ADDRESS"
-    , 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"
-    , Option []        ["memory"]
-      (ReqArg (\ m opts -> opts { optIMem = read m }) "MEMORY")
-      "memory size for instances"
-    , Option []        ["disk"]
-      (ReqArg (\ d opts -> opts { optIDsk = read d }) "DISK")
-      "disk size for instances"
-    , Option []        ["vcpus"]
-      (ReqArg (\ p opts -> opts { optIVCPUs = read p }) "NUM")
-      "number of virtual cpus for instances"
-    , Option []        ["req-nodes"]
-      (ReqArg (\ n opts -> opts { optINodes = read n }) "NODES")
-      "number of nodes for the new instances (1=plain, 2=mirrored)"
-    , Option ['V']     ["version"]
-      (NoArg (\ opts -> opts { optShowVer = True}))
-      "show the version of the program"
-    , Option ['h']     ["help"]
-      (NoArg (\ opts -> opts { optShowHelp = True}))
-      "show help"
+    [ oPrintNodes
+    , oDataFile
+    , oNodeSim
+    , oRapiMaster
+    , oLuxiSocket
+    , oVerbose
+    , oQuiet
+    , oOfflineNode
+    , oIMem
+    , oIDisk
+    , oIVcpus
+    , oINodes
+    , oMaxCpu
+    , oMinDisk
+    , oTieredSpec
+    , oShowVer
+    , oShowHelp

     ]
 
     ]
 

-filterFails :: Cluster.AllocSolution
-            -> Maybe [(Node.List, Instance.Instance, [Node.Node])]
-filterFails sols =
-    if null sols then Nothing -- No nodes onto which to allocate at all
-    else let sols' = filter (isJust . fst3) sols
-         in if null sols' then
-                Nothing -- No valid allocation solutions
-            else
-                return $ map (\(x, y, z) -> (fromJust x, y, z)) sols'
-
-processResults :: (Monad m) => [(Node.List, Instance.Instance, [Node.Node])]
-               -> m (Node.List, Instance.Instance, [Node.Node])
-processResults sols =
-    let sols' = map (\e@(nl', _, _) -> (Cluster.compCV  nl', e)) sols
-        sols'' = sortBy (compare `on` fst) sols'
-    in return $ snd $ head sols''
-
+-- | The allocation phase we're in (initial, after tiered allocs, or
+-- after regular allocation).
+data Phase = PInitial
+           | PFinal
+           | PTiered
+
+statsData :: [(String, Cluster.CStats -> String)]
+statsData = [ ("SCORE", printf "%.8f" . Cluster.csScore)
+            , ("INST_CNT", printf "%d" . Cluster.csNinst)
+            , ("MEM_FREE", printf "%d" . Cluster.csFmem)
+            , ("MEM_AVAIL", printf "%d" . Cluster.csAmem)
+            , ("MEM_RESVD",
+               \cs -> printf "%d" (Cluster.csFmem cs - Cluster.csAmem cs))
+            , ("MEM_INST", printf "%d" . Cluster.csImem)
+            , ("MEM_OVERHEAD",
+               \cs -> printf "%d" (Cluster.csXmem cs + Cluster.csNmem cs))
+            , ("MEM_EFF",
+               \cs -> printf "%.8f" (fromIntegral (Cluster.csImem cs) /
+                                     Cluster.csTmem cs))
+            , ("DSK_FREE", printf "%d" . Cluster.csFdsk)
+            , ("DSK_AVAIL", printf "%d". Cluster.csAdsk)
+            , ("DSK_RESVD",
+               \cs -> printf "%d" (Cluster.csFdsk cs - Cluster.csAdsk cs))
+            , ("DSK_INST", printf "%d" . Cluster.csIdsk)
+            , ("DSK_EFF",
+               \cs -> printf "%.8f" (fromIntegral (Cluster.csIdsk cs) /
+                                    Cluster.csTdsk cs))
+            , ("CPU_INST", printf "%d" . Cluster.csIcpu)
+            , ("CPU_EFF",
+               \cs -> printf "%.8f" (fromIntegral (Cluster.csIcpu cs) /
+                                     Cluster.csTcpu cs))
+            , ("MNODE_MEM_AVAIL", printf "%d" . Cluster.csMmem)
+            , ("MNODE_DSK_AVAIL", printf "%d" . Cluster.csMdsk)
+            ]
+
+specData :: [(String, RSpec -> String)]
+specData = [ ("MEM", printf "%d" . rspecMem)
+           , ("DSK", printf "%d" . rspecDsk)
+           , ("CPU", printf "%d" . rspecCpu)
+           ]
+
+clusterData :: [(String, Cluster.CStats -> String)]
+clusterData = [ ("MEM", printf "%.0f" . Cluster.csTmem)
+              , ("DSK", printf "%.0f" . Cluster.csTdsk)
+              , ("CPU", printf "%.0f" . Cluster.csTcpu)
+              ]
+
+-- | Recursively place instances on the cluster until we're out of space

 iterateDepth :: Node.List
              -> Instance.List
              -> Instance.Instance
              -> Int
              -> [Instance.Instance]
 iterateDepth :: Node.List
              -> Instance.List
              -> Instance.Instance
              -> Int
              -> [Instance.Instance]

-             -> (Node.List, [Instance.Instance])
+             -> Result (FailStats, Node.List, [Instance.Instance])

 iterateDepth nl il newinst nreq ixes =
       let depth = length ixes
 iterateDepth nl il newinst nreq ixes =
       let depth = length ixes

-          newname = (printf "new-%d" depth)::String
-          newidx = (length $ Container.elems il) + depth
+          newname = printf "new-%d" depth::String
+          newidx = length (Container.elems il) + depth

           newi2 = Instance.setIdx (Instance.setName newinst newname) newidx
           newi2 = Instance.setIdx (Instance.setName newinst newname) newidx

-          sols = (Cluster.tryAlloc nl il newi2 nreq)::
-                 Maybe Cluster.AllocSolution
-          orig = (nl, ixes)
-      in
-        if isNothing sols then orig
-        else let sols' = fromJust sols
-                 sols'' = filterFails sols'
-             in if isNothing sols'' then orig
-                else let (xnl, xi, _) = fromJust $ processResults $
-                                        fromJust sols''
-                     in iterateDepth xnl il newinst nreq (xi:ixes)
+      in case Cluster.tryAlloc nl il newi2 nreq of
+           Bad s -> Bad s
+           Ok (errs, _, sols3) ->
+               case sols3 of
+                 Nothing -> Ok (Cluster.collapseFailures errs, nl, ixes)
+                 Just (_, (xnl, xi, _)) ->
+                     iterateDepth xnl il newinst nreq $! (xi:ixes)
+
+tieredAlloc :: Node.List
+            -> Instance.List
+            -> Instance.Instance
+            -> Int
+            -> [Instance.Instance]
+            -> Result (FailStats, Node.List, [Instance.Instance])
+tieredAlloc nl il newinst nreq ixes =
+    case iterateDepth nl il newinst nreq ixes of
+      Bad s -> Bad s
+      Ok (errs, nl', ixes') ->
+          case Instance.shrinkByType newinst . fst . last $
+               sortBy (compare `on` snd) errs of
+            Bad _ -> Ok (errs, nl', ixes')
+            Ok newinst' ->
+                tieredAlloc nl' il newinst' nreq ixes'
+
+
+-- | Function to print stats for a given phase
+printStats :: Phase -> Cluster.CStats -> [(String, String)]
+printStats ph cs =
+  map (\(s, fn) -> (printf "%s_%s" kind s, fn cs)) statsData
+  where kind = case ph of
+                 PInitial -> "INI"
+                 PFinal -> "FIN"
+                 PTiered -> "TRL"
+
+-- | Print final stats and related metrics
+printResults :: Node.List -> Int -> Int -> [(FailMode, Int)] -> IO ()
+printResults fin_nl num_instances allocs sreason = do
+  let fin_stats = Cluster.totalResources fin_nl
+      fin_instances = num_instances + allocs
+
+  when (num_instances + allocs /= Cluster.csNinst fin_stats) $
+       do
+         hPrintf stderr "ERROR: internal inconsistency, allocated (%d)\
+                        \ != counted (%d)\n" (num_instances + allocs)
+                                 (Cluster.csNinst fin_stats)
+         exitWith $ ExitFailure 1

 
 

+  printKeys $ printStats PFinal fin_stats
+  printKeys [ ("ALLOC_USAGE", printf "%.8f"
+                                ((fromIntegral num_instances::Double) /
+                                 fromIntegral fin_instances))
+            , ("ALLOC_INSTANCES", printf "%d" allocs)
+            , ("ALLOC_FAIL_REASON", map toUpper . show . fst $ head sreason)
+            ]
+  printKeys $ map (\(x, y) -> (printf "ALLOC_%s_CNT" (show x),
+                               printf "%d" y)) sreason
+  -- this should be the final entry
+  printKeys [("OK", "1")]
+
+-- | Ensure a value is quoted if needed
+ensureQuoted :: String -> String
+ensureQuoted v = if not (all (\c -> (isAlphaNum c || c == '.')) v)
+                 then '\'':v ++ "'"
+                 else v
+
+-- | Format a list of key/values as a shell fragment
+printKeys :: [(String, String)] -> IO ()
+printKeys = mapM_ (\(k, v) ->
+                   printf "HTS_%s=%s\n" (map toUpper k) (ensureQuoted v))
+
+printInstance :: Node.List -> Instance.Instance -> [String]
+printInstance nl i = [ Instance.name i
+                     , (Container.nameOf nl $ Instance.pNode i)
+                     , (let sdx = Instance.sNode i
+                        in if sdx == Node.noSecondary then ""
+                           else Container.nameOf nl sdx)
+                     , show (Instance.mem i)
+                     , show (Instance.dsk i)
+                     , show (Instance.vcpus i)
+                     ]

 
 -- | Main function.
 main :: IO ()
 main = do
   cmd_args <- System.getArgs
 
 -- | Main function.
 main :: IO ()
 main = do
   cmd_args <- System.getArgs

-  (opts, args) <- CLI.parseOpts cmd_args "hspace" options defaultOptions
+  (opts, args) <- parseOpts cmd_args "hspace" options

 
   unless (null args) $ do
          hPutStrLn stderr "Error: this program doesn't take any arguments."
          exitWith $ ExitFailure 1
 
   let verbose = optVerbose opts
 
   unless (null args) $ do
          hPutStrLn stderr "Error: this program doesn't take any arguments."
          exitWith $ ExitFailure 1
 
   let verbose = optVerbose opts

+      ispec = optISpec opts
+      shownodes = optShowNodes opts
+
+  (fixed_nl, il, _, csf) <- loadExternalData opts
+
+  printKeys $ map (\(a, fn) -> ("SPEC_" ++ a, fn ispec)) specData
+  printKeys [ ("SPEC_RQN", printf "%d" (optINodes opts)) ]

 
 

-  (fixed_nl, il, csf) <- CLI.loadExternalData opts

   let num_instances = length $ Container.elems il
 
   let offline_names = optOffline opts
       all_nodes = Container.elems fixed_nl
       all_names = map Node.name all_nodes
   let num_instances = length $ Container.elems il
 
   let offline_names = optOffline opts
       all_nodes = Container.elems fixed_nl
       all_names = map Node.name all_nodes

-      offline_wrong = filter (\n -> not $ elem n all_names) offline_names
+      offline_wrong = filter (flip notElem all_names) offline_names

       offline_indices = map Node.idx $
                         filter (\n -> elem (Node.name n) offline_names)
                                all_nodes
       req_nodes = optINodes opts
       offline_indices = map Node.idx $
                         filter (\n -> elem (Node.name n) offline_names)
                                all_nodes
       req_nodes = optINodes opts

+      m_cpu = optMcpu opts
+      m_dsk = optMdsk opts

 
   when (length offline_wrong > 0) $ do
 
   when (length offline_wrong > 0) $ do

-         printf "Error: Wrong node name(s) set as offline: %s\n"
-                (commaJoin offline_wrong)
+         hPrintf stderr "Error: Wrong node name(s) set as offline: %s\n"
+                     (commaJoin offline_wrong)

          exitWith $ ExitFailure 1
 
   when (req_nodes /= 1 && req_nodes /= 2) $ do
          exitWith $ ExitFailure 1
 
   when (req_nodes /= 1 && req_nodes /= 2) $ do

-         printf "Error: Invalid required nodes (%d)\n" req_nodes
+         hPrintf stderr "Error: Invalid required nodes (%d)\n" req_nodes

          exitWith $ ExitFailure 1
 
          exitWith $ ExitFailure 1
 

-  let nl = Container.map (\n -> if elem (Node.idx n) offline_indices
+  let nm = Container.map (\n -> if elem (Node.idx n) offline_indices

                                 then Node.setOffline n True
                                 else n) fixed_nl
                                 then Node.setOffline n True
                                 else n) fixed_nl

+      nl = Container.map (flip Node.setMdsk m_dsk . flip Node.setMcpu m_cpu)
+           nm

 
 

-  when (length csf > 0 && verbose > 1) $ do
-         printf "Note: Stripping common suffix of '%s' from names\n" csf
-
-  let bad_nodes = fst $ Cluster.computeBadItems nl il
-  when (length bad_nodes > 0) $ do
-         putStrLn "Error: Cluster not N+1, no space to allocate."
-         exitWith $ ExitFailure 1
+  when (length csf > 0 && verbose > 1) $
+       hPrintf stderr "Note: Stripping common suffix of '%s' from names\n" csf

 
 

-  when (optShowNodes opts) $
+  when (isJust shownodes) $

        do
        do

-         putStrLn "Initial cluster status:"
-         putStrLn $ Cluster.printNodes nl
+         hPutStrLn stderr "Initial cluster status:"
+         hPutStrLn stderr $ Cluster.printNodes nl (fromJust shownodes)

 
   let ini_cv = Cluster.compCV nl
 
   let ini_cv = Cluster.compCV nl

-      (orig_mem, orig_disk) = Cluster.totalResources nl
-
-  (if verbose > 2 then
-       printf "Initial coefficients: overall %.8f, %s\n"
-       ini_cv (Cluster.printStats nl)
-   else
-       printf "Initial score: %.8f\n" ini_cv)
-  printf "Initial instances: %d\n" num_instances
-  printf "Initial free RAM: %d\n" orig_mem
-  printf "Initial free disk: %d\n" orig_disk
-
-  let nmlen = Container.maxNameLen nl
-      newinst = Instance.create "new" (optIMem opts) (optIDsk opts)
-                (optIVCPUs opts) "ADMIN_down" (-1) (-1)
-
-  let (fin_nl, ixes) = iterateDepth nl il newinst req_nodes []
-      allocs = length ixes
-      fin_instances = num_instances + allocs
+      ini_stats = Cluster.totalResources nl
+
+  when (verbose > 2) $
+         hPrintf stderr "Initial coefficients: overall %.8f, %s\n"
+                 ini_cv (Cluster.printStats nl)
+
+  printKeys $ map (\(a, fn) -> ("CLUSTER_" ++ a, fn ini_stats)) clusterData
+  printKeys [("CLUSTER_NODES", printf "%d" (length all_nodes))]
+  printKeys $ printStats PInitial ini_stats
+
+  let bad_nodes = fst $ Cluster.computeBadItems nl il
+  when (length bad_nodes > 0) $ do
+         -- This is failn1 case, so we print the same final stats and
+         -- exit early
+         printResults nl num_instances 0 [(FailN1, 1)]
+         exitWith ExitSuccess
+
+  -- utility functions
+  let iofspec spx = Instance.create "new" (rspecMem spx) (rspecDsk spx)
+                    (rspecCpu spx) "ADMIN_down" [] (-1) (-1)
+      exitifbad val = (case val of
+                         Bad s -> do
+                           hPrintf stderr "Failure: %s\n" s
+                           exitWith $ ExitFailure 1
+                         Ok x -> return x)
+
+
+  let reqinst = iofspec ispec
+
+  -- Run the tiered allocation, if enabled
+
+  (case optTieredSpec opts of
+     Nothing -> return ()
+     Just tspec -> do
+       let tresu = tieredAlloc nl il (iofspec tspec) req_nodes []
+       (_, trl_nl, trl_ixes) <- exitifbad tresu
+       let fin_trl_ixes = reverse trl_ixes
+           ix_byspec = groupBy ((==) `on` Instance.specOf) fin_trl_ixes
+           spec_map = map (\ixs -> (Instance.specOf $ head ixs, length ixs))
+                      ix_byspec::[(RSpec, Int)]
+           spec_map' = map (\(spec, cnt) ->
+                                printf "%d,%d,%d=%d" (rspecMem spec)
+                                       (rspecDsk spec) (rspecCpu spec) cnt)
+                       spec_map::[String]
+
+       when (verbose > 1) $ do
+         hPutStrLn stderr "Tiered allocation map"
+         hPutStr stderr . unlines . map ((:) ' ' .  intercalate " ") $
+                 formatTable (map (printInstance trl_nl) fin_trl_ixes)
+                                 [False, False, False, True, True, True]
+
+       when (isJust shownodes) $ do
+         hPutStrLn stderr ""
+         hPutStrLn stderr "Tiered allocation status:"
+         hPutStrLn stderr $ Cluster.printNodes trl_nl (fromJust shownodes)
+
+       printKeys $ printStats PTiered (Cluster.totalResources trl_nl)
+       printKeys [("TSPEC", intercalate " " spec_map')])
+
+  -- Run the standard (avg-mode) allocation
+
+  let result = iterateDepth nl il reqinst req_nodes []
+  (ereason, fin_nl, ixes) <- exitifbad result
+
+  let allocs = length ixes

       fin_ixes = reverse ixes
       fin_ixes = reverse ixes

-      ix_namelen = maximum . map (length . Instance.name) $ fin_ixes
-      (final_mem, final_disk) = Cluster.totalResources fin_nl
-
-  printf "Final score: %.8f\n" (Cluster.compCV fin_nl)
-  printf "Final instances: %d\n" (num_instances + allocs)
-  printf "Final free RAM: %d\n" final_mem
-  printf "Final free disk: %d\n" final_disk
-  printf "Usage: %.5f\n" (((fromIntegral num_instances)::Double) /
-                          (fromIntegral fin_instances))
-  printf "Allocations: %d\n" allocs
+      sreason = reverse $ sortBy (compare `on` snd) ereason
+

   when (verbose > 1) $ do
   when (verbose > 1) $ do

-         putStr . unlines . map (\i -> printf "Inst: %*s %-*s %-*s"
-                     ix_namelen (Instance.name i)
-                     nmlen (Container.nameOf fin_nl $ Instance.pnode i)
-                     nmlen (let sdx = Instance.snode i
-                            in if sdx == Node.noSecondary then ""
-                               else Container.nameOf fin_nl sdx))
-         $ fin_ixes
-
-  when (optShowNodes opts) $
+         hPutStrLn stderr "Instance map"
+         hPutStr stderr . unlines . map ((:) ' ' .  intercalate " ") $
+                 formatTable (map (printInstance fin_nl) fin_ixes)
+                                 [False, False, False, True, True, True]
+  when (isJust shownodes) $

        do
        do

-         let (orig_mem, orig_disk) = Cluster.totalResources nl
-             (final_mem, final_disk) = Cluster.totalResources fin_nl
-         putStrLn ""
-         putStrLn "Final cluster status:"
-         putStrLn $ Cluster.printNodes fin_nl
-         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
+         hPutStrLn stderr ""
+         hPutStrLn stderr "Final cluster status:"
+         hPutStrLn stderr $ Cluster.printNodes fin_nl (fromJust shownodes)
+
+  printResults fin_nl num_instances allocs sreason