summaryrefslogtreecommitdiffhomepage
path: root/src/Xmobar/Plugins/Monitors/Top
diff options
context:
space:
mode:
Diffstat (limited to 'src/Xmobar/Plugins/Monitors/Top')
-rw-r--r--src/Xmobar/Plugins/Monitors/Top/Common.hs32
-rw-r--r--src/Xmobar/Plugins/Monitors/Top/FreeBSD.hsc143
-rw-r--r--src/Xmobar/Plugins/Monitors/Top/Linux.hs92
3 files changed, 267 insertions, 0 deletions
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 <jao@gnu.org>
+-- 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 <jao@gnu.org>
+-- 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 <unistd.h>
+#include <sys/sysctl.h>
+#include <sys/user.h>
+#include <libprocstat.h>
+
+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 <jao@gnu.org>
+-- 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