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. --- src/Xmobar/Plugins/Monitors/Top/Common.hs | 32 +++++++ src/Xmobar/Plugins/Monitors/Top/FreeBSD.hsc | 143 ++++++++++++++++++++++++++++ src/Xmobar/Plugins/Monitors/Top/Linux.hs | 92 ++++++++++++++++++ 3 files changed, 267 insertions(+) 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 (limited to 'src/Xmobar/Plugins/Monitors/Top') 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 -- cgit v1.2.3