module Ganeti.DataCollectors.CPUload
( dcName
, dcVersion
, dcFormatVersion
, dcCategory
, dcKind
, dcReport
, dcUpdate
) where
import Control.Arrow (first)
import qualified Control.Exception as E
import Control.Monad (liftM)
import Data.Attoparsec.Text.Lazy as A
import Data.Maybe (fromMaybe)
import Data.Text.Lazy (pack, unpack)
import qualified Text.JSON as J
import qualified Data.Sequence as Seq
import System.Posix.Unistd (getSysVar, SysVar(ClockTick))
import System.Time (ClockTime(..), getClockTime)
import qualified Ganeti.BasicTypes as BT
import qualified Ganeti.Constants as C
import Ganeti.Cpu.LoadParser(cpustatParser)
import Ganeti.DataCollectors.Types
import qualified Ganeti.JSON as GJ
import Ganeti.Utils
import Ganeti.Cpu.Types
defaultFile :: FilePath
defaultFile = C.statFile
bufferSize :: Int
bufferSize = C.cpuavgloadBufferSize
windowSizeInUSec :: Integer
windowSizeInUSec = 1000000 * toInteger C.cpuavgloadWindowSize
defaultCharNum :: Int
defaultCharNum = 80*20
dcName :: String
dcName = C.dataCollectorCPULoad
dcVersion :: DCVersion
dcVersion = DCVerBuiltin
dcFormatVersion :: Int
dcFormatVersion = 1
dcCategory :: Maybe DCCategory
dcCategory = Nothing
dcKind :: DCKind
dcKind = DCKPerf
dcReport :: Maybe CollectorData -> IO DCReport
dcReport colData =
let extractColData c = case c of
(CPULoadData v) -> Just v
_ -> Nothing
cpuLoadData = fromMaybe Seq.empty $ colData >>= extractColData
in buildDCReport cpuLoadData
type Buffer = Seq.Seq (ClockTime, [Integer])
computeLoad :: CPUstat -> Integer
computeLoad cpuData =
csUser cpuData + csNice cpuData + csSystem cpuData
+ csIowait cpuData + csIrq cpuData + csSoftirq cpuData
+ csSteal cpuData + csGuest cpuData + csGuestNice cpuData
dcCollectFromFile :: FilePath -> IO (ClockTime, [Integer])
dcCollectFromFile inputFile = do
contents <-
((E.try $ readFile inputFile) :: IO (Either IOError String)) >>=
exitIfBad "reading from file" . either (BT.Bad . show) BT.Ok
cpustatData <-
case A.parse cpustatParser $ pack contents of
A.Fail unparsedText contexts errorMessage -> exitErr $
show (Prelude.take defaultCharNum $ unpack unparsedText) ++ "\n"
++ show contexts ++ "\n" ++ errorMessage
A.Done _ cpustatD -> return cpustatD
now <- getClockTime
return (now, map computeLoad cpustatData)
dcCollect :: IO Buffer
dcCollect = do
l <- dcCollectFromFile defaultFile
return (Seq.singleton l)
formatData :: [Double] -> CPUavgload
formatData [] = CPUavgload (0 :: Int) [] (0 :: Double)
formatData l@(x:xs) = CPUavgload (length l 1) xs x
updateEntry :: Buffer -> Buffer -> Buffer
updateEntry newBuffer mapEntry =
(Seq.><) newBuffer (Seq.take bufferSize mapEntry)
dcUpdate :: Maybe CollectorData -> IO CollectorData
dcUpdate mcd = do
v <- dcCollect
let new_v = fromMaybe v $ do
cd <- mcd
case cd of
CPULoadData old_v -> return $ updateEntry v old_v
_ -> Nothing
new_v `seq` return $ CPULoadData new_v
computeAverage :: Buffer -> Integer -> Integer -> BT.Result [Double]
computeAverage s w ticks =
let inUSec = fmap (first clockTimeToUSec) s
window = Seq.takeWhileL ((> w) . fst) inUSec
go Seq.EmptyL _ = BT.Bad "Empty buffer"
go _ Seq.EmptyR = BT.Bad "Empty buffer"
go (leftmost Seq.:< _) (_ Seq.:> rightmost) = do
let (timestampL, listL) = leftmost
(timestampR, listR) = rightmost
workInWindow = zipWith () listL listR
timediff = timestampL timestampR
overall = fromIntegral (timediff * ticks) / 1000000 :: Double
if overall > 0
then BT.Ok $ map (flip (/) overall . fromIntegral) workInWindow
else BT.Bad $ "Time covered by data is not sufficient."
++ "The window considered is " ++ show w
in go (Seq.viewl window) (Seq.viewr window)
buildJsonReport :: Buffer -> IO J.JSValue
buildJsonReport v = do
ticks <- getSysVar ClockTick
now <- liftM clockTimeToUSec getClockTime
let res = computeAverage v (now windowSizeInUSec) ticks
showError s = J.showJSON $ GJ.containerFromList [("error", s)]
return $ BT.genericResult showError (J.showJSON . formatData) res
buildDCReport :: Buffer -> IO DCReport
buildDCReport v =
buildJsonReport v >>=
buildReport dcName dcVersion dcFormatVersion dcCategory dcKind