Synnefo » snf-ganeti » ganeti-local

                 if Instance.snode elem == Node.noSecondary then step_tbl

                  if sdx /= Node.noSecondary then

loadData :: ([(String, Int)], Node.AssocList,

             [(String, Int)], Instance.AssocList) -- ^ Data from either

                                                  -- Text.loadData

                                                  -- or Rapi.loadData

         -> Result (NodeList, InstanceList, String, NameList, NameList)

loadData (ktn, nl, kti, il) = do

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

type AssocList = [(Int, Instance)]

{-| Loading data from external sources

This module holds the common code for loading the cluster state from external sources.

-}

module Ganeti.HTools.Loader

    where

type NameAssoc = [(String, Int)]

-- | Lookups a node into an assoc list

lookupNode :: (Monad m) => NameAssoc -> String -> String -> m Int

lookupNode ktn inst node =

    case lookup node ktn of

      Nothing -> fail $ "Unknown node '" ++ node ++ "' for instance " ++ inst

      Just idx -> return idx

assignIndices :: (a -> Int -> a)

              -> [(String, a)]

              -> (NameAssoc, [(Int, a)])

assignIndices set_fn =

    unzip . map (\ (idx, (k, v)) -> ((k, idx), (idx, set_fn v idx)))

          . zip [0..]

    -- * Misc stuff

    , AssocList

    , noSecondary

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

type AssocList = [(Int, Node)]

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

noSecondary :: Int

noSecondary = -1

      loadData

import Ganeti.HTools.Loader

import qualified Ganeti.HTools.Node as Node

import qualified Ganeti.HTools.Instance as Instance

getInstances :: NameAssoc

             -> String

             -> Result [(String, Instance.Instance)]

getInstances ktn body = do

  arr <- loadJSArray body

  ilist <- mapM (parseInstance ktn) arr

  return ilist

getNodes :: String -> Result [(String, Node.Node)]

getNodes body = do

  arr <- loadJSArray body

  nlist <- mapM parseNode arr

  return nlist

parseInstance :: [(String, Int)]

              -> JSObject JSValue

              -> Result (String, Instance.Instance)

parseInstance ktn a = do

  name <- fromObj "name" a

  disk <- fromObj "disk_usage" a

  mem <- fromObj "beparams" a >>= fromObj "memory"

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

  snodes <- getListElement "snodes" a

  snode <- (if null snodes then return Node.noSecondary

            else readEitherString (head snodes) >>= lookupNode ktn name)

  running <- fromObj "status" a

  let inst = Instance.create mem disk running pnode snode

  return (name, inst)

parseNode :: JSObject JSValue -> Result (String, Node.Node)

parseNode a = do

    name <- fromObj "name" a

    offline <- fromObj "offline" a

    node <- (case offline of

               True -> return $ Node.create 0 0 0 0 0 True

               _ -> do

                 drained <- fromObj "drained" a

                 mtotal <- fromObj "mtotal" a

                 mnode <- fromObj "mnode" a

                 mfree <- fromObj "mfree" a

                 dtotal <- fromObj "dtotal" a

                 dfree <- fromObj "dfree" a

                 return $ Node.create mtotal mnode mfree

                        dtotal dfree (offline || drained))

    return (name, node)

loadData :: String -- ^ Cluster/URL to use as source

         -> IO (Result (NameAssoc, Node.AssocList,

                        NameAssoc, Instance.AssocList))

loadData master = do -- IO monad

  let url = formatHost master

  node_body <- getUrl $ printf "%s/2/nodes?bulk=1" url

  inst_body <- getUrl $ printf "%s/2/instances?bulk=1" url

  return $ do -- Result monad

    node_data <- node_body >>= getNodes

    let (node_names, node_idx) = assignIndices Node.setIdx node_data

    inst_data <- inst_body >>= getInstances node_names

    let (inst_names, inst_idx) = assignIndices Instance.setIdx inst_data

    return (node_names, node_idx, inst_names, inst_idx)

{-| Parsing data from text-files

This module holds the code for loading the cluster state from text

files, as produced by gnt-node/gnt-instance list.

-}

module Ganeti.HTools.Text

    where

import Control.Monad

import Ganeti.HTools.Utils

import Ganeti.HTools.Loader

import qualified Ganeti.HTools.Node as Node

import qualified Ganeti.HTools.Instance as Instance

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

tryRead :: (Monad m, Read a) => String -> String -> m a

tryRead name s =

    let sols = readsPrec 0 s

    in case sols of

         (v, ""):[] -> return v

         (_, e):[] -> fail $ name ++ ": leftover characters when parsing '"

                      ++ s ++ "': '" ++ e ++ "'"

         _ -> fail $ name ++ ": cannot parse string '" ++ s ++ "'"

-- | Load a node from a field list

loadNode :: (Monad m) => [String] -> m (String, Node.Node)

loadNode (name:tm:nm:fm:td:fd:fo:[]) = do

  new_node <-

      if any (== "?") [tm,nm,fm,td,fd] || fo == "Y" then

          return $ Node.create 0 0 0 0 0 True

      else do

        vtm <- tryRead name tm

        vnm <- tryRead name nm

        vfm <- tryRead name fm

        vtd <- tryRead name td

        vfd <- tryRead name fd

        return $ Node.create vtm vnm vfm vtd vfd False

  return (name, new_node)

loadNode s = fail $ "Invalid/incomplete node data: '" ++ (show s) ++ "'"

-- | Load an instance from a field list

loadInst :: (Monad m) =>

            [(String, Int)] -> [String] -> m (String, Instance.Instance)

loadInst ktn (name:mem:dsk:status:pnode:snode:[]) = do

  pidx <- lookupNode ktn name pnode

  sidx <- (if null snode then return Node.noSecondary

           else lookupNode ktn name snode)

  vmem <- tryRead name mem

  vdsk <- tryRead name dsk

  when (sidx == pidx) $ fail $ "Instance " ++ name ++

           " has same primary and secondary node - " ++ pnode

  let newinst = Instance.create vmem vdsk status pidx sidx

  return (name, newinst)

loadInst _ s = fail $ "Invalid/incomplete instance data: '" ++ (show s) ++ "'"

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

-}

loadTabular :: (Monad m) => String -> ([String] -> m (String, a))

            -> (a -> Int -> a) -> m ([(String, Int)], [(Int, a)])

loadTabular text_data convert_fn set_fn = do

  let lines_data = lines text_data

      rows = map (sepSplit '|') lines_data

  kerows <- mapM convert_fn rows

  return $ assignIndices set_fn kerows

loadData :: String -- ^ Node data in string format

         -> String -- ^ Instance data in string format

         -> IO (Result (NameAssoc, Node.AssocList,

                        NameAssoc, Instance.AssocList))

loadData nfile ifile = do -- IO monad

  ndata <- readFile nfile

  idata <- readFile ifile

  return $ do

    {- node file: name t_mem n_mem f_mem t_disk f_disk -}

    (ktn, nl) <- loadTabular ndata loadNode Node.setIdx

    {- instance file: name mem disk status pnode snode -}

    (kti, il) <- loadTabular idata (loadInst ktn) Instance.setIdx

    return (ktn, nl, kti, il)

import qualified Ganeti.HTools.Rapi as Rapi

import qualified Ganeti.HTools.Text as Text

  input_data <-

      case optMaster opts of

        "" -> Text.loadData nodef instf

        host -> Rapi.loadData host

  let ldresult = input_data >> Cluster.loadData

import qualified Ganeti.HTools.Rapi as Rapi

import qualified Ganeti.HTools.Text as Text

  input_data <-

      case optMaster opts of

        "" -> Text.loadData nodef instf

        host -> Rapi.loadData host

  let ldresult = input_data >>= Cluster.loadData

import qualified Ganeti.HTools.Rapi as Rapi

              input_data <- Rapi.loadData name

              let ldresult = input_data >>= Cluster.loadData