add disk monitor for freebsd

6 files changed, 617 insertions, 125 deletions

diff --git a/src/Xmobar/Plugins/Monitors/Disk.hs b/src/Xmobar/Plugins/Monitors/Disk.hs
index debc522..47d1eac 100644
--- a/src/Xmobar/Plugins/Monitors/Disk.hs
+++ b/src/Xmobar/Plugins/Monitors/Disk.hs
@@ -12,20 +12,25 @@
 --
 -----------------------------------------------------------------------------
 
+{-# LANGUAGE CPP #-}
+
 module Xmobar.Plugins.Monitors.Disk (diskUConfig, runDiskU, startDiskIO) where
 
 import Xmobar.Plugins.Monitors.Common
-import Xmobar.System.StatFS
-
-import Data.IORef (IORef, newIORef, readIORef, writeIORef)
+#if defined(freebsd_HOST_OS)
+import qualified Xmobar.Plugins.Monitors.Disk.FreeBSD as MD
+#else
+import qualified Xmobar.Plugins.Monitors.Disk.Linux as MD
+#endif
 
-import Control.Exception (SomeException, handle)
 import Control.Monad (zipWithM)
-import qualified Data.ByteString.Lazy.Char8 as B
-import Data.List (isPrefixOf, find)
-import Data.Maybe (catMaybes)
-import System.Directory (canonicalizePath, doesFileExist)
 import System.Console.GetOpt
+import Data.List (find)
+
+import Xmobar.Plugins.Monitors.Disk.Common (
+  DevName
+  , Path
+  )
 
 data DiskIOOpts = DiskIOOpts
   { totalIconPattern :: Maybe IconPattern
@@ -93,103 +98,12 @@ diskUConfig = mkMConfig ""
               , "usedbar", "usedvbar", "usedipat"
               ]
 
-type DevName = String
-type Path = String
-type DevDataRef = IORef [(DevName, [Float])]
-
-mountedDevices :: [String] -> IO [(DevName, Path)]
-mountedDevices req = do
-  s <- B.readFile "/etc/mtab"
-  parse `fmap` mapM mbcanon (devs s)
-  where
-    mbcanon (d, p) = doesFileExist d >>= \e ->
-                     if e
-                        then Just `fmap` canon (d,p)
-                        else return Nothing
-    canon (d, p) = do {d' <- canonicalizePath d; return (d', p)}
-    devs = filter isDev . map (firstTwo . B.words) . B.lines
-    parse = map undev . filter isReq . catMaybes
-    firstTwo (a:b:_) = (B.unpack a, B.unpack b)
-    firstTwo _ = ("", "")
-    isDev (d, _) = "/dev/" `isPrefixOf` d
-    isReq (d, p) = p `elem` req || drop 5 d `elem` req
-    undev (d, f) = (drop 5 d, f)
-
-diskDevices :: [String] -> IO [(DevName, Path)]
-diskDevices req = do
-  s <- B.readFile "/proc/diskstats"
-  parse `fmap` mapM canon (devs s)
-  where
-    canon (d, p) = do {d' <- canonicalizePath d; return (d', p)}
-    devs = map (third . B.words) . B.lines
-    parse = map undev . filter isReq
-    third (_:_:c:_) = ("/dev/" ++ B.unpack c, B.unpack c)
-    third _ = ("", "")
-    isReq (d, p) = p `elem` req || drop 5 d `elem` req
-    undev (d, f) = (drop 5 d, f)
-
-mountedOrDiskDevices :: [String] -> IO [(DevName, Path)]
-mountedOrDiskDevices req = do
-  mnt <- mountedDevices req
-  case mnt of
-       []    -> diskDevices req
-       other -> return other
-
-diskData :: IO [(DevName, [Float])]
-diskData = do
-  s <- B.readFile "/proc/diskstats"
-  let extract ws = (head ws, map read (tail ws))
-  return $ map (extract . map B.unpack . drop 2 . B.words) (B.lines s)
-
-mountedData :: DevDataRef -> [DevName] -> IO [(DevName, [Float])]
-mountedData dref devs = do
-  dt <- readIORef dref
-  dt' <- diskData
-  writeIORef dref dt'
-  return $ map (parseDev (zipWith diff dt' dt)) devs
-  where diff (dev, xs) (_, ys) = (dev, zipWith (-) xs ys)
-
-
-parseDev :: [(DevName, [Float])] -> DevName -> (DevName, [Float])
-parseDev dat dev =
-  case find ((==dev) . fst) dat of
-    Nothing -> (dev, [0, 0, 0])
-    Just (_, xs) ->
-      let r = 4096 * xs !! 2
-          w = 4096 * xs !! 6
-          t = r + w
-          rSp = speed r (xs !! 3)
-          wSp = speed w (xs !! 7)
-          sp =  speed t (xs !! 3 + xs !! 7)
-          speed x d = if d == 0 then 0 else x / d
-          dat' = if length xs > 6
-                 then [sp, rSp, wSp, t, r, w]
-                 else [0, 0, 0, 0, 0, 0]
-      in (dev, dat')
-
 speedToStr :: Float -> String
 speedToStr = showWithUnits 2 1 . (/ 1024)
 
 sizeToStr :: Integer -> String
 sizeToStr = showWithUnits 3 0 . fromIntegral
 
-findTempl :: DevName -> Path -> [(String, String)] -> String
-findTempl dev path disks =
-  case find devOrPath disks of
-    Just (_, t) -> t
-    Nothing -> ""
-  where devOrPath (d, _) = d == dev || d == path
-
-devTemplates :: [(String, String)]
-                -> [(DevName, Path)]
-                -> [(DevName, [Float])]
-                -> [(String, [Float])]
-devTemplates disks mounted dat =
-  map (\(d, p) -> (findTempl d p disks, findData d)) mounted
-  where findData dev = case find ((==dev) . fst) dat of
-                         Nothing -> [0, 0, 0]
-                         Just (_, xs) -> xs
-
 runDiskIO' :: DiskIOOpts -> (String, [Float]) -> Monitor String
 runDiskIO' opts (tmp, xs) = do
   s <- mapM (showWithColors speedToStr) xs
@@ -202,37 +116,25 @@ runDiskIO' opts (tmp, xs) = do
   setConfigValue tmp template
   parseTemplate $ s ++ b ++ vb ++ ipat
 
-runDiskIO :: DevDataRef -> [(String, String)] -> [String] -> Monitor String
+runDiskIO :: MD.DevDataRef -> [(String, String)] -> [String] -> Monitor String
 runDiskIO dref disks argv = do
   opts <- io $ parseOptsWith dioOptions dioDefaultOpts argv
-  dev <- io $ mountedOrDiskDevices (map fst disks)
-  dat <- io $ mountedData dref (map fst dev)
-  strs <- mapM (runDiskIO' opts) $ devTemplates disks dev dat
+  stats <- io $ MD.fetchDataIO dref disks
+  mounted <- io $ MD.fetchDataUsage disks
+  strs <- mapM (runDiskIO' opts) $ devTemplates disks (map fst mounted) stats
   return $ (if contiguous opts then concat else unwords) strs
 
 startDiskIO :: [(String, String)] ->
                [String] -> Int -> (String -> IO ()) -> IO ()
 startDiskIO disks args rate cb = do
-  dev <- mountedOrDiskDevices (map fst disks)
-  dref <- newIORef (map (\d -> (fst d, repeat 0)) dev)
-  _ <- mountedData dref (map fst dev)
+  dref <- MD.initializeDevDataRef disks
   runM args diskIOConfig (runDiskIO dref disks) rate cb
 
-fsStats :: String -> IO [Integer]
-fsStats path = do
-  stats <- getFileSystemStats path
-  case stats of
-    Nothing -> return [0, 0, 0]
-    Just f -> let tot = fsStatByteCount f
-                  free = fsStatBytesAvailable f
-                  used = fsStatBytesUsed f
-              in return [tot, free, used]
-
-runDiskU' :: DiskUOpts -> String -> String -> Monitor String
-runDiskU' opts tmp path = do
+runDiskU' :: DiskUOpts -> String -> [Integer] -> Monitor String
+runDiskU' opts tmp stat = do
   setConfigValue tmp template
-  [total, free, diff] <-  io (handle ign $ fsStats path)
-  let strs = map sizeToStr [free, diff]
+  let [total, free, diff] = stat
+      strs = map sizeToStr [free, diff]
       freep = if total > 0 then free * 100 `div` total else 0
       fr = fromIntegral freep / 100
   s <- zipWithM showWithColors' strs [freep, 100 - freep]
@@ -244,12 +146,27 @@ runDiskU' opts tmp path = do
   uvb <- showVerticalBar (fromIntegral $ 100 - freep) (1 - fr)
   uipat <- showIconPattern (usedIconPattern opts) (1 - fr)
   parseTemplate $ [sizeToStr total] ++ s ++ sp ++ [fb,fvb,fipat,ub,uvb,uipat]
-  where ign = const (return [0, 0, 0]) :: SomeException -> IO [Integer]
-
 
 runDiskU :: [(String, String)] -> [String] -> Monitor String
 runDiskU disks argv = do
-  devs <- io $ mountedDevices (map fst disks)
   opts <- io $ parseOptsWith duOptions duDefaultOpts argv
-  strs <- mapM (\(d, p) -> runDiskU' opts (findTempl d p disks) p) devs
+  stats <- io $ MD.fetchDataUsage disks
+  strs <- mapM (\((d, p), stat) -> runDiskU' opts (findTempl d p disks) stat) stats
   return $ (if contiguousU opts then concat else unwords) strs
+
+findTempl :: DevName -> Path -> [(String, String)] -> String
+findTempl dev path disks =
+  case find devOrPath disks of
+    Just (_, t) -> t
+    Nothing -> ""
+  where devOrPath (d, _) = d == dev || d == path
+
+devTemplates :: [(String, String)]
+                -> [(DevName, Path)]
+                -> [(DevName, [Float])]
+                -> [(String, [Float])]
+devTemplates disks mounted dat =
+  map (\(d, p) -> (findTempl d p disks, findData d)) mounted
+  where findData dev = case find ((==dev) . fst) dat of
+                         Nothing -> [0, 0, 0]
+                         Just (_, xs) -> xs
diff --git a/src/Xmobar/Plugins/Monitors/Disk/Common.hs b/src/Xmobar/Plugins/Monitors/Disk/Common.hs
new file mode 100644
index 0000000..cdfb73c
--- /dev/null
+++ b/src/Xmobar/Plugins/Monitors/Disk/Common.hs
@@ -0,0 +1,21 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Plugins.Monitors.Disk.Common
+-- Copyright   :  (c) 2010, 2011, 2012, 2014, 2018, 2019 Jose A Ortega Ruiz
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  Jose A Ortega Ruiz <jao@gnu.org>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+--  Disk usage and throughput monitors for Xmobar
+--
+-----------------------------------------------------------------------------
+
+module Xmobar.Plugins.Monitors.Disk.Common (
+  DevName
+  , Path
+  ) where
+
+type DevName = String
+type Path = String
diff --git a/src/Xmobar/Plugins/Monitors/Disk/FreeBSD.hsc b/src/Xmobar/Plugins/Monitors/Disk/FreeBSD.hsc
new file mode 100644
index 0000000..296ba6c
--- /dev/null
+++ b/src/Xmobar/Plugins/Monitors/Disk/FreeBSD.hsc
@@ -0,0 +1,403 @@
+{-# LANGUAGE CPP                      #-}
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE EmptyDataDecls #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CApiFFI #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NumDecimals #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Plugins.Monitors.Disk.Freebsd
+-- Copyright   :  (c) 2010, 2011, 2012, 2014, 2018, 2019 Jose A Ortega Ruiz
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  Jose A Ortega Ruiz <jao@gnu.org>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+--  Disk usage and throughput monitors for Xmobar
+--
+-----------------------------------------------------------------------------
+
+module Xmobar.Plugins.Monitors.Disk.FreeBSD
+  (
+    fetchDataIO
+  , fetchDataUsage
+  , initializeDevDataRef
+  , DevDataRef
+  ) where
+
+import Data.IORef (
+  IORef
+  , newIORef
+  , readIORef
+  , writeIORef
+  )
+
+import Xmobar.Plugins.Monitors.Disk.Common (
+  DevName
+  , Path
+  )
+
+import qualified Control.Exception.Extensible as E
+import qualified Data.List as DL
+import qualified Data.Map as DM
+import qualified Data.Set as DS
+import           Data.Time.Clock.POSIX
+import           Foreign
+import           Foreign.C.Error (throwErrnoIfMinus1_)
+import           Foreign.C.String
+import           Foreign.C.Types
+import           System.BSD.Sysctl
+
+#include <sys/sysctl.h>
+#include <sys/mount.h>
+#include <devstat.h>
+#include <libgeom.h>
+
+foreign import ccall unsafe "sys/mount.h getfsstat" c_getfsstat :: Ptr STATFS -> CInt -> CInt -> IO CInt
+foreign import ccall unsafe "geom_stats_open" c_geom_stats_open :: IO CInt
+foreign import ccall unsafe "geom_stats_snapshot_get" c_geom_stats_snapshot_get :: IO (Ptr GSNAP)
+foreign import ccall unsafe "&geom_stats_snapshot_free" c_geom_stats_snapshot_free :: FinalizerPtr GSNAP
+foreign import ccall unsafe "geom_stats_snapshot_next" c_geom_stats_snapshot_next :: Ptr GSNAP -> IO (Ptr DEVSTAT)
+foreign import ccall unsafe "geom_gettree" c_geom_gettree :: Ptr GMESH -> IO CInt
+foreign import ccall unsafe "geom_lookupid" c_geom_lookupid :: Ptr GMESH -> Ptr VOIDPTR -> IO (Ptr GIDENT)
+foreign import ccall unsafe "&geom_deletetree" c_geom_deletetree :: FinalizerPtr GMESH
+foreign import ccall unsafe "geom_stats_snapshot_timestamp" c_geom_stats_snapshot_timestamp :: Ptr GSNAP -> Ptr Timespec -> IO CInt
+
+type DevDataRef = IORef (DM.Map String DevStatData)
+
+data STATFS
+data StatFs = StatFs !(ForeignPtr STATFS)
+  deriving (Eq, Show)
+
+data DEVSTAT
+data DevStat = DevStat !(ForeignPtr DEVSTAT)
+  deriving (Eq, Show)
+
+data GMESH
+data GMesh = GMesh !(ForeignPtr GMESH)
+
+data GSNAP
+data GSnap = GSnap !(ForeignPtr GSNAP)
+
+data GIDENT
+data VOIDPTR
+data Timespec
+
+data DevStatData = DevStatData {
+  devname :: String
+  , readDevStat :: Int64
+  , writeDevStat :: Int64
+  , devstatId :: Ptr VOIDPTR
+  , devStatTime :: Rational
+  }
+  deriving (Show, Eq)
+
+data StatFsData = StatFsData
+  {
+    fsMntFromName :: String
+  , fsMntOnName :: String
+  , fsStatBlockSize :: Integer
+  -- ^ Optimal transfer block size.
+  , fsStatBlockCount :: Integer
+  -- ^ Total data blocks in file system.
+  , fsStatByteCount :: Integer
+  -- ^ Total bytes in file system.
+  , fsStatBytesFree :: Integer
+  -- ^ Free bytes in file system.
+  , fsStatBytesAvailable :: Integer
+  -- ^ Free bytes available to non-superusers.
+  , fsStatBytesUsed :: Integer
+  -- ^ Bytes used.
+  }
+  deriving (Show, Read, Eq)
+
+data GIdentData = GIdentData
+  {
+    lgPtr :: Ptr VOIDPTR
+  , lgWhat :: CInt
+  }
+  deriving (Show, Eq)
+
+instance Storable GIdentData where
+  alignment _ = #{alignment struct gident}
+  sizeOf _    = #{size struct gident}
+  peek ptr    = do
+    gIdentLgPtr <- #{peek struct gident, lg_ptr} ptr :: IO (Ptr VOIDPTR)
+    gIdentLgWhat <- #{peek struct gident, lg_what} ptr :: IO CInt
+    return GIdentData {
+      lgPtr=gIdentLgPtr
+      , lgWhat=gIdentLgWhat
+      }
+
+  poke _ _    = pure ()
+
+instance Storable DevStatData where
+  alignment _ = #{alignment struct devstat}
+  sizeOf _    = #{size struct devstat}
+  peek ptr    = do
+    device_id <- #{peek struct devstat, id} ptr :: IO (Ptr VOIDPTR)
+    device_name <- peekCString $ #{ptr struct devstat, device_name} ptr
+    unit_number <- #{peek struct devstat, unit_number} ptr :: IO Int
+    bytes_values <- peekArray 4 $ #{ptr struct devstat, bytes} ptr  :: IO [CUIntMax]
+    let
+      read_value = bytes_values !! #{const DEVSTAT_READ}
+      write_value = bytes_values !! #{const DEVSTAT_WRITE}
+    return DevStatData {
+      devname=concat [device_name, show unit_number]
+      , readDevStat=fromInteger . toInteger $ read_value
+      , writeDevStat=fromInteger . toInteger $ write_value
+      , devstatId=device_id
+      , devStatTime=0
+      }
+
+
+  poke _ _    = pure ()
+
+instance Storable StatFsData where
+  alignment _ = #{alignment struct statfs}
+  sizeOf _    = #{size struct statfs}
+  peek ptr    = do
+       fmntfromname <- peekCString $ #{ptr struct statfs, f_mntfromname} ptr
+       fmntonname <- peekCString $ #{ptr struct statfs, f_mntonname} ptr
+       bsize <- #{peek struct statfs, f_bsize} ptr
+       bcount <- #{peek struct statfs, f_blocks} ptr
+       bfree <- #{peek struct statfs, f_bfree} ptr
+       bavail <- #{peek struct statfs, f_bavail} ptr
+       let
+         bpb = toI bsize
+       return $ StatFsData {
+         fsMntFromName = fmntfromname
+         , fsMntOnName = fmntonname
+         , fsStatBlockSize = bpb
+         , fsStatBlockCount = toI bcount
+         , fsStatByteCount = toI bcount * bpb
+         , fsStatBytesFree = toI bfree * bpb
+         , fsStatBytesAvailable = toI bavail * bpb
+         , fsStatBytesUsed = toI (bcount - bfree) * bpb
+         }
+
+  poke _ _    = pure ()
+
+
+toI :: CULong -> Integer
+toI = toInteger
+
+mountCount :: IO CInt
+mountCount = c_getfsstat nullPtr 0 #{const MNT_NOWAIT}
+
+getMountInfo :: IO [StatFsData]
+getMountInfo = do
+  cmountcount <- mountCount
+  let
+    cbytes = cmountcount * #{size struct statfs}
+    bytes = fromInteger . toInteger $ cbytes
+    mountcount = fromInteger . toInteger $ cmountcount
+  allocaBytes bytes $ \vfs -> do
+    c_getfsstat vfs cbytes #{const MNT_NOWAIT}
+    peekArray mountcount $ castPtr vfs :: IO [StatFsData]
+
+cTimeToInteger :: CTime -> Integer
+cTimeToInteger (CTime n) = fromIntegral n
+
+getSnapshotTime :: GSnap -> IO Integer
+getSnapshotTime (GSnap snap_fp) = do
+  allocaBytes #{const sizeof(struct timespec)} $ \p_ts -> do
+    withForeignPtr snap_fp $ \snap_ptr -> do
+      throwErrnoIfMinus1_ "geom_stats_snapshot_timestamp"
+        $ c_geom_stats_snapshot_timestamp snap_ptr p_ts
+      u_sec  <- #{peek struct timespec,tv_sec}  p_ts :: IO CTime
+      u_nsec <- #{peek struct timespec,tv_nsec} p_ts :: IO CLong
+      return (cTimeToInteger u_sec * 1e12 + fromIntegral u_nsec * 1e3)
+
+checkGeomStat' :: GIdentData -> GSnap -> DevStatData -> [DevStatData] -> IO [DevStatData]
+checkGeomStat' gident_data gsnap stat acc
+  | (lgWhat gident_data) /= #{const ISPROVIDER} = return acc
+  | otherwise = do
+      lgNamePtr <- #{peek struct gprovider, lg_name} $ lgPtr gident_data
+      lgName <- peekCString $ castPtr lgNamePtr
+      lgTime <- toRational <$> getSnapshotTime gsnap
+      return $ stat
+        {
+          devname=concat ["/dev/", lgName]
+        , devStatTime= lgTime / 1e12
+        } : acc
+
+
+checkGeomStat :: Ptr GIDENT -> GSnap -> DevStatData -> [DevStatData] -> IO [DevStatData]
+checkGeomStat gident_ptr gsnap stat acc
+  | gident_ptr == nullPtr = return acc
+  | otherwise = do
+      gIdent <- peek $ castPtr gident_ptr :: IO GIdentData
+      checkGeomStat' gIdent gsnap stat acc
+
+
+getGeomStats' :: GMesh -> GSnap -> Ptr DEVSTAT -> [DevStatData] -> IO [DevStatData]
+getGeomStats' gmeshD@(GMesh gmesh_fp) gsnapD@(GSnap snap_fp) ptr acc
+  | ptr == nullPtr = return acc
+  | otherwise = do
+      withForeignPtr snap_fp $ \snap_ptr -> do
+        acc' <- withForeignPtr gmesh_fp $ \gmesh_ptr -> do
+          stat <- (peek $ castPtr ptr) :: IO DevStatData
+          gIdentPtr <- c_geom_lookupid gmesh_ptr (devstatId stat)
+          checkGeomStat gIdentPtr gsnapD stat acc
+        nextStatPtr <- c_geom_stats_snapshot_next snap_ptr
+        getGeomStats' gmeshD gsnapD nextStatPtr acc'
+
+getGeomStats :: IO [DevStatData]
+getGeomStats = do
+  gmesh_fp <- mallocForeignPtrBytes bytesmesh
+  addForeignPtrFinalizer c_geom_deletetree gmesh_fp
+  c_geom_stats_open
+  withForeignPtr gmesh_fp $ \gmesh_ptr -> do
+    c_geom_gettree gmesh_ptr
+    snap_ptr <- c_geom_stats_snapshot_get
+    snap_fp <- newForeignPtr c_geom_stats_snapshot_free snap_ptr
+    withForeignPtr snap_fp $ \snap_ptr' -> do
+      nextStatPtr <- c_geom_stats_snapshot_next snap_ptr'
+      getGeomStats' (GMesh gmesh_fp) (GSnap snap_fp) nextStatPtr []
+  where
+    bytesmesh = #{size struct gmesh}
+
+
+readGeomStats :: DM.Map String DevStatData -> IO (DM.Map String DevStatData)
+readGeomStats acc = do
+  (Prelude.foldr (\x-> DM.insert (devname x) x) acc) <$> getGeomStats
+
+defaultDevStatData :: DevStatData
+defaultDevStatData = DevStatData
+  {
+    devname = ""
+  , readDevStat = 0
+  , writeDevStat = 0
+  , devstatId = nullPtr
+  , devStatTime = 0
+  }
+
+sysctlNextOid :: [Int32] -> IO [Int32]
+sysctlNextOid oid = do
+  let query_oid = #{const CTL_SYSCTL} : #{const CTL_SYSCTL_NEXT} : oid
+  E.catch (sysctlPeekArray query_oid :: IO [Int32]) (\(E.SomeException _) -> return [])
+
+sysctlOidToName :: [Int32] -> IO String
+sysctlOidToName oid = do
+  let query_oid = #{const CTL_SYSCTL} : #{const CTL_SYSCTL_NAME} : oid
+  nameO <- sysctlReadString query_oid
+  return nameO
+
+fetchZfsStat :: [Int32] -> DM.Map (String, String) DevStatData -> [String] -> IO (DM.Map (String, String) DevStatData)
+fetchZfsStat oid acc (_ : _ : poolName : "dataset" : refName : "nread" : []) = do
+  readsB <- sysctlReadLong oid
+  let val = DM.findWithDefault defaultDevStatData (poolName, refName) acc
+      val' = val
+        {
+          readDevStat = readsB
+        }
+  return $ DM.insert (poolName, refName) val' acc
+
+fetchZfsStat oid acc (_ : _ : poolName : "dataset" : refName : "nwritten" : []) = do
+  writesB <- sysctlReadLong oid
+  let val = DM.findWithDefault defaultDevStatData (poolName, refName) acc
+      val' = val
+        {
+          writeDevStat = writesB
+        }
+  return $ DM.insert (poolName, refName) val' acc
+
+fetchZfsStat oid acc (_ : _ : poolName : "dataset" : refName : "dataset_name" : []) = do
+  datasetName <- sysctlReadString oid
+  datasetTime <- toRational <$> getPOSIXTime
+  let val = DM.findWithDefault defaultDevStatData (poolName, refName) acc
+      val' = val
+        {
+          devname = datasetName
+        , devStatTime = datasetTime
+        }
+  return $ DM.insert (poolName, refName) val' acc
+
+fetchZfsStat _ acc _ = return acc
+
+readZfsStat' :: [Int32] -> [Int32] -> DM.Map (String, String) DevStatData -> IO (DM.Map (String, String) DevStatData)
+readZfsStat' mainOid actOid acc
+   | mainOid `DL.isPrefixOf` actOid = do
+       nameDS <- sysctlOidToName actOid
+       let nameArr = splitOnDot nameDS
+       acc' <- fetchZfsStat actOid acc nameArr
+       nextOid <- sysctlNextOid actOid
+       readZfsStat' mainOid nextOid acc'
+
+   | otherwise = return acc
+
+splitOnDot :: String -> [String]
+splitOnDot [] = [[]]
+splitOnDot ('.':xs) = [] : splitOnDot xs
+splitOnDot (x:xs) =
+           let rest = splitOnDot xs
+           in (x : head rest) : tail rest
+
+readZfsStats :: DM.Map DevName DevStatData -> IO (DM.Map DevName DevStatData)
+readZfsStats acc = do
+  mainO <- sysctlNameToOid "kstat.zfs"
+  mainOid <- sysctlExtractOid mainO
+  (DM.foldr (\x-> DM.insert (devname x) x) acc) <$> (readZfsStat' mainOid mainOid $ DM.empty)
+
+readDevsStats :: IO (DM.Map DevName DevStatData)
+readDevsStats = do
+  geomStats <- readGeomStats DM.empty
+  readZfsStats geomStats
+
+extractDataIO :: DM.Map String DevStatData -> DM.Map String DevStatData -> String -> (DevName, [Float])
+extractDataIO currs prevs disk = (disk, diffStat)
+  where
+    diffStat = [sp, rSp, wSp, fromInteger t, fromInteger  r, fromInteger w]
+    r = toInteger $ (readDevStat curr) - (readDevStat prev)
+    w = toInteger $ (writeDevStat curr) - (writeDevStat prev)
+    t = r + w
+    rSp = speed r diffTime
+    wSp = speed w diffTime
+    sp =  speed t diffTime
+    curr = DM.findWithDefault defaultDevStatData disk currs
+    prev = DM.findWithDefault defaultDevStatData disk prevs
+    diffTime = (devStatTime curr) - (devStatTime prev)
+    speed :: Integer -> Rational -> Float
+    speed _ 0 = 0
+    speed x d = (fromInteger x) / (realToFrac d)
+
+fetchDataIO :: DevDataRef -> [(String, String)] -> IO [(DevName, [Float])]
+fetchDataIO dref disks = do
+  currStats <- readDevsStats
+  prevStats <- readIORef dref
+  writeIORef dref currStats
+  return $ map (extractDataIO currStats prevStats) $ mountedOrDiskDevices disks currStats
+
+fetchDataUsage :: [(String, String)] -> IO [((DevName, Path), [Integer])]
+fetchDataUsage disks = Prelude.map extractStat <$> Prelude.filter isReq <$> getMountInfo
+  where
+    req = Prelude.map fst disks
+    isReq :: StatFsData -> Bool
+    isReq stat = (fsMntOnName stat) `elem` req
+                 || Prelude.drop 5 (fsMntFromName stat) `elem` req
+                 || (fsMntFromName stat) `elem` req
+    extractStat :: StatFsData -> ((String, String), [Integer])
+    extractStat stat = ((fsMntFromName stat, fsMntOnName stat)
+      , [
+          fsStatByteCount stat
+        , fsStatBytesFree stat
+        , fsStatBytesUsed stat
+        ]
+      )
+
+initializeDevDataRef :: [(String, String)] -> IO DevDataRef
+initializeDevDataRef _ = do
+  stats <- readDevsStats
+  newIORef stats
+
+mountedOrDiskDevices :: [(DevName, Path)] -> DM.Map String DevStatData -> [DevName]
+mountedOrDiskDevices mounted devs = DS.elems $ mountedOrDiskDevices' mountedAcc (DM.keys devs)
+  where
+    mountedAcc = mountedOrDiskDevices' DS.empty (map fst mounted)
+
+mountedOrDiskDevices' :: DS.Set DevName -> [DevName] -> DS.Set DevName
+mountedOrDiskDevices' acc [] = acc
+mountedOrDiskDevices' acc (x:xs) = mountedOrDiskDevices' (DS.insert x acc) xs
diff --git a/src/Xmobar/Plugins/Monitors/Disk/Linux.hs b/src/Xmobar/Plugins/Monitors/Disk/Linux.hs
new file mode 100644
index 0000000..aacb648
--- /dev/null
+++ b/src/Xmobar/Plugins/Monitors/Disk/Linux.hs
@@ -0,0 +1,148 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Plugins.Monitors.Disk.Linux
+-- Copyright   :  (c) 2010, 2011, 2012, 2014, 2018, 2019 Jose A Ortega Ruiz
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  Jose A Ortega Ruiz <jao@gnu.org>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+--  Disk usage and throughput monitors for Xmobar
+--
+-----------------------------------------------------------------------------
+
+module Xmobar.Plugins.Monitors.Disk.Linux
+  (
+    fetchDataIO
+  , fetchDataUsage
+  , initializeDevDataRef
+  , DevDataRef
+  ) where
+
+import Data.IORef (
+  IORef
+  , newIORef
+  , readIORef
+  , writeIORef
+  )
+
+import Xmobar.System.StatFS (
+  getFileSystemStats
+  , fsStatByteCount
+  , fsStatBytesAvailable
+  , fsStatBytesUsed
+  )
+import qualified Data.ByteString.Lazy.Char8 as B
+import Data.List (isPrefixOf, find)
+import Data.Maybe (catMaybes)
+import System.Directory (canonicalizePath, doesFileExist)
+import Control.Exception (SomeException, handle)
+
+import Xmobar.Plugins.Monitors.Disk.Common (
+  DevName
+  , Path
+  )
+
+type DevDataRef = IORef [(DevName, [Float])]
+
+fsStats :: String -> IO [Integer]
+fsStats path = do
+  stats <- getFileSystemStats path
+  case stats of
+    Nothing -> return [0, 0, 0]
+    Just f -> let tot = fsStatByteCount f
+                  free = fsStatBytesAvailable f
+                  used = fsStatBytesUsed f
+              in return [tot, free, used]
+
+mountedDevices :: [String] -> IO [(DevName, Path)]
+mountedDevices req = do
+  s <- B.readFile "/etc/mtab"
+  parse `fmap` mapM mbcanon (devs s)
+  where
+    mbcanon (d, p) = doesFileExist d >>= \e ->
+                     if e
+                        then Just `fmap` canon (d,p)
+                        else return Nothing
+    canon (d, p) = do {d' <- canonicalizePath d; return (d', p)}
+    devs = filter isDev . map (firstTwo . B.words) . B.lines
+    parse = map undev . filter isReq . catMaybes
+    firstTwo (a:b:_) = (B.unpack a, B.unpack b)
+    firstTwo _ = ("", "")
+    isDev (d, _) = "/dev/" `isPrefixOf` d
+    isReq (d, p) = p `elem` req || drop 5 d `elem` req
+    undev (d, f) = (drop 5 d, f)
+
+diskDevices :: [String] -> IO [(DevName, Path)]
+diskDevices req = do
+  s <- B.readFile "/proc/diskstats"
+  parse `fmap` mapM canon (devs s)
+  where
+    canon (d, p) = do {d' <- canonicalizePath d; return (d', p)}
+    devs = map (third . B.words) . B.lines
+    parse = map undev . filter isReq
+    third (_:_:c:_) = ("/dev/" ++ B.unpack c, B.unpack c)
+    third _ = ("", "")
+    isReq (d, p) = p `elem` req || drop 5 d `elem` req
+    undev (d, f) = (drop 5 d, f)
+
+mountedOrDiskDevices :: [String] -> IO [(DevName, Path)]
+mountedOrDiskDevices req = do
+  mnt <- mountedDevices req
+  case mnt of
+       []    -> diskDevices req
+       other -> return other
+
+diskData :: IO [(DevName, [Float])]
+diskData = do
+  s <- B.readFile "/proc/diskstats"
+  let extract ws = (head ws, map read (tail ws))
+  return $ map (extract . map B.unpack . drop 2 . B.words) (B.lines s)
+
+mountedData :: DevDataRef -> [DevName] -> IO [(DevName, [Float])]
+mountedData dref devs = do
+  dt <- readIORef dref
+  dt' <- diskData
+  writeIORef dref dt'
+  return $ map (parseDev (zipWith diff dt' dt)) devs
+  where diff (dev, xs) (_, ys) = (dev, zipWith (-) xs ys)
+
+
+parseDev :: [(DevName, [Float])] -> DevName -> (DevName, [Float])
+parseDev dat dev =
+  case find ((==dev) . fst) dat of
+    Nothing -> (dev, [0, 0, 0])
+    Just (_, xs) ->
+      let r = 4096 * xs !! 2
+          w = 4096 * xs !! 6
+          t = r + w
+          rSp = speed r (xs !! 3)
+          wSp = speed w (xs !! 7)
+          sp =  speed t (xs !! 3 + xs !! 7)
+          speed x d = if d == 0 then 0 else x / d
+          dat' = if length xs > 6
+                 then [sp, rSp, wSp, t, r, w]
+                 else [0, 0, 0, 0, 0, 0]
+      in (dev, dat')
+
+fetchDataIO :: DevDataRef -> [(String, String)] -> IO [(String, [Float])]
+fetchDataIO dref disks = do
+  dev <- mountedOrDiskDevices (map fst disks)
+  mountedData dref (map fst dev)
+
+fetchDataUsage :: [(String, String)] -> IO [((String, String), [Integer])]
+fetchDataUsage disks = do
+  devs <- mountedDevices (map fst disks)
+  mapM fetchStats devs
+  where
+    fetchStats :: (String, String) -> IO ((String, String), [Integer])
+    fetchStats (dev, path) = do
+      stats <- handle ign $ fsStats path
+      return ((dev, path), stats)
+    ign = const (return [0, 0, 0]) :: SomeException -> IO [Integer]
+
+initializeDevDataRef :: [(String, String)] -> IO DevDataRef
+initializeDevDataRef disks = do
+  dev <- mountedOrDiskDevices (map fst disks)
+  newIORef (map (\d -> (fst d, repeat 0)) dev)
diff --git a/src/Xmobar/Plugins/Monitors/Net/FreeBSD.hsc b/src/Xmobar/Plugins/Monitors/Net/FreeBSD.hsc
index ab446e3..4d6c144 100644
--- a/src/Xmobar/Plugins/Monitors/Net/FreeBSD.hsc
+++ b/src/Xmobar/Plugins/Monitors/Net/FreeBSD.hsc
@@ -29,7 +29,6 @@ import Control.Exception (catch, SomeException(..))
 import Foreign (Int32, plusPtr)
 import Foreign.C.Types (CUIntMax, CUChar)
 import Foreign.C.String (peekCString)
-import Foreign.ForeignPtr ()
 import Foreign.Storable (Storable, alignment, sizeOf, peek, poke)
 import System.BSD.Sysctl (OID, sysctlPrepareOid, sysctlReadInt, sysctlPeek)
 
diff --git a/xmobar.cabal b/xmobar.cabal
index bcb70f9..3799d64 100644
--- a/xmobar.cabal
+++ b/xmobar.cabal
@@ -159,6 +159,7 @@ library
                    Xmobar.Plugins.Monitors.Cpu.Common,
                    Xmobar.Plugins.Monitors.CpuFreq,
                    Xmobar.Plugins.Monitors.Disk,
+                   Xmobar.Plugins.Monitors.Disk.Common,
                    Xmobar.Plugins.Monitors.Mem,
                    Xmobar.Plugins.Monitors.MultiCoreTemp,
                    Xmobar.Plugins.Monitors.MultiCpu,
@@ -297,9 +298,11 @@ library
        -- enables freebsd specific code
        extra-libraries: procstat
                       , kvm
+                      , geom
        build-depends: bsd-sysctl
        other-modules: Xmobar.Plugins.Monitors.Batt.FreeBSD,
                       Xmobar.Plugins.Monitors.Cpu.FreeBSD,
+                      Xmobar.Plugins.Monitors.Disk.FreeBSD,
                       Xmobar.Plugins.Monitors.Mem.FreeBSD,
                       Xmobar.Plugins.Monitors.Net.FreeBSD,
                       Xmobar.Plugins.Monitors.Swap.FreeBSD,
@@ -308,6 +311,7 @@ library
     else
        other-modules: Xmobar.Plugins.Monitors.Batt.Linux,
                       Xmobar.Plugins.Monitors.Cpu.Linux,
+                      Xmobar.Plugins.Monitors.Disk.Linux,
                       Xmobar.Plugins.Monitors.Mem.Linux,
                       Xmobar.Plugins.Monitors.Net.Linux,
                       Xmobar.Plugins.Monitors.Swap.Linux,