From 88a10df5a1f40e77d5321aec02109bd0ad01e578 Mon Sep 17 00:00:00 2001
From: Iustin Pop <iustin@google.com>
Date: Thu, 22 Mar 2012 12:34:53 +0000
Subject: [PATCH] Rework exit model
While updating the confd code, I realised that we have _lots_ of
duplication in the exit model for the various programs.
So this patch attempts to abstract all the exits via a couple of new
functions; sorry for the somewhat big patch, but I hope the payoff is
worth the change: the actual exit conditions are much clearer.
Note that the patch (also) moves the exitIfBad function to Utils.hs,
since that is more logical.
Signed-off-by: Iustin Pop <iustin@google.com>
Reviewed-by: Guido Trotter <ultrotter@google.com>
---
htools/Ganeti/BasicTypes.hs | 11 ---------
htools/Ganeti/Confd/Server.hs | 3 +--
htools/Ganeti/Daemon.hs | 31 +++++++------------------
htools/Ganeti/HTools/CLI.hs | 7 +++---
htools/Ganeti/HTools/ExtLoader.hs | 31 +++++++------------------
htools/Ganeti/HTools/Program/Hspace.hs | 31 ++++++++-----------------
htools/Ganeti/HTools/Utils.hs | 32 ++++++++++++++++++++++++++
7 files changed, 61 insertions(+), 85 deletions(-)
diff --git a/htools/Ganeti/BasicTypes.hs b/htools/Ganeti/BasicTypes.hs
index fa9e30f77..ec3e138af 100644
--- a/htools/Ganeti/BasicTypes.hs
+++ b/htools/Ganeti/BasicTypes.hs
@@ -26,12 +26,9 @@ module Ganeti.BasicTypes
, eitherToResult
, annotateResult
, annotateIOError
- , exitIfBad
) where
import Control.Monad
-import System.IO (hPutStrLn, stderr)
-import System.Exit
-- | This is similar to the JSON library Result type - /very/ similar,
-- but we want to use it in multiple places, so we abstract it into a
@@ -81,11 +78,3 @@ annotateResult _ v = v
annotateIOError :: String -> IOError -> IO (Result a)
annotateIOError description exc =
return . Bad $ description ++ ": " ++ show exc
-
--- | Unwraps a 'Result', exiting the program if it is a 'Bad' value,
--- otherwise returning the actual contained value.
-exitIfBad :: Result a -> IO a
-exitIfBad (Bad s) = do
- hPutStrLn stderr $ "Failure: " ++ s
- exitWith (ExitFailure 1)
-exitIfBad (Ok v) = return v
diff --git a/htools/Ganeti/Confd/Server.hs b/htools/Ganeti/Confd/Server.hs
index 9c38bdb77..ffe40a989 100644
--- a/htools/Ganeti/Confd/Server.hs
+++ b/htools/Ganeti/Confd/Server.hs
@@ -51,7 +51,6 @@ import Ganeti.Confd
import Ganeti.Config
import Ganeti.Hash
import Ganeti.Logging
-import Ganeti.BasicTypes
import qualified Ganeti.Constants as C
-- * Types and constants definitions
@@ -504,7 +503,7 @@ listener s hmac resp = do
main :: DaemonOptions -> IO ()
main opts = do
parseresult <- parseAddress opts C.defaultConfdPort
- (af_family, bindaddr) <- exitIfBad parseresult
+ (af_family, bindaddr) <- exitIfBad "parsing bind address" parseresult
s <- S.socket af_family S.Datagram S.defaultProtocol
S.bindSocket s bindaddr
cref <- newIORef (Bad "Configuration not yet loaded")
diff --git a/htools/Ganeti/Daemon.hs b/htools/Ganeti/Daemon.hs
index 15583be55..e0587f8ec 100644
--- a/htools/Ganeti/Daemon.hs
+++ b/htools/Ganeti/Daemon.hs
@@ -171,13 +171,8 @@ parseOpts argv progname options =
(opt_list, args, []) ->
do
parsed_opts <-
- case foldM (flip id) defaultOptions opt_list of
- Bad msg -> do
- hPutStrLn stderr "Error while parsing command\
- \line arguments:"
- hPutStrLn stderr msg
- exitWith $ ExitFailure 1
- Ok val -> return val
+ exitIfBad "Error while parsing command line arguments" $
+ foldM (flip id) defaultOptions opt_list
return (parsed_opts, args)
(_, _, errs) -> do
hPutStrLn stderr $ "Command line error: " ++ concat errs
@@ -291,21 +286,16 @@ genericMain daemon options main = do
compilerName (Data.Version.showVersion compilerVersion)
os arch :: IO ()
exitWith ExitSuccess
- unless (null args) $ do
- hPutStrLn stderr "This program doesn't take any arguments"
- exitWith $ ExitFailure C.exitFailure
+
+ exitUnless (null args) "This program doesn't take any arguments"
unless (optNoUserChecks opts) $ do
runtimeEnts <- getEnts
- case runtimeEnts of
- Bad msg -> do
- hPutStrLn stderr $ "Can't find required user/groups: " ++ msg
- exitWith $ ExitFailure C.exitFailure
- Ok ents -> verifyDaemonUser daemon ents
+ ents <- exitIfBad "Can't find required user/groups" runtimeEnts
+ verifyDaemonUser daemon ents
syslog <- case optSyslogUsage opts of
- Nothing -> exitIfBad $
- annotateResult "Invalid cluster syslog setting" $
+ Nothing -> exitIfBad "Invalid cluster syslog setting" $
syslogUsageFromRaw C.syslogUsage
Just v -> return v
let processFn = if optDaemonize opts then daemonize else id
@@ -319,11 +309,6 @@ innerMain daemon opts syslog main = do
setupLogging (daemonLogFile daemon) (daemonName daemon) (optDebug opts)
(not (optDaemonize opts)) False syslog
pid_fd <- writePidFile (daemonPidFile daemon)
- case pid_fd of
- Bad msg -> do
- hPutStrLn stderr $ "Cannot write PID file; already locked? Error: " ++
- msg
- exitWith $ ExitFailure 1
- _ -> return ()
+ _ <- exitIfBad "Cannot write PID file; already locked? Error" pid_fd
logNotice "starting"
main
diff --git a/htools/Ganeti/HTools/CLI.hs b/htools/Ganeti/HTools/CLI.hs
index c953aec7f..399ad87e8 100644
--- a/htools/Ganeti/HTools/CLI.hs
+++ b/htools/Ganeti/HTools/CLI.hs
@@ -88,7 +88,7 @@ import System.Console.GetOpt
import System.IO
import System.Info
import System.Exit
-import Text.Printf (printf, hPrintf)
+import Text.Printf (printf)
import qualified Ganeti.HTools.Version as Version(version)
import qualified Ganeti.HTools.Container as Container
@@ -577,9 +577,8 @@ setNodeStatus opts fixed_nl = do
m_dsk = optMdsk opts
unless (null offline_wrong) $ do
- hPrintf stderr "Error: Wrong node name(s) set as offline: %s\n"
- (commaJoin (map lrContent offline_wrong)) :: IO ()
- exitWith $ ExitFailure 1
+ exitErr $ printf "wrong node name(s) set as offline: %s\n"
+ (commaJoin (map lrContent offline_wrong))
let setMCpuFn = case m_cpu of
Nothing -> id
Just new_mcpu -> flip Node.setMcpu new_mcpu
diff --git a/htools/Ganeti/HTools/ExtLoader.hs b/htools/Ganeti/HTools/ExtLoader.hs
index 79aa4b6d3..2defadecf 100644
--- a/htools/Ganeti/HTools/ExtLoader.hs
+++ b/htools/Ganeti/HTools/ExtLoader.hs
@@ -8,7 +8,7 @@ libraries implementing the low-level protocols.
{-
-Copyright (C) 2009, 2010, 2011 Google Inc.
+Copyright (C) 2009, 2010, 2011, 2012 Google Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
@@ -37,7 +37,6 @@ import Control.Monad
import Data.Maybe (isJust, fromJust)
import System.FilePath
import System.IO
-import System.Exit
import Text.Printf (hPrintf)
import qualified Ganeti.HTools.Luxi as Luxi
@@ -50,7 +49,7 @@ import Ganeti.HTools.Loader (mergeData, checkData, ClusterData(..)
import Ganeti.HTools.Types
import Ganeti.HTools.CLI
-import Ganeti.HTools.Utils (sepSplit, tryRead)
+import Ganeti.HTools.Utils (sepSplit, tryRead, exitIfBad, exitWhen)
-- | Error beautifier.
wrapIO :: IO (Result a) -> IO (Result a)
@@ -92,20 +91,12 @@ loadExternalData opts = do
selInsts = optSelInst opts
exInsts = optExInst opts
- when (length allSet > 1) $
- do
- hPutStrLn stderr ("Error: Only one of the rapi, luxi, and data" ++
- " files options should be given.")
- exitWith $ ExitFailure 1
+ exitWhen (length allSet > 1) "Only one of the rapi, luxi, and data\
+ \ files options should be given"
util_contents <- maybe (return "") readFile (optDynuFile opts)
- let util_data = mapM parseUtilisation $ lines util_contents
- util_data' <- case util_data of
- Ok x -> return x
- Bad y -> do
- hPutStrLn stderr ("Error: can't parse utilisation" ++
- " data: " ++ show y)
- exitWith $ ExitFailure 1
+ util_data <- exitIfBad "can't parse utilisation data" .
+ mapM parseUtilisation $ lines util_contents
input_data <-
case () of
_ | setRapi -> wrapIO $ Rapi.loadData mhost
@@ -115,14 +106,8 @@ loadExternalData opts = do
| setIAllocSrc -> wrapIO $ IAlloc.loadData $ fromJust iallocsrc
| otherwise -> return $ Bad "No backend selected! Exiting."
- let ldresult = input_data >>= mergeData util_data' exTags selInsts exInsts
- cdata <-
- case ldresult of
- Ok x -> return x
- Bad s -> do
- hPrintf stderr
- "Error: failed to load data, aborting. Details:\n%s\n" s:: IO ()
- exitWith $ ExitFailure 1
+ let ldresult = input_data >>= mergeData util_data exTags selInsts exInsts
+ cdata <- exitIfBad "failed to load data, aborting" ldresult
let (fix_msgs, nl) = checkData (cdNodes cdata) (cdInstances cdata)
unless (optVerbose opts == 0) $ maybeShowWarnings fix_msgs
diff --git a/htools/Ganeti/HTools/Program/Hspace.hs b/htools/Ganeti/HTools/Program/Hspace.hs
index c7fcfdea4..ed5c39ba6 100644
--- a/htools/Ganeti/HTools/Program/Hspace.hs
+++ b/htools/Ganeti/HTools/Program/Hspace.hs
@@ -31,7 +31,6 @@ import Data.Function (on)
import Data.List
import Data.Maybe (fromMaybe)
import Data.Ord (comparing)
-import System.Exit
import System.IO
import Text.Printf (printf, hPrintf)
@@ -173,12 +172,10 @@ printResults True _ 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) :: IO ()
- exitWith $ ExitFailure 1
+ exitWhen (num_instances + allocs /= Cluster.csNinst fin_stats) $
+ printf "internal inconsistency, allocated (%d)\
+ \ != counted (%d)\n" (num_instances + allocs)
+ (Cluster.csNinst fin_stats)
printKeys $ printStats PFinal fin_stats
printKeys [ ("ALLOC_USAGE", printf "%.8f"
@@ -350,12 +347,6 @@ failureReason = show . fst . head
sortReasons :: [(FailMode, Int)] -> [(FailMode, Int)]
sortReasons = reverse . sortBy (comparing snd)
--- | Aborts the program if we get a bad value.
-exitIfBad :: Result a -> IO a
-exitIfBad (Bad s) =
- hPrintf stderr "Failure: %s\n" s >> exitWith (ExitFailure 1)
-exitIfBad (Ok v) = return v
-
-- | Runs an allocation algorithm and saves cluster state.
runAllocation :: ClusterData -- ^ Cluster data
-> Maybe Cluster.AllocResult -- ^ Optional stop-allocation
@@ -369,7 +360,7 @@ runAllocation cdata stop_allocation actual_result spec dt mode opts = do
(reasons, new_nl, new_il, new_ixes, _) <-
case stop_allocation of
Just result_noalloc -> return result_noalloc
- Nothing -> exitIfBad actual_result
+ Nothing -> exitIfBad "failure during allocation" actual_result
let name = head . words . specDescription $ mode
descr = name ++ " allocation"
@@ -395,9 +386,7 @@ instFromSpec spx disk_template su =
-- | Main function.
main :: Options -> [String] -> IO ()
main opts args = do
- unless (null args) $ do
- hPutStrLn stderr "Error: this program doesn't take any arguments."
- exitWith $ ExitFailure 1
+ exitUnless (null args) "this program doesn't take any arguments"
let verbose = optVerbose opts
machine_r = optMachineReadable opts
@@ -408,10 +397,7 @@ main opts args = do
cluster_disk_template <-
case iPolicyDiskTemplates ipol of
first_templ:_ -> return first_templ
- _ -> do
- _ <- hPutStrLn stderr $ "Error: null list of disk templates\
- \ received from cluster!"
- exitWith $ ExitFailure 1
+ _ -> exitErr "null list of disk templates received from cluster"
let num_instances = Container.size il
all_nodes = Container.elems fixed_nl
@@ -440,7 +426,8 @@ main opts args = do
then Nothing
else Just (optMaxLength opts)
- allocnodes <- exitIfBad $ Cluster.genAllocNodes gl nl req_nodes True
+ allocnodes <- exitIfBad "failure during allocation" $
+ Cluster.genAllocNodes gl nl req_nodes True
-- Run the tiered allocation
diff --git a/htools/Ganeti/HTools/Utils.hs b/htools/Ganeti/HTools/Utils.hs
index d47f58143..a890c500c 100644
--- a/htools/Ganeti/HTools/Utils.hs
+++ b/htools/Ganeti/HTools/Utils.hs
@@ -36,6 +36,10 @@ module Ganeti.HTools.Utils
, printTable
, parseUnit
, plural
+ , exitIfBad
+ , exitErr
+ , exitWhen
+ , exitUnless
) where
import Data.Char (toUpper)
@@ -43,6 +47,10 @@ import Data.List
import Debug.Trace
+import Ganeti.BasicTypes
+import System.IO
+import System.Exit
+
-- * Debug functions
-- | To be used only for debugging, breaks referential integrity.
@@ -198,3 +206,27 @@ parseUnit str =
scaling <- parseUnitValue unit
return $ truncate (fromIntegral v * scaling)
_ -> fail $ "Can't parse string '" ++ str ++ "'"
+
+-- | Unwraps a 'Result', exiting the program if it is a 'Bad' value,
+-- otherwise returning the actual contained value.
+exitIfBad :: String -> Result a -> IO a
+exitIfBad msg (Bad s) = do
+ hPutStrLn stderr $ "Error: " ++ msg ++ ": " ++ s
+ exitWith (ExitFailure 1)
+exitIfBad _ (Ok v) = return v
+
+-- | Exits immediately with an error message.
+exitErr :: String -> IO a
+exitErr errmsg = do
+ hPutStrLn stderr $ "Error: " ++ errmsg ++ "."
+ exitWith (ExitFailure 1)
+
+-- | Exits with an error message if the given boolean condition if true.
+exitWhen :: Bool -> String -> IO ()
+exitWhen True msg = exitErr msg
+exitWhen False _ = return ()
+
+-- | Exits with an error message /unless/ the given boolean condition
+-- if true, the opposite of 'exitWhen'.
+exitUnless :: Bool -> String -> IO ()
+exitUnless cond = exitWhen (not cond)
--
GitLab