Revision 79eef90b htools/Ganeti/HTools/Program/Hspace.hs
b/htools/Ganeti/HTools/Program/Hspace.hs | ||
---|---|---|
26 | 26 |
module Ganeti.HTools.Program.Hspace (main, options) where |
27 | 27 |
|
28 | 28 |
import Control.Monad |
29 |
import Data.Char (toUpper, isAlphaNum, toLower)
|
|
29 |
import Data.Char (toUpper, toLower) |
|
30 | 30 |
import Data.Function (on) |
31 | 31 |
import Data.List |
32 | 32 |
import Data.Maybe (fromMaybe) |
... | ... | |
81 | 81 |
data SpecType = SpecNormal |
82 | 82 |
| SpecTiered |
83 | 83 |
|
84 |
-- | Prefix for machine readable names |
|
85 |
htsPrefix :: String |
|
86 |
htsPrefix = "HTS" |
|
87 |
|
|
84 | 88 |
-- | What we prefix a spec with. |
85 | 89 |
specPrefix :: SpecType -> String |
86 | 90 |
specPrefix SpecNormal = "SPEC" |
... | ... | |
177 | 181 |
\ != counted (%d)\n" (num_instances + allocs) |
178 | 182 |
(Cluster.csNinst fin_stats) |
179 | 183 |
|
180 |
printKeys $ printStats PFinal fin_stats |
|
181 |
printKeys [ ("ALLOC_USAGE", printf "%.8f" |
|
184 |
printKeysHTS $ printStats PFinal fin_stats
|
|
185 |
printKeysHTS [ ("ALLOC_USAGE", printf "%.8f"
|
|
182 | 186 |
((fromIntegral num_instances::Double) / |
183 | 187 |
fromIntegral fin_instances)) |
184 | 188 |
, ("ALLOC_INSTANCES", printf "%d" allocs) |
185 | 189 |
, ("ALLOC_FAIL_REASON", map toUpper . show . fst $ head sreason) |
186 | 190 |
] |
187 |
printKeys $ map (\(x, y) -> (printf "ALLOC_%s_CNT" (show x), |
|
191 |
printKeysHTS $ map (\(x, y) -> (printf "ALLOC_%s_CNT" (show x),
|
|
188 | 192 |
printf "%d" y)) sreason |
189 | 193 |
|
190 | 194 |
printResults False ini_nl fin_nl _ allocs sreason = do |
... | ... | |
193 | 197 |
printFRScores ini_nl fin_nl sreason |
194 | 198 |
|
195 | 199 |
-- | Prints the final @OK@ marker in machine readable output. |
196 |
printFinal :: Bool -> IO () |
|
197 |
printFinal True = |
|
198 |
-- this should be the final entry |
|
199 |
printKeys [("OK", "1")] |
|
200 |
|
|
201 |
printFinal False = return () |
|
200 |
printFinalHTS :: Bool -> IO () |
|
201 |
printFinalHTS = printFinal htsPrefix |
|
202 | 202 |
|
203 | 203 |
-- | Compute the tiered spec counts from a list of allocated |
204 | 204 |
-- instances. |
... | ... | |
232 | 232 |
let ini_stats = Cluster.totalResources ini_nl |
233 | 233 |
fin_stats = Cluster.totalResources fin_nl |
234 | 234 |
(rini, ralo, runa) = Cluster.computeAllocationDelta ini_stats fin_stats |
235 |
printKeys $ formatRSpec "USED" rini |
|
236 |
printKeys $ formatRSpec "POOL" ralo |
|
237 |
printKeys $ formatRSpec "UNAV" runa |
|
238 |
|
|
239 |
-- | Ensure a value is quoted if needed. |
|
240 |
ensureQuoted :: String -> String |
|
241 |
ensureQuoted v = if not (all (\c -> isAlphaNum c || c == '.') v) |
|
242 |
then '\'':v ++ "'" |
|
243 |
else v |
|
235 |
printKeysHTS $ formatRSpec "USED" rini |
|
236 |
printKeysHTS $ formatRSpec "POOL" ralo |
|
237 |
printKeysHTS $ formatRSpec "UNAV" runa |
|
244 | 238 |
|
245 | 239 |
-- | Format a list of key\/values as a shell fragment. |
246 |
printKeys :: [(String, String)] -> IO () |
|
247 |
printKeys = mapM_ (\(k, v) -> |
|
248 |
printf "HTS_%s=%s\n" (map toUpper k) (ensureQuoted v)) |
|
240 |
printKeysHTS :: [(String, String)] -> IO () |
|
241 |
printKeysHTS = printKeys htsPrefix |
|
249 | 242 |
|
250 | 243 |
-- | Converts instance data to a list of strings. |
251 | 244 |
printInstance :: Node.List -> Instance.Instance -> [String] |
... | ... | |
280 | 273 |
-- | Print the cluster resources. |
281 | 274 |
printCluster :: Bool -> Cluster.CStats -> Int -> IO () |
282 | 275 |
printCluster True ini_stats node_count = do |
283 |
printKeys $ map (\(a, fn) -> ("CLUSTER_" ++ a, fn ini_stats)) clusterData |
|
284 |
printKeys [("CLUSTER_NODES", printf "%d" node_count)] |
|
285 |
printKeys $ printStats PInitial ini_stats |
|
276 |
printKeysHTS $ map (\(a, fn) -> ("CLUSTER_" ++ a, fn ini_stats)) clusterData
|
|
277 |
printKeysHTS [("CLUSTER_NODES", printf "%d" node_count)]
|
|
278 |
printKeysHTS $ printStats PInitial ini_stats
|
|
286 | 279 |
|
287 | 280 |
printCluster False ini_stats node_count = do |
288 | 281 |
printf "The cluster has %d nodes and the following resources:\n %s.\n" |
... | ... | |
294 | 287 |
-- | Prints the normal instance spec. |
295 | 288 |
printISpec :: Bool -> RSpec -> SpecType -> DiskTemplate -> IO () |
296 | 289 |
printISpec True ispec spec disk_template = do |
297 |
printKeys $ map (\(a, fn) -> (prefix ++ "_" ++ a, fn ispec)) specData |
|
298 |
printKeys [ (prefix ++ "_RQN", printf "%d" req_nodes) ] |
|
299 |
printKeys [ (prefix ++ "_DISK_TEMPLATE", |
|
290 |
printKeysHTS $ map (\(a, fn) -> (prefix ++ "_" ++ a, fn ispec)) specData
|
|
291 |
printKeysHTS [ (prefix ++ "_RQN", printf "%d" req_nodes) ]
|
|
292 |
printKeysHTS [ (prefix ++ "_DISK_TEMPLATE",
|
|
300 | 293 |
diskTemplateToRaw disk_template) ] |
301 | 294 |
where req_nodes = Instance.requiredNodes disk_template |
302 | 295 |
prefix = specPrefix spec |
... | ... | |
311 | 304 |
printTiered :: Bool -> [(RSpec, Int)] |
312 | 305 |
-> Node.List -> Node.List -> [(FailMode, Int)] -> IO () |
313 | 306 |
printTiered True spec_map nl trl_nl _ = do |
314 |
printKeys $ printStats PTiered (Cluster.totalResources trl_nl) |
|
315 |
printKeys [("TSPEC", unwords (formatSpecMap spec_map))] |
|
307 |
printKeysHTS $ printStats PTiered (Cluster.totalResources trl_nl)
|
|
308 |
printKeysHTS [("TSPEC", unwords (formatSpecMap spec_map))]
|
|
316 | 309 |
printAllocationStats nl trl_nl |
317 | 310 |
|
318 | 311 |
printTiered False spec_map ini_nl fin_nl sreason = do |
... | ... | |
457 | 450 |
|
458 | 451 |
-- Print final result |
459 | 452 |
|
460 |
printFinal machine_r |
|
453 |
printFinalHTS machine_r |
Also available in: Unified diff