code.grnet.gr Git - ganeti-local/blob - hail.hs

   1 {-| Solver for N+1 cluster errors
   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 Monad
  31 import System
  32 import System.IO
  33 import qualified System
  34
  35 import Text.Printf (printf)
  36
  37 import qualified Ganeti.HTools.Cluster as Cluster
  38 import qualified Ganeti.HTools.Node as Node
  39
  40 import Ganeti.HTools.CLI
  41 import Ganeti.HTools.IAlloc
  42 import Ganeti.HTools.Types
  43 import Ganeti.HTools.Loader (RqType(..), Request(..))
  44
  45 -- | Options list and functions
  46 options :: [OptType]
  47 options = [oShowVer, oShowHelp]
  48
  49 processResults :: (Monad m) => Cluster.AllocSolution -> m (String, [Node.Node])
  50 processResults (fstats, successes, sols) =
  51     case sols of
  52       Nothing -> fail "No valid allocation solutions"
  53       Just (best, (_, _, w)) ->
  54           let tfails = length fstats
  55               info = printf "successes %d, failures %d,\
  56                             \ best score: %.8f for node(s) %s"
  57                             successes tfails
  58                             best (intercalate "/" . map Node.name $ w)::String
  59           in return (info, w)
  60
  61 -- | Process a request and return new node lists
  62 processRequest :: Request
  63                -> Result Cluster.AllocSolution
  64 processRequest request =
  65   let Request rqtype nl il _ = request
  66   in case rqtype of
  67        Allocate xi reqn -> Cluster.tryAlloc nl il xi reqn
  68        Relocate idx reqn exnodes -> Cluster.tryReloc nl il idx reqn exnodes
  69
  70 -- | Main function.
  71 main :: IO ()
  72 main = do
  73   cmd_args <- System.getArgs
  74   (_, args) <- parseOpts cmd_args "hail" options
  75
  76   when (null args) $ do
  77          hPutStrLn stderr "Error: this program needs an input file."
  78          exitWith $ ExitFailure 1
  79
  80   let input_file = head args
  81   input_data <- readFile input_file
  82
  83   request <- case (parseData input_data) of
  84                Bad err -> do
  85                  hPutStrLn stderr $ "Error: " ++ err
  86                  exitWith $ ExitFailure 1
  87                Ok rq -> return rq
  88
  89   let Request _ _ _ csf = request
  90       sols = processRequest request >>= processResults
  91   let (ok, info, rn) =
  92           case sols of
  93             Ok (ginfo, sn) -> (True, "Request successful: " ++ ginfo,
  94                                    map ((++ csf) . Node.name) sn)
  95             Bad s -> (False, "Request failed: " ++ s, [])
  96       resp = formatResponse ok info rn
  97   putStrLn resp