Revision 2c9336a4
b/htools/Ganeti/HTools/CLI.hs | ||
---|---|---|
199 | 199 |
oDiskTemplate :: OptType |
200 | 200 |
oDiskTemplate = Option "" ["disk-template"] |
201 | 201 |
(ReqArg (\ t opts -> do |
202 |
dt <- dtFromString t
|
|
202 |
dt <- diskTemplateFromString t
|
|
203 | 203 |
return $ opts { optDiskTemplate = dt }) "TEMPLATE") |
204 | 204 |
"select the desired disk template" |
205 | 205 |
|
b/htools/Ganeti/HTools/Cluster.hs | ||
---|---|---|
724 | 724 |
Bad message -> [printf "Group %s: error %s" gname message] |
725 | 725 |
where grp = Container.find groupId gl |
726 | 726 |
gname = Group.name grp |
727 |
pol = apolToString (Group.allocPolicy grp)
|
|
727 |
pol = allocPolicyToString (Group.allocPolicy grp)
|
|
728 | 728 |
|
729 | 729 |
-- | From a list of possibly bad and possibly empty solutions, filter |
730 | 730 |
-- only the groups with a valid result. Note that the result will be |
... | ... | |
830 | 830 |
-- this function, whatever mode we have is just a primary change. |
831 | 831 |
failOnSecondaryChange :: (Monad m) => EvacMode -> DiskTemplate -> m () |
832 | 832 |
failOnSecondaryChange ChangeSecondary dt = |
833 |
fail $ "Instances with disk template '" ++ dtToString dt ++
|
|
833 |
fail $ "Instances with disk template '" ++ diskTemplateToString dt ++
|
|
834 | 834 |
"' can't execute change secondary" |
835 | 835 |
failOnSecondaryChange _ _ = return () |
836 | 836 |
|
b/htools/Ganeti/HTools/Program/Hspace.hs | ||
---|---|---|
295 | 295 |
printISpec True ispec spec disk_template = do |
296 | 296 |
printKeys $ map (\(a, fn) -> (prefix ++ "_" ++ a, fn ispec)) specData |
297 | 297 |
printKeys [ (prefix ++ "_RQN", printf "%d" req_nodes) ] |
298 |
printKeys [ (prefix ++ "_DISK_TEMPLATE", dtToString disk_template) ] |
|
298 |
printKeys [ (prefix ++ "_DISK_TEMPLATE", |
|
299 |
diskTemplateToString disk_template) ] |
|
299 | 300 |
where req_nodes = Instance.requiredNodes disk_template |
300 | 301 |
prefix = specPrefix spec |
301 | 302 |
|
... | ... | |
303 | 304 |
printf "%s instance spec is:\n %s, using disk\ |
304 | 305 |
\ template '%s'.\n" |
305 | 306 |
(specDescription spec) |
306 |
(formatResources ispec specData) (dtToString disk_template)
|
|
307 |
(formatResources ispec specData) (diskTemplateToString disk_template)
|
|
307 | 308 |
|
308 | 309 |
-- | Prints the tiered results. |
309 | 310 |
printTiered :: Bool -> [(RSpec, Int)] -> Double |
b/htools/Ganeti/HTools/QC.hs | ||
---|---|---|
587 | 587 |
nl = Data.Map.fromList ndx |
588 | 588 |
tags = "" |
589 | 589 |
sbal = if autobal then "Y" else "N" |
590 |
sdt = Types.dtToString dt
|
|
590 |
sdt = Types.diskTemplateToString dt
|
|
591 | 591 |
inst = Text.loadInst nl |
592 | 592 |
[name, mem_s, dsk_s, vcpus_s, status, |
593 | 593 |
sbal, pnode, snode, sdt, tags] |
b/htools/Ganeti/HTools/Simu.hs | ||
---|---|---|
54 | 54 |
parseDesc desc = |
55 | 55 |
case sepSplit ',' desc of |
56 | 56 |
[a, n, d, m, c] -> do |
57 |
apol <- apolFromString a `mplus` apolAbbrev a
|
|
57 |
apol <- allocPolicyFromString a `mplus` apolAbbrev a
|
|
58 | 58 |
ncount <- tryRead "node count" n |
59 | 59 |
disk <- annotateResult "disk size" (parseUnit d) |
60 | 60 |
mem <- annotateResult "memory size" (parseUnit m) |
b/htools/Ganeti/HTools/Text.hs | ||
---|---|---|
57 | 57 |
serializeGroup :: Group.Group -> String |
58 | 58 |
serializeGroup grp = |
59 | 59 |
printf "%s|%s|%s" (Group.name grp) (Group.uuid grp) |
60 |
(apolToString (Group.allocPolicy grp))
|
|
60 |
(allocPolicyToString (Group.allocPolicy grp))
|
|
61 | 61 |
|
62 | 62 |
-- | Generate group file data from a group list. |
63 | 63 |
serializeGroups :: Group.List -> String |
... | ... | |
97 | 97 |
iname (Instance.mem inst) (Instance.dsk inst) |
98 | 98 |
(Instance.vcpus inst) (Instance.runSt inst) |
99 | 99 |
(if Instance.autoBalance inst then "Y" else "N") |
100 |
pnode snode (dtToString (Instance.diskTemplate inst))
|
|
100 |
pnode snode (diskTemplateToString (Instance.diskTemplate inst))
|
|
101 | 101 |
(intercalate "," (Instance.tags inst)) |
102 | 102 |
|
103 | 103 |
-- | Generate instance file data from instance objects. |
... | ... | |
121 | 121 |
-> m (String, Group.Group) -- ^ The result, a tuple of group |
122 | 122 |
-- UUID and group object |
123 | 123 |
loadGroup [name, gid, apol] = do |
124 |
xapol <- apolFromString apol
|
|
124 |
xapol <- allocPolicyFromString apol
|
|
125 | 125 |
return (gid, Group.create name gid xapol) |
126 | 126 |
|
127 | 127 |
loadGroup s = fail $ "Invalid/incomplete group data: '" ++ show s ++ "'" |
... | ... | |
167 | 167 |
"N" -> return False |
168 | 168 |
_ -> fail $ "Invalid auto_balance value '" ++ auto_bal ++ |
169 | 169 |
"' for instance " ++ name |
170 |
disk_template <- annotateResult ("Instance " ++ name) (dtFromString dt) |
|
170 |
disk_template <- annotateResult ("Instance " ++ name) |
|
171 |
(diskTemplateFromString dt) |
|
171 | 172 |
when (sidx == pidx) $ fail $ "Instance " ++ name ++ |
172 | 173 |
" has same primary and secondary node - " ++ pnode |
173 | 174 |
let vtags = sepSplit ',' tags |
b/htools/Ganeti/HTools/Types.hs | ||
---|---|---|
32 | 32 |
, Weight |
33 | 33 |
, GroupID |
34 | 34 |
, AllocPolicy(..) |
35 |
, apolFromString
|
|
36 |
, apolToString
|
|
35 |
, allocPolicyFromString
|
|
36 |
, allocPolicyToString
|
|
37 | 37 |
, RSpec(..) |
38 | 38 |
, DynUtil(..) |
39 | 39 |
, zeroUtil |
... | ... | |
49 | 49 |
, Placement |
50 | 50 |
, IMove(..) |
51 | 51 |
, DiskTemplate(..) |
52 |
, dtToString
|
|
53 |
, dtFromString
|
|
52 |
, diskTemplateToString
|
|
53 |
, diskTemplateFromString
|
|
54 | 54 |
, MoveJob |
55 | 55 |
, JobSet |
56 | 56 |
, Result(..) |
... | ... | |
110 | 110 |
deriving (Show, Read, Eq, Ord, Enum, Bounded) |
111 | 111 |
|
112 | 112 |
-- | Convert a string to an alloc policy. |
113 |
apolFromString :: (Monad m) => String -> m AllocPolicy
|
|
114 |
apolFromString s =
|
|
113 |
allocPolicyFromString :: (Monad m) => String -> m AllocPolicy
|
|
114 |
allocPolicyFromString s =
|
|
115 | 115 |
case () of |
116 | 116 |
_ | s == C.allocPolicyPreferred -> return AllocPreferred |
117 | 117 |
| s == C.allocPolicyLastResort -> return AllocLastResort |
... | ... | |
119 | 119 |
| otherwise -> fail $ "Invalid alloc policy mode: " ++ s |
120 | 120 |
|
121 | 121 |
-- | Convert an alloc policy to the Ganeti string equivalent. |
122 |
apolToString :: AllocPolicy -> String
|
|
123 |
apolToString AllocPreferred = C.allocPolicyPreferred
|
|
124 |
apolToString AllocLastResort = C.allocPolicyLastResort
|
|
125 |
apolToString AllocUnallocable = C.allocPolicyUnallocable
|
|
122 |
allocPolicyToString :: AllocPolicy -> String
|
|
123 |
allocPolicyToString AllocPreferred = C.allocPolicyPreferred
|
|
124 |
allocPolicyToString AllocLastResort = C.allocPolicyLastResort
|
|
125 |
allocPolicyToString AllocUnallocable = C.allocPolicyUnallocable
|
|
126 | 126 |
|
127 | 127 |
instance JSON.JSON AllocPolicy where |
128 |
showJSON = JSON.showJSON . apolToString
|
|
128 |
showJSON = JSON.showJSON . allocPolicyToString
|
|
129 | 129 |
readJSON s = case JSON.readJSON s of |
130 |
JSON.Ok s' -> apolFromString s'
|
|
130 |
JSON.Ok s' -> allocPolicyFromString s'
|
|
131 | 131 |
JSON.Error e -> JSON.Error $ |
132 | 132 |
"Can't parse alloc_policy: " ++ e |
133 | 133 |
|
... | ... | |
191 | 191 |
deriving (Show, Read, Eq, Enum, Bounded) |
192 | 192 |
|
193 | 193 |
-- | Converts a DiskTemplate to String. |
194 |
dtToString :: DiskTemplate -> String
|
|
195 |
dtToString DTDiskless = C.dtDiskless
|
|
196 |
dtToString DTFile = C.dtFile
|
|
197 |
dtToString DTSharedFile = C.dtSharedFile
|
|
198 |
dtToString DTPlain = C.dtPlain
|
|
199 |
dtToString DTBlock = C.dtBlock
|
|
200 |
dtToString DTDrbd8 = C.dtDrbd8
|
|
194 |
diskTemplateToString :: DiskTemplate -> String
|
|
195 |
diskTemplateToString DTDiskless = C.dtDiskless
|
|
196 |
diskTemplateToString DTFile = C.dtFile
|
|
197 |
diskTemplateToString DTSharedFile = C.dtSharedFile
|
|
198 |
diskTemplateToString DTPlain = C.dtPlain
|
|
199 |
diskTemplateToString DTBlock = C.dtBlock
|
|
200 |
diskTemplateToString DTDrbd8 = C.dtDrbd8
|
|
201 | 201 |
|
202 | 202 |
-- | Converts a DiskTemplate from String. |
203 |
dtFromString :: (Monad m) => String -> m DiskTemplate
|
|
204 |
dtFromString s =
|
|
203 |
diskTemplateFromString :: (Monad m) => String -> m DiskTemplate
|
|
204 |
diskTemplateFromString s =
|
|
205 | 205 |
case () of |
206 | 206 |
_ | s == C.dtDiskless -> return DTDiskless |
207 | 207 |
| s == C.dtFile -> return DTFile |
... | ... | |
212 | 212 |
| otherwise -> fail $ "Invalid disk template: " ++ s |
213 | 213 |
|
214 | 214 |
instance JSON.JSON DiskTemplate where |
215 |
showJSON = JSON.showJSON . dtToString
|
|
215 |
showJSON = JSON.showJSON . diskTemplateToString
|
|
216 | 216 |
readJSON s = case JSON.readJSON s of |
217 |
JSON.Ok s' -> dtFromString s'
|
|
217 |
JSON.Ok s' -> diskTemplateFromString s'
|
|
218 | 218 |
JSON.Error e -> JSON.Error $ |
219 | 219 |
"Can't parse disk_template as string: " ++ e |
220 | 220 |
|
Also available in: Unified diff