/ - Diff - snf-ganeti - Greek Research and Technology Network's projects

     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
-...
                      , (2,  "pri_tags_score")
+                     ]
     -- | Holds the weights used by 'compCVNodes' for each metric.
     detailedCVWeights :: [Double]
     detailedCVWeights = map fst detailedCVInfo
-...
     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
-...
         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

     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

     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).

b/htools/Ganeti/HTools/ExtLoader.hs
55	55	wrapIO :: IO (Result a) -> IO (Result a)
56	56	wrapIO = flip catch (return . Bad . show)
57	57
	58	-- \| Parses a user-supplied utilisation string.
58	59	parseUtilisation :: String -> Result (String, DynUtil)
59	60	parseUtilisation line =
60	61	case sepSplit ' ' line of

               , 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}

                    " 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
-...
                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

              -> 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
-...
     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

     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
-...
     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)

     import Ganeti.HTools.Loader (Request(..), ClusterData(..))
     import Ganeti.HTools.ExtLoader (maybeSaveData)
     -- | Options list and functions
     -- | Options list and functions.
     options :: [OptType]
     options =
         [ oPrintNodes

     import qualified Ganeti.Luxi as L
     import Ganeti.Jobs
     -- | Options list and functions
     -- | Options list and functions.
     options :: [OptType]
     options =
         [ oPrintNodes
-...
                                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
-...
                   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
-...
          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
-...
                    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
-...
       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

     import Ganeti.HTools.CLI
     import Ganeti.HTools.Types
     -- | Options list and functions
     -- | Options list and functions.
     options :: [OptType]
     options =
         [ oPrintNodes
-...
         , 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 =
-...
                      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)
-...
       let (_, fix_nl) = checkData nl il
       return cdata { cdNodes = fix_nl }
     -- | Writes cluster data out
     -- | Writes cluster data out.
     writeData :: Int
               -> String
               -> Options
-...
                    name err >> return False
         Ok processed -> writeDataInner nlen name opts cdata processed
     -- | Inner function for writing cluster data to disk.
     writeDataInner :: Int
                    -> String
                    -> Options

     import Ganeti.HTools.ExtLoader
     import Ganeti.HTools.Loader
     -- | Options list and functions
     -- | Options list and functions.
     options :: [OptType]
     options =
         [ oPrintNodes
-...
     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)
-...
                 , ("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)
-...
                   , ("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
-...
         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)
-...
         , ("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
-...
       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
-...
                          , 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 =
-...
       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) ->

                | FailoverAndReplace Ndx  -- ^ Failover, replace secondary (f, r:ns)
                  deriving (Show, Read)
     -- | Instance disk template type
     -- | Instance disk template type.
     data DiskTemplate = DTDiskless
                       | DTFile
                       | DTSharedFile
-...
                       | 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
-...
     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
-...
     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

b/htools/Ganeti/HTools/Version.hs.in
1	1	-- Hey Emacs, this is a -- haskell -- file
	2	{- \| Auto-generated module holding version information.
	3	-}
2	4
3	5	module Ganeti.HTools.Version
4	6	(

     import Ganeti.HTools.CLI
     import Ganeti.HTools.Utils (sepSplit)
     -- | Options list and functions
     -- | Options list and functions.
     options :: [OptType]
     options =
         [ oReplay
-...
     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

Synnefo » snf-ganeti

Revision 179c0828