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, 2010, 2011 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.Maybe (isJust, fromJust)
  30 import Monad
  31 import System (exitWith, ExitCode(..))
  32 import System.IO
  33 import qualified System
  34
  35 import qualified Ganeti.HTools.Cluster as Cluster
  36
  37 import Ganeti.HTools.CLI
  38 import Ganeti.HTools.IAlloc
  39 import Ganeti.HTools.Types
  40 import Ganeti.HTools.Loader (RqType(..), Request(..), ClusterData(..))
  41 import Ganeti.HTools.ExtLoader (loadExternalData)
  42
  43 -- | Options list and functions
  44 options :: [OptType]
  45 options =
  46     [ oPrintNodes
  47     , oDataFile
  48     , oNodeSim
  49     , oShowVer
  50     , oShowHelp
  51     ]
  52
  53 processResults :: (Monad m) =>
  54                   RqType -> Cluster.AllocSolution
  55                -> m Cluster.AllocSolution
  56 processResults _ (Cluster.AllocSolution { Cluster.asSolutions = [],
  57                                           Cluster.asLog = msgs }) =
  58   fail $ intercalate ", " msgs
  59
  60 processResults (Evacuate _) as = return as
  61
  62 processResults _ as =
  63     case Cluster.asSolutions as of
  64       _:[] -> return as
  65       _ -> fail "Internal error: multiple allocation solutions"
  66
  67 -- | Process a request and return new node lists
  68 processRequest :: Request
  69                -> Result Cluster.AllocSolution
  70 processRequest request =
  71   let Request rqtype (ClusterData gl nl il _) = request
  72   in case rqtype of
  73        Allocate xi reqn -> Cluster.tryMGAlloc gl nl il xi reqn
  74        Relocate idx reqn exnodes -> Cluster.tryMGReloc gl nl il
  75                                     idx reqn exnodes
  76        Evacuate exnodes -> Cluster.tryMGEvac gl nl il exnodes
  77
  78 -- | Reads the request from the data file(s)
  79 readRequest :: Options -> [String] -> IO Request
  80 readRequest opts args = do
  81   when (null args) $ do
  82          hPutStrLn stderr "Error: this program needs an input file."
  83          exitWith $ ExitFailure 1
  84
  85   input_data <- readFile (head args)
  86   r1 <- case (parseData input_data) of
  87           Bad err -> do
  88             hPutStrLn stderr $ "Error: " ++ err
  89             exitWith $ ExitFailure 1
  90           Ok rq -> return rq
  91   r2 <- if isJust (optDataFile opts) ||  (not . null . optNodeSim) opts
  92         then  do
  93           cdata <- loadExternalData opts
  94           let Request rqt _ = r1
  95           return $ Request rqt cdata
  96         else return r1
  97   return r2
  98
  99 -- | Main function.
 100 main :: IO ()
 101 main = do
 102   cmd_args <- System.getArgs
 103   (opts, args) <- parseOpts cmd_args "hail" options
 104
 105   let shownodes = optShowNodes opts
 106
 107   request <- readRequest opts args
 108
 109   let Request rq cdata = request
 110
 111   when (isJust shownodes) $ do
 112          hPutStrLn stderr "Initial cluster status:"
 113          hPutStrLn stderr $ Cluster.printNodes (cdNodes cdata)
 114                        (fromJust shownodes)
 115
 116   let sols = processRequest request >>= processResults rq
 117   let (ok, info, rn) =
 118           case sols of
 119             Ok as -> (True, "Request successful: " ++
 120                             intercalate ", " (Cluster.asLog as),
 121                       Cluster.asSolutions as)
 122             Bad s -> (False, "Request failed: " ++ s, [])
 123       resp = formatResponse ok info rq rn
 124   putStrLn resp