Synnefo » snf-ganeti » ganeti-local

{-

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

parseInstance ktn n a = do

  base <- parseBaseInstance n a

  nodes <- fromObj a "nodes"

  pidx <- lookupNode ktn n pnode

  return (n, Instance.setBoth (snd base) pidx sidx)

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

{-

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

            _ -> convert "be/memory" mem

  xvcpus <- convert "be/vcpus" vcpus

  xpnode <- convert "pnode" pnode >>= lookupNode ktn xname

  xrunning <- convert "status" status

  xtags <- convert "tags" tags

  xauto_balance <- convert "auto_balance" auto_balance

{-

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

  vcpus <- extract "vcpus" beparams

  pnode <- extract "pnode" a >>= lookupNode ktn name

  snodes <- extract "snodes" a

  running <- extract "status" a

  tags <- extract "tags" a

  auto_balance <- extract "auto_balance" beparams

      all_msgs = concatMap (solutionDescription mggl) sols

      goodSols = filterMGResults mggl sols

      sortedSols = sortMGResults mggl goodSols

-- | Try to allocate an instance on a multi-group cluster.

tryMGAlloc :: Group.List           -- ^ The group list

{-

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

neighColors :: Graph.Graph -> VertColorMap -> Graph.Vertex -> [Color]

neighColors g cMap v = verticesColors cMap $ neighbors g v

-- | Color one node.

colorNode :: Graph.Graph -> VertColorMap -> Graph.Vertex -> Color

-- use of "head" is A-ok as the source is an infinite list

{-

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

  , "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 ((==) `on` group) nodes'

  in map (\nl -> (group (head nl), nl)) nodes''

{-

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

wrapReadRequest :: Options -> [String] -> IO Request

wrapReadRequest opts args = do

  if isJust (optDataFile opts) ||  (not . null . optNodeSim) opts

    then do

      cdata <- loadExternalData opts

{-

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

       Just fin_tbl ->

         do

           let (Cluster.Table _ _ _ fin_plc) = fin_tbl

               (sol_line, cmds) = Cluster.printSolutionLine ini_nl ini_il

                                  nmlen imlen cur_plc fin_plc_len

               afn = Cluster.involvedNodes ini_il cur_plc

  case optGroup opts of

    Nothing -> do

      return (Group.name grp, cdata)

    Just g -> case Container.findByName gl g of

      Nothing -> do

{-

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

specDescription SpecNormal = "Standard (fixed-size)"

specDescription SpecTiered = "Tiered (initial size)"

-- | Efficiency generic function.

effFn :: (Cluster.CStats -> Integer)

      -> (Cluster.CStats -> Double)

                  \ != counted (%d)\n" (num_instances + allocs)

           (Cluster.csNinst fin_stats)

  printKeysHTS $ printStats PFinal fin_stats

  printKeysHTS [ ("ALLOC_USAGE", printf "%.8f"

                                   ((fromIntegral num_instances::Double) /

                                   fromIntegral fin_instances))

               , ("ALLOC_INSTANCES", printf "%d" allocs)

               ]

  printKeysHTS $ map (\(x, y) -> (printf "ALLOC_%s_CNT" (show x),

                                  printf "%d" y)) sreason

printFinalHTS :: Bool -> IO ()

printFinalHTS = printFinal htsPrefix

-- | Compute the tiered spec counts from a list of allocated

-- instances.

tieredSpecMap :: [Instance.Instance]

tieredSpecMap trl_ixes =

  let fin_trl_ixes = reverse trl_ixes

      ix_byspec = groupBy ((==) `on` Instance.specOf) fin_trl_ixes

      spec_map = map (\ixs -> (Instance.specOf $ head ixs, length ixs))

                 ix_byspec

  in spec_map

        Just result_noalloc -> return result_noalloc

        Nothing -> exitIfBad "failure during allocation" actual_result

      descr = name ++ " allocation"

      ldescr = "after " ++ map toLower descr

{-

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

handleCall cdata QueryClusterInfo =

  let cluster = configCluster cdata

      hypervisors = clusterEnabledHypervisors cluster

      bits = show (bitSize (0::Int)) ++ "bits"

      arch_tuple = [bits, arch]

      obj = [ ("software_version", showJSON C.releaseVersion)

            , ("architecture", showJSON arch_tuple)

            , ("name", showJSON $ clusterClusterName cluster)

            , ("master", showJSON $ clusterMasterNode cluster)

            , ("enabled_hypervisors", showJSON hypervisors)

            , ("hvparams", showJSON $ clusterHvparams cluster)

            , ("os_hvp", showJSON $ clusterOsHvp cluster)

  , chompPrefix

  , wrap

  , trim

  ) where

import Data.Char (toUpper, isAlphaNum, isDigit, isSpace)

-- strings.

trim :: String -> String

trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace

warn = length x > 0 ==> not (null x)

warn = length x /= 0 ==> not (null x)

warn = length x == 0 ==> null x

            -> c

passFailOpt defaults failfn passfn

              (opt@(GetOpt.Option _ longs _ _, _), bad, good) =

      good_cmd = prefix ++ good

      bad_cmd = prefix ++ bad in

  case (parseOptsInner defaults [bad_cmd]  "prog" [opt] [],

{-

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

prop_nameOf :: Node.Node -> Property

prop_nameOf node =

  let nl = makeSmallCluster node 1

-- | We test that in a cluster, given a random node, we can find it by

-- its name and alias, as long as all names and aliases are unique,

{-

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

case_JobStatusPri_py_equiv :: Assertion

case_JobStatusPri_py_equiv = do

  let num_jobs = 2000::Int

  -- check for non-ASCII fields, usually due to 'arbitrary :: String'

  mapM_ (\job -> when (any (not . isAscii) (encode job)) .

                 assertFailure $ "Job has non-ASCII fields: " ++ show job

{-

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

case_py_compat_networks :: HUnit.Assertion

case_py_compat_networks = do

  let num_networks = 500::Int

      serialized = J.encode networks

  -- check for non-ASCII fields, usually due to 'arbitrary :: String'

  mapM_ (\net -> when (any (not . isAscii) (J.encode net)) .

case_py_compat_nodegroups :: HUnit.Assertion

case_py_compat_nodegroups = do

  let num_groups = 500::Int

  -- check for non-ASCII fields, usually due to 'arbitrary :: String'

  mapM_ (\group -> when (any (not . isAscii) (J.encode group)) .

                 HUnit.assertFailure $

{-

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

case_py_compat_types :: HUnit.Assertion

case_py_compat_types = do

  let num_opcodes = length OpCodes.allOpIDs * 100

                             OpCodes.metaOpCode o, o)) opcodes

      serialized = J.encode opcodes

  -- check for non-ASCII fields, usually due to 'arbitrary :: String'

{-

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

readTestData filename = do

    name <- testDataFilename "/test/data/" filename

    readFile name

            -> Gen Prop -- ^ Test result

prop_select def lst1 lst2 =

  select def (flist ++ tlist) ==? expectedresult

          flist = zip (repeat False) lst1

          tlist = zip (repeat True)  lst2

-- | Test basic select functionality with undefined default

prop_select_undefd :: [Int]            -- ^ List of False values

                   -> NonEmptyList Int -- ^ List of True values

                   -> Gen Prop         -- ^ Test result

prop_select_undefd lst1 (NonEmpty lst2) =

  select undefined (flist ++ tlist) ==? head lst2

    where flist = zip (repeat False) lst1

          tlist = zip (repeat True)  lst2

-- | Test basic select functionality with undefined list values

prop_select_undefv :: [Int]            -- ^ List of False values

                   -> NonEmptyList Int -- ^ List of True values

                   -> Gen Prop         -- ^ Test result

prop_select_undefv lst1 (NonEmpty lst2) =

  select undefined cndlist ==? head lst2

    where flist = zip (repeat False) lst1

          tlist = zip (repeat True)  lst2