packages feed

bsd-sysctl (empty) → 1.0.0

raw patch · 7 files changed

+359/−0 lines, 7 filesdep +basesetup-changed

Dependencies added: base

Files

+ LICENSE view
@@ -0,0 +1,23 @@+Copyright (c) 2009 Maxime Henrion <mhenrion@gmail.com>+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.++THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain
+ System/BSD/Sysctl.hsc view
@@ -0,0 +1,224 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+-- vim:filetype=haskell+-----------------------------------------------------------------------------+-- |+-- Module      :  System.BSD.Sysctl+-- Copyright   :  (c) Maxime Henrion 2009+-- License     :  see LICENSE+-- +-- Maintainer  :  mhenrion@gmail.com+-- Stability   :  stable+-- Portability :  portable+--+-- This module allows access to the BSD sysctl(3) interface via the Haskell FFI.+--+-- Convenience functions to read and write the usual sysctl types are provided,+-- as well as more advanced functions to handle binary values given a suitable+-- Storable instance.  It is also possible to retrieve data whose size changes+-- at runtime with the 'sysctlPeekArray' function.+--+-- Nodes may be queried either by their name, their OID as a list of 'Int's, or+-- by an OID returned by 'sysctlNameToOid' if speed is a concern.+-------------------------------------------------------------------------------++#include <sys/param.h>+#include <sys/sysctl.h>+module System.BSD.Sysctl (+  -- * The data types+  SysctlKey,		-- The class of types that can be used to identify a node+  OID,			-- The @OID@ datatype identifies a sysctl node++  -- * Name to OID conversion+  sysctlNameToOid,	-- :: String -> IO OID++  -- * Basic reading functions+  sysctlReadInt,	-- :: SysctlKey k => k -> IO #{type int}+  sysctlReadUInt,	-- :: SysctlKey k => k -> IO #{type unsigned int}+  sysctlReadLong,	-- :: SysctlKey k => k -> IO #{type long}+  sysctlReadULong,	-- :: SysctlKey k => k -> IO #{type unsigned long}+  sysctlReadQuad,	-- :: SysctlKey k => k -> IO Int64+  sysctlReadUQuad,	-- :: SysctlKey k => k -> IO Word64+  sysctlReadString,	-- :: SysctlKey k => k -> IO String++  -- * Advanced reading functions+  sysctlPeek,		-- :: forall k a. (SysctlKey k, Storable a) => k -> IO a+  sysctlPeekArray,	-- :: forall k a. (SysctlKey k, Storable a) => k -> IO [a]++  -- * Basic writing functions+  sysctlWriteInt,	-- :: SysctlKey k => k -> #{type int} -> IO ()+  sysctlWriteUInt,	-- :: SysctlKey k => k -> #{type unsigned int} -> IO ()+  sysctlWriteLong,	-- :: SysctlKey k => k -> #{type long} -> IO ()+  sysctlWriteULong,	-- :: SysctlKey k => k -> #{type unsigned long} -> IO ()+  sysctlWriteQuad,	-- :: SysctlKey k => k -> Int64 -> IO ()+  sysctlWriteUQuad,	-- :: SysctlKey k => k -> Word64 -> IO ()+  sysctlWriteString,	-- :: SysctlKey k => k -> String -> IO ()++  -- * Advanced writing functions+  sysctlPoke		-- :: (SysctlKey k, Storable a) => k -> a -> IO ()+  ) 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 {-# UNPACK #-} !(ForeignPtr CInt)+               {-# UNPACK #-} !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++-- Call sysctl with a size set to 0 to retrieve the size of the object.+sysctlGetSize :: Ptr CInt -> CUInt -> IO CSize+sysctlGetSize oid len = sysctlRead oid len nullPtr 0 (const return)++-- Get the OID corresponding to a sysctl name.+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 = #{const CTL_MAXNAME}++{-+-- This could be used to implement some form of type checking at runtime some+-- day, but the interface is undocumented and probably unportable though.+oidToType :: Ptr CInt -> CUInt -> IO (CUInt, String)+oidToType oid len =+  let len' = len + 2 in+    allocaArray (fromIntegral len') $ \oid' ->+      allocaBytes defaultBufSize $ \buf ->+        alloca $ \sizePtr ->+          do poke oid' 0+             poke (oid' `advancePtr` 1) 4+             copyArray (oid' `advancePtr` 2) oid (fromIntegral len)+             poke sizePtr (fromIntegral defaultBufSize)+             throwErrnoIfMinus1_ "sysctl"+               (c_sysctl oid' len' buf sizePtr nullPtr 0)+             kind <- peek buf+             fmt  <- peekCString (buf `plusPtr` (sizeOf kind))+             return (kind, fmt)+  where defaultBufSize = 1024 -- as in FreeBSD's libc+-}++-- Base primitive for all reading operations.  Abstracts away the low-level C+-- machinery such as using a pointer to have multiple return values.+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++-- Read a sysctl value that is an instance of Storable.+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 #{type int}+sysctlReadInt = sysctlPeek++sysctlReadUInt :: SysctlKey k => k -> IO #{type unsigned int}+sysctlReadUInt = sysctlPeek++sysctlReadLong :: SysctlKey k => k -> IO #{type long}+sysctlReadLong = sysctlPeek++sysctlReadULong :: SysctlKey k => k -> IO #{type unsigned long}+sysctlReadULong = sysctlPeek++sysctlReadQuad :: SysctlKey k => k -> IO Int64+sysctlReadQuad = sysctlPeek++sysctlReadUQuad :: SysctlKey k => k -> IO Word64+sysctlReadUQuad = sysctlPeek++-- Useful specialisation of sysctlRead for when the size of the data isn't+-- statically known, and also potentially variable with time.+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	-- Allows to make room for lists of variable length+    allocaBytes (fromIntegral bufSize) $ \buf ->+      sysctlRead oid len buf bufSize f++-- Retrieve a variable number of elements from a sysctl.+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++-- Read a String from a sysctl.  If the string can possibly change with+-- time, use sysctlPeekArray instead.+sysctlReadString :: SysctlKey k => k -> IO String+sysctlReadString key =+  sysctlReadDynamic key id (curry (peekCStringLen . second ((subtract 1) . fromIntegral)))++-- Base primitive for all writing operations.+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 -> #{type int} -> IO ()+sysctlWriteInt = sysctlPoke++sysctlWriteUInt :: SysctlKey k => k -> #{type unsigned int} -> IO ()+sysctlWriteUInt = sysctlPoke++sysctlWriteLong :: SysctlKey k => k -> #{type long} -> IO ()+sysctlWriteLong = sysctlPoke++sysctlWriteULong :: SysctlKey k => k -> #{type unsigned long} -> 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)
+ bsd-sysctl.cabal view
@@ -0,0 +1,24 @@+Name:		bsd-sysctl+Version:	1.0.0+License-File:	LICENSE+License:	BSD3+Author:		Maxime Henrion+Copyright:	2009, Maxime Henrion+Maintainer:	Maxime Henrion <mhenrion@gmail.com>+Category:	System+Synopsis:	Access to the BSD sysctl(3) interface+Description:	This module provides efficient access to the BSD sysctl(3)+                interface via the Haskell FFI.  It allows to read and write+                both basic sysctl types, as well as complex opaque types+                described via Storable instances.+Build-Type:	Simple+Cabal-Version:	>= 1.2+Tested-with:	GHC ==6.10+Data-Files:	demo/Demo.hsc demo/demo.cabal demo/demo.output++Library+  Build-Depends:	base+  Exposed-Modules:	System.BSD.Sysctl+  Extensions:		ForeignFunctionInterface, ScopedTypeVariables,+                        TypeSynonymInstances, FlexibleInstances+  GHC-Options:		-Wall -O2 -funbox-strict-fields
+ demo/Demo.hsc view
@@ -0,0 +1,65 @@+#include <sys/types.h>+#include <sys/user.h>+#include <sys/time.h>+#include <sys/sysctl.h>+-- vim:filetype=haskell+module Main where++import System.BSD.Sysctl+import System.Posix.Types+import Foreign.C+import Foreign.Ptr+import Foreign.Storable++-- This demo program is designed to run on FreeBSD; other BSD systems+-- are likely to have different names and/or types for these sysctls.++data TimeVal = TimeVal CTime CLong++instance Storable TimeVal where+  sizeOf _    = #{size struct timeval}+  alignment _ = alignment (undefined::CTime)+  peek ptr    = do sec  <- #{peek struct timeval, tv_sec} ptr+                   usec <- #{peek struct timeval, tv_usec} ptr+                   return (TimeVal sec usec)++instance Show TimeVal where+  showsPrec p (TimeVal sec usec) = showString "{ usec = " .+                                   showsPrec p sec .+                                   showString ", usec = " .+                                   showsPrec p usec .+                                   showString " }"++data Proc = Proc CPid CUid String++instance Storable Proc where+  sizeOf _    = #{size struct kinfo_proc}+  alignment _ = alignment (undefined::CInt)+  peek ptr    = do pid <- #{peek struct kinfo_proc, ki_pid} ptr+                   uid <- #{peek struct kinfo_proc, ki_uid} ptr+                   cmd <- peekCString (#{ptr struct kinfo_proc, ki_comm} ptr)+                   return (Proc pid uid cmd )++instance Show Proc where+  showsPrec p (Proc pid uid cmd) = showsPrec p pid .+                                   showString "\t" .+                                   showsPrec p uid .+                                   showString ('\t':cmd)++main :: IO ()+main = do osrelease <- sysctlReadString "kern.osrelease"+          putStrLn ("kern.osrelease: " ++ osrelease)+          tv <- sysctlPeek "kern.boottime" :: IO TimeVal+          putStrLn ("kern.boottime: " ++ show tv)+          maxfiles <- sysctlNameToOid "kern.maxfiles" >>= sysctlReadInt+          putStrLn ("kern.maxfiles: " ++ show maxfiles)+          lastpid <- sysctlReadInt "kern.lastpid"+          putStrLn ("kern.lastpid: " ++ show lastpid)+          numvnodes <- sysctlReadLong "vfs.numvnodes"+          putStrLn ("vfs.numvnodes: " ++ show numvnodes)+          recvspace <- sysctlReadULong "net.inet.tcp.recvspace"+          putStrLn ("net.inet.tcp.recvspace: " ++ show recvspace)+          procs <- sysctlPeekArray "kern.proc.all" :: IO [Proc]+          putStrLn "PID\tUID\tCOMMAND"+          mapM_ print procs+          sysctlWriteInt "vfs.usermount" 0 -- Will explode if not root
+ demo/demo.cabal view
@@ -0,0 +1,6 @@+Name: demo+Version: 0.0+Build-Depends: base, bsd-sysctl+Build-Type: Simple+Executable: demo+Main-is: Demo.hs
+ demo/demo.output view
@@ -0,0 +1,14 @@+kern.osrelease: 7.2-PRERELEASE+kern.boottime: { usec = 1241115805, usec = 736670 }+kern.maxfiles: 32768+kern.lastpid: 90199+vfs.numvnodes: 45973+net.inet.tcp.recvspace: 65536+PID	UID	COMMAND+90199	1001	demo+89970	1001	vim+89593	1001	zsh+87861	1001	screen+87841	1001	ssh+[...lots of lines removed...]+test: sysctl: permission denied (Operation not permitted)