X-Git-Url: https://code.grnet.gr/git/ganeti-local/blobdiff_plain/15f4c8ca1fa047af3b571303603dfab315624996..c0e31451c263a373dedbcbff6d0a94aea1b6d353:/Ganeti/HTools/Node.hs diff --git a/Ganeti/HTools/Node.hs b/Ganeti/HTools/Node.hs index 05930cd..73162e6 100644 --- a/Ganeti/HTools/Node.hs +++ b/Ganeti/HTools/Node.hs @@ -4,264 +4,546 @@ updated value. -} +{- + +Copyright (C) 2009, 2010 Google Inc. + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, but +WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +02110-1301, USA. + +-} + module Ganeti.HTools.Node - ( Node(failN1, name, idx, t_mem, n_mem, f_mem, r_mem, t_dsk, f_dsk, - p_mem, p_dsk, p_rem, - plist, slist, offline) + ( Node(..) , List -- * Constructor , create -- ** Finalization after data loading , buildPeers , setIdx - , setName + , setAlias , setOffline , setXmem , setFmem + , setPri + , setSec + , setMdsk + , setMcpu + -- * Tag maps + , addTags + , delTags + , rejectAddTags -- * Instance (re)location , removePri , removeSec , addPri + , addPriEx , addSec - , setPri - , setSec + , addSecEx + -- * Stats + , availDisk + , availMem + , availCpu + , conflictingPrimaries -- * Formatting + , defaultFields + , showHeader + , showField , list -- * Misc stuff , AssocList + , AllocElement , noSecondary + , computeGroups ) where -import Data.List +import Data.List hiding (group) +import qualified Data.Map as Map +import qualified Data.Foldable as Foldable +import Data.Ord (comparing) import Text.Printf (printf) import qualified Ganeti.HTools.Container as Container import qualified Ganeti.HTools.Instance as Instance -import qualified Ganeti.HTools.PeerMap as PeerMap +import qualified Ganeti.HTools.PeerMap as P import qualified Ganeti.HTools.Types as T -data Node = Node { name :: String -- ^ the node name - , t_mem :: Double -- ^ total memory (MiB) - , n_mem :: Int -- ^ node memory (MiB) - , f_mem :: Int -- ^ free memory (MiB) - , x_mem :: Int -- ^ unaccounted memory (MiB) - , t_dsk :: Double -- ^ total disk space (MiB) - , f_dsk :: Int -- ^ free disk space (MiB) - , plist :: [T.Idx]-- ^ list of primary instance indices - , slist :: [T.Idx]-- ^ list of secondary instance indices - , idx :: T.Ndx -- ^ internal index for book-keeping - , peers :: PeerMap.PeerMap -- ^ pnode to instance mapping - , failN1:: Bool -- ^ whether the node has failed n1 - , r_mem :: Int -- ^ maximum memory needed for - -- failover by primaries of this node - , p_mem :: Double -- ^ percent of free memory - , p_dsk :: Double -- ^ percent of free disk - , p_rem :: Double -- ^ percent of reserved memory - , offline :: Bool -- ^ whether the node should not be used - -- for allocations and skipped from - -- score computations - } deriving (Show) +-- * Type declarations + +-- | The tag map type +type TagMap = Map.Map String Int + +-- | The node type. +data Node = Node + { name :: String -- ^ The node name + , alias :: String -- ^ The shortened name (for display purposes) + , tMem :: Double -- ^ Total memory (MiB) + , nMem :: Int -- ^ Node memory (MiB) + , fMem :: Int -- ^ Free memory (MiB) + , xMem :: Int -- ^ Unaccounted memory (MiB) + , tDsk :: Double -- ^ Total disk space (MiB) + , fDsk :: Int -- ^ Free disk space (MiB) + , tCpu :: Double -- ^ Total CPU count + , uCpu :: Int -- ^ Used VCPU count + , pList :: [T.Idx] -- ^ List of primary instance indices + , sList :: [T.Idx] -- ^ List of secondary instance indices + , idx :: T.Ndx -- ^ Internal index for book-keeping + , peers :: P.PeerMap -- ^ Pnode to instance mapping + , failN1 :: Bool -- ^ Whether the node has failed n1 + , rMem :: Int -- ^ Maximum memory needed for failover by + -- primaries of this node + , pMem :: Double -- ^ Percent of free memory + , pDsk :: Double -- ^ Percent of free disk + , pRem :: Double -- ^ Percent of reserved memory + , pCpu :: Double -- ^ Ratio of virtual to physical CPUs + , mDsk :: Double -- ^ Minimum free disk ratio + , mCpu :: Double -- ^ Max ratio of virt-to-phys CPUs + , loDsk :: Int -- ^ Autocomputed from mDsk low disk + -- threshold + , hiCpu :: Int -- ^ Autocomputed from mCpu high cpu + -- threshold + , offline :: Bool -- ^ Whether the node should not be used + -- for allocations and skipped from score + -- computations + , utilPool :: T.DynUtil -- ^ Total utilisation capacity + , utilLoad :: T.DynUtil -- ^ Sum of instance utilisation + , pTags :: TagMap -- ^ Map of primary instance tags and their count + , group :: T.Gdx -- ^ The node's group (index) + } deriving (Show, Eq) instance T.Element Node where nameOf = name idxOf = idx - setName = setName + setAlias = setAlias setIdx = setIdx + allNames n = [name n, alias n] --- | A simple name for the int, node association list +-- | A simple name for the int, node association list. type AssocList = [(T.Ndx, Node)] --- | A simple name for a node map +-- | A simple name for a node map. type List = Container.Container Node --- | Constant node index for a non-moveable instance +-- | A simple name for an allocation element (here just for logistic +-- reasons) +type AllocElement = (List, Instance.Instance, [Node], T.Score) + +-- | Constant node index for a non-moveable instance. noSecondary :: T.Ndx noSecondary = -1 -{- | Create a new node. +-- * Helper functions -The index and the peers maps are empty, and will be need to be update -later via the 'setIdx' and 'buildPeers' functions. +-- | Add a tag to a tagmap +addTag :: TagMap -> String -> TagMap +addTag t s = Map.insertWith (+) s 1 t --} -create :: String -> Double -> Int -> Int -> Double -> Int -> Bool -> Node +-- | Add multiple tags +addTags :: TagMap -> [String] -> TagMap +addTags = foldl' addTag + +-- | Adjust or delete a tag from a tagmap +delTag :: TagMap -> String -> TagMap +delTag t s = Map.update (\v -> if v > 1 + then Just (v-1) + else Nothing) + s t + +-- | Remove multiple tags +delTags :: TagMap -> [String] -> TagMap +delTags = foldl' delTag + +-- | Check if we can add a list of tags to a tagmap +rejectAddTags :: TagMap -> [String] -> Bool +rejectAddTags t = any (`Map.member` t) + +-- | Check how many primary instances have conflicting tags. The +-- algorithm to compute this is to sum the count of all tags, then +-- subtract the size of the tag map (since each tag has at least one, +-- non-conflicting instance); this is equivalent to summing the +-- values in the tag map minus one. +conflictingPrimaries :: Node -> Int +conflictingPrimaries (Node { pTags = t }) = Foldable.sum t - Map.size t + +-- * Initialization functions + +-- | Create a new node. +-- +-- The index and the peers maps are empty, and will be need to be +-- update later via the 'setIdx' and 'buildPeers' functions. +create :: String -> Double -> Int -> Int -> Double + -> Int -> Double -> Bool -> T.Gdx -> Node create name_init mem_t_init mem_n_init mem_f_init - dsk_t_init dsk_f_init offline_init = - Node - { - name = name_init, - t_mem = mem_t_init, - n_mem = mem_n_init, - f_mem = mem_f_init, - t_dsk = dsk_t_init, - f_dsk = dsk_f_init, - plist = [], - slist = [], - failN1 = True, - idx = -1, - peers = PeerMap.empty, - r_mem = 0, - p_mem = (fromIntegral mem_f_init) / mem_t_init, - p_dsk = (fromIntegral dsk_f_init) / dsk_t_init, - p_rem = 0, - offline = offline_init, - x_mem = 0 - } + dsk_t_init dsk_f_init cpu_t_init offline_init group_init = + Node { name = name_init + , alias = name_init + , tMem = mem_t_init + , nMem = mem_n_init + , fMem = mem_f_init + , tDsk = dsk_t_init + , fDsk = dsk_f_init + , tCpu = cpu_t_init + , uCpu = 0 + , pList = [] + , sList = [] + , failN1 = True + , idx = -1 + , peers = P.empty + , rMem = 0 + , pMem = fromIntegral mem_f_init / mem_t_init + , pDsk = fromIntegral dsk_f_init / dsk_t_init + , pRem = 0 + , pCpu = 0 + , offline = offline_init + , xMem = 0 + , mDsk = T.defReservedDiskRatio + , mCpu = T.defVcpuRatio + , loDsk = mDskToloDsk T.defReservedDiskRatio dsk_t_init + , hiCpu = mCpuTohiCpu T.defVcpuRatio cpu_t_init + , utilPool = T.baseUtil + , utilLoad = T.zeroUtil + , pTags = Map.empty + , group = group_init + } + +-- | Conversion formula from mDsk\/tDsk to loDsk +mDskToloDsk :: Double -> Double -> Int +mDskToloDsk mval tdsk = floor (mval * tdsk) + +-- | Conversion formula from mCpu\/tCpu to hiCpu +mCpuTohiCpu :: Double -> Double -> Int +mCpuTohiCpu mval tcpu = floor (mval * tcpu) -- | Changes the index. +-- -- This is used only during the building of the data structures. setIdx :: Node -> T.Ndx -> Node setIdx t i = t {idx = i} --- | Changes the name +-- | Changes the alias. +-- -- This is used only during the building of the data structures. -setName t s = t {name = s} +setAlias :: Node -> String -> Node +setAlias t s = t { alias = s } --- | Sets the offline attribute +-- | Sets the offline attribute. setOffline :: Node -> Bool -> Node setOffline t val = t { offline = val } --- | Sets the unnaccounted memory +-- | Sets the unnaccounted memory. setXmem :: Node -> Int -> Node -setXmem t val = t { x_mem = val } +setXmem t val = t { xMem = val } --- | Sets the free memory -setFmem :: Node -> Int -> Node -setFmem t new_mem = - let new_n1 = computeFailN1 (r_mem t) new_mem (f_dsk t) - new_mp = (fromIntegral new_mem) / (t_mem t) - in - t { f_mem = new_mem, failN1 = new_n1, p_mem = new_mp } - --- | Given the rmem, free memory and disk, computes the failn1 status. -computeFailN1 :: Int -> Int -> Int -> Bool -computeFailN1 new_rmem new_mem new_dsk = - new_mem <= new_rmem || new_dsk <= 0 +-- | Sets the max disk usage ratio +setMdsk :: Node -> Double -> Node +setMdsk t val = t { mDsk = val, loDsk = mDskToloDsk val (tDsk t) } --- | Given the new free memory and disk, fail if any of them is below zero. -failHealth :: Int -> Int -> Bool -failHealth new_mem new_dsk = new_mem <= 0 || new_dsk <= 0 +-- | Sets the max cpu usage ratio +setMcpu :: Node -> Double -> Node +setMcpu t val = t { mCpu = val, hiCpu = mCpuTohiCpu val (tCpu t) } -- | Computes the maximum reserved memory for peers from a peer map. -computeMaxRes :: PeerMap.PeerMap -> PeerMap.Elem -computeMaxRes new_peers = PeerMap.maxElem new_peers +computeMaxRes :: P.PeerMap -> P.Elem +computeMaxRes = P.maxElem -- | Builds the peer map for a given node. -buildPeers :: Node -> Instance.List -> Int -> Node -buildPeers t il num_nodes = +buildPeers :: Node -> Instance.List -> Node +buildPeers t il = let mdata = map (\i_idx -> let inst = Container.find i_idx il - in (Instance.pnode inst, Instance.mem inst)) - (slist t) - pmap = PeerMap.accumArray (+) mdata + in (Instance.pNode inst, Instance.mem inst)) + (sList t) + pmap = P.accumArray (+) mdata new_rmem = computeMaxRes pmap - new_failN1 = computeFailN1 new_rmem (f_mem t) (f_dsk t) - new_prem = (fromIntegral new_rmem) / (t_mem t) - in t {peers=pmap, failN1 = new_failN1, r_mem = new_rmem, p_rem = new_prem} + new_failN1 = fMem t <= new_rmem + new_prem = fromIntegral new_rmem / tMem t + in t {peers=pmap, failN1 = new_failN1, rMem = new_rmem, pRem = new_prem} + +-- | Assigns an instance to a node as primary and update the used VCPU +-- count, utilisation data and tags map. +setPri :: Node -> Instance.Instance -> Node +setPri t inst = t { pList = Instance.idx inst:pList t + , uCpu = new_count + , pCpu = fromIntegral new_count / tCpu t + , utilLoad = utilLoad t `T.addUtil` Instance.util inst + , pTags = addTags (pTags t) (Instance.tags inst) + } + where new_count = uCpu t + Instance.vcpus inst + +-- | Assigns an instance to a node as secondary without other updates. +setSec :: Node -> Instance.Instance -> Node +setSec t inst = t { sList = Instance.idx inst:sList t + , utilLoad = old_load { T.dskWeight = T.dskWeight old_load + + T.dskWeight (Instance.util inst) } + } + where old_load = utilLoad t + +-- * Update functions + +-- | Sets the free memory. +setFmem :: Node -> Int -> Node +setFmem t new_mem = + let new_n1 = new_mem <= rMem t + new_mp = fromIntegral new_mem / tMem t + in t { fMem = new_mem, failN1 = new_n1, pMem = new_mp } -- | Removes a primary instance. removePri :: Node -> Instance.Instance -> Node removePri t inst = let iname = Instance.idx inst - new_plist = delete iname (plist t) - new_mem = f_mem t + Instance.mem inst - new_dsk = f_dsk t + Instance.dsk inst - new_mp = (fromIntegral new_mem) / (t_mem t) - new_dp = (fromIntegral new_dsk) / (t_dsk t) - new_failn1 = computeFailN1 (r_mem t) new_mem new_dsk - in t {plist = new_plist, f_mem = new_mem, f_dsk = new_dsk, - failN1 = new_failn1, p_mem = new_mp, p_dsk = new_dp} + new_plist = delete iname (pList t) + new_mem = fMem t + Instance.mem inst + new_dsk = fDsk t + Instance.dsk inst + new_mp = fromIntegral new_mem / tMem t + new_dp = fromIntegral new_dsk / tDsk t + new_failn1 = new_mem <= rMem t + new_ucpu = uCpu t - Instance.vcpus inst + new_rcpu = fromIntegral new_ucpu / tCpu t + new_load = utilLoad t `T.subUtil` Instance.util inst + in t { pList = new_plist, fMem = new_mem, fDsk = new_dsk + , failN1 = new_failn1, pMem = new_mp, pDsk = new_dp + , uCpu = new_ucpu, pCpu = new_rcpu, utilLoad = new_load + , pTags = delTags (pTags t) (Instance.tags inst) } -- | Removes a secondary instance. removeSec :: Node -> Instance.Instance -> Node removeSec t inst = let iname = Instance.idx inst - pnode = Instance.pnode inst - new_slist = delete iname (slist t) - new_dsk = f_dsk t + Instance.dsk inst + pnode = Instance.pNode inst + new_slist = delete iname (sList t) + new_dsk = fDsk t + Instance.dsk inst old_peers = peers t - old_peem = PeerMap.find pnode old_peers - new_peem = old_peem - (Instance.mem inst) - new_peers = PeerMap.add pnode new_peem old_peers - old_rmem = r_mem t - new_rmem = if old_peem < old_rmem then - old_rmem - else - computeMaxRes new_peers - new_prem = (fromIntegral new_rmem) / (t_mem t) - new_failn1 = computeFailN1 new_rmem (f_mem t) new_dsk - new_dp = (fromIntegral new_dsk) / (t_dsk t) - in t {slist = new_slist, f_dsk = new_dsk, peers = new_peers, - failN1 = new_failn1, r_mem = new_rmem, p_dsk = new_dp, - p_rem = new_prem} - --- | Adds a primary instance. -addPri :: Node -> Instance.Instance -> Maybe Node -addPri t inst = + old_peem = P.find pnode old_peers + new_peem = old_peem - Instance.mem inst + new_peers = if new_peem > 0 + then P.add pnode new_peem old_peers + else P.remove pnode old_peers + old_rmem = rMem t + new_rmem = if old_peem < old_rmem + then old_rmem + else computeMaxRes new_peers + new_prem = fromIntegral new_rmem / tMem t + new_failn1 = fMem t <= new_rmem + new_dp = fromIntegral new_dsk / tDsk t + old_load = utilLoad t + new_load = old_load { T.dskWeight = T.dskWeight old_load - + T.dskWeight (Instance.util inst) } + in t { sList = new_slist, fDsk = new_dsk, peers = new_peers + , failN1 = new_failn1, rMem = new_rmem, pDsk = new_dp + , pRem = new_prem, utilLoad = new_load } + +-- | Adds a primary instance (basic version). +addPri :: Node -> Instance.Instance -> T.OpResult Node +addPri = addPriEx False + +-- | Adds a primary instance (extended version). +addPriEx :: Bool -- ^ Whether to override the N+1 and + -- other /soft/ checks, useful if we + -- come from a worse status + -- (e.g. offline) + -> Node -- ^ The target node + -> Instance.Instance -- ^ The instance to add + -> T.OpResult Node -- ^ The result of the operation, + -- either the new version of the node + -- or a failure mode +addPriEx force t inst = let iname = Instance.idx inst - new_mem = f_mem t - Instance.mem inst - new_dsk = f_dsk t - Instance.dsk inst - new_failn1 = computeFailN1 (r_mem t) new_mem new_dsk in - if (failHealth new_mem new_dsk) || (new_failn1 && not (failN1 t)) then - Nothing - else - let new_plist = iname:(plist t) - new_mp = (fromIntegral new_mem) / (t_mem t) - new_dp = (fromIntegral new_dsk) / (t_dsk t) - in - Just t {plist = new_plist, f_mem = new_mem, f_dsk = new_dsk, - failN1 = new_failn1, p_mem = new_mp, p_dsk = new_dp} - --- | Adds a secondary instance. -addSec :: Node -> Instance.Instance -> T.Ndx -> Maybe Node -addSec t inst pdx = + new_mem = fMem t - Instance.mem inst + new_dsk = fDsk t - Instance.dsk inst + new_failn1 = new_mem <= rMem t + new_ucpu = uCpu t + Instance.vcpus inst + new_pcpu = fromIntegral new_ucpu / tCpu t + new_dp = fromIntegral new_dsk / tDsk t + l_cpu = mCpu t + new_load = utilLoad t `T.addUtil` Instance.util inst + inst_tags = Instance.tags inst + old_tags = pTags t + strict = not force + in case () of + _ | new_mem <= 0 -> T.OpFail T.FailMem + | new_dsk <= 0 -> T.OpFail T.FailDisk + | mDsk t > new_dp && strict -> T.OpFail T.FailDisk + | new_failn1 && not (failN1 t) && strict -> T.OpFail T.FailMem + | l_cpu >= 0 && l_cpu < new_pcpu && strict -> T.OpFail T.FailCPU + | rejectAddTags old_tags inst_tags -> T.OpFail T.FailTags + | otherwise -> + let new_plist = iname:pList t + new_mp = fromIntegral new_mem / tMem t + r = t { pList = new_plist, fMem = new_mem, fDsk = new_dsk + , failN1 = new_failn1, pMem = new_mp, pDsk = new_dp + , uCpu = new_ucpu, pCpu = new_pcpu + , utilLoad = new_load + , pTags = addTags old_tags inst_tags } + in T.OpGood r + +-- | Adds a secondary instance (basic version). +addSec :: Node -> Instance.Instance -> T.Ndx -> T.OpResult Node +addSec = addSecEx False + +-- | Adds a secondary instance (extended version). +addSecEx :: Bool -> Node -> Instance.Instance -> T.Ndx -> T.OpResult Node +addSecEx force t inst pdx = let iname = Instance.idx inst old_peers = peers t - old_mem = f_mem t - new_dsk = f_dsk t - Instance.dsk inst - new_peem = PeerMap.find pdx old_peers + Instance.mem inst - new_peers = PeerMap.add pdx new_peem old_peers - new_rmem = max (r_mem t) new_peem - new_prem = (fromIntegral new_rmem) / (t_mem t) - new_failn1 = computeFailN1 new_rmem old_mem new_dsk in - if (failHealth old_mem new_dsk) || (new_failn1 && not (failN1 t)) then - Nothing - else - let new_slist = iname:(slist t) - new_dp = (fromIntegral new_dsk) / (t_dsk t) - in - Just t {slist = new_slist, f_dsk = new_dsk, - peers = new_peers, failN1 = new_failn1, - r_mem = new_rmem, p_dsk = new_dp, - p_rem = new_prem} - --- | Add a primary instance to a node without other updates -setPri :: Node -> T.Idx -> Node -setPri t idx = t { plist = idx:(plist t) } - --- | Add a secondary instance to a node without other updates -setSec :: Node -> T.Idx -> Node -setSec t idx = t { slist = idx:(slist t) } + old_mem = fMem t + new_dsk = fDsk t - Instance.dsk inst + new_peem = P.find pdx old_peers + Instance.mem inst + new_peers = P.add pdx new_peem old_peers + new_rmem = max (rMem t) new_peem + new_prem = fromIntegral new_rmem / tMem t + new_failn1 = old_mem <= new_rmem + new_dp = fromIntegral new_dsk / tDsk t + old_load = utilLoad t + new_load = old_load { T.dskWeight = T.dskWeight old_load + + T.dskWeight (Instance.util inst) } + strict = not force + in case () of + _ | new_dsk <= 0 -> T.OpFail T.FailDisk + | mDsk t > new_dp && strict -> T.OpFail T.FailDisk + | Instance.mem inst >= old_mem && strict -> T.OpFail T.FailMem + | new_failn1 && not (failN1 t) && strict -> T.OpFail T.FailMem + | otherwise -> + let new_slist = iname:sList t + r = t { sList = new_slist, fDsk = new_dsk + , peers = new_peers, failN1 = new_failn1 + , rMem = new_rmem, pDsk = new_dp + , pRem = new_prem, utilLoad = new_load } + in T.OpGood r + +-- * Stats functions + +-- | Computes the amount of available disk on a given node +availDisk :: Node -> Int +availDisk t = + let _f = fDsk t + _l = loDsk t + in if _f < _l + then 0 + else _f - _l + +-- | Computes the amount of available memory on a given node +availMem :: Node -> Int +availMem t = + let _f = fMem t + _l = rMem t + in if _f < _l + then 0 + else _f - _l + +-- | Computes the amount of available memory on a given node +availCpu :: Node -> Int +availCpu t = + let _u = uCpu t + _l = hiCpu t + in if _l >= _u + then _l - _u + else 0 + +-- * Display functions + +showField :: Node -> String -> String +showField t field = + case field of + "idx" -> printf "%4d" $ idx t + "name" -> alias t + "fqdn" -> name t + "status" -> if offline t then "-" + else if failN1 t then "*" else " " + "tmem" -> printf "%5.0f" $ tMem t + "nmem" -> printf "%5d" $ nMem t + "xmem" -> printf "%5d" $ xMem t + "fmem" -> printf "%5d" $ fMem t + "imem" -> printf "%5d" imem + "rmem" -> printf "%5d" $ rMem t + "amem" -> printf "%5d" $ fMem t - rMem t + "tdsk" -> printf "%5.0f" $ tDsk t / 1024 + "fdsk" -> printf "%5d" $ fDsk t `div` 1024 + "tcpu" -> printf "%4.0f" $ tCpu t + "ucpu" -> printf "%4d" $ uCpu t + "pcnt" -> printf "%3d" $ length (pList t) + "scnt" -> printf "%3d" $ length (sList t) + "plist" -> show $ pList t + "slist" -> show $ sList t + "pfmem" -> printf "%6.4f" $ pMem t + "pfdsk" -> printf "%6.4f" $ pDsk t + "rcpu" -> printf "%5.2f" $ pCpu t + "cload" -> printf "%5.3f" uC + "mload" -> printf "%5.3f" uM + "dload" -> printf "%5.3f" uD + "nload" -> printf "%5.3f" uN + "ptags" -> intercalate "," . map (\(k, v) -> printf "%s=%d" k v) . + Map.toList $ pTags t + "peermap" -> show $ peers t + _ -> T.unknownField + where + T.DynUtil { T.cpuWeight = uC, T.memWeight = uM, + T.dskWeight = uD, T.netWeight = uN } = utilLoad t + imem = truncate (tMem t) - nMem t - xMem t - fMem t + +-- | Returns the header and numeric propery of a field +showHeader :: String -> (String, Bool) +showHeader field = + case field of + "idx" -> ("Index", True) + "name" -> ("Name", False) + "fqdn" -> ("Name", False) + "status" -> ("F", False) + "tmem" -> ("t_mem", True) + "nmem" -> ("n_mem", True) + "xmem" -> ("x_mem", True) + "fmem" -> ("f_mem", True) + "imem" -> ("i_mem", True) + "rmem" -> ("r_mem", True) + "amem" -> ("a_mem", True) + "tdsk" -> ("t_dsk", True) + "fdsk" -> ("f_dsk", True) + "tcpu" -> ("pcpu", True) + "ucpu" -> ("vcpu", True) + "pcnt" -> ("pcnt", True) + "scnt" -> ("scnt", True) + "plist" -> ("primaries", True) + "slist" -> ("secondaries", True) + "pfmem" -> ("p_fmem", True) + "pfdsk" -> ("p_fdsk", True) + "rcpu" -> ("r_cpu", True) + "cload" -> ("lCpu", True) + "mload" -> ("lMem", True) + "dload" -> ("lDsk", True) + "nload" -> ("lNet", True) + "ptags" -> ("PrimaryTags", False) + "peermap" -> ("PeerMap", False) + -- TODO: add node fields (group.uuid, group) + _ -> (T.unknownField, False) -- | String converter for the node list functionality. -list :: Int -> Node -> String -list mname t = - let pl = plist t - sl = slist t - mp = p_mem t - dp = p_dsk t - off = offline t - fn = failN1 t - tmem = t_mem t - nmem = n_mem t - xmem = x_mem t - fmem = f_mem t - imem = (truncate tmem) - nmem - xmem - fmem - in - printf " %c %-*s %5.0f %5d %5d %5d %5d %5d %5.0f %5d %3d %3d %.5f %.5f" - (if off then '-' else if fn then '*' else ' ') - mname (name t) tmem nmem imem xmem fmem (r_mem t) - ((t_dsk t) / 1024) ((f_dsk t) `div` 1024) - (length pl) (length sl) - mp dp +list :: [String] -> Node -> [String] +list fields t = map (showField t) fields + + +defaultFields :: [String] +defaultFields = + [ "status", "name", "tmem", "nmem", "imem", "xmem", "fmem" + , "rmem", "tdsk", "fdsk", "tcpu", "ucpu", "pcnt", "scnt" + , "pfmem", "pfdsk", "rcpu" + , "cload", "mload", "dload", "nload" ] + +-- | Split a list of nodes into a list of (node group UUID, list of +-- associated nodes) +computeGroups :: [Node] -> [(T.Gdx, [Node])] +computeGroups nodes = + let nodes' = sortBy (comparing group) nodes + nodes'' = groupBy (\a b -> group a == group b) nodes' + in map (\nl -> (group (head nl), nl)) nodes''