Revision 88a10df5 htools/Ganeti/HTools/Program/Hspace.hs
| b/htools/Ganeti/HTools/Program/Hspace.hs | ||
|---|---|---|
| 31 | 31 |
import Data.List |
| 32 | 32 |
import Data.Maybe (fromMaybe) |
| 33 | 33 |
import Data.Ord (comparing) |
| 34 |
import System.Exit |
|
| 35 | 34 |
import System.IO |
| 36 | 35 |
|
| 37 | 36 |
import Text.Printf (printf, hPrintf) |
| ... | ... | |
| 173 | 172 |
let fin_stats = Cluster.totalResources fin_nl |
| 174 | 173 |
fin_instances = num_instances + allocs |
| 175 | 174 |
|
| 176 |
when (num_instances + allocs /= Cluster.csNinst fin_stats) $ |
|
| 177 |
do |
|
| 178 |
hPrintf stderr "ERROR: internal inconsistency, allocated (%d)\ |
|
| 179 |
\ != counted (%d)\n" (num_instances + allocs) |
|
| 180 |
(Cluster.csNinst fin_stats) :: IO () |
|
| 181 |
exitWith $ ExitFailure 1 |
|
| 175 |
exitWhen (num_instances + allocs /= Cluster.csNinst fin_stats) $ |
|
| 176 |
printf "internal inconsistency, allocated (%d)\ |
|
| 177 |
\ != counted (%d)\n" (num_instances + allocs) |
|
| 178 |
(Cluster.csNinst fin_stats) |
|
| 182 | 179 |
|
| 183 | 180 |
printKeys $ printStats PFinal fin_stats |
| 184 | 181 |
printKeys [ ("ALLOC_USAGE", printf "%.8f"
|
| ... | ... | |
| 350 | 347 |
sortReasons :: [(FailMode, Int)] -> [(FailMode, Int)] |
| 351 | 348 |
sortReasons = reverse . sortBy (comparing snd) |
| 352 | 349 |
|
| 353 |
-- | Aborts the program if we get a bad value. |
|
| 354 |
exitIfBad :: Result a -> IO a |
|
| 355 |
exitIfBad (Bad s) = |
|
| 356 |
hPrintf stderr "Failure: %s\n" s >> exitWith (ExitFailure 1) |
|
| 357 |
exitIfBad (Ok v) = return v |
|
| 358 |
|
|
| 359 | 350 |
-- | Runs an allocation algorithm and saves cluster state. |
| 360 | 351 |
runAllocation :: ClusterData -- ^ Cluster data |
| 361 | 352 |
-> Maybe Cluster.AllocResult -- ^ Optional stop-allocation |
| ... | ... | |
| 369 | 360 |
(reasons, new_nl, new_il, new_ixes, _) <- |
| 370 | 361 |
case stop_allocation of |
| 371 | 362 |
Just result_noalloc -> return result_noalloc |
| 372 |
Nothing -> exitIfBad actual_result |
|
| 363 |
Nothing -> exitIfBad "failure during allocation" actual_result
|
|
| 373 | 364 |
|
| 374 | 365 |
let name = head . words . specDescription $ mode |
| 375 | 366 |
descr = name ++ " allocation" |
| ... | ... | |
| 395 | 386 |
-- | Main function. |
| 396 | 387 |
main :: Options -> [String] -> IO () |
| 397 | 388 |
main opts args = do |
| 398 |
unless (null args) $ do |
|
| 399 |
hPutStrLn stderr "Error: this program doesn't take any arguments." |
|
| 400 |
exitWith $ ExitFailure 1 |
|
| 389 |
exitUnless (null args) "this program doesn't take any arguments" |
|
| 401 | 390 |
|
| 402 | 391 |
let verbose = optVerbose opts |
| 403 | 392 |
machine_r = optMachineReadable opts |
| ... | ... | |
| 408 | 397 |
cluster_disk_template <- |
| 409 | 398 |
case iPolicyDiskTemplates ipol of |
| 410 | 399 |
first_templ:_ -> return first_templ |
| 411 |
_ -> do |
|
| 412 |
_ <- hPutStrLn stderr $ "Error: null list of disk templates\ |
|
| 413 |
\ received from cluster!" |
|
| 414 |
exitWith $ ExitFailure 1 |
|
| 400 |
_ -> exitErr "null list of disk templates received from cluster" |
|
| 415 | 401 |
|
| 416 | 402 |
let num_instances = Container.size il |
| 417 | 403 |
all_nodes = Container.elems fixed_nl |
| ... | ... | |
| 440 | 426 |
then Nothing |
| 441 | 427 |
else Just (optMaxLength opts) |
| 442 | 428 |
|
| 443 |
allocnodes <- exitIfBad $ Cluster.genAllocNodes gl nl req_nodes True |
|
| 429 |
allocnodes <- exitIfBad "failure during allocation" $ |
|
| 430 |
Cluster.genAllocNodes gl nl req_nodes True |
|
| 444 | 431 |
|
| 445 | 432 |
-- Run the tiered allocation |
| 446 | 433 |
|
Also available in: Unified diff