From 8287e45b62d0d310512574850bad4741c4b3a53d Mon Sep 17 00:00:00 2001 From: Michal Zielonka Date: Mon, 11 Oct 2021 23:11:30 +0200 Subject: add top for freebsd proc In FreeBSD /proc/pid/stat is missing we should use for top procstat library. --- .github/workflows/haskell.yml | 1 + src/Xmobar/Plugins/Monitors/Top.hs | 109 +++++---------------- src/Xmobar/Plugins/Monitors/Top/Common.hs | 32 +++++++ src/Xmobar/Plugins/Monitors/Top/FreeBSD.hsc | 143 ++++++++++++++++++++++++++++ src/Xmobar/Plugins/Monitors/Top/Linux.hs | 92 ++++++++++++++++++ xmobar.cabal | 4 + 6 files changed, 298 insertions(+), 83 deletions(-) create mode 100644 src/Xmobar/Plugins/Monitors/Top/Common.hs create mode 100644 src/Xmobar/Plugins/Monitors/Top/FreeBSD.hsc create mode 100644 src/Xmobar/Plugins/Monitors/Top/Linux.hs diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index 8b195ab..e720e9e 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -36,6 +36,7 @@ jobs: - name: Install packages run: | + sudo apt-get update sudo apt-get install -y xorg-dev sudo apt-get install -y libasound2-dev libxpm-dev libmpd-dev libxrandr-dev sudo apt-get install -y happy c2hs hspec-discover diff --git a/src/Xmobar/Plugins/Monitors/Top.hs b/src/Xmobar/Plugins/Monitors/Top.hs index d6df249..e99ec3b 100644 --- a/src/Xmobar/Plugins/Monitors/Top.hs +++ b/src/Xmobar/Plugins/Monitors/Top.hs @@ -1,3 +1,5 @@ +{-#LANGUAGE CPP #-} +{-# LANGUAGE BangPatterns #-} ----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Top @@ -12,24 +14,27 @@ -- ----------------------------------------------------------------------------- -{-# LANGUAGE ForeignFunctionInterface #-} -{-# LANGUAGE BangPatterns #-} - module Xmobar.Plugins.Monitors.Top (startTop, topMemConfig, runTopMem) where import Xmobar.Plugins.Monitors.Common -import Control.Exception (SomeException, handle) -import Data.IORef (IORef, newIORef, readIORef, writeIORef) -import Data.List (sortBy, foldl') +import Data.IORef (newIORef, readIORef, writeIORef) +import Data.List (sortBy) import Data.Ord (comparing) -import Data.Time.Clock (UTCTime, getCurrentTime, diffUTCTime) -import System.Directory (getDirectoryContents) -import System.FilePath (()) -import System.IO (IOMode(ReadMode), hGetLine, withFile) -import System.Posix.Unistd (SysVar(ClockTick), getSysVar) +import Data.Time.Clock (getCurrentTime, diffUTCTime) + +import Xmobar.Plugins.Monitors.Top.Common ( + MemInfo + , TimeInfo + , Times + , TimesRef) + +#if defined(freebsd_HOST_OS) +import qualified Xmobar.Plugins.Monitors.Top.FreeBSD as MT +#else +import qualified Xmobar.Plugins.Monitors.Top.Linux as MT +#endif -import Foreign.C.Types maxEntries :: Int maxEntries = 10 @@ -47,41 +52,6 @@ topConfig = mkMConfig "" , k <- [ "name", "cpu", "both" , "mname", "mem", "mboth"]]) -foreign import ccall "unistd.h getpagesize" - c_getpagesize :: CInt - -pageSize :: Float -pageSize = fromIntegral c_getpagesize / 1024 - -processes :: IO [FilePath] -processes = fmap (filter isPid) (getDirectoryContents "/proc") - where isPid = (`elem` ['0'..'9']) . head - -statWords :: [String] -> [String] -statWords line@(x:pn:ppn:xs) = - if last pn == ')' then line else statWords (x:(pn ++ " " ++ ppn):xs) -statWords _ = replicate 52 "0" - -getProcessData :: FilePath -> IO [String] -getProcessData pidf = - handle ign $ withFile ("/proc" pidf "stat") ReadMode readWords - where readWords = fmap (statWords . words) . hGetLine - ign = const (return []) :: SomeException -> IO [String] - -memPages :: [String] -> String -memPages fs = fs!!23 - -ppid :: [String] -> String -ppid fs = fs!!3 - -skip :: [String] -> Bool -skip fs = length fs < 24 || memPages fs == "0" || ppid fs == "0" - -handleProcesses :: ([String] -> a) -> IO [a] -handleProcesses f = - fmap (foldl' (\a p -> if skip p then a else f p : a) []) - (processes >>= mapM getProcessData) - showInfo :: String -> String -> Float -> Monitor [String] showInfo nm sms mms = do mnw <- getConfigValue maxWidth @@ -94,20 +64,10 @@ showInfo nm sms mms = do both <- showWithColors' (rnm ++ " " ++ sms) mms return [nm, mstr, both] -processName :: [String] -> String -processName = drop 1 . init . (!!1) sortTop :: [(String, Float)] -> [(String, Float)] sortTop = sortBy (flip (comparing snd)) -type MemInfo = (String, Float) - -meminfo :: [String] -> MemInfo -meminfo fs = (processName fs, pageSize * parseFloat (fs!!23)) - -meminfos :: IO [MemInfo] -meminfos = handleProcesses meminfo - showMemInfo :: Float -> MemInfo -> Monitor [String] showMemInfo scale (nm, rss) = showInfo nm (showWithUnits 3 1 rss) (100 * rss / sc) @@ -117,30 +77,8 @@ showMemInfos :: [MemInfo] -> Monitor [[String]] showMemInfos ms = mapM (showMemInfo tm) ms where tm = sum (map snd ms) -runTopMem :: [String] -> Monitor String -runTopMem _ = do - mis <- io meminfos - pstr <- showMemInfos (sortTop mis) - parseTemplate $ concat pstr - -type Pid = Int -type TimeInfo = (String, Float) -type TimeEntry = (Pid, TimeInfo) -type Times = [TimeEntry] -type TimesRef = IORef (Times, UTCTime) - -timeMemEntry :: [String] -> (TimeEntry, MemInfo) -timeMemEntry fs = ((p, (n, t)), (n, r)) - where p = parseInt (head fs) - n = processName fs - t = parseFloat (fs!!13) + parseFloat (fs!!14) - (_, r) = meminfo fs - -timeMemEntries :: IO [(TimeEntry, MemInfo)] -timeMemEntries = handleProcesses timeMemEntry - timeMemInfos :: IO (Times, [MemInfo], Int) -timeMemInfos = fmap res timeMemEntries +timeMemInfos = fmap res MT.timeMemEntries where res x = (sortBy (comparing fst) $ map fst x, map snd x, length x) combine :: Times -> Times -> Times @@ -164,7 +102,7 @@ topProcesses tref scale = do c1 <- getCurrentTime let scx = realToFrac (diffUTCTime c1 c0) * scale !scx' = if scx > 0 then scx else scale - nts = map (\(_, (nm, t)) -> (nm, min 100 (t / scx'))) (combine t0 t1) + nts = map (\(_, (nm, t)) -> (nm, t / scx')) (combine t0 t1) !t1' = take' (length t1) t1 !nts' = take' maxEntries (sortTop nts) !mis' = take' maxEntries (sortTop mis) @@ -178,6 +116,12 @@ showTimeInfo (n, t) = showTimeInfos :: [TimeInfo] -> Monitor [[String]] showTimeInfos = mapM showTimeInfo +runTopMem :: [String] -> Monitor String +runTopMem _ = do + mis <- io MT.meminfos + pstr <- showMemInfos (sortTop mis) + parseTemplate $ concat pstr + runTop :: TimesRef -> Float -> [String] -> Monitor String runTop tref scale _ = do (no, ps, ms) <- io $ topProcesses tref scale @@ -187,9 +131,8 @@ runTop tref scale _ = do startTop :: [String] -> Int -> (String -> IO ()) -> IO () startTop a r cb = do - cr <- getSysVar ClockTick c <- getCurrentTime tref <- newIORef ([], c) - let scale = fromIntegral cr / 100 + scale <- MT.scale _ <- topProcesses tref scale runM a topConfig (runTop tref scale) r cb diff --git a/src/Xmobar/Plugins/Monitors/Top/Common.hs b/src/Xmobar/Plugins/Monitors/Top/Common.hs new file mode 100644 index 0000000..74b6fdd --- /dev/null +++ b/src/Xmobar/Plugins/Monitors/Top/Common.hs @@ -0,0 +1,32 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Plugins.Monitors.Top.Common +-- Copyright : (c) 2010, 2011, 2012, 2013, 2014, 2018 Jose A Ortega Ruiz +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Jose A Ortega Ruiz +-- Stability : unstable +-- Portability : unportable +-- +-- Process activity and memory consumption monitors +-- +----------------------------------------------------------------------------- + +module Xmobar.Plugins.Monitors.Top.Common ( + MemInfo + , Pid + , TimeInfo + , TimeEntry + , Times + , TimesRef + ) where + +import Data.IORef (IORef) +import Data.Time.Clock (UTCTime) + +type MemInfo = (String, Float) +type Pid = Int +type TimeInfo = (String, Float) +type TimeEntry = (Pid, TimeInfo) +type Times = [TimeEntry] +type TimesRef = IORef (Times, UTCTime) diff --git a/src/Xmobar/Plugins/Monitors/Top/FreeBSD.hsc b/src/Xmobar/Plugins/Monitors/Top/FreeBSD.hsc new file mode 100644 index 0000000..cb822ef --- /dev/null +++ b/src/Xmobar/Plugins/Monitors/Top/FreeBSD.hsc @@ -0,0 +1,143 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE EmptyDataDecls #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CApiFFI #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Plugins.Monitors.Top.FreeBSD +-- Copyright : (c) 2010, 2011, 2012, 2013, 2014, 2018 Jose A Ortega Ruiz +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Jose A Ortega Ruiz +-- Stability : unstable +-- Portability : unportable +-- +-- Process activity and memory consumption monitors +-- +----------------------------------------------------------------------------- + +module Xmobar.Plugins.Monitors.Top.FreeBSD ( + timeMemEntries + , meminfos + , scale) where + +import Foreign +import Foreign.C.Types +import Foreign.C.String + +import Xmobar.Plugins.Monitors.Top.Common (MemInfo, TimeEntry) + +#include +#include +#include +#include + +foreign import ccall "unistd.h getpagesize" c_getpagesize :: CInt +foreign import ccall unsafe "libprocstat.h procstat_open_sysctl" c_procstat_open_sysctl :: IO (Ptr PROCSTAT) +foreign import ccall "&procstat_close" c_procstat_close :: FinalizerPtr PROCSTAT +foreign import ccall "&procstat_freeprocs" c_procstat_freeprocs :: FinalizerEnvPtr PROCSTAT KINFO_PROC +foreign import ccall unsafe "libprocstat.h procstat_getprocs" c_procstat_getprocs :: Ptr PROCSTAT -> CInt -> CInt -> Ptr CUInt -> IO (Ptr KINFO_PROC) + +data PROCSTAT +data ProcStat = ProcStat !(ForeignPtr PROCSTAT) + deriving (Eq, Ord, Show) + +data KINFO_PROC +data KinfoProc = KinfoProc [ProcData] Int + deriving (Eq, Show) + +data ProcData = ProcData { + pname :: String + , cpu :: Float + , tdflags :: CULong + , flag :: CULong + , stat :: CUChar + , rss :: Float + , pid :: Int + , runtime :: Float + } + deriving (Show, Read, Eq) + +instance Storable ProcData where + alignment _ = #{alignment struct kinfo_proc} + sizeOf _ = #{size struct kinfo_proc} + peek ptr = do + c <- #{peek struct kinfo_proc, ki_pctcpu} ptr + ctdflags <- #{peek struct kinfo_proc, ki_tdflags} ptr + cflag <- #{peek struct kinfo_proc, ki_flag} ptr + cstat <- #{peek struct kinfo_proc, ki_stat} ptr + cruntime <- #{peek struct kinfo_proc, ki_runtime} ptr :: IO CULong + crss <- #{peek struct kinfo_proc, ki_rssize} ptr :: IO CULong + cname <- peekCString (ptr `plusPtr` (#offset struct kinfo_proc, ki_comm)) + cpid <- #{peek struct kinfo_proc, ki_pid} ptr + let crssf = (fromIntegral . toInteger) crss + let cruntimef = ((fromIntegral . toInteger) cruntime + 500000) / 10000 + return $ ProcData { + pname = cname + , cpu = (pctdouble c) * 100 + , tdflags = ctdflags + , stat = cstat + , flag = cflag + , rss = crssf * pageSize + , pid = cpid + , runtime = cruntimef} + + poke _ _ = pure () + +pctdouble :: Int -> Float +pctdouble p = (fromIntegral p) / #{const FSCALE} + + +pageSize :: Float +pageSize = fromIntegral c_getpagesize / 1024 + + +getProcStat:: IO ProcStat +getProcStat = do + proc_ptr <- c_procstat_open_sysctl + ptr <- newForeignPtr c_procstat_close proc_ptr + return $ ProcStat ptr + + +getProcessesInfo :: ProcStat -> IO [ProcData] +getProcessesInfo (ProcStat ps_fp) = do + withForeignPtr ps_fp $ \ps_ptr -> do + alloca $ \n_ptr -> do + kinfo_proc_ptr <- c_procstat_getprocs ps_ptr #{const KERN_PROC_PROC} 0 n_ptr + newForeignPtrEnv c_procstat_freeprocs ps_ptr kinfo_proc_ptr + num <- peek (n_ptr :: Ptr CUInt) + pds <- peekArray (fromIntegral num) $ castPtr kinfo_proc_ptr :: IO [ProcData] + + return $ [p | p <- pds, flag p .&. #{const P_SYSTEM} == 0] + + +processes :: IO [ProcData] +processes = do + proc_stat <- getProcStat + getProcessesInfo proc_stat + +handleProcesses :: (ProcData -> a) -> IO [a] +handleProcesses f = do + ps <- processes + return $ fmap (\pd -> f pd) ps + +meminfo :: ProcData -> MemInfo +meminfo pd = (pname pd, rss pd) + +meminfos :: IO [MemInfo] +meminfos = handleProcesses meminfo + +timeMemEntry :: ProcData -> (TimeEntry, MemInfo) +timeMemEntry pd = ((p, (n, t)), (n, r)) + where p = pid pd + n = pname pd + t = runtime pd + (_, r) = meminfo pd + +timeMemEntries :: IO [(TimeEntry, MemInfo)] +timeMemEntries = handleProcesses timeMemEntry + +scale :: IO Float +scale = return 1 diff --git a/src/Xmobar/Plugins/Monitors/Top/Linux.hs b/src/Xmobar/Plugins/Monitors/Top/Linux.hs new file mode 100644 index 0000000..715a7cd --- /dev/null +++ b/src/Xmobar/Plugins/Monitors/Top/Linux.hs @@ -0,0 +1,92 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Plugins.Monitors.Top.Linux +-- Copyright : (c) 2010, 2011, 2012, 2013, 2014, 2018 Jose A Ortega Ruiz +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Jose A Ortega Ruiz +-- Stability : unstable +-- Portability : unportable +-- +-- Process activity and memory consumption monitors +-- +----------------------------------------------------------------------------- + +{-# LANGUAGE ForeignFunctionInterface #-} + +module Xmobar.Plugins.Monitors.Top.Linux ( + timeMemEntries + , meminfos + , scale) where + +import Xmobar.Plugins.Monitors.Common (parseFloat, parseInt) +import Xmobar.Plugins.Monitors.Top.Common (MemInfo, TimeEntry) + +import Control.Exception (SomeException, handle) +import Data.List (foldl') +import System.Directory (getDirectoryContents) +import System.FilePath (()) +import System.IO (IOMode(ReadMode), hGetLine, withFile) +import System.Posix.Unistd (SysVar(ClockTick), getSysVar) + +import Foreign.C.Types + +foreign import ccall "unistd.h getpagesize" + c_getpagesize :: CInt + +pageSize :: Float +pageSize = fromIntegral c_getpagesize / 1024 + +processes :: IO [FilePath] +processes = fmap (filter isPid) (getDirectoryContents "/proc") + where isPid = (`elem` ['0'..'9']) . head + +statWords :: [String] -> [String] +statWords line@(x:pn:ppn:xs) = + if last pn == ')' then line else statWords (x:(pn ++ " " ++ ppn):xs) +statWords _ = replicate 52 "0" + +getProcessData :: FilePath -> IO [String] +getProcessData pidf = + handle ign $ withFile ("/proc" pidf "stat") ReadMode readWords + where readWords = fmap (statWords . words) . hGetLine + ign = const (return []) :: SomeException -> IO [String] + +memPages :: [String] -> String +memPages fs = fs!!23 + +ppid :: [String] -> String +ppid fs = fs!!3 + +skip :: [String] -> Bool +skip fs = length fs < 24 || memPages fs == "0" || ppid fs == "0" + +handleProcesses :: ([String] -> a) -> IO [a] +handleProcesses f = + fmap (foldl' (\a p -> if skip p then a else f p : a) []) + (processes >>= mapM getProcessData) + +processName :: [String] -> String +processName = drop 1 . init . (!!1) + +meminfo :: [String] -> MemInfo +meminfo fs = (processName fs, pageSize * parseFloat (fs!!23)) + +meminfos :: IO [MemInfo] +meminfos = handleProcesses meminfo + +timeMemEntry :: [String] -> (TimeEntry, MemInfo) +timeMemEntry fs = ((p, (n, t)), (n, r)) + where p = parseInt (head fs) + n = processName fs + t = parseFloat (fs!!13) + parseFloat (fs!!14) + (_, r) = meminfo fs + +timeMemEntries :: IO [(TimeEntry, MemInfo)] +timeMemEntries = handleProcesses timeMemEntry + + +scale :: IO Float +scale = do + cr <- getSysVar ClockTick + return $ fromIntegral cr / 100 diff --git a/xmobar.cabal b/xmobar.cabal index dadbe59..721e849 100644 --- a/xmobar.cabal +++ b/xmobar.cabal @@ -168,6 +168,7 @@ library Xmobar.Plugins.Monitors.Thermal, Xmobar.Plugins.Monitors.ThermalZone, Xmobar.Plugins.Monitors.Top, + Xmobar.Plugins.Monitors.Top.Common, Xmobar.Plugins.Monitors.Uptime, Xmobar.Plugins.Monitors.Bright, Xmobar.Plugins.Monitors.CatInt @@ -294,12 +295,14 @@ library if os(freebsd) -- enables freebsd specific code + extra-libraries: procstat build-depends: bsd-sysctl other-modules: Xmobar.Plugins.Monitors.Batt.FreeBSD, Xmobar.Plugins.Monitors.Cpu.FreeBSD, Xmobar.Plugins.Monitors.Mem.FreeBSD, Xmobar.Plugins.Monitors.Net.FreeBSD, Xmobar.Plugins.Monitors.Swap.FreeBSD, + Xmobar.Plugins.Monitors.Top.FreeBSD, Xmobar.Plugins.Monitors.Uptime.FreeBSD else other-modules: Xmobar.Plugins.Monitors.Batt.Linux, @@ -307,6 +310,7 @@ library Xmobar.Plugins.Monitors.Mem.Linux, Xmobar.Plugins.Monitors.Net.Linux, Xmobar.Plugins.Monitors.Swap.Linux, + Xmobar.Plugins.Monitors.Top.Linux, Xmobar.Plugins.Monitors.Uptime.Linux executable xmobar -- cgit v1.2.3