From 575877608271984296b64af9c45ba503f0b97349 Mon Sep 17 00:00:00 2001
From: Iustin Pop <iustin@google.com>
Date: Tue, 9 Mar 2010 15:40:44 +0100
Subject: [PATCH] Fix iallocator crash when no solutions exist
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Commit 5436576 added an un-guarded `head' call, which crashes with
βPrelude.head: empty listβ when no results exists for the per-instance
allocation/relocation calls.
This patch fixes this, and also adds another check for an unguarded
`head' call during parsing of input data.
(cherry picked from commit e41f4ba0ad09bcf3a696ab4eb7a1952e29f37d1f)
---
Ganeti/HTools/IAlloc.hs | 11 +++++++----
1 file changed, 7 insertions(+), 4 deletions(-)
diff --git a/Ganeti/HTools/IAlloc.hs b/Ganeti/HTools/IAlloc.hs
index 52eaf1251..dc2c85843 100644
--- a/Ganeti/HTools/IAlloc.hs
+++ b/Ganeti/HTools/IAlloc.hs
@@ -64,7 +64,9 @@ parseInstance :: NameAssoc -- ^ The node name-to-index association list
parseInstance ktn n a = do
base <- parseBaseInstance n a
nodes <- fromObj "nodes" a
- pnode <- readEitherString $ head nodes
+ pnode <- if null nodes
+ then Bad $ "empty node list for instance " ++ n
+ else readEitherString $ head nodes
pidx <- lookupNode ktn n pnode
let snodes = tail nodes
sidx <- (if null snodes then return Node.noSecondary
@@ -141,8 +143,10 @@ parseData body = do
other -> fail ("Invalid request type '" ++ other ++ "'")
return $ Request rqtype map_n map_i ptags csf
-formatRVal :: String -> RqType
- -> [Node.AllocElement] -> JSValue
+-- | Format the result
+formatRVal :: String -> RqType -> [Node.AllocElement] -> JSValue
+formatRVal _ _ [] = JSArray []
+
formatRVal csf (Evacuate _) elems =
let sols = map (\(_, inst, nl) ->
let names = Instance.name inst : map Node.name nl
@@ -155,7 +159,6 @@ formatRVal csf _ elems =
nodes' = map ((++ csf) . Node.name) nodes
in JSArray $ map (JSString . toJSString) nodes'
-
-- | Formats the response into a valid IAllocator response message.
formatResponse :: Bool -- ^ Whether the request was successful
-> String -- ^ Information text
--
GitLab