## Revision 9dcec001

b/Ganeti/HTools/Cluster.hs
624 624
-> Instance.List     -- ^ The instance list
625 625
-> Instance.Instance -- ^ The instance to allocate
626 626
-> Int               -- ^ Required number of nodes
627
-> m [(Maybe Node.List, [Node.Node])] -- ^ Possible solution list
627
-> m [(Maybe Node.List, Instance.Instance, [Node.Node])]
628
-- ^ Possible solution list
628 629
tryAlloc nl _ inst 2 =
629 630
let all_nodes = getOnline nl
630 631
all_pairs = liftM2 (,) all_nodes all_nodes
631 632
ok_pairs = filter (\(x, y) -> Node.idx x /= Node.idx y) all_pairs
632
sols = map (\(p, s) ->
633
(fst \$ allocateOnPair nl inst p s, [p, s]))
633
sols = map (\(p, s) -> let (mnl, i) = allocateOnPair nl inst p s
634
in (mnl, i, [p, s]))
634 635
ok_pairs
635 636
in return sols
636 637

637 638
tryAlloc nl _ inst 1 =
638 639
let all_nodes = getOnline nl
639
sols = map (\p -> (fst \$ allocateOnSingle nl inst p, [p]))
640
sols = map (\p -> let (mnl, i) = allocateOnSingle nl inst p
641
in (mnl, i, [p]))
640 642
all_nodes
641 643
in return sols
642 644

......
651 653
-> Idx           -- ^ The index of the instance to move
652 654
-> Int           -- ^ The numver of nodes required
653 655
-> [Ndx]         -- ^ Nodes which should not be used
654
-> m [(Maybe Node.List, [Node.Node])] -- ^ Solution list
656
-> m [(Maybe Node.List, Instance.Instance, [Node.Node])]
657
-- ^ Solution list
655 658
tryReloc nl il xid 1 ex_idx =
656 659
let all_nodes = getOnline nl
657 660
inst = Container.find xid il
658 661
ex_idx' = (Instance.pnode inst):ex_idx
659 662
valid_nodes = filter (not . flip elem ex_idx' . Node.idx) all_nodes
660 663
valid_idxes = map Node.idx valid_nodes
661
sols1 = map (\x -> let (mnl, _, _, _) =
662
applyMove nl inst (ReplaceSecondary x)
663
in (mnl, [Container.find x nl])
664
sols1 = map (\x -> let (mnl, i, _, _) =
665
applyMove nl inst (ReplaceSecondary x)
666
in (mnl, i, [Container.find x nl])
664 667
) valid_idxes
665 668
in return sols1
666 669

b/hail.hs
44 44
import Ganeti.HTools.IAlloc
45 45
import Ganeti.HTools.Types
46 46
47
import Ganeti.HTools.Utils
47 48

48 49
-- | Command line options structure.
49 50
data Options = Options
......
74 75
]
75 76

76 77

77
filterFails :: (Monad m) => [(Maybe Node.List, [Node.Node])]
78
filterFails :: (Monad m) => [(Maybe Node.List, Instance.Instance, [Node.Node])]
78 79
-> m [(Node.List, [Node.Node])]
79 80
filterFails sols =
80 81
if null sols then fail "No nodes onto which to allocate at all"
81
else let sols' = filter (isJust . fst) sols
82
else let sols' = filter (isJust . fst3) sols
82 83
in if null sols' then
83 84
fail "No valid allocation solutions"
84 85
else
85
return \$ map (\(x, y) -> (fromJust x, y)) sols'
86
return \$ map (\(x, _, y) -> (fromJust x, y)) sols'
86 87

87 88
processResults :: (Monad m) => [(Node.List, [Node.Node])]
88 89
-> m (String, [Node.Node])
b/hspace.hs
132 132
"show help"
133 133
]
134 134

135
filterFails :: (Monad m) => [(Maybe Node.List, [Node.Node])]
136
-> m [(Node.List, [Node.Node])]
135
filterFails :: (Monad m) => [(Maybe Node.List, Instance.Instance, [Node.Node])]
136
-> m [(Node.List, Instance.Instance, [Node.Node])]
137 137
filterFails sols =
138 138
if null sols then fail "No nodes onto which to allocate at all"
139
else let sols' = filter (isJust . fst) sols
139
else let sols' = filter (isJust . fst3) sols
140 140
in if null sols' then
141 141
fail "No valid allocation solutions"
142 142
else
143
return \$ map (\(x, y) -> (fromJust x, y)) sols'
143
return \$ map (\(x, y, z) -> (fromJust x, y, z)) sols'
144 144

145
processResults :: (Monad m) => [(Node.List, [Node.Node])]
146
-> m (Node.List, [Node.Node])
145
processResults :: (Monad m) => [(Node.List, Instance.Instance, [Node.Node])]
146
-> m (Node.List, Instance.Instance, [Node.Node])
147 147
processResults sols =
148
let sols' = map (\(nl', ns) -> (Cluster.compCV  nl', (nl', ns))) sols
148
let sols' = map (\e@(nl', _, _) -> (Cluster.compCV  nl', e)) sols
149 149
sols'' = sortBy (compare `on` fst) sols'
150 150
in return \$ snd \$ head sols''
151 151

......
153 153
-> Instance.List
154 154
-> Instance.Instance
155 155
-> Int
156
-> Int
157
-> (Node.List, Int)
158
iterateDepth nl il newinst nreq depth =
159
let newname = printf "new-%d" depth
156
-> [Instance.Instance]
157
-> (Node.List, [Instance.Instance])
158
iterateDepth nl il newinst nreq ixes =
159
let depth = length ixes
160
newname = printf "new-%d" depth
160 161
newidx = (length \$ Container.elems il) + depth
161 162
newi2 = Instance.setIdx (Instance.setName newinst newname) newidx
162 163
sols = Cluster.tryAlloc nl il newi2 nreq
163
orig = (nl, depth)
164
orig = (nl, ixes)
164 165
in
165 166
if isNothing sols then orig
166 167
else let sols' = fromJust sols
167 168
sols'' = filterFails sols'
168 169
in if isNothing sols'' then orig
169
else let (xnl, _) = fromJust \$ processResults \$ fromJust sols''
170
in iterateDepth xnl il newinst nreq (depth+1)
170
else let (xnl, xi, _) = fromJust \$ processResults \$
171
fromJust sols''
172
in iterateDepth xnl il newinst nreq (xi:ixes)
171 173

172 174

173 175
-- | Main function.
......
183 185
let verbose = optVerbose opts
184 186

185 187
(fixed_nl, il, csf) <- CLI.loadExternalData opts
188
let num_instances = length \$ Container.elems il
186 189

187 190
let offline_names = optOffline opts
188 191
all_nodes = Container.elems fixed_nl
......
193 196
all_nodes
194 197

195 198
when (length offline_wrong > 0) \$ do
196
printf "Wrong node name(s) set as offline: %s\n"
199
printf "Error: Wrong node name(s) set as offline: %s\n"
197 200
(commaJoin offline_wrong)
198 201
exitWith \$ ExitFailure 1
199 202

......
206 209

207 210
208 211
when (length bad_nodes > 0) \$ do
209
putStrLn "Cluster not N+1, no space to allocate."
212
putStrLn "Error: Cluster not N+1, no space to allocate."
210 213
exitWith \$ ExitFailure 1
211 214

212 215
when (optShowNodes opts) \$
......
215 218
putStrLn \$ Cluster.printNodes nl
216 219

217 220
let ini_cv = Cluster.compCV nl
221
(orig_mem, orig_disk) = Cluster.totalResources nl
218 222

219 223
(if verbose > 2 then
220 224
printf "Initial coefficients: overall %.8f, %s\n"
221 225
ini_cv (Cluster.printStats nl)
222 226
else
223 227
printf "Initial score: %.8f\n" ini_cv)
228
printf "Initial instances: %d\n" num_instances
229
printf "Initial free RAM: %d\n" orig_mem
230
printf "Initial free disk: %d\n" orig_disk
224 231

225
let imlen = Container.maxNameLen il
226
nmlen = Container.maxNameLen nl
232
let nmlen = Container.maxNameLen nl
227 233
newinst = Instance.create "new" (optIMem opts) (optIDsk opts)
228 234
229 235

230
let (fin_nl, fin_depth) = iterateDepth nl il newinst (optINodes opts) 0
231

232
unless (verbose == 0) \$
233
printf "Solution length=%d\n" fin_depth
236
let (fin_nl, ixes) =
237
iterateDepth nl il newinst (optINodes opts) []
238
allocs = length ixes
239
fin_instances = num_instances + allocs
240
fin_ixes = reverse ixes
241
ix_namelen = maximum . map (length . Instance.name) \$ fin_ixes
242
(final_mem, final_disk) = Cluster.totalResources fin_nl
243

244
printf "Final score: %.8f\n" (Cluster.compCV fin_nl)
245
printf "Final instances: %d\n" (num_instances + allocs)
246
printf "Final free RAM: %d\n" final_mem
247
printf "Final free disk: %d\n" final_disk
248
printf "Usage: %.2f\n" (((fromIntegral num_instances)::Double) /
249
(fromIntegral fin_instances))
250
printf "Allocations: %d\n" allocs
251
when (verbose > 1) \$ do
252
putStr . unlines . map (\i -> printf "Inst: %*s %-*s %-*s"
253
ix_namelen (Instance.name i)
254
nmlen (Container.nameOf fin_nl \$ Instance.pnode i)
255
nmlen (Container.nameOf fin_nl \$ Instance.snode i))
256
\$ fin_ixes
234 257

235 258
when (optShowNodes opts) \$
236 259
do

Also available in: Unified diff