diff --git a/htools/Ganeti/HTools/Cluster.hs b/htools/Ganeti/HTools/Cluster.hs index 5fc4c4f8557d740a9a056706e3e982a2fd601083..97a0561aede44addabb2742f099701e3190bae4c 100644 --- a/htools/Ganeti/HTools/Cluster.hs +++ b/htools/Ganeti/HTools/Cluster.hs @@ -139,6 +139,7 @@ emptyEvacSolution = EvacSolution { esMoved = [] data Table = Table Node.List Instance.List Score [Placement] deriving (Show, Read) +-- | Cluster statistics data type. data CStats = CStats { csFmem :: Integer -- ^ Cluster free mem , csFdsk :: Integer -- ^ Cluster free disk , csAmem :: Integer -- ^ Cluster allocatable mem @@ -278,6 +279,7 @@ detailedCVInfo = [ (1, "free_mem_cv") , (2, "pri_tags_score") ] +-- | Holds the weights used by 'compCVNodes' for each metric. detailedCVWeights :: [Double] detailedCVWeights = map fst detailedCVInfo @@ -333,7 +335,6 @@ compCVNodes = sum . zipWith (*) detailedCVWeights . compDetailedCV compCV :: Node.List -> Double compCV = compCVNodes . Container.elems - -- | Compute online nodes from a 'Node.List'. getOnline :: Node.List -> [Node.Node] getOnline = filter (not . Node.offline) . Container.elems @@ -1314,8 +1315,16 @@ printStats nl = in intercalate ", " formatted -- | Convert a placement into a list of OpCodes (basically a job). -iMoveToJob :: Node.List -> Instance.List - -> Idx -> IMove -> [OpCodes.OpCode] +iMoveToJob :: Node.List -- ^ The node list; only used for node + -- names, so any version is good + -- (before or after the operation) + -> Instance.List -- ^ The instance list; also used for + -- names only + -> Idx -- ^ The index of the instance being + -- moved + -> IMove -- ^ The actual move to be described + -> [OpCodes.OpCode] -- ^ The list of opcodes equivalent to + -- the given move iMoveToJob nl il idx move = let inst = Container.find idx il iname = Instance.name inst diff --git a/htools/Ganeti/HTools/Compat.hs b/htools/Ganeti/HTools/Compat.hs index 2a35d37c663f5c203b1ab3db19f732f6a35bbc4b..36a0fbfce5c897add063188621d96217c6360a67 100644 --- a/htools/Ganeti/HTools/Compat.hs +++ b/htools/Ganeti/HTools/Compat.hs @@ -34,6 +34,11 @@ module Ganeti.HTools.Compat import qualified Control.Parallel.Strategies +-- | Wrapper over the function exported from +-- "Control.Parallel.Strategies". +-- +-- This wraps either the old or the new name of the function, +-- depending on the detected library version. rwhnf :: Control.Parallel.Strategies.Strategy a #ifdef PARALLEL3 rwhnf = Control.Parallel.Strategies.rseq diff --git a/htools/Ganeti/HTools/Container.hs b/htools/Ganeti/HTools/Container.hs index b527015b44049032d3871235bc3c7b522b6b1c67..5b2d3cc9de60a1a5325da078f2d404e51502cefb 100644 --- a/htools/Ganeti/HTools/Container.hs +++ b/htools/Ganeti/HTools/Container.hs @@ -59,7 +59,11 @@ import qualified Data.IntMap as IntMap import qualified Ganeti.HTools.Types as T +-- | Our key type. + type Key = IntMap.Key + +-- | Our container type. type Container = IntMap.IntMap -- | Locate a key in the map (must exist). diff --git a/htools/Ganeti/HTools/ExtLoader.hs b/htools/Ganeti/HTools/ExtLoader.hs index 06cd7df51bd320b12c5c555cc129789e78efea02..0b63a2c18afc49b26ff36e8da97be767c185927e 100644 --- a/htools/Ganeti/HTools/ExtLoader.hs +++ b/htools/Ganeti/HTools/ExtLoader.hs @@ -55,6 +55,7 @@ import Ganeti.HTools.Utils (sepSplit, tryRead) wrapIO :: IO (Result a) -> IO (Result a) wrapIO = flip catch (return . Bad . show) +-- | Parses a user-supplied utilisation string. parseUtilisation :: String -> Result (String, DynUtil) parseUtilisation line = case sepSplit ' ' line of diff --git a/htools/Ganeti/HTools/Group.hs b/htools/Ganeti/HTools/Group.hs index 82816784a11350bf1642132afb85cfcb03370776..6df5f4c74223863ba710fecd3b0dc68f0c76c1ac 100644 --- a/htools/Ganeti/HTools/Group.hs +++ b/htools/Ganeti/HTools/Group.hs @@ -73,6 +73,8 @@ create name_init id_init apol_init = , idx = -1 } +-- | Sets the group index. +-- -- This is used only during the building of the data structures. setIdx :: Group -> T.Gdx -> Group setIdx t i = t {idx = i} diff --git a/htools/Ganeti/HTools/IAlloc.hs b/htools/Ganeti/HTools/IAlloc.hs index a8fc8af68f651506f0000f468bea71ff602dfcab..d86a6571e61be404cbfd1478e322de3580ea9791 100644 --- a/htools/Ganeti/HTools/IAlloc.hs +++ b/htools/Ganeti/HTools/IAlloc.hs @@ -237,7 +237,7 @@ formatNodeEvac gl nl il (fin_nl, fin_il, es) = " were moved successfully" in Ok (info, showJSON (mes, fes, Cluster.esOpCodes es), fin_nl, fin_il) --- | Process a request and return new node lists +-- | Process a request and return new node lists. processRequest :: Request -> Result IAllocResult processRequest request = let Request rqtype (ClusterData gl nl il _) = request @@ -251,7 +251,7 @@ processRequest request = Cluster.tryNodeEvac gl nl il mode xi >>= formatNodeEvac gl nl il --- | Reads the request from the data file(s) +-- | Reads the request from the data file(s). readRequest :: Options -> [String] -> IO Request readRequest opts args = do when (null args) $ do diff --git a/htools/Ganeti/HTools/Instance.hs b/htools/Ganeti/HTools/Instance.hs index 4f8d5f56a4da428dd9f8fcb8abf623624e22e380..4ff497fcdb7497ac94027c449ef889b065f918a1 100644 --- a/htools/Ganeti/HTools/Instance.hs +++ b/htools/Ganeti/HTools/Instance.hs @@ -159,6 +159,7 @@ setBoth :: Instance -- ^ the original instance -> Instance -- ^ the modified instance setBoth t p s = t { pNode = p, sNode = s } +-- | Sets the movable flag on an instance. setMovable :: Instance -- ^ The original instance -> Bool -- ^ New movable flag -> Instance -- ^ The modified instance @@ -186,7 +187,7 @@ specOf :: Instance -> T.RSpec specOf Instance { mem = m, dsk = d, vcpus = c } = T.RSpec { T.rspecCpu = c, T.rspecMem = m, T.rspecDsk = d } --- | Computed the number of nodes for a given disk template +-- | Computed the number of nodes for a given disk template. requiredNodes :: T.DiskTemplate -> Int requiredNodes T.DTDrbd8 = 2 requiredNodes _ = 1 diff --git a/htools/Ganeti/HTools/Luxi.hs b/htools/Ganeti/HTools/Luxi.hs index 9b3fa9c507200c9ad1a8f765b51f406a8e6f1470..ee526be00a2ccdbe6dc2082ee1acab3d8cddaaa3 100644 --- a/htools/Ganeti/HTools/Luxi.hs +++ b/htools/Ganeti/HTools/Luxi.hs @@ -88,14 +88,15 @@ queryGroupsMsg :: L.LuxiOp queryGroupsMsg = L.QueryGroups [] ["uuid", "name", "alloc_policy"] False --- | Wraper over callMethod doing node query. +-- | Wraper over 'callMethod' doing node query. queryNodes :: L.Client -> IO (Result JSValue) queryNodes = L.callMethod queryNodesMsg --- | Wraper over callMethod doing instance query. +-- | Wraper over 'callMethod' doing instance query. queryInstances :: L.Client -> IO (Result JSValue) queryInstances = L.callMethod queryInstancesMsg +-- | Wrapper over 'callMethod' doing cluster information query. queryClusterInfo :: L.Client -> IO (Result JSValue) queryClusterInfo = L.callMethod queryClusterInfoMsg @@ -167,15 +168,18 @@ parseNode ktg (JSArray [ name, mtotal, mnode, mfree, dtotal, dfree parseNode _ v = fail ("Invalid node query result: " ++ show v) +-- | Parses the cluster tags. getClusterTags :: JSValue -> Result [String] getClusterTags v = do let errmsg = "Parsing cluster info" obj <- annotateResult errmsg $ asJSObject v tryFromObj errmsg (fromJSObject obj) "tags" +-- | Parses the cluster groups. getGroups :: JSValue -> Result [(String, Group.Group)] getGroups arr = toArray arr >>= mapM parseGroup +-- | Parses a given group information. parseGroup :: JSValue -> Result (String, Group.Group) parseGroup (JSArray [ uuid, name, apol ]) = do xname <- annotateResult "Parsing new group" (fromJVal name) diff --git a/htools/Ganeti/HTools/Program/Hail.hs b/htools/Ganeti/HTools/Program/Hail.hs index ad7c77566367ffa28ab8c522812a71c13d9514ef..1fb9b80d4edbd4cca8c8c024669d764a09a69b3d 100644 --- a/htools/Ganeti/HTools/Program/Hail.hs +++ b/htools/Ganeti/HTools/Program/Hail.hs @@ -36,7 +36,7 @@ import Ganeti.HTools.IAlloc import Ganeti.HTools.Loader (Request(..), ClusterData(..)) import Ganeti.HTools.ExtLoader (maybeSaveData) --- | Options list and functions +-- | Options list and functions. options :: [OptType] options = [ oPrintNodes diff --git a/htools/Ganeti/HTools/Program/Hbal.hs b/htools/Ganeti/HTools/Program/Hbal.hs index ca6b9d731ef6de78043bcd509fe4f8cbc4c2a156..21bf9995583936a1ea1c77a932d2104c8af9fdcb 100644 --- a/htools/Ganeti/HTools/Program/Hbal.hs +++ b/htools/Ganeti/HTools/Program/Hbal.hs @@ -54,7 +54,7 @@ import Ganeti.HTools.Loader import qualified Ganeti.Luxi as L import Ganeti.Jobs --- | Options list and functions +-- | Options list and functions. options :: [OptType] options = [ oPrintNodes @@ -133,14 +133,14 @@ iterateDepth ini_tbl max_rounds disk_moves inst_moves nmlen imlen mg_limit min_gain evac_mode Nothing -> return (ini_tbl, cmd_strs) --- | Formats the solution for the oneline display +-- | Formats the solution for the oneline display. formatOneline :: Double -> Int -> Double -> String formatOneline ini_cv plc_len fin_cv = printf "%.8f %d %.8f %8.3f" ini_cv plc_len fin_cv (if fin_cv == 0 then 1 else ini_cv / fin_cv) -- | Polls a set of jobs at a fixed interval until all are finished --- one way or another +-- one way or another. waitForJobs :: L.Client -> [String] -> IO (Result [JobStatus]) waitForJobs client jids = do sts <- L.queryJobsStatus client jids @@ -153,11 +153,11 @@ waitForJobs client jids = do waitForJobs client jids else return $ Ok s --- | Check that a set of job statuses is all success +-- | Check that a set of job statuses is all success. checkJobsStatus :: [JobStatus] -> Bool checkJobsStatus = all (== JOB_STATUS_SUCCESS) --- | Wrapper over execJobSet checking for early termination +-- | Wrapper over execJobSet checking for early termination. execWrapper :: String -> Node.List -> Instance.List -> IORef Int -> [JobSet] -> IO Bool execWrapper _ _ _ _ [] = return True @@ -170,7 +170,7 @@ execWrapper master nl il cref alljss = do return False else execJobSet master nl il cref alljss) --- | Execute an entire jobset +-- | Execute an entire jobset. execJobSet :: String -> Node.List -> Instance.List -> IORef Int -> [JobSet] -> IO Bool execJobSet _ _ _ _ [] = return True @@ -201,14 +201,14 @@ execJobSet master nl il cref (js:jss) = do hPutStrLn stderr "Aborting." return False) --- | Signal handler for graceful termination +-- | Signal handler for graceful termination. hangleSigInt :: IORef Int -> IO () hangleSigInt cref = do writeIORef cref 1 putStrLn ("Cancel request registered, will exit at" ++ " the end of the current job set...") --- | Signal handler for immediate termination +-- | Signal handler for immediate termination. hangleSigTerm :: IORef Int -> IO () hangleSigTerm cref = do -- update the cref to 2, just for consistency @@ -216,6 +216,7 @@ hangleSigTerm cref = do putStrLn "Double cancel request, exiting now..." exitImmediately $ ExitFailure 2 +-- | Runs a job set with handling of signals. runJobSet :: String -> Node.List -> Instance.List -> [JobSet] -> IO Bool runJobSet master fin_nl il cmd_jobs = do cref <- newIORef 0 diff --git a/htools/Ganeti/HTools/Program/Hscan.hs b/htools/Ganeti/HTools/Program/Hscan.hs index 3fd39cb9d5090ca64e62f2f7c83493bdabe9776d..0dbcf6e08f3bdf6bf5870a7ef5cd0f13772b2b3e 100644 --- a/htools/Ganeti/HTools/Program/Hscan.hs +++ b/htools/Ganeti/HTools/Program/Hscan.hs @@ -46,7 +46,7 @@ import Ganeti.HTools.Text (serializeCluster) import Ganeti.HTools.CLI import Ganeti.HTools.Types --- | Options list and functions +-- | Options list and functions. options :: [OptType] options = [ oPrintNodes @@ -58,7 +58,7 @@ options = , oShowHelp ] --- | Return a one-line summary of cluster state +-- | Return a one-line summary of cluster state. printCluster :: Node.List -> Instance.List -> String printCluster nl il = @@ -79,7 +79,7 @@ printCluster nl il = ccv --- | Replace slashes with underscore for saving to filesystem +-- | Replace slashes with underscore for saving to filesystem. fixSlash :: String -> String fixSlash = map (\x -> if x == '/' then '_' else x) @@ -91,7 +91,7 @@ processData input_data = do let (_, fix_nl) = checkData nl il return cdata { cdNodes = fix_nl } --- | Writes cluster data out +-- | Writes cluster data out. writeData :: Int -> String -> Options @@ -108,6 +108,7 @@ writeData nlen name opts (Ok cdata) = do name err >> return False Ok processed -> writeDataInner nlen name opts cdata processed +-- | Inner function for writing cluster data to disk. writeDataInner :: Int -> String -> Options diff --git a/htools/Ganeti/HTools/Program/Hspace.hs b/htools/Ganeti/HTools/Program/Hspace.hs index 0f865ae7faeb9d9bdec3cc13cf429d4fd99bbafe..a4cb285f93d57950d11622122dec594c9c4860d0 100644 --- a/htools/Ganeti/HTools/Program/Hspace.hs +++ b/htools/Ganeti/HTools/Program/Hspace.hs @@ -48,7 +48,7 @@ import Ganeti.HTools.CLI import Ganeti.HTools.ExtLoader import Ganeti.HTools.Loader --- | Options list and functions +-- | Options list and functions. options :: [OptType] options = [ oPrintNodes @@ -110,6 +110,8 @@ dskEff = effFn Cluster.csIdsk Cluster.csTdsk cpuEff :: Cluster.CStats -> Double cpuEff = effFn Cluster.csIcpu (fromIntegral . Cluster.csVcpu) +-- | Holds data for converting a 'Cluster.CStats' structure into +-- detailed statictics. statsData :: [(String, Cluster.CStats -> String)] statsData = [ ("SCORE", printf "%.8f" . Cluster.csScore) , ("INST_CNT", printf "%d" . Cluster.csNinst) @@ -133,12 +135,14 @@ statsData = [ ("SCORE", printf "%.8f" . Cluster.csScore) , ("MNODE_DSK_AVAIL", printf "%d" . Cluster.csMdsk) ] +-- | List holding 'RSpec' formatting information. specData :: [(String, RSpec -> String)] specData = [ ("MEM", printf "%d" . rspecMem) , ("DSK", printf "%d" . rspecDsk) , ("CPU", printf "%d" . rspecCpu) ] +-- | List holding 'Cluster.CStats' formatting information. clusterData :: [(String, Cluster.CStats -> String)] clusterData = [ ("MEM", printf "%.0f" . Cluster.csTmem) , ("DSK", printf "%.0f" . Cluster.csTdsk) @@ -146,7 +150,7 @@ clusterData = [ ("MEM", printf "%.0f" . Cluster.csTmem) , ("VCPU", printf "%d" . Cluster.csVcpu) ] --- | Function to print stats for a given phase +-- | Function to print stats for a given phase. printStats :: Phase -> Cluster.CStats -> [(String, String)] printStats ph cs = map (\(s, fn) -> (printf "%s_%s" kind s, fn cs)) statsData @@ -211,6 +215,7 @@ formatSpecMap = map (\(spec, cnt) -> printf "%d,%d,%d=%d" (rspecMem spec) (rspecDsk spec) (rspecCpu spec) cnt) +-- | Formats \"key-metrics\" values. formatRSpec :: Double -> String -> RSpec -> [(String, String)] formatRSpec m_cpu s r = [ ("KM_" ++ s ++ "_CPU", show $ rspecCpu r) @@ -219,6 +224,7 @@ formatRSpec m_cpu s r = , ("KM_" ++ s ++ "_DSK", show $ rspecDsk r) ] +-- | Shows allocations stats. printAllocationStats :: Double -> Node.List -> Node.List -> IO () printAllocationStats m_cpu ini_nl fin_nl = do let ini_stats = Cluster.totalResources ini_nl @@ -228,17 +234,18 @@ printAllocationStats m_cpu ini_nl fin_nl = do printKeys $ formatRSpec m_cpu "POOL"ralo printKeys $ formatRSpec m_cpu "UNAV" runa --- | Ensure a value is quoted if needed +-- | Ensure a value is quoted if needed. ensureQuoted :: String -> String ensureQuoted v = if not (all (\c -> isAlphaNum c || c == '.') v) then '\'':v ++ "'" else v --- | Format a list of key\/values as a shell fragment +-- | Format a list of key\/values as a shell fragment. printKeys :: [(String, String)] -> IO () printKeys = mapM_ (\(k, v) -> printf "HTS_%s=%s\n" (map toUpper k) (ensureQuoted v)) +-- | Converts instance data to a list of strings. printInstance :: Node.List -> Instance.Instance -> [String] printInstance nl i = [ Instance.name i , Container.nameOf nl $ Instance.pNode i @@ -250,7 +257,7 @@ printInstance nl i = [ Instance.name i , show (Instance.vcpus i) ] --- | Optionally print the allocation map +-- | Optionally print the allocation map. printAllocationMap :: Int -> String -> Node.List -> [Instance.Instance] -> IO () printAllocationMap verbose msg nl ixes = @@ -314,11 +321,13 @@ printTiered False spec_map _ ini_nl fin_nl sreason = do printClusterScores ini_nl fin_nl printClusterEff (Cluster.totalResources fin_nl) +-- | Displays the initial/final cluster scores. printClusterScores :: Node.List -> Node.List -> IO () printClusterScores ini_nl fin_nl = do printf " - initial cluster score: %.8f\n" $ Cluster.compCV ini_nl::IO () printf " - final cluster score: %.8f\n" $ Cluster.compCV fin_nl +-- | Displays the cluster efficiency. printClusterEff :: Cluster.CStats -> IO () printClusterEff cs = mapM_ (\(s, fn) -> diff --git a/htools/Ganeti/HTools/Types.hs b/htools/Ganeti/HTools/Types.hs index af9b79a9a57949f58f4ad3a5589d978ab416f6b9..6452f5b6d6efa2582085d875eff7ee0860443da9 100644 --- a/htools/Ganeti/HTools/Types.hs +++ b/htools/Ganeti/HTools/Types.hs @@ -180,7 +180,7 @@ data IMove = Failover -- ^ Failover the instance (f) | FailoverAndReplace Ndx -- ^ Failover, replace secondary (f, r:ns) deriving (Show, Read) --- | Instance disk template type +-- | Instance disk template type. data DiskTemplate = DTDiskless | DTFile | DTSharedFile @@ -189,7 +189,7 @@ data DiskTemplate = DTDiskless | DTDrbd8 deriving (Show, Read, Eq, Enum, Bounded) --- | Converts a DiskTemplate to String +-- | Converts a DiskTemplate to String. dtToString :: DiskTemplate -> String dtToString DTDiskless = C.dtDiskless dtToString DTFile = C.dtFile @@ -198,7 +198,7 @@ dtToString DTPlain = C.dtPlain dtToString DTBlock = C.dtBlock dtToString DTDrbd8 = C.dtDrbd8 --- | Converts a DiskTemplate from String +-- | Converts a DiskTemplate from String. dtFromString :: (Monad m) => String -> m DiskTemplate dtFromString s = case () of @@ -281,7 +281,7 @@ isOk _ = False isBad :: Result a -> Bool isBad = not . isOk --- | Converter from Either String to 'Result' +-- | Converter from Either String to 'Result'. eitherToResult :: Either String a -> Result a eitherToResult (Left s) = Bad s eitherToResult (Right v) = Ok v diff --git a/htools/Ganeti/HTools/Version.hs.in b/htools/Ganeti/HTools/Version.hs.in index 3785e913b4e5af79b98b0354ff494f6fb3399d72..d0721e77aa01f85c9ded2bae82bd253f598ca4ff 100644 --- a/htools/Ganeti/HTools/Version.hs.in +++ b/htools/Ganeti/HTools/Version.hs.in @@ -1,4 +1,6 @@ -- Hey Emacs, this is a -*- haskell -*- file +{- | Auto-generated module holding version information. +-} module Ganeti.HTools.Version ( diff --git a/htools/test.hs b/htools/test.hs index d46d22aea89dc250859c4de04398c4e98ed84994..34bd05a174e00a8d0078cf1725f1a79ac2c32d57 100644 --- a/htools/test.hs +++ b/htools/test.hs @@ -37,7 +37,7 @@ import Ganeti.HTools.QC import Ganeti.HTools.CLI import Ganeti.HTools.Utils (sepSplit) --- | Options list and functions +-- | Options list and functions. options :: [OptType] options = [ oReplay @@ -61,7 +61,7 @@ slow = stdArgs incIORef :: IORef Int -> IO () incIORef ir = atomicModifyIORef ir (\x -> (x + 1, ())) --- | Wrapper over a test runner with error counting +-- | Wrapper over a test runner with error counting. wrapTest :: IORef Int -> (Args -> IO Result) -> Args