module System.Xen.CBindings
( xc_interface_open
, xc_interface_close
, xc_find_device_number
, xc_domain_create
, xc_domain_dumpcore
, xc_domain_dumpcore_via_callback
, xc_domain_max_vcpus
, xc_domain_pause
, xc_domain_unpause
, xc_domain_destroy
, xc_domain_resume
, xc_domain_shutdown
, xc_vcpu_setaffinity
, xc_vcpu_getaffinity
, xc_domain_getinfo
, xc_domain_getinfolist
, xc_CORE_MAGIC
, xc_CORE_MAGIC_HVM
, DomId(..)
, XCHandle(..)
) where
import Data.Bits
import Data.List (foldl1')
import Data.Word
import Data.Array.IArray
import Foreign.C
import Foreign.Ptr
import Foreign.Storable
import Foreign.Marshal.Array
xc_CORE_MAGIC :: CInt
xc_CORE_MAGIC = 0xF00FEBED
xc_CORE_MAGIC_HVM :: CInt
xc_CORE_MAGIC_HVM = 0xF00FEBEE
data DomainFlag = Dying | Crashed | Shutdown | Paused | Blocked | Running | HVM | Debugged deriving (Eq, Ord, Show, Enum)
instance Storable [DomainFlag] where
sizeOf _ = sizeOf (undefined :: CUInt)
alignment _ = alignment (undefined :: CUInt)
peek ptr = do
v <- peek (castPtr ptr)
return $ fromBits v
poke ptr a = poke (castPtr ptr) (toBits a)
toBits :: [DomainFlag] -> CUInt
toBits flgs = foldl1' (.|.) (map (bit . fromEnum) flgs)
fromBits :: CUInt -> [DomainFlag]
fromBits v = map (toEnum . fst) flagsSet
where
flagsSet :: [(Int,Bool)]
flagsSet = filter ((==True) . snd) (zip [0..] flgVals)
flgVals :: [Bool]
flgVals = map (uncurry testBit) (zip (repeat v) [0..31])
data XC_DomInfo = XC_DomInfo {
diDomId :: Word32,
diSSIDRef :: Word32,
diFlags :: [DomainFlag],
diShutdownReason :: XCShutdown,
diNrPages :: CUInt,
diSharedInfoFrame :: CUInt,
diCpuTime :: Word64,
diMaxMemKB :: CULong,
diNrOnlineVCPUs :: CUInt,
diMaxVCPUId :: CUInt,
diDomHandle :: [XenDomainHandle]
} deriving (Eq, Ord, Show)
type XenDomainHandle = Word8
type XenDomainHandleT = Ptr Word8
instance Storable XC_DomInfo where
sizeOf _= ((60))
alignment _ = alignment (undefined :: Word64)
peek ptr = do
domId <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
ssidRef <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) ptr
flags <- peekByteOff ptr (sizeOf domId + sizeOf ssidRef)
sr <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) ptr
nrPgs <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
infoF <- ((\hsc_ptr -> peekByteOff hsc_ptr 20)) ptr
cpuT <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) ptr
maxM <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) ptr
nrOC <- ((\hsc_ptr -> peekByteOff hsc_ptr 36)) ptr
maxCI <- ((\hsc_ptr -> peekByteOff hsc_ptr 40)) ptr
dh <- peekArray 16 (plusPtr ptr ((44)))
return $ XC_DomInfo domId ssidRef flags sr nrPgs infoF cpuT maxM nrOC maxCI dh
poke ptr a = do
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr (diDomId a)
((\hsc_ptr -> pokeByteOff hsc_ptr 4)) ptr (diSSIDRef a)
pokeByteOff ptr (sizeOf (diDomId a) + sizeOf (diSSIDRef a)) (diFlags a)
((\hsc_ptr -> pokeByteOff hsc_ptr 12)) ptr (diShutdownReason a)
((\hsc_ptr -> pokeByteOff hsc_ptr 16)) ptr (diNrPages a)
((\hsc_ptr -> pokeByteOff hsc_ptr 20)) ptr (diSharedInfoFrame a)
((\hsc_ptr -> pokeByteOff hsc_ptr 24)) ptr (diCpuTime a)
((\hsc_ptr -> pokeByteOff hsc_ptr 32)) ptr (diMaxMemKB a)
((\hsc_ptr -> pokeByteOff hsc_ptr 36)) ptr (diNrOnlineVCPUs a)
((\hsc_ptr -> pokeByteOff hsc_ptr 40)) ptr (diMaxVCPUId a)
let p = plusPtr ptr 76
domHandles = take 16 $ diDomHandle a ++ repeat 0
pokeArray p domHandles
data XCShutdown = SHUTDOWN_poweroff | SHUTDOWN_reboot | SHUTDOWN_suspend | SHUTDOWN_crash
deriving (Eq, Ord, Show, Read, Enum)
instance Storable XCShutdown where
sizeOf _ = sizeOf (undefined :: CInt)
alignment _ = alignment (undefined :: CInt)
peek ptr = peek (castPtr ptr :: Ptr CInt) >>= return . toEnum . fromIntegral
poke ptr a = poke (castPtr ptr :: Ptr CInt) (fromIntegral (fromEnum a))
newtype XCHandle = XCHdl CInt deriving (Eq, Ord, Show)
instance Storable XCHandle where
sizeOf _ = sizeOf (undefined :: CInt)
alignment _ = alignment (undefined :: CInt)
peek ptr = peek (castPtr ptr) >>= return . XCHdl
poke ptr (XCHdl h) = poke (castPtr ptr) h
newtype DomId = DomId Word32 deriving (Eq, Ord, Show)
instance Storable DomId where
sizeOf _ = sizeOf (undefined :: Word32)
alignment _ = alignment (undefined :: Word32)
peek ptr = peek (castPtr ptr) >>= return . DomId
poke ptr i = poke (castPtr ptr) i
foreign import ccall unsafe "xc_interface_open"
xc_interface_open :: IO XCHandle
foreign import ccall unsafe "xc_interface_close"
xc_interface_close :: XCHandle -> IO CInt
foreign import ccall unsafe "xc_find_device_number"
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
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)
foreign import ccall safe "xenctrl.h xc_domain_dumpcore_via_callback"
xc_domain_dumpcore_via_callback :: XCHandle -> DomId -> Ptr Word8 -> IO Dumpcore_rtn_t
foreign import ccall unsafe "xenctrl.h xc_domain_max_vcpus"
xc_domain_max_vcpus :: XCHandle -> DomId -> CUInt -> IO CInt
foreign import ccall unsafe "xenctrl.h xc_domain_pause"
xc_domain_pause :: XCHandle -> DomId -> IO CInt
foreign import ccall unsafe "xenctrl.h xc_domain_unpause"
xc_domain_unpause :: XCHandle -> DomId -> IO CInt
foreign import ccall unsafe "xenctrl.h xc_domain_destroy"
xc_domain_destroy :: XCHandle -> DomId -> IO CInt
foreign import ccall unsafe "xenctrl.h xc_domain_resume"
xc_domain_resume :: XCHandle -> DomId -> CInt -> IO CInt
foreign import ccall unsafe "xenctrl.h xc_domain_shutdown"
xc_domain_shutdown :: XCHandle -> DomId -> CInt -> IO CInt
foreign import ccall unsafe "xenctrl.h xc_vcpu_setaffinity"
xc_vcpu_setaffinity :: XCHandle -> DomId -> CInt -> Word64 -> IO CInt
foreign import ccall unsafe "xenctrl.h xc_vcpu_getaffinity"
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
foreign import ccall unsafe "xenctrl.h xc_domain_getinfolist"
xc_domain_getinfolist :: XCHandle -> DomId -> CUInt -> Ptr XC_DomInfo -> CInt
data XC_Core_Header = XC_Core_Header {
xchMagic :: CInt
, xchNrVCPUs :: CInt
, xchNrPages :: CInt
, xchCTXTOffset :: CInt
, xchIndexOffset :: CInt
, xchPagesOffset :: CInt } deriving (Eq, Ord, Show)
instance Storable XC_Core_Header where
sizeOf _ = ((24))
alignment _ = alignment (undefined :: CInt)
peek ptr = do
m <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
v <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) ptr
p <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
c <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) ptr
i <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
g <- ((\hsc_ptr -> peekByteOff hsc_ptr 20)) ptr
return (XC_Core_Header m v p c i g)
poke ptr (XC_Core_Header m v p c i g) = do
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr m
((\hsc_ptr -> pokeByteOff hsc_ptr 4)) ptr v
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr p
((\hsc_ptr -> pokeByteOff hsc_ptr 12)) ptr c
((\hsc_ptr -> pokeByteOff hsc_ptr 16)) ptr i
((\hsc_ptr -> pokeByteOff hsc_ptr 20)) ptr g