LGTM Thanks,
Guido On Thu, Apr 11, 2013 at 6:19 AM, Klaus Aehlig <[email protected]> wrote: > In that way, tools building on Instance will benefit from the corrected > verification semantics of the instance policy on disk space. > > Signed-off-by: Klaus Aehlig <[email protected]> > --- > src/Ganeti/HTools/Backend/IAlloc.hs | 7 +++++-- > src/Ganeti/HTools/Backend/Luxi.hs | 2 +- > src/Ganeti/HTools/Backend/Rapi.hs | 3 ++- > src/Ganeti/HTools/Backend/Text.hs | 2 +- > src/Ganeti/HTools/Instance.hs | 6 +++--- > src/Ganeti/HTools/Program/Hspace.hs | 5 ++++- > test/hs/Test/Ganeti/HTools/Instance.hs | 2 +- > test/hs/Test/Ganeti/TestHTools.hs | 4 ++-- > 8 files changed, 19 insertions(+), 12 deletions(-) > > diff --git a/src/Ganeti/HTools/Backend/IAlloc.hs > b/src/Ganeti/HTools/Backend/IAlloc.hs > index d1d1436..65cbf3d 100644 > --- a/src/Ganeti/HTools/Backend/IAlloc.hs > +++ b/src/Ganeti/HTools/Backend/IAlloc.hs > @@ -65,14 +65,17 @@ parseBaseInstance :: String > -> JSRecord > -> Result (String, Instance.Instance) > parseBaseInstance n a = do > - let extract x = tryFromObj ("invalid data for instance '" ++ n ++ "'") a x > + let errorMessage = "invalid data for instance '" ++ n ++ "'" > + let extract x = tryFromObj errorMessage a x > disk <- extract "disk_space_total" > + disks <- extract "disks" >>= toArray >>= asObjectList >>= > + mapM (flip (tryFromObj errorMessage) "size" . fromJSObject) > mem <- extract "memory" > vcpus <- extract "vcpus" > tags <- extract "tags" > dt <- extract "disk_template" > su <- extract "spindle_use" > - return (n, Instance.create n mem disk vcpus Running tags True 0 0 dt su) > + return (n, Instance.create n mem disk disks vcpus Running tags True 0 0 dt > su) > > -- | Parses an instance as found in the cluster instance list. > parseInstance :: NameAssoc -- ^ The node name-to-index association list > diff --git a/src/Ganeti/HTools/Backend/Luxi.hs > b/src/Ganeti/HTools/Backend/Luxi.hs > index febb0ab..eca265e 100644 > --- a/src/Ganeti/HTools/Backend/Luxi.hs > +++ b/src/Ganeti/HTools/Backend/Luxi.hs > @@ -172,7 +172,7 @@ parseInstance ktn [ name, disk, mem, vcpus > xauto_balance <- convert "auto_balance" auto_balance > xdt <- convert "disk_template" disk_template > xsu <- convert "be/spindle_use" su > - let inst = Instance.create xname xmem xdisk xvcpus > + let inst = Instance.create xname xmem xdisk [xdisk] xvcpus > xrunning xtags xauto_balance xpnode snode xdt xsu > return (xname, inst) > > diff --git a/src/Ganeti/HTools/Backend/Rapi.hs > b/src/Ganeti/HTools/Backend/Rapi.hs > index eaf061c..387d6e2 100644 > --- a/src/Ganeti/HTools/Backend/Rapi.hs > +++ b/src/Ganeti/HTools/Backend/Rapi.hs > @@ -130,6 +130,7 @@ parseInstance ktn a = do > let owner_name = "Instance '" ++ name ++ "', error while parsing data" > let extract s x = tryFromObj owner_name x s > disk <- extract "disk_usage" a > + disks <- extract "disk.sizes" a > beparams <- liftM fromJSObject (extract "beparams" a) > omem <- extract "oper_ram" a > mem <- case omem of > @@ -146,7 +147,7 @@ parseInstance ktn a = do > auto_balance <- extract "auto_balance" beparams > dt <- extract "disk_template" a > su <- extract "spindle_use" beparams > - let inst = Instance.create name mem disk vcpus running tags > + let inst = Instance.create name mem disk disks vcpus running tags > auto_balance pnode snode dt su > return (name, inst) > > diff --git a/src/Ganeti/HTools/Backend/Text.hs > b/src/Ganeti/HTools/Backend/Text.hs > index cb3719c..31fc23a 100644 > --- a/src/Ganeti/HTools/Backend/Text.hs > +++ b/src/Ganeti/HTools/Backend/Text.hs > @@ -230,7 +230,7 @@ loadInst ktn [ name, mem, dsk, vcpus, status, auto_bal, > pnode, snode > when (sidx == pidx) . fail $ "Instance " ++ name ++ > " has same primary and secondary node - " ++ pnode > let vtags = commaSplit tags > - newinst = Instance.create name vmem vdsk vvcpus vstatus vtags > + newinst = Instance.create name vmem vdsk [vdsk] vvcpus vstatus vtags > auto_balance pidx sidx disk_template spindle_use > return (name, newinst) > > diff --git a/src/Ganeti/HTools/Instance.hs b/src/Ganeti/HTools/Instance.hs > index 6dd6c6b..cfda115 100644 > --- a/src/Ganeti/HTools/Instance.hs > +++ b/src/Ganeti/HTools/Instance.hs > @@ -163,16 +163,16 @@ type List = Container.Container Instance > -- > -- Some parameters are not initialized by function, and must be set > -- later (via 'setIdx' for example). > -create :: String -> Int -> Int -> Int -> T.InstanceStatus > +create :: String -> Int -> Int -> [Int] -> Int -> T.InstanceStatus > -> [String] -> Bool -> T.Ndx -> T.Ndx -> T.DiskTemplate -> Int > -> Instance > -create name_init mem_init dsk_init vcpus_init run_init tags_init > +create name_init mem_init dsk_init disks_init vcpus_init run_init tags_init > auto_balance_init pn sn dt su = > Instance { name = name_init > , alias = name_init > , mem = mem_init > , dsk = dsk_init > - , disks = [dsk_init] > + , disks = disks_init > , vcpus = vcpus_init > , runSt = run_init > , pNode = pn > diff --git a/src/Ganeti/HTools/Program/Hspace.hs > b/src/Ganeti/HTools/Program/Hspace.hs > index 02c81bf..46d69f0 100644 > --- a/src/Ganeti/HTools/Program/Hspace.hs > +++ b/src/Ganeti/HTools/Program/Hspace.hs > @@ -390,9 +390,12 @@ runAllocation cdata stop_allocation actual_result spec > dt mode opts = do > return (sortReasons reasons, new_nl, length new_ixes, tieredSpecMap > new_ixes) > > -- | Create an instance from a given spec. > +-- For values not implied by the resorce specification (like distribution of > +-- of the disk space to individual disks), sensible defaults are guessed > (e.g., > +-- having a single disk). > instFromSpec :: RSpec -> DiskTemplate -> Int -> Instance.Instance > instFromSpec spx = > - Instance.create "new" (rspecMem spx) (rspecDsk spx) > + Instance.create "new" (rspecMem spx) (rspecDsk spx) [rspecDsk spx] > (rspecCpu spx) Running [] True (-1) (-1) > > -- | Main function. > diff --git a/test/hs/Test/Ganeti/HTools/Instance.hs > b/test/hs/Test/Ganeti/HTools/Instance.hs > index 0f71c26..ca8f682 100644 > --- a/test/hs/Test/Ganeti/HTools/Instance.hs > +++ b/test/hs/Test/Ganeti/HTools/Instance.hs > @@ -62,7 +62,7 @@ genInstanceSmallerThan lim_mem lim_dsk lim_cpu = do > sn <- arbitrary > vcpus <- choose (0, lim_cpu) > dt <- arbitrary > - return $ Instance.create name mem dsk vcpus run_st [] True pn sn dt 1 > + return $ Instance.create name mem dsk [dsk] vcpus run_st [] True pn sn dt 1 > > -- | Generates an instance smaller than a node. > genInstanceSmallerThanNode :: Node.Node -> Gen Instance.Instance > diff --git a/test/hs/Test/Ganeti/TestHTools.hs > b/test/hs/Test/Ganeti/TestHTools.hs > index b27c34c..4a9272a 100644 > --- a/test/hs/Test/Ganeti/TestHTools.hs > +++ b/test/hs/Test/Ganeti/TestHTools.hs > @@ -96,8 +96,8 @@ defGroupAssoc = Map.singleton (Group.uuid defGroup) > (Group.idx defGroup) > -- | Create an instance given its spec. > createInstance :: Int -> Int -> Int -> Instance.Instance > createInstance mem dsk vcpus = > - Instance.create "inst-unnamed" mem dsk vcpus Types.Running [] True (-1) > (-1) > - Types.DTDrbd8 1 > + Instance.create "inst-unnamed" mem dsk [dsk] vcpus Types.Running [] True > (-1) > + (-1) Types.DTDrbd8 1 > > -- | Create a small cluster by repeating a node spec. > makeSmallCluster :: Node.Node -> Int -> Node.List > -- > 1.8.1.3 > -- Guido Trotter Ganeti Engineering Google Germany GmbH Dienerstr. 12, 80331, München Registergericht und -nummer: Hamburg, HRB 86891 Sitz der Gesellschaft: Hamburg Geschäftsführer: Graham Law, Katherine Stephens Steuernummer: 48/725/00206 Umsatzsteueridentifikationsnummer: DE813741370
