Synnefo » snf-ganeti » ganeti-local

-- | Class for types which support show help and show version.

    -- | Denotes whether the show help option has been passed.

    -- | Denotes whether the show version option has been passed.

-- | Class for types which support the -i\/-n\/-m options.

    -- | Returns the node file name.

    -- | Tells whether the node file has been passed as an option.

    -- | Returns the instance file name.

    -- | Tells whether the instance file has been passed as an option.

    -- | Rapi target, if one has been passed.

    -- | Whether to be less verbose.

-- | Parse the environment and return the node\/instance names.

--

-- This also hardcodes here the default node\/instance file names.

-- | A shell script template for autogenerated scripts.

-- | External tool data loader from a variety of sources.

-- * Types

-- | A separate name for the cluster score type.

-- | A cluster solution described as the solution delta and the list

-- of placements.

-- * Utility functions

-- | Returns the delta of a solution or -1 for Nothing.

solutionDelta :: Maybe Solution -> Int

solutionDelta sol = case sol of

                      Just (Solution d _) -> d

                      _ -> -1

{-| Computes the pair of bad nodes and instances.

The bad node list is computed via a simple 'verifyN1' check, and the

bad instance list is the list of primary and secondary instances of

those nodes.

-}

computeBadItems :: Node.List -> Instance.List ->

                   ([Node.Node], [Instance.Instance])

computeBadItems nl il =

  let bad_nodes = verifyN1 $ filter (not . Node.offline) $ Container.elems nl

      bad_instances = map (\idx -> Container.find idx il) $

                      sort $ nub $ concat $

                      map (\ n -> (Node.slist n) ++ (Node.plist n)) bad_nodes

  in

    (bad_nodes, bad_instances)

-- | Compute the total free disk and memory in the cluster.

totalResources :: Container.Container Node.Node -> (Int, Int)

totalResources nl =

    foldl'

    (\ (mem, dsk) node -> (mem + (Node.f_mem node),

                           dsk + (Node.f_dsk node)))

    (0, 0) (Container.elems nl)

-- | Compute the mem and disk covariance.

compDetailedCV :: Node.List -> (Double, Double, Double, Double, Double)

compDetailedCV nl =

    let

        all_nodes = Container.elems nl

        (offline, nodes) = partition Node.offline all_nodes

        mem_l = map Node.p_mem nodes

        dsk_l = map Node.p_dsk nodes

        mem_cv = varianceCoeff mem_l

        dsk_cv = varianceCoeff dsk_l

        n1_l = length $ filter Node.failN1 nodes

        n1_score = (fromIntegral n1_l) / (fromIntegral $ length nodes)

        res_l = map Node.p_rem nodes

        res_cv = varianceCoeff res_l

        offline_inst = sum . map (\n -> (length . Node.plist $ n) +

                                        (length . Node.slist $ n)) $ offline

        online_inst = sum . map (\n -> (length . Node.plist $ n) +

                                       (length . Node.slist $ n)) $ nodes

        off_score = (fromIntegral offline_inst) /

                    (fromIntegral $ online_inst + offline_inst)

    in (mem_cv, dsk_cv, n1_score, res_cv, off_score)

-- | Compute the /total/ variance.

compCV :: Node.List -> Double

compCV nl =

    let (mem_cv, dsk_cv, n1_score, res_cv, off_score) = compDetailedCV nl

    in mem_cv + dsk_cv + n1_score + res_cv + off_score

-- * hn1 functions

-- | Add an instance and return the new node and instance maps.

{-| Compute a new version of a cluster given a solution.

-- ** First phase functions

{-| Given a list 1,2,3..n build a list of pairs [(1, [2..n]), (2,

{-| Checks if removal of instances results in N+1 pass.

-- | Computes the removals list for a given depth.

-- ** Second phase functions

-- | Single-node relocation cost.

-- | Compute best solution.

--

-- This function compares two solutions, choosing the minimum valid

-- solution.

{-| Auxiliary function for solution computation.

We write this in an explicit recursive fashion in order to control

early-abort in case we have met the min delta. We can't use foldr

instead of explicit recursion since we need the accumulator for the

abort decision.

-}

advanceSolution :: [Maybe Removal] -- ^ The removal to process

                -> Int             -- ^ Minimum delta parameter

                -> Int             -- ^ Maximum delta parameter

                -> Maybe Solution  -- ^ Current best solution

                -> Maybe Solution  -- ^ New best solution

advanceSolution [] _ _ sol = sol

advanceSolution (Nothing:xs) m n sol = advanceSolution xs m n sol

advanceSolution ((Just (Removal nx removed)):xs) min_d max_d prev_sol =

    let new_sol = checkPlacement nx removed [] 0 prev_sol max_d

        new_delta = solutionDelta $! new_sol

    in

      if new_delta >= 0 && new_delta <= min_d then

          new_sol

      else

          advanceSolution xs min_d max_d new_sol

-- | Computes the placement solution.

solutionFromRemovals :: [Maybe Removal] -- ^ The list of (possible) removals

                     -> Int             -- ^ Minimum delta parameter

                     -> Int             -- ^ Maximum delta parameter

                     -> Maybe Solution  -- ^ The best solution found

solutionFromRemovals removals min_delta max_delta =

    advanceSolution removals min_delta max_delta Nothing

{-| Computes the solution at the given depth.

This is a wrapper over both computeRemovals and

solutionFromRemovals. In case we have no solution, we return Nothing.

-}

computeSolution :: Node.List        -- ^ The original node data

                -> [Instance.Instance] -- ^ The list of /bad/ instances

                -> Int             -- ^ The /depth/ of removals

                -> Int             -- ^ Maximum number of removals to process

                -> Int             -- ^ Minimum delta parameter

                -> Int             -- ^ Maximum delta parameter

                -> Maybe Solution  -- ^ The best solution found (or Nothing)

computeSolution nl bad_instances depth max_removals min_delta max_delta =

  let

      removals = computeRemovals nl bad_instances depth

      removals' = capRemovals removals max_removals

  in

    solutionFromRemovals removals' min_delta max_delta

-- * hbal functions

-- | Compute best table. Note that the ordering of the arguments is important.

compareTables :: Table -> Table -> Table

compareTables a@(Table _ _ a_cv _) b@(Table _ _ b_cv _ ) =

    if a_cv > b_cv then b else a

-- | Applies an instance move to a given node list and instance.

-- | Tries to allocate an instance on one given node.

-- | Tries to allocate an instance on a given pair of nodes.

-- | Tries to perform an instance move and returns the best table

-- between the original one and the new one.

-- * Formatting functions

-- | Converts a placement to string format.

printSolutionLine :: Node.List     -- ^ The node list

                  -> Instance.List -- ^ The instance list

                  -> Int           -- ^ Maximum node name length

                  -> Int           -- ^ Maximum instance name length

                  -> Placement     -- ^ The current placement

                  -> Int           -- ^ The index of the placement in

                                   -- the solution

-- | Given a list of commands, prefix them with @gnt-instance@ and

-- also beautify the display a little.

-- | Converts a solution to string format.

-- | Shows statistics for a given node list.

-- | Compute the name of an element in a container.

-- | Compute the maximum name length in an Element Container.

-- | Find an element by name in a Container; this is a very slow function.

-- | The request type.

    = Allocate Instance.Instance Int -- ^ A new instance allocation

    | Relocate Idx Int [Ndx]         -- ^ Move an instance to a new

                                     -- secondary node

-- | A complete request, as received from Ganeti.

-- | Parse the basic specifications of an instance.

--

-- Instances in the cluster instance list and the instance in an

-- 'Allocate' request share some common properties, which are read by

-- this function.

-- | Parses an instance as found in the cluster instance list.

parseInstance :: NameAssoc        -- ^ The node name-to-index association list

              -> String           -- ^ The name of the instance

              -> JSObject JSValue -- ^ The JSON object

-- | Parses a node as found in the cluster node list.

parseNode :: String           -- ^ The node's name

          -> JSObject JSValue -- ^ The JSON object

          -> Result (String, Node.Node)

-- | Top-level parser.

parseData :: String         -- ^ The JSON message as received from Ganeti

          -> Result Request -- ^ A (possible valid) request

-- | Formats the response into a valid IAllocator response message.

formatResponse :: Bool     -- ^ Whether the request was successful

               -> String   -- ^ Information text

               -> [String] -- ^ The list of chosen nodes

               -> String   -- ^ The JSON-formatted message

-- * Type declarations

-- | The instance type

data Instance = Instance { name :: String   -- ^ The instance name

                         , mem :: Int       -- ^ Memory of the instance

                         , dsk :: Int       -- ^ Disk size of instance

                         , running :: Bool  -- ^ Whether the instance

                         , run_st :: String -- ^ Original (text) run status

                         , pnode :: T.Ndx   -- ^ Original primary node

                         , snode :: T.Ndx   -- ^ Original secondary node

                         , idx :: T.Idx     -- ^ Internal index for

-- | A simple name for the int, instance association list.

-- | A simple name for an instance map.

-- * Initialization

-- | Create an instance.

--

-- Some parameters are not initialized by function, and must be set

-- later (via 'setIdx' for example).

-- | Changes the index.

--

-- This is used only during the building of the data structures.

setIdx :: Instance  -- ^ the original instance

        -> T.Idx    -- ^ new index

        -> Instance -- ^ the modified instance

setIdx t i = t { idx = i }

-- | Changes the name.

--

-- This is used only during the building of the data structures.

setName :: Instance -- ^ The original instance

        -> String   -- ^ New name

        -> Instance

setName t s = t { name = s }

-- * Update functions

-- | Lookups a node into an assoc list.

-- | Lookups an instance into an assoc list.

-- | Given a list of elements (and their names), assign indices to them.

-- | For each instance, add its index to its primary and secondary nodes.

-- | starts with a dot.

-- | Remove tail suffix from a string.

-- | Initializer function that loads the data from a node and instance

-- list and massages it into the correct format.

-- | Checks the cluster data for consistency.

    , setPri

    , setSec

-- * Type declarations

-- | The node type.

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

                 , 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

-- | A simple name for the int, node association list.

-- | A simple name for a node map.

-- | Constant node index for a non-moveable instance.

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

--

-- | Changes the name.

--

setName :: Node -> String -> Node

-- | Sets the offline attribute.

-- | Sets the unnaccounted memory.

-- | Assigns an instance to a node as primary without other updates.

setPri :: Node -> T.Idx -> Node

setPri t idx = t { plist = idx:(plist t) }

-- | Assigns an instance to a node as secondary without other updates.

setSec :: Node -> T.Idx -> Node

setSec t idx = t { slist = idx:(slist t) }

-- * Update functions

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

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

-- * Display functions

-- * Initialization functions

-- | Create a new empty map.

-- | Our reverse-compare function.

-- | Add or update (via a custom function) an element.

-- * Basic operations

-- | Returns either the value for a key or zero if not found

-- | Add an element to a peermap, overwriting the previous value

-- | Remove an element from a peermap

-- | Find the maximum element.

--

-- Since this is a sorted list, we just get the value at the head of

-- the list, or zero for a null list

-- | Read an URL via curl and return the body if successful.

-- | Append the default port if not passed in.

-- | Parse a instance list in JSON format.

-- | Parse a node list in JSON format.

-- | Construct an instance from a JSON object.

-- | Construct a node from a JSON object.

-- | Builds the cluster data from an URL.

-- | Safe 'read' function returning data encapsulated in a Result.

-- | Load a node from a field list.

-- | Load an instance from a field list.

-- | Convert newline and delimiter-separated text.

--

-- This function converts a text in tabular format as generated by

-- @gnt-instance list@ and @gnt-node list@ to a list of objects using

-- a supplied conversion function.

-- | Builds the cluster data from node\/instance files.

-- | The instance index type.

-- | The node index type.

-- | The type used to hold name-to-idx mappings.

-- | A generic class for items that have updateable names and indices.

    -- | Returns the name of the element

    -- | Returns the index of the element

    -- | Updates the name of the element

    -- | Updates the index of the element

-- * Debug functions

-- * Miscelaneous

-- * Mathematical functions

-- | Get an Ok result or print the error and exit.

-- * JSON-related functions

-- | Converts a JSON Result into a monadic value.

fromJResult :: Monad m => J.Result a -> m a

fromJResult (J.Error x) = fail x

fromJResult (J.Ok x) = return x

-- | Tries to read a string from a JSON value.

--

-- In case the value was not a string, we fail the read (in the

-- context of the current monad.

-- | Converts a JSON message into an array of JSON objects.

-- | Reads a the value of a key in a JSON object.

-- | Converts a JSON value into a JSON object.

-- | Coneverts a list of JSON values into a list of JSON objects.

-- | The version of the sources.

version :: String

doc: $(DOCS) Ganeti/HTools/Version.hs

	rm -rf $(HDDIR)/*