hsXenCtrl 0.0.6 → 0.0.7

raw patch · 3 files changed

+425/−22 lines, 3 filesdep +dlistPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: dlist

API changes (from Hackage documentation)

Files

• System/Xen.hs +394/−0
• System/Xen/CBindings.hsc +26/−17
• hsXenCtrl.cabal +5/−5

@@ -0,0 +1,394 @@+module System.Xen+	( Xen+	, runXen+	, runXen_+	, execXen+	, mkCallback+	, xcInterfaceOpen+	, xcInterfaceClose+	, xcFindDeviceNumber+	, xcDomainCreate+	, xcDomainDumpcore+	, xcDomainDumpcoreViaCallback+	, xcDomainMaxVCPUs+	, xcDomainPause+	, xcDomainUnpause+	, xcDomainResume+	, xcDomainShutdown+	, xcVCPUSetAffinity+	, xcVCPUGetAffinity+	, xcDomainGetInfo+	, xcDomainGetInfoList+	, xcDomainHVMGetContext+	, xcDomainHVMSetContext+	, xcVCPUGetInfo+	, xcDomainSetCPUWeight+	, xcDomainGetCPUUsage+	, xcDomainSetHandle+	, xcSedfDomainSet+	, xcSedfDomainGet+	, xcDomainSendTrigger+	, xcEvtChanAllocUnbound+	, xcEvtChanReset+	, xcEvtChanOpen+	, xcEvtChanClose+	, xcEvtChanNotify+	, xcEvtChanBindUnboundPort+	, xcEvtChanBindInterdomain+	, xcEvtChanBindVIRQ+	, xcEvtChanUnbind+	, xcEvtChanPending+	, xcEvtChanUnmask+	-- Types+	, System.Xen.CBindings.DomId(..)+	, DumpcoreCallback+	, XCEHandle+	, EventChannelPort+	) where++import System.Xen.CBindings+import Control.Monad (liftM, ap)+import Control.Monad.Writer+import Control.Monad.Error+import Control.Monad.Trans (lift)+import Data.DList hiding (unfoldr)+import Data.List (foldl', unfoldr)+import Data.Bits ((.|.), testBit, shiftR)+import Data.Word+import Foreign.C (Errno(..), getErrno, CInt)+import Foreign.Ptr+import Foreign.Marshal.Alloc (allocaBytes)+import Foreign.C.String (withCString, CString)+import Foreign.C.Types (CChar)+import Foreign.C (CInt, CUInt)+import Foreign.Storable (peek, sizeOf)+import qualified Data.ByteString as B++instance Ord Errno where+	(Errno a) `compare` (Errno b) = a `compare` b++data XenMessage = XmFunctionCall String | XmError String | XmWarn String | XmInfo String+    deriving (Eq, Ord, Show)++type XenMessages = DList XenMessage++instance Show Errno where+	showsPrec _ (Errno e) = \s -> ("Errno " ++ (show e)) ++ s+++data XenError = XeErrno Errno | XeUnspec | XeString String | XeHandleTNot16Bytes+    deriving (Eq, Ord, Show)++instance Error XenError where+	noMsg = XeUnspec+	strMsg = XeString++-- |Xen is a monad transformer stack consisting of ErrorT, WritterT and IO.+newtype Xen a = X { unXen ::  ErrorT XenError (WriterT XenMessages IO) a }+	deriving (Monad, MonadIO, MonadWriter XenMessages, MonadError XenError)++-- |Given a Xen action and a default value, will run the action returning the result on success+-- or the default value on failure.+runXen :: Xen a -> a -> IO a+runXen act def = do+    res <- execXen act+    case res of+        (Left  _, _) -> return def+        (Right x, _) -> return x++-- |Executes the Xen action+runXen_ :: Xen a -> IO ()+runXen_ act = execXen act >> return ()++-- |Runs the Xen action, returning the result (or Left error) and a trace of messages.+execXen :: Xen a -> IO (Either XenError a, XenMessages)+execXen act = do+    err <- runWriterT (runErrorT $ unXen act)+    case err of+        (Right a,w) -> return (Right a,w)+	(Left e,w) -> return (Left e,w)++errnoOnNegOne :: CInt -> a -> Xen a+errnoOnNegOne (-1) _ = liftIO getErrno >>= throwError . XeErrno+errnoOnNegOne e a    = return a++-- Log Xen Function == lxf+lxf = tell . singleton . XmFunctionCall++xcInterfaceOpen :: Xen XCHandle+xcInterfaceOpen = do+	lxf "xcInterfaceOpen"+	h <- liftIO xc_interface_open+	errnoOnNegOne h (XCHdl h)++xcInterfaceClose :: XCHandle -> Xen ()+xcInterfaceClose hdl = do+	lxf "xcInterfaceClose"+	r <- liftIO $ xc_interface_close hdl+	errnoOnNegOne r ()++xcFindDeviceNumber :: String -> Xen ()+xcFindDeviceNumber str = do+	lxf "xcFindDeviceNumber"+	r <- liftIO (withCString str xc_find_device_number)+	errnoOnNegOne r ()++-- FIXME figure out these arguments+xcDomainCreate :: XCHandle -> Word32 -> XenDomainHandleT -> Word32 -> Ptr Word32 -> Xen ()+xcDomainCreate xh ssid domHdl flags ptr = do+	lxf "xcDomainCreate"+	r <- liftIO $ xc_domain_create xh ssid domHdl flags ptr+	errnoOnNegOne r ()++xcDomainDumpcore :: XCHandle -> DomId -> String -> Xen () +xcDomainDumpcore hdl dom str = do+	lxf "xcDomainDumpcore"+	r <- liftIO (withCString str (xc_domain_dumpcore hdl dom))+	errnoOnNegOne r ()++type DumpcoreCallback = B.ByteString -> IO Int++xcDomainDumpcoreViaCallback :: XCHandle -> DomId -> DumpcoreCallback -> Xen ()+xcDomainDumpcoreViaCallback hdl dom cb = do+	lxf "xcDomainDumpCoreviaCallback"+	r <- liftIO doDump+	errnoOnNegOne r ()+  where+  cbWrapper :: Ptr Word8 -> CString -> CUInt -> IO CInt+  cbWrapper _ buf len = do+		bs <- B.packCStringLen (buf, fromIntegral len)+		r <- cb bs+		return $ fromIntegral r+  doDump = do+	c <- mkCallback cbWrapper+	r <- xc_domain_dumpcore_via_callback hdl dom nullPtr c+	return $ fromIntegral r++foreign import ccall "wrapper"+    mkCallback :: Dumpcore_rtn_t -> IO (FunPtr Dumpcore_rtn_t)++xcDomainMaxVCPUs :: XCHandle -> DomId -> Int -> Xen ()+xcDomainMaxVCPUs hdl dom nr = do+	lxf "xcDomainMaxVCPUs"+	r <- liftIO $ xc_domain_max_vcpus hdl dom (fromIntegral nr)+	errnoOnNegOne r ()++xcDomainPause :: XCHandle -> DomId -> Xen ()+xcDomainPause hdl dom = do+	lxf "xcDomainPause"+	r <- liftIO $ xc_domain_pause hdl dom+	errnoOnNegOne r ()++xcDomainUnpause :: XCHandle -> DomId -> Xen ()+xcDomainUnpause hdl dom = do+	lxf "xcDomainUnpause"+	r <- liftIO $ xc_domain_unpause hdl dom+	errnoOnNegOne r ()++xcDomainDestroy :: XCHandle -> DomId -> Xen ()+xcDomainDestroy hdl dom = do+	lxf "xcDomainDestroy"+	r <- liftIO $ xc_domain_destroy hdl dom+	errnoOnNegOne r ()++xcDomainResume :: XCHandle -> DomId -> Bool -> Xen ()+xcDomainResume hdl dom fast = do+	lxf "xcDomainResume"+	r <- liftIO $ xc_domain_resume hdl dom (fromIntegral $ fromEnum fast)+	errnoOnNegOne r ()++xcDomainShutdown :: XCHandle -> DomId -> XCShutdown -> Xen ()+xcDomainShutdown hdl dom s = do+	lxf "xcDomainShutdown"+	r <- liftIO $ xc_domain_shutdown hdl dom (fromIntegral $ fromEnum s)+	errnoOnNegOne r ()++xcVCPUSetAffinity :: XCHandle -> DomId -> Int -> [Int] -> Xen ()+xcVCPUSetAffinity hdl dom cpu mapping = do+	lxf "xcVCPUSetAffinity"+	let w = foldl' (\a b -> a .|. fromIntegral b) 0 mapping+	r <- liftIO $ xc_vcpu_setaffinity hdl dom (fromIntegral cpu) w+	errnoOnNegOne r ()++xcVCPUGetAffinity :: XCHandle -> DomId -> Int -> Xen [Int]+xcVCPUGetAffinity hdl dom cpu = do+	lxf "xcVCPUGetAffinity"+	(r,m) <- liftIO $ allocaBytes 8 $ \ptr -> do+		r <- xc_vcpu_getaffinity hdl dom (fromIntegral cpu) ptr+		w <- peek ptr+		let mapping = unfoldr bitDecomp (w,0)+		return (r,mapping)+	errnoOnNegOne r m+  where+  bitDecomp :: (Word64, Int) -> Maybe (Int, (Word64, Int))+  bitDecomp (0,_) = Nothing+  bitDecomp (w,c) = if (testBit w 0) then Just (c, (w `shiftR` 1, c + 1)) else bitDecomp (w `shiftR` 1, c + 1)++xcDomainGetInfo :: XCHandle -> DomId -> Int -> Xen XCDomInfo+xcDomainGetInfo hdl dom s = do+	lxf "xcDomainGetInfo"+	(r,i) <- liftIO $ allocaBytes (s * sizeOf (undefined :: XCDomInfo)) $ \ptr -> do+		r <- xc_domain_getinfo hdl dom (fromIntegral s) ptr+		i <- peek ptr+		return (r,i)+	errnoOnNegOne r i++-- FIXME how is this different than xcDomainGetInfo?  Am I using it right?+xcDomainGetInfoList :: XCHandle -> DomId -> Int -> Xen XCDomInfo+xcDomainGetInfoList hdl dom s = do+	lxf "xcDomainGetInfoList" +	(r,i) <- liftIO $ allocaBytes (s * sizeOf (undefined :: XCDomInfo)) $ \ptr -> do+		r <- xc_domain_getinfo hdl dom (fromIntegral s) ptr+		i <- peek ptr+		return (r,i)+	errnoOnNegOne r i++-- according to libxc, xc_domain_hvm_getcontext returns the context size when given a null ptr+xcDomainHVMGetContext :: XCHandle -> DomId -> Xen B.ByteString+xcDomainHVMGetContext hdl dom = do+	lxf "xcDomainHVMGetContext"+	r <- liftIO $ xc_domain_hvm_getcontext hdl dom nullPtr 0+	errnoOnNegOne r ()+	(r',bs) <- liftIO $ allocaBytes (fromIntegral r) $ \ptr -> do+		res <- xc_domain_hvm_getcontext hdl dom ptr (fromIntegral r)+		bs <- B.packCStringLen (castPtr ptr, fromIntegral r)+		return (res, bs)+	errnoOnNegOne r' bs++xcDomainHVMSetContext :: XCHandle -> DomId -> B.ByteString -> Xen ()+xcDomainHVMSetContext hdl dom ctx = do+	lxf "xcDomainHVMSetContext"+	r <- liftIO $ B.useAsCStringLen ctx $ \(ptr,len) ->+		xc_domain_hvm_setcontext hdl dom (castPtr ptr) (fromIntegral len)+	errnoOnNegOne r ()++xcVCPUGetInfo :: XCHandle -> DomId -> Int -> Xen VCPUInfo+xcVCPUGetInfo hdl dom cpu = do+	lxf "xcVCPUGetInfo"+	(r,i) <- liftIO $ allocaBytes (sizeOf (undefined :: VCPUInfo)) $ \ptr -> do+		r <- xc_vcpu_getinfo hdl dom (fromIntegral cpu) ptr+		i <- peek ptr+		return (r,i)+	errnoOnNegOne r i++xcDomainSetCPUWeight :: XCHandle -> DomId -> Float -> Xen ()+xcDomainSetCPUWeight hdl dom w = do+	lxf "xcDomainSetCPUWeight"+	r <- liftIO $ xc_domain_setcpuweight hdl dom (realToFrac w)+	errnoOnNegOne r ()++xcDomainGetCPUUsage :: XCHandle -> DomId -> Int -> Xen Integer+xcDomainGetCPUUsage hdl dom cpu = do+	lxf "xcDomainGetCPUUsage"+	r <- liftIO $ xc_domain_get_cpu_usage hdl dom (fromIntegral cpu)+	errnoOnNegOne (fromIntegral r) (fromIntegral r)++xcDomainSetHandle :: XCHandle -> DomId -> B.ByteString -> Xen ()+xcDomainSetHandle hdl dom h = do+	lxf "xcDomainSetHandle"+	if B.length h /= 16+		then throwError XeHandleTNot16Bytes+		else do r <- liftIO $ B.useAsCString h $ \ptr -> xc_domain_sethandle hdl dom (castPtr ptr)+			errnoOnNegOne r ()+++xcSedfDomainSet :: XCHandle -> DomId -> +			Word64 ->	-- Period+			Word64 ->	-- Slice+			Word64 ->	-- Latency+			Word16 ->	-- Extra time+			Word16 ->	-- Weight+			Xen ()+xcSedfDomainSet hdl dom per slice latency et weight = do+	lxf "xcSedfDomainSet"+	r <- liftIO $ xc_sedf_domain_set hdl dom per slice latency et weight+	errnoOnNegOne r ()++xcSedfDomainGet :: XCHandle -> DomId -> Xen (Word64,Word64,Word64,Word16,Word16)+xcSedfDomainGet hdl dom = do+	lxf "xcSedfDomainGet"+	(r,p,s,l,e,w) <- liftIO $ do+		let w64 = sizeOf (undefined :: Word64)+		    w16 = sizeOf (undefined :: Word16)+		allocaBytes w64 $ \period -> allocaBytes w64 $ \slice -> allocaBytes w64 $ \latency -> do+		allocaBytes w16 $ \extraTime -> allocaBytes w16 $ \weight -> do+		r <- xc_sedf_domain_get hdl dom period slice latency extraTime weight+		p <- peek period+		s <- peek slice+		l <- peek latency+		e <- peek extraTime+		w <- peek weight+		return (r,p,s,l,e,w)+	errnoOnNegOne r (p,s,l,e,w)++xcDomainSendTrigger :: XCHandle -> DomId -> Int -> Int -> Xen ()+xcDomainSendTrigger hdl dom triggerType vcpu = do+	lxf "xcDomainSendTrigger"+	r <- liftIO $ xc_domain_send_trigger hdl dom (fromIntegral triggerType) (fromIntegral vcpu)+	errnoOnNegOne r ()++xcEvtChanAllocUnbound :: XCHandle -> DomId -> DomId -> Xen XCEHandle+xcEvtChanAllocUnbound hdl domA domB = do+	lxf "xcEvtChanAllocUnbound"+	r <- liftIO $ xc_evtchn_alloc_unbound hdl domA domB+	errnoOnNegOne r (XCEHandle r)++xcEvtChanReset :: XCHandle -> DomId -> Xen ()+xcEvtChanReset hdl dom = do+	lxf "xcEvtChanReset"+	r <- liftIO $ xc_evtchn_reset hdl dom+	errnoOnNegOne r ()++xcEvtChanOpen :: Xen XCEHandle+xcEvtChanOpen = do+	lxf "xcEvtChanOpen"+	r <- liftIO xc_evtchn_open+	errnoOnNegOne r (XCEHandle r)++xcEvtChanClose :: XCEHandle -> Xen ()+xcEvtChanClose hdl = do+	lxf "xcEvtChanClose"+	r <- liftIO $ xc_evtchn_close hdl+	errnoOnNegOne r ()++xcEvtChanNotify :: XCEHandle -> EventChannelPort -> Xen ()+xcEvtChanNotify hdl port = do+	lxf "xcEvChanNotify"+	r <- liftIO $ xc_evtchn_notify hdl port+	errnoOnNegOne r ()++xcEvtChanBindUnboundPort :: XCEHandle -> DomId -> Xen EventChannelPort+xcEvtChanBindUnboundPort hdl dom = do+	lxf "xcEvtChanBindUnboundPort"+	r <- liftIO $ xc_evtchn_bind_unbound_port hdl dom+	errnoOnNegOne r (ECPort $ fromIntegral r)++xcEvtChanBindInterdomain :: XCEHandle -> DomId -> EventChannelPort -> Xen EventChannelPort+xcEvtChanBindInterdomain hdl dom port = do+	lxf "xcEvtChanBindInterdomain"+	r <- liftIO $ xc_evtchn_bind_interdomain hdl dom port+	errnoOnNegOne r (ECPort $ fromIntegral r)++xcEvtChanBindVIRQ :: XCEHandle -> Int -> Xen EventChannelPort+xcEvtChanBindVIRQ hdl virq = do+	lxf "xcEvtChanBindVIRQ"+	r <- liftIO $ xc_evtchn_bind_virq hdl (fromIntegral virq)+	errnoOnNegOne r (ECPort $ fromIntegral r)++xcEvtChanUnbind :: XCEHandle -> EventChannelPort -> Xen ()+xcEvtChanUnbind hdl port = do+	lxf "xcEvtChanUnbind"+	r <- liftIO $ xc_evtchn_unbind hdl port+	errnoOnNegOne r ()++xcEvtChanPending :: XCEHandle -> Xen EventChannelPort+xcEvtChanPending hdl = do+	lxf "xcEvtChanPending"+	r <- liftIO $ xc_evtchn_pending hdl+	errnoOnNegOne r (ECPort $ fromIntegral r)++xcEvtChanUnmask :: XCEHandle -> EventChannelPort -> Xen ()+xcEvtChanUnmask hdl port = do+	lxf "xcEvtChanUnmask"+	r <- liftIO $ xc_evtchn_unmask hdl port+	errnoOnNegOne r ()

@@ -21,6 +21,7 @@     , xc_domain_get_cpu_usage     , xc_domain_sethandle     , xc_sedf_domain_set+    , xc_sedf_domain_get     , xc_domain_send_trigger     , xc_vcpu_getinfo     , VCPUInfo(..)@@ -100,7 +101,9 @@     , xc_set_error_handler     , xc_set_hvm_param     , xc_get_hvm_param+#if defined(__powerpc__)     , xc_alloc_real_mode_area+#endif #if defined(__ia64__)     , xc_ia64_save_to_nvram     , xc_ia64_nvram_init@@ -110,7 +113,10 @@     , xc_CORE_MAGIC_HVM     , DomId(..)     , XCHandle(..)+    , XCShutdown(..)+    , XCDomInfo     , EventChanPortOrError+    , Dumpcore_rtn_t     , XCEHandle(..)     , EventChannelPort(..)     , XCPhysInfo(..)@@ -123,6 +129,7 @@     , perfcOpQuery     , MemoryProtectionFlags     , MMUExtOp(..)+    , XenDomainHandleT     ) where  import Data.Bits@@ -167,7 +174,7 @@   flgVals :: [Bool]   flgVals = map (uncurry testBit) (zip (repeat v) [0..31]) -data XC_DomInfo = XC_DomInfo {+data XCDomInfo = XCDomInfo {     diDomId           :: Word32,     diSSIDRef         :: Word32,     diFlags           :: [DomainFlag],@@ -184,7 +191,7 @@ type XenDomainHandle = Word8 type XenDomainHandleT = Ptr Word8 -instance Storable XC_DomInfo where+instance Storable XCDomInfo where     sizeOf _= (#size xc_dominfo_t)     alignment _ = alignment (undefined :: Word64)     peek ptr = do@@ -199,7 +206,7 @@          nrOC  <- (#peek xc_dominfo_t, nr_online_vcpus) ptr          maxCI <- (#peek xc_dominfo_t, max_vcpu_id) ptr          dh    <- peekArray 16 (plusPtr ptr (#offset xc_dominfo_t, handle))-         return $ XC_DomInfo domId ssidRef flags sr nrPgs infoF cpuT maxM nrOC maxCI dh+         return $ XCDomInfo domId ssidRef flags sr nrPgs infoF cpuT maxM nrOC maxCI dh     poke ptr a = do         (#poke xc_dominfo_t, domid) ptr (diDomId a)         (#poke xc_dominfo_t, ssidref) ptr (diSSIDRef a)@@ -244,7 +251,7 @@     poke ptr i = poke (castPtr ptr) i  foreign import ccall unsafe "xc_interface_open"-    xc_interface_open :: IO XCHandle+    xc_interface_open :: IO CInt  foreign import ccall unsafe "xc_interface_close"     xc_interface_close :: XCHandle -> IO CInt@@ -253,15 +260,16 @@     xc_find_device_number :: CString -> IO CInt  foreign import ccall unsafe "xenctrl.h xc_domain_create"-    xc_domain_create :: XCHandle -> DomId -> XenDomainHandleT -> Word32 -> IO CInt+    xc_domain_create :: XCHandle -> Word32 -> XenDomainHandleT -> Word32 -> Ptr Word32 -> IO CInt+--    xc_domain_create :: XCHandle -> DomId -> XenDomainHandleT -> Word32 -> IO CInt  foreign import ccall unsafe "xenctrl.h xc_domain_dumpcore"     xc_domain_dumpcore :: XCHandle -> DomId -> CString -> IO CInt -type Dumpcore_rtn_t = FunPtr (Ptr Word8 -> CString -> CUInt -> IO CInt)+type Dumpcore_rtn_t = (Ptr Word8 -> CString -> CUInt -> IO CInt)  foreign import ccall safe "xenctrl.h xc_domain_dumpcore_via_callback"-    xc_domain_dumpcore_via_callback :: XCHandle -> DomId -> Ptr Word8 -> IO Dumpcore_rtn_t+    xc_domain_dumpcore_via_callback :: XCHandle -> DomId -> Ptr Word8 -> FunPtr Dumpcore_rtn_t -> IO CInt  foreign import ccall unsafe "xenctrl.h xc_domain_max_vcpus"     xc_domain_max_vcpus :: XCHandle -> DomId -> CUInt -> IO CInt@@ -288,10 +296,10 @@     xc_vcpu_getaffinity :: XCHandle -> DomId -> CInt -> Ptr Word64 -> IO CInt  foreign import ccall unsafe "xenctrl.h xc_domain_getinfo"-    xc_domain_getinfo :: XCHandle -> DomId -> CUInt -> Ptr XC_DomInfo -> IO CInt+    xc_domain_getinfo :: XCHandle -> DomId -> CUInt -> Ptr XCDomInfo -> IO CInt  foreign import ccall unsafe "xenctrl.h xc_domain_getinfolist"-    xc_domain_getinfolist :: XCHandle -> DomId -> CUInt -> Ptr XC_DomInfo -> CInt+    xc_domain_getinfolist :: XCHandle -> DomId -> CUInt -> Ptr XCDomInfo -> CInt  foreign import ccall unsafe "xenctrl.h xc_domain_hvm_getcontext"     xc_domain_hvm_getcontext :: XCHandle -> DomId -> Ptr Word8 -> Word32 -> IO CInt@@ -356,10 +364,10 @@  -}  foreign import ccall unsafe "xenctrl.h xc_sedf_domain_set"-    xc_sedf_domain_set :: XCHandle -> DomId -> Word64 -> Word64 -> Word64 -> Word64 -> Word16 -> Word16 -> IO CInt+    xc_sedf_domain_set :: XCHandle -> DomId -> Word64 -> Word64 -> Word64 -> Word16 -> Word16 -> IO CInt  foreign import ccall unsafe "xenctrl.h xc_sedf_domain_get"-    xc_sedf_domain_get :: XCHandle -> DomId -> Ptr Word64 -> Ptr Word64 -> Ptr Word64 -> Ptr Word64 -> Ptr Word16 -> Ptr Word16 -> IO CInt+    xc_sedf_domain_get :: XCHandle -> DomId -> Ptr Word64 -> Ptr Word64 -> Ptr Word64 -> Ptr Word16 -> Ptr Word16 -> IO CInt  {- FIXME make XenDomCtrlSchedCredit (in c: xen_domctrl_sched_credit) and Storable instance  -@@ -376,13 +384,13 @@ -- EVENT CHANNEL FUNCTIONS -- type EventChanPortOrError = CInt -newtype XCEHandle = XCEHdl CInt deriving (Eq, Ord, Show)+newtype XCEHandle = XCEHandle CInt deriving (Eq, Ord, Show)  instance Storable XCEHandle where     sizeOf _ = sizeOf (undefined :: CInt)     alignment _ = alignment (undefined :: CInt)-    peek ptr = peek (castPtr ptr) >>= return . XCEHdl-    poke ptr (XCEHdl h) = poke (castPtr ptr) h+    peek ptr = peek (castPtr ptr) >>= return . XCEHandle+    poke ptr (XCEHandle h) = poke (castPtr ptr) h  foreign import ccall unsafe "xenctrl.h xc_evtchn_alloc_unbound"     xc_evtchn_alloc_unbound :: XCHandle -> DomId -> DomId -> IO EventChanPortOrError@@ -426,7 +434,7 @@     xc_evtchn_pending :: XCEHandle -> IO EventChanPortOrError  foreign import ccall unsafe "xenctrl.h xc_evtchn_unmask"-    xc_evtchn_unmask :: XCEHandle -> IO EventChanPortOrError+    xc_evtchn_unmask :: XCEHandle -> EventChannelPort -> IO CInt  type Bus = CInt type Dev = CInt@@ -714,8 +722,7 @@       xc_error_code_to_desc_c :: CInt -> IO CString  xc_error_code_to_desc :: XCErrorCode -> IO CString-xc_error_code_to_desc c = do-    xc_error_code_to_desc_c (fromIntegral $ fromEnum c)+xc_error_code_to_desc = xc_error_code_to_desc_c . fromIntegral . fromEnum  foreign import ccall unsafe "xenctrl.h xc_set_error_handler"       xc_set_error_handler :: XCErrorHandler -> IO XCErrorHandler@@ -726,8 +733,10 @@ foreign import ccall unsafe "xenctrl.h xc_get_hvm_param"       xc_get_hvm_param :: XCHandle -> DomId_t -> CInt -> Ptr CULong -> IO CInt +#if defined(__powerpc__) foreign import ccall unsafe "xenctrl.h xc_alloc_real_mode_area"       xc_alloc_real_mode_area :: XCHandle -> DomId -> CUInt -> IO CInt+#endif  #if defined(__ia64__) foreign import ccall unsafe "xenctrl.h xc_ia64_save_to_nvram"

@@ -1,12 +1,12 @@ name:                hsXenCtrl-version:             0.0.6+version:             0.0.7 synopsis:            FFI bindings to the Xen Control library. description:         FFI bindings to xenctrl.h and perhaps more.                      The System.Xen.CBindings should provide direct access                      to the C API while System.Xen will eventually provide                      a higher level abstraction.  This library binding                      allows pure haskell programs to use XenCtrl functions;-                     this can be Haskell versions of xend, xm, and+                     these can be Haskell versions of xend, xm, and                      virt-manager but more interesting projects are possible.                      Think about a happs app controlling domains and complex                      policy controls on resource (CPU, memory, PCI) uses.@@ -17,10 +17,10 @@ maintainer:          thomas.dubuisson@gmail.com homepage:            http://haskell.org/haskellwiki/HsXenCtrl stability:           experimental-build-Depends:       base, bytestring, mtl, array+build-Depends:       base, bytestring, mtl, array, dlist build-type:          Simple ghc-options:         -exposed-modules:     System.Xen.CBindings-extensions:          ForeignFunctionInterface, FlexibleInstances+exposed-modules:     System.Xen.CBindings, System.Xen+extensions:          ForeignFunctionInterface, FlexibleInstances, GeneralizedNewtypeDeriving extra-libraries:     xenctrl extra-lib-dirs:      /usr/lib