Synnefo » snf-ganeti

  , eitherToResult

  , annotateResult

  , annotateIOError

  ) where

import Control.Monad

-- | This is similar to the JSON library Result type - /very/ similar,

-- but we want to use it in multiple places, so we abstract it into a

annotateIOError :: String -> IOError -> IO (Result a)

annotateIOError description exc =

  return . Bad $ description ++ ": " ++ show exc

import Ganeti.Config

import Ganeti.Hash

import Ganeti.Logging

import qualified Ganeti.Constants as C

-- * Types and constants definitions

main :: DaemonOptions -> IO ()

main opts = do

  parseresult <- parseAddress opts C.defaultConfdPort

  s <- S.socket af_family S.Datagram S.defaultProtocol

  S.bindSocket s bindaddr

  cref <- newIORef (Bad "Configuration not yet loaded")

    (opt_list, args, []) ->

      do

        parsed_opts <-

        return (parsed_opts, args)

    (_, _, errs) -> do

      hPutStrLn stderr $ "Command line error: "  ++ concat errs

           compilerName (Data.Version.showVersion compilerVersion)

           os arch :: IO ()

    exitWith ExitSuccess

  unless (optNoUserChecks opts) $ do

    runtimeEnts <- getEnts

  syslog <- case optSyslogUsage opts of

                         syslogUsageFromRaw C.syslogUsage

              Just v -> return v

  let processFn = if optDaemonize opts then daemonize else id

  setupLogging (daemonLogFile daemon) (daemonName daemon) (optDebug opts)

                 (not (optDaemonize opts)) False syslog

  pid_fd <- writePidFile (daemonPidFile daemon)

  logNotice "starting"

  main

import System.IO

import System.Info

import System.Exit

import qualified Ganeti.HTools.Version as Version(version)

import qualified Ganeti.HTools.Container as Container

      m_dsk = optMdsk opts

  unless (null offline_wrong) $ do

  let setMCpuFn = case m_cpu of

                    Nothing -> id

                    Just new_mcpu -> flip Node.setMcpu new_mcpu

{-

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

import Data.Maybe (isJust, fromJust)

import System.FilePath

import System.IO

import Text.Printf (hPrintf)

import qualified Ganeti.HTools.Luxi as Luxi

import Ganeti.HTools.Types

import Ganeti.HTools.CLI

-- | Error beautifier.

wrapIO :: IO (Result a) -> IO (Result a)

      selInsts = optSelInst opts

      exInsts = optExInst opts

  util_contents <- maybe (return "") readFile (optDynuFile opts)

  input_data <-

    case () of

      _ | setRapi -> wrapIO $ Rapi.loadData mhost

        | setIAllocSrc -> wrapIO $ IAlloc.loadData $ fromJust iallocsrc

        | otherwise -> return $ Bad "No backend selected! Exiting."

  let (fix_msgs, nl) = checkData (cdNodes cdata) (cdInstances cdata)

  unless (optVerbose opts == 0) $ maybeShowWarnings fix_msgs

import Data.List

import Data.Maybe (fromMaybe)

import Data.Ord (comparing)

import System.IO

import Text.Printf (printf, hPrintf)

  let fin_stats = Cluster.totalResources fin_nl

      fin_instances = num_instances + allocs

  printKeys $ printStats PFinal fin_stats

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

sortReasons :: [(FailMode, Int)] -> [(FailMode, Int)]

sortReasons = reverse . sortBy (comparing snd)

-- | Runs an allocation algorithm and saves cluster state.

runAllocation :: ClusterData                -- ^ Cluster data

              -> Maybe Cluster.AllocResult  -- ^ Optional stop-allocation

  (reasons, new_nl, new_il, new_ixes, _) <-

      case stop_allocation of

        Just result_noalloc -> return result_noalloc

  let name = head . words . specDescription $ mode

      descr = name ++ " allocation"

-- | Main function.

main :: Options -> [String] -> IO ()

main opts args = do

  let verbose = optVerbose opts

      machine_r = optMachineReadable opts

  cluster_disk_template <-

    case iPolicyDiskTemplates ipol of

      first_templ:_ -> return first_templ

  let num_instances = Container.size il

      all_nodes = Container.elems fixed_nl

                   then Nothing

                   else Just (optMaxLength opts)

  -- Run the tiered allocation

  , printTable

  , parseUnit

  , plural

  ) where

import Data.Char (toUpper)

import Debug.Trace

-- * Debug functions

-- | To be used only for debugging, breaks referential integrity.

        scaling <- parseUnitValue unit

        return $ truncate (fromIntegral v * scaling)

    _ -> fail $ "Can't parse string '" ++ str ++ "'"