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 System.Console.GetOpt
  34 import qualified System
  35
  36 import Text.Printf (printf)
  37
  38 import qualified Ganeti.HTools.Cluster as Cluster
  39 import qualified Ganeti.HTools.Node as Node
  40 import qualified Ganeti.HTools.CLI as CLI
  41 import Ganeti.HTools.IAlloc
  42 import Ganeti.HTools.Types
  43 import Ganeti.HTools.Loader (RqType(..), Request(..))
  44
  45 -- | Command line options structure.
  46 data Options = Options
  47     { optShowVer   :: Bool           -- ^ Just show the program version
  48     , optShowHelp  :: Bool           -- ^ Just show the help
  49     } deriving Show
  50
  51 -- | Default values for the command line options.
  52 defaultOptions :: Options
  53 defaultOptions  = Options
  54  { optShowVer   = False
  55  , optShowHelp  = False
  56  }
  57
  58 instance CLI.CLIOptions Options where
  59     showVersion = optShowVer
  60     showHelp    = optShowHelp
  61
  62 -- | Options list and functions
  63 options :: [OptDescr (Options -> Options)]
  64 options =
  65     [ Option ['V']     ["version"]
  66       (NoArg (\ opts -> opts { optShowVer = True}))
  67       "show the version of the program"
  68     , Option ['h']     ["help"]
  69       (NoArg (\ opts -> opts { optShowHelp = True}))
  70       "show help"
  71     ]
  72
  73
  74 processResults :: (Monad m) => Cluster.AllocSolution -> m (String, [Node.Node])
  75 processResults (fstats, succ, sols) =
  76     case sols of
  77       Nothing -> fail "No valid allocation solutions"
  78       Just (best, (_, _, w)) ->
  79           let tfails = length fstats
  80               info = printf "successes %d, failures %d,\
  81                             \ best score: %.8f for node(s) %s"
  82                             succ tfails
  83                             best (intercalate "/" . map Node.name $ w)::String
  84           in return (info, w)
  85
  86 -- | Process a request and return new node lists
  87 processRequest :: Request
  88                -> Result Cluster.AllocSolution
  89 processRequest request =
  90   let Request rqtype nl il _ = request
  91   in case rqtype of
  92        Allocate xi reqn -> Cluster.tryAlloc nl il xi reqn
  93        Relocate idx reqn exnodes -> Cluster.tryReloc nl il idx reqn exnodes
  94
  95 -- | Main function.
  96 main :: IO ()
  97 main = do
  98   cmd_args <- System.getArgs
  99   (_, args) <- CLI.parseOpts cmd_args "hail" options defaultOptions
 100
 101   when (null args) $ do
 102          hPutStrLn stderr "Error: this program needs an input file."
 103          exitWith $ ExitFailure 1
 104
 105   let input_file = head args
 106   input_data <- readFile input_file
 107
 108   request <- case (parseData input_data) of
 109                Bad err -> do
 110                  hPutStrLn stderr $ "Error: " ++ err
 111                  exitWith $ ExitFailure 1
 112                Ok rq -> return rq
 113
 114   let Request _ _ _ csf = request
 115       sols = processRequest request >>= processResults
 116   let (ok, info, rn) =
 117           case sols of
 118             Ok (info, sn) -> (True, "Request successful: " ++ info,
 119                                   map ((++ csf) . Node.name) sn)
 120             Bad s -> (False, "Request failed: " ++ s, [])
 121       resp = formatResponse ok info rn
 122   putStrLn resp