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
|