Commit 6429e8d8 authored by Iustin Pop's avatar Iustin Pop
Browse files

htools: read/save the disk template in Text backend



This requires that we change the signature of loadInst in order to
properly annotate the error messages, which in turn requires more
unittest changes.

Also, this invalidates yet again saved data files…
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarGuido Trotter <ultrotter@google.com>
parent b3c5e8de
......@@ -506,7 +506,7 @@ testInstance =
prop_Text_Load_Instance name mem dsk vcpus status
(NonEmpty pnode) snode
(NonNegative pdx) (NonNegative sdx) autobal =
(NonNegative pdx) (NonNegative sdx) autobal dt =
pnode /= snode && pdx /= sdx ==>
let vcpus_s = show vcpus
dsk_s = show dsk
......@@ -517,20 +517,23 @@ prop_Text_Load_Instance name mem dsk vcpus status
nl = Data.Map.fromList ndx
tags = ""
sbal = if autobal then "Y" else "N"
sdt = Types.dtToString dt
inst = Text.loadInst nl
[name, mem_s, dsk_s, vcpus_s, status,
sbal, pnode, snode, tags]:: Maybe (String, Instance.Instance)
sbal, pnode, snode, sdt, tags]
fail1 = Text.loadInst nl
[name, mem_s, dsk_s, vcpus_s, status,
sbal, pnode, pnode, tags]:: Maybe (String, Instance.Instance)
sbal, pnode, pnode, tags]
_types = ( name::String, mem::Int, dsk::Int
, vcpus::Int, status::String
, snode::String
, autobal::Bool)
in
case inst of
Nothing -> False
Just (_, i) ->
Types.Bad msg -> printTestCase ("Failed to load instance: " ++ msg)
False
Types.Ok (_, i) -> printTestCase ("Mismatch in some field while\
\ loading the instance") $
Instance.name i == name &&
Instance.vcpus i == vcpus &&
Instance.mem i == mem &&
......@@ -539,13 +542,15 @@ prop_Text_Load_Instance name mem dsk vcpus status
then Node.noSecondary
else sdx) &&
Instance.autoBalance i == autobal &&
isNothing fail1
Types.isBad fail1
prop_Text_Load_InstanceFail ktn fields =
length fields /= 9 ==>
length fields /= 10 ==>
case Text.loadInst nl fields of
Types.Ok _ -> False
Types.Bad msg -> "Invalid/incomplete instance data: '" `isPrefixOf` msg
Types.Ok _ -> printTestCase "Managed to load instance from invalid\
\ data" False
Types.Bad msg -> printTestCase ("Unrecognised error message: " ++ msg) $
"Invalid/incomplete instance data: '" `isPrefixOf` msg
where nl = Data.Map.fromList ktn
prop_Text_Load_Node name tm nm fm td fd tc fo =
......
......@@ -93,11 +93,12 @@ serializeInstance nl inst =
then ""
else Container.nameOf nl sidx)
in
printf "%s|%d|%d|%d|%s|%s|%s|%s|%s"
printf "%s|%d|%d|%d|%s|%s|%s|%s|%s|%s"
iname (Instance.mem inst) (Instance.dsk inst)
(Instance.vcpus inst) (Instance.runSt inst)
(if Instance.autoBalance inst then "Y" else "N")
pnode snode (intercalate "," (Instance.tags inst))
pnode snode (dtToString (Instance.diskTemplate inst))
(intercalate "," (Instance.tags inst))
-- | Generate instance file data from instance objects.
serializeInstances :: Node.List -> Instance.List -> String
......@@ -148,15 +149,13 @@ loadNode ktg [name, tm, nm, fm, td, fd, tc, fo, gu] = do
loadNode _ s = fail $ "Invalid/incomplete node data: '" ++ show s ++ "'"
-- | Load an instance from a field list.
loadInst :: (Monad m) =>
NameAssoc -- ^ Association list with
-- the current nodes
-> [String] -- ^ Input data as a list of
-- fields
-> m (String, Instance.Instance) -- ^ The result, a tuple of
-- instance name and the
-- instance object
loadInst ktn [name, mem, dsk, vcpus, status, auto_bal, pnode, snode, tags] = do
loadInst :: NameAssoc -- ^ Association list with the current nodes
-> [String] -- ^ Input data as a list of fields
-> Result (String, Instance.Instance) -- ^ A tuple of
-- instance name and
-- the instance object
loadInst ktn [ name, mem, dsk, vcpus, status, auto_bal, pnode, snode
, dt, tags ] = do
pidx <- lookupNode ktn name pnode
sidx <- (if null snode then return Node.noSecondary
else lookupNode ktn name snode)
......@@ -168,11 +167,12 @@ loadInst ktn [name, mem, dsk, vcpus, status, auto_bal, pnode, snode, tags] = do
"N" -> return False
_ -> fail $ "Invalid auto_balance value '" ++ auto_bal ++
"' for instance " ++ name
disk_template <- annotateResult ("Instance " ++ name) (dtFromString dt)
when (sidx == pidx) $ fail $ "Instance " ++ name ++
" has same primary and secondary node - " ++ pnode
let vtags = sepSplit ',' tags
newinst = Instance.create name vmem vdsk vvcpus status vtags
auto_balance pidx sidx DTDrbd8
auto_balance pidx sidx disk_template
return (name, newinst)
loadInst _ s = fail $ "Invalid/incomplete instance data: '" ++ show s ++ "'"
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment