module System.BSD.Sysctl (
SysctlKey,
OID,
sysctlNameToOid,
sysctlReadInt,
sysctlReadUInt,
sysctlReadLong,
sysctlReadULong,
sysctlReadQuad,
sysctlReadUQuad,
sysctlReadString,
sysctlPeek,
sysctlPeekArray,
sysctlWriteInt,
sysctlWriteUInt,
sysctlWriteLong,
sysctlWriteULong,
sysctlWriteQuad,
sysctlWriteUQuad,
sysctlWriteString,
sysctlPoke
) where
import Control.Arrow (second)
import Data.Int
import Data.Word
import Foreign.Ptr
import Foreign.C
import Foreign.Marshal
import Foreign.Storable
import Foreign.ForeignPtr
data OID = OID !(ForeignPtr CInt)
!CUInt
class SysctlKey k where
withKey :: k -> (Ptr CInt -> CUInt -> IO a) -> IO a
instance SysctlKey OID where
withKey (OID fp len) f = withForeignPtr fp (\ptr -> f ptr len)
instance SysctlKey String where
withKey name f = sysctlNameToOid name >>= flip withKey f
instance SysctlKey [Int] where
withKey oid f = withArrayLen (map fromIntegral oid)
(\len ptr -> f ptr (fromIntegral len))
foreign import ccall unsafe "sysctl"
c_sysctl :: Ptr CInt -> CUInt -> Ptr a -> Ptr CSize -> Ptr b -> CSize -> IO CInt
foreign import ccall unsafe "sysctlnametomib"
c_sysctlnametomib :: CString -> Ptr CInt -> Ptr CSize -> IO CInt
sysctlGetSize :: Ptr CInt -> CUInt -> IO CSize
sysctlGetSize oid len = sysctlRead oid len nullPtr 0 (const return)
sysctlNameToOid :: String -> IO OID
sysctlNameToOid name =
withCString name $ \cname -> do
fp <- mallocForeignPtrArray (fromIntegral maxlen)
len <- withForeignPtr fp $ \oid ->
alloca $ \sizePtr -> do
poke sizePtr maxlen
throwErrnoIfMinus1_ "sysctlnametomib"
(c_sysctlnametomib cname oid sizePtr)
peek sizePtr
return (OID fp (fromIntegral len))
where maxlen = 10
sysctlRead :: Ptr CInt -> CUInt -> Ptr a -> CSize -> (Ptr a -> CSize -> IO b) -> IO b
sysctlRead oid len buf size f =
alloca $ \sizePtr -> do
poke sizePtr size
throwErrnoIfMinus1_ "sysctl"
(c_sysctl oid len buf sizePtr nullPtr 0)
realSize <- peek sizePtr
f buf realSize
sysctlPeek :: forall k a. (SysctlKey k, Storable a) => k -> IO a
sysctlPeek key =
withKey key $ \oid len ->
alloca $ \buf ->
sysctlRead oid len buf (fromIntegral (sizeOf (undefined::a)))
(const . peek)
sysctlReadInt :: SysctlKey k => k -> IO Int32
sysctlReadInt = sysctlPeek
sysctlReadUInt :: SysctlKey k => k -> IO Word32
sysctlReadUInt = sysctlPeek
sysctlReadLong :: SysctlKey k => k -> IO Int32
sysctlReadLong = sysctlPeek
sysctlReadULong :: SysctlKey k => k -> IO Word32
sysctlReadULong = sysctlPeek
sysctlReadQuad :: SysctlKey k => k -> IO Int64
sysctlReadQuad = sysctlPeek
sysctlReadUQuad :: SysctlKey k => k -> IO Word64
sysctlReadUQuad = sysctlPeek
sysctlReadDynamic :: SysctlKey k => k -> (CSize -> CSize) -> (Ptr a -> CSize -> IO b) -> IO b
sysctlReadDynamic key scale f =
withKey key $ \oid len -> do
size <- sysctlGetSize oid len
let bufSize = scale size
allocaBytes (fromIntegral bufSize) $ \buf ->
sysctlRead oid len buf bufSize f
sysctlPeekArray :: forall k a. (SysctlKey k, Storable a) => k -> IO [a]
sysctlPeekArray key =
sysctlReadDynamic key (*2) $ \buf size ->
peekArray (fromIntegral size `div` sizeOf (undefined::a)) buf
sysctlReadString :: SysctlKey k => k -> IO String
sysctlReadString key =
sysctlReadDynamic key id (curry (peekCStringLen . second ((subtract 1) . fromIntegral)))
sysctlWrite :: Ptr CInt -> CUInt -> Ptr a -> CSize -> IO ()
sysctlWrite oid len buf size =
throwErrnoIfMinus1_ "sysctl" (c_sysctl oid len nullPtr nullPtr buf size)
sysctlPoke :: (SysctlKey k, Storable a) => k -> a -> IO ()
sysctlPoke key x =
withKey key $ \oid len ->
with x $ \buf -> sysctlWrite oid len buf (fromIntegral (sizeOf buf))
sysctlWriteInt :: SysctlKey k => k -> Int32 -> IO ()
sysctlWriteInt = sysctlPoke
sysctlWriteUInt :: SysctlKey k => k -> Word32 -> IO ()
sysctlWriteUInt = sysctlPoke
sysctlWriteLong :: SysctlKey k => k -> Int32 -> IO ()
sysctlWriteLong = sysctlPoke
sysctlWriteULong :: SysctlKey k => k -> Word32 -> IO ()
sysctlWriteULong = sysctlPoke
sysctlWriteQuad :: SysctlKey k => k -> Int64 -> IO ()
sysctlWriteQuad = sysctlPoke
sysctlWriteUQuad :: SysctlKey k => k -> Word64 -> IO ()
sysctlWriteUQuad = sysctlPoke
sysctlWriteString :: SysctlKey k => k -> String -> IO ()
sysctlWriteString key s =
withKey key $ \oid len ->
withCStringLen s $ \(cs,slen) -> sysctlWrite oid len cs (fromIntegral slen)