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_domain_hvm_getcontext , xc_domain_hvm_setcontext , xc_domain_setcpuweight , xc_domain_get_cpu_usage , xc_domain_sethandle , xc_sedf_domain_set , xc_sedf_domain_get , xc_domain_send_trigger , xc_vcpu_getinfo , VCPUInfo(..) -- Start Event Channel Functions , xc_evtchn_alloc_unbound , xc_evtchn_reset , xc_evtchn_open , xc_evtchn_close , xc_evtchn_fd , xc_evtchn_notify , xc_evtchn_bind_unbound_port , xc_evtchn_bind_interdomain , xc_evtchn_bind_virq , xc_evtchn_unbind , xc_evtchn_pending , xc_evtchn_unmask , xc_physdev_pci_access_modify , xc_readconsolering , xc_send_debug_keys , xc_physinfo , xc_sched_id , xc_getcpuinfo , xc_domain_setmaxmem , xc_domain_set_memmap_limit , xc_domain_set_time_offset , xc_domain_memory_increase_reservation , xc_domain_memory_decrease_reservation , xc_domain_memory_populate_physmap , xc_domain_ioport_permission , xc_domain_irq_permission , xc_make_page_below_4G , xc_perfc_control , xc_map_foreign_range , xc_map_foreign_batch , xc_translate_foreign_address , xc_get_pfn_list #if defined(__ia64__) , xc_ia64_fpsr_default , xc_ia64_get_pfn_list #endif , xc_copy_to_domain_page , xc_clear_domain_page , xc_mmuext_op , xc_memory_op , xc_get_pfn_type_batch , xc_get_tot_pages -- Trace buffer operations , xc_tbuf_enable , xc_tbuf_disable , xc_tbuf_get_size , xc_tbuf_set_cpu_mask , xc_tbuf_set_evt_mask , xc_domctl , xc_sysctl , xc_version , xc_acm_op -- Grant table operations , GTHandle (..) , xc_gnttab_open , xc_gnttab_close , xc_gnttab_map_grant_ref , xc_gnttab_map_grant_refs , xc_gnttab_munmap , DomId_t , xc_hvm_set_pci_intx_level , xc_hvm_set_isa_irq_level , xc_hvm_set_pci_link_route -- Error handling operations , XCErrorCode(..) , xcMaxErrorMsgLen , XCError(..) , xc_get_last_error , xc_clear_last_error , XCErrorHandler , xc_default_error_handler , xc_error_code_to_desc , 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 #endif -- Start data types , xc_CORE_MAGIC , xc_CORE_MAGIC_HVM , DomId(..) , XCHandle(..) , XCShutdown(..) , XCDomInfo , EventChanPortOrError , Dumpcore_rtn_t , XCEHandle(..) , EventChannelPort(..) , XCPhysInfo(..) , XCCPUInfo(..) , XCperfcDesc(..) , XCperfcVal , XenPFN , PerfcOp , perfcOpReset , perfcOpQuery , MemoryProtectionFlags , MMUExtOp(..) , XenDomainHandleT , XenVersion , xENVER_extraversion , xENVER_compile_info , xENVER_capabilities , xENVER_changeset , xENVER_platform_parameters , xENVER_get_features , xENVER_pagesize , xENVER_guest_handle , xENVER_version ) where import Data.Bits import Data.List (foldl1') import Data.Word import Data.Int import qualified Data.ByteString as B import Data.Array.IArray import Foreign.C import Foreign.Ptr import Foreign.Storable import Foreign.Marshal.Array (peekArray, pokeArray) #include #include #include 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 XCDomInfo = XCDomInfo { 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 XCDomInfo where sizeOf _= (#size xc_dominfo_t) alignment _ = alignment (undefined :: Word64) peek ptr = do domId <- (#peek xc_dominfo_t, domid) ptr ssidRef <- (#peek xc_dominfo_t, ssidref) ptr flags <- peekByteOff ptr (sizeOf domId + sizeOf ssidRef) sr <- (#peek xc_dominfo_t, shutdown_reason) ptr nrPgs <- (#peek xc_dominfo_t, nr_pages) ptr infoF <- (#peek xc_dominfo_t, shared_info_frame) ptr cpuT <- (#peek xc_dominfo_t, cpu_time) ptr maxM <- (#peek xc_dominfo_t, max_memkb) ptr 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 $ 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) pokeByteOff ptr (sizeOf (diDomId a) + sizeOf (diSSIDRef a)) (diFlags a) (#poke xc_dominfo_t, shutdown_reason) ptr (diShutdownReason a) (#poke xc_dominfo_t, nr_pages) ptr (diNrPages a) (#poke xc_dominfo_t, shared_info_frame) ptr (diSharedInfoFrame a) (#poke xc_dominfo_t, cpu_time) ptr (diCpuTime a) (#poke xc_dominfo_t, max_memkb) ptr (diMaxMemKB a) (#poke xc_dominfo_t, nr_online_vcpus) ptr (diNrOnlineVCPUs a) (#poke xc_dominfo_t, max_vcpu_id) ptr (diMaxVCPUId a) let p = plusPtr ptr 76 domHandles = take 16 $ diDomHandle a ++ repeat 0 pokeArray p domHandles -- |SHUTDOWN constants matching those found in 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)) -- |Xen Control Handle identifies the IO channel through which must functions will pass their messages. 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 -- |DomId identifies the Xen VM 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 CInt 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 -> 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 = (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 -> 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 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 XCDomInfo -> IO CInt foreign import ccall unsafe "xenctrl.h xc_domain_getinfolist" 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 foreign import ccall unsafe "xenctrl.h xc_domain_hvm_setcontext" xc_domain_hvm_setcontext :: XCHandle -> DomId -> Ptr Word8 -> Word32 -> IO CInt -- vcpu_info_t == xen_domctl_getvcpuinfo_t data VCPUInfo = VCPUInfo { viVCPU :: Word32, viOnline :: Word8, viBlocked :: Word8, viRunning :: Word8, viCPUTime :: Word64, viCPU :: Word32 } deriving (Eq, Ord, Show) instance Storable VCPUInfo where sizeOf _ = (#size xen_domctl_getvcpuinfo_t) alignment _ = alignment (undefined :: Word64) peek ptr = do v <- (#peek xen_domctl_getvcpuinfo_t, vcpu) ptr o <- (#peek xen_domctl_getvcpuinfo_t, online) ptr b <- (#peek xen_domctl_getvcpuinfo_t, blocked) ptr r <- (#peek xen_domctl_getvcpuinfo_t, running) ptr t <- (#peek xen_domctl_getvcpuinfo_t, cpu_time) ptr c <- (#peek xen_domctl_getvcpuinfo_t, cpu) ptr return $ VCPUInfo v o b r t c poke ptr (VCPUInfo v o b r t c) = do (#poke xen_domctl_getvcpuinfo_t, vcpu) ptr v (#poke xen_domctl_getvcpuinfo_t, online) ptr o (#poke xen_domctl_getvcpuinfo_t, blocked) ptr b (#poke xen_domctl_getvcpuinfo_t, running) ptr r (#poke xen_domctl_getvcpuinfo_t, cpu_time) ptr t (#poke xen_domctl_getvcpuinfo_t, cpu) ptr c -- TODO need to base VCPU_Guest_Context on arch specific info -- -- foreign import ccall unsafe "xenctrl.h xc_vcpu_setcontext" -- xc_vcpu_setcontext :: XCHandle -> DomId -> Word32 -> Ptr VCPU_Guest_Context -> IO CInt -- -- foreign import ccall unsafe"xenctrl.h xc_vcpu_getcontext" -- xc_vcpu_getcontext :: XCHandle -> DomId -> Word32 -> Ptr VCPU_Guest_Context -> IO CInt foreign import ccall unsafe "xenctrl.h xc_vcpu_getinfo" xc_vcpu_getinfo :: XCHandle -> DomId -> Word32 -> Ptr VCPUInfo -> IO CInt foreign import ccall unsafe "xenctrl.h xc_domain_setcpuweight" xc_domain_setcpuweight :: XCHandle -> DomId -> CFloat -> IO CInt foreign import ccall unsafe "xenctrl.h xc_domain_get_cpu_usage" xc_domain_get_cpu_usage :: XCHandle -> DomId -> CInt -> IO CLLong foreign import ccall unsafe "xenctrl.h xc_domain_sethandle" xc_domain_sethandle :: XCHandle -> DomId -> XenDomainHandleT -> IO CInt {- - FIXME make ShadowOpStats and instance for Storable - foreign import ccall unsafe "xenctrl.h xc_shadow_control" - xc_shadow_control :: XCHandle -> DomId -> CUInt -> Ptr CULong -> CULong -> Ptr CULong -> Word32 -> Ptr ShadowOpStats -> IO CInt -} foreign import ccall unsafe "xenctrl.h xc_sedf_domain_set" 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 Word16 -> Ptr Word16 -> IO CInt {- FIXME make XenDomCtrlSchedCredit (in c: xen_domctrl_sched_credit) and Storable instance - - foreign import ccall unsafe "xenctrl.h xc_sched_credit_domain_set" - xc_sched_credit_domain_set :: XCHandle -> DomId -> Ptr XenDomCtrlSchedCredit -> IO CInt - - foreign import ccall unsafe "xenctrl.h xc_sched_credit_domain_get" - xc_sched_credit_domain_get :: XCHandle -> DomId -> Ptr XenDomCtrlSchedCredit -> IO CInt -} foreign import ccall unsafe "xenctrl.h xc_domain_send_trigger" xc_domain_send_trigger :: XCHandle -> DomId -> Word32 -> Word32 -> IO CInt -- EVENT CHANNEL FUNCTIONS -- type EventChanPortOrError = CInt 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 . 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 foreign import ccall unsafe "xenctrl.h xc_evtchn_reset" xc_evtchn_reset :: XCHandle -> DomId -> IO CInt foreign import ccall unsafe "xenctrl.h xc_evtchn_open" xc_evtchn_open :: IO CInt foreign import ccall unsafe "xenctrl.h xc_evtchn_close" xc_evtchn_close :: XCEHandle -> IO CInt foreign import ccall unsafe "xenctrl.h xc_evtchn_fd" xc_evtchn_fd :: CInt -> IO CInt newtype EventChannelPort = ECPort Word32 deriving (Eq, Ord, Show) instance Storable EventChannelPort where sizeOf _ = sizeOf (undefined :: Word32) alignment _ = alignment (undefined :: Word32) peek ptr = peek (castPtr ptr) >>= return . ECPort poke ptr (ECPort p) = poke (castPtr ptr) p foreign import ccall unsafe "xenctrl.h xc_evtchn_notify" xc_evtchn_notify :: XCEHandle -> EventChannelPort -> IO CInt foreign import ccall unsafe "xenctrl.h xc_evtchn_bind_unbound_port" xc_evtchn_bind_unbound_port :: XCEHandle -> DomId -> IO EventChanPortOrError foreign import ccall unsafe "xenctrl.h xc_evtchn_bind_interdomain" xc_evtchn_bind_interdomain :: XCEHandle -> DomId -> EventChannelPort -> IO EventChanPortOrError foreign import ccall unsafe "xenctrl.h xc_evtchn_bind_virq" xc_evtchn_bind_virq :: XCEHandle -> CUInt -> IO EventChanPortOrError foreign import ccall unsafe "xenctrl.h xc_evtchn_unbind" xc_evtchn_unbind :: XCEHandle -> EventChannelPort -> IO CInt foreign import ccall unsafe "xenctrl.h xc_evtchn_pending" xc_evtchn_pending :: XCEHandle -> IO EventChanPortOrError foreign import ccall unsafe "xenctrl.h xc_evtchn_unmask" xc_evtchn_unmask :: XCEHandle -> EventChannelPort -> IO CInt type Bus = CInt type Dev = CInt type Function = CInt type Enable = CInt foreign import ccall unsafe "xenctrl.h xc_physdev_pci_access_modify" xc_physdev_pci_access_modify :: XCHandle -> DomId -> Bus -> Dev -> Function -> Enable -> IO CInt foreign import ccall unsafe "xenctrl.h xc_readconsolering" xc_readconsolering :: XCHandle -> Ptr CString -> Ptr CUInt -> CInt -> IO CInt foreign import ccall unsafe "xenctrl.h xc_send_debug_keys" xc_send_debug_keys :: XCHandle -> CString -> IO CInt data XCPhysInfo = XCPhysInfo { piThreadsPerCore :: Word32, piCoresPerSocket :: Word32, piNrCPUs :: Word32, -- ^ Sockets per node (Xen < 3, I think) or the number of CPUs (Xen >= 3, I think) piMaxNodeId :: Word32, -- ^ Number of nodes (Xen <= 3.4) or the max node ID (Xen >= 4.0) piCPUkhz :: Word32, piTotalPages :: Word64, piFreePages :: Word64, piScrubPages :: Word64, piHWCap :: [Word32] } deriving (Eq, Ord, Show) instance Storable XCPhysInfo where sizeOf _ = (#size xen_sysctl_physinfo_t) alignment _ = alignment (undefined :: Word64) peek ptr = do t <- (#peek xen_sysctl_physinfo_t, threads_per_core) ptr c <- (#peek xen_sysctl_physinfo_t, cores_per_socket) ptr #if XEN_SYSCTL_INTERFACE_VERSION < 6 s <- (#peek xen_sysctl_physinfo_t, sockets_per_node) ptr #else s <- (#peek xen_sysctl_physinfo_t, nr_cpus) ptr #endif #if XEN_SYSCTL_INTERFACE_VERSION < 7 nr <- (#peek xen_sysctl_physinfo_t, nr_nodes) ptr #else nr <- (#peek xen_sysctl_physinfo_t, max_node_id) ptr #endif cpu <- (#peek xen_sysctl_physinfo_t, cpu_khz) ptr tp <- (#peek xen_sysctl_physinfo_t, total_pages) ptr fp <- (#peek xen_sysctl_physinfo_t, free_pages) ptr sp <- (#peek xen_sysctl_physinfo_t, scrub_pages) ptr let p = castPtr (plusPtr ptr (#offset xen_sysctl_physinfo_t, hw_cap)) :: Ptr Word32 hw <- (peekArray 8 p) :: IO [Word32] return $ XCPhysInfo t c s nr cpu tp fp sp hw poke ptr (XCPhysInfo t c s nr cpu tp fp sp hw) = do (#poke xen_sysctl_physinfo_t, threads_per_core) ptr t (#poke xen_sysctl_physinfo_t, cores_per_socket) ptr c #if XEN_SYSCTL_INTERFACE_VERSION < 6 (#poke xen_sysctl_physinfo_t, sockets_per_node) ptr s #else (#poke xen_sysctl_physinfo_t, nr_cpus) ptr s #endif #if XEN_SYSCTL_INTERFACE_VERSION < 7 (#poke xen_sysctl_physinfo_t, nr_nodes) ptr nr #else (#poke xen_sysctl_physinfo_t, max_node_id) ptr nr #endif (#poke xen_sysctl_physinfo_t, cpu_khz) ptr cpu (#poke xen_sysctl_physinfo_t, total_pages) ptr tp (#poke xen_sysctl_physinfo_t, free_pages) ptr fp (#poke xen_sysctl_physinfo_t, scrub_pages) ptr sp let p = castPtr $ plusPtr ptr (#offset xen_sysctl_physinfo_t, hw_cap) pokeArray p hw foreign import ccall unsafe "xenctrl.h xc_physinfo" xc_physinfo :: XCHandle -> Ptr XCPhysInfo -> IO CInt foreign import ccall unsafe "xenctrl.h xc_sched_id" xc_sched_id :: XCHandle -> Ptr CInt -> IO CInt data XCCPUInfo = XCCPUInfo { ciIdleTime :: Word64 } deriving (Eq, Ord, Show) instance Storable XCCPUInfo where sizeOf _ = (#size xen_sysctl_cpuinfo_t) alignment _ = alignment (undefined :: Word64) peek ptr = (#peek xen_sysctl_cpuinfo_t, idletime) ptr >>= return . XCCPUInfo poke ptr (XCCPUInfo i) = (#poke xen_sysctl_cpuinfo_t, idletime) ptr i foreign import ccall unsafe "xenctrl.h xc_getcpuinfo" xc_getcpuinfo :: XCHandle -> CInt -> Ptr XCCPUInfo -> Ptr CInt -> IO CInt foreign import ccall unsafe "xenctrl.h xc_domain_setmaxmem" xc_domain_setmaxmem :: XCHandle -> DomId -> CUInt -> IO CInt foreign import ccall unsafe "xenctrl.h xc_domain_set_memmap_limit" xc_domain_set_memmap_limit :: XCHandle -> DomId -> CULong -> IO CInt foreign import ccall unsafe "xenctrl.h xc_domain_set_time_offset" xc_domain_set_time_offset :: XCHandle -> DomId -> Int32 -> IO CInt #if defined(__powerpc__) type XenPFN = CULLong #else -- x86, x86_64, ia64 type XenPFN = CULong #endif foreign import ccall unsafe "xenctrl.h xc_domain_memory_increase_reservation" xc_domain_memory_increase_reservation :: XCHandle -> DomId -> CULong -> CUInt -> CUInt -> Ptr XenPFN -> IO CInt foreign import ccall unsafe "xenctrl.h xc_domain_memory_decrease_reservation" xc_domain_memory_decrease_reservation :: XCHandle -> DomId -> CULong -> CUInt -> Ptr XenPFN -> IO CInt foreign import ccall unsafe "xenctrl.h xc_domain_memory_populate_physmap" xc_domain_memory_populate_physmap :: XCHandle -> DomId -> CULong -> CUInt -> CUInt -> Ptr XenPFN -> IO CInt foreign import ccall unsafe "xenctrl.h xc_domain_ioport_permission" xc_domain_ioport_permission :: XCHandle -> DomId -> Word32 -> Word32 -> Word32 -> IO CInt foreign import ccall unsafe "xenctrl.h xc_domain_irq_permission" xc_domain_irq_permission :: XCHandle -> DomId -> Word8 -> Word8 -> IO CInt foreign import ccall unsafe "xenctrl.h xc_domain_iomem_permission" xc_domain_iomem_permission :: XCHandle -> DomId -> CULong -> CULong -> Word8 -> IO CInt foreign import ccall unsafe "xenctrl.h xc_make_page_below_4G" xc_make_page_below_4G :: XCHandle -> DomId -> CULong -> IO CULong data XCperfcDesc = XCperfcDesc B.ByteString Word32 type XCperfcVal = Word32 instance Storable XCperfcDesc where sizeOf _ = (#size xen_sysctl_perfc_desc_t) alignment _ = alignment (undefined :: Word32) peek ptr = do bs <- B.packCStringLen (castPtr ptr,80) w <- (#peek xen_sysctl_perfc_desc_t, nr_vals) ptr return $ XCperfcDesc bs w poke ptr (XCperfcDesc bs w) = do pokeArray (castPtr ptr) (take 80 (B.unpack bs ++ repeat 0)) (#poke xen_sysctl_perfc_desc_t, nr_vals) ptr w type PerfcOp = Word32 perfcOpReset = 1 perfcOpQuery = 2 -- |Must mlock() the XCperfc data structures after poking and before calling this function. foreign import ccall unsafe "xenctrl.h xc_perfc_control" xc_perfc_control :: XCHandle -> PerfcOp -> Ptr XCperfcDesc -> Ptr XCperfcVal -> Ptr CInt -> Ptr CInt -> IO CInt type MemoryProtectionFlags = CInt foreign import ccall unsafe "xenctrl.h xc_map_foreign_range" xc_map_foreign_range :: XCHandle -> DomId -> CInt -> MemoryProtectionFlags -> CULong -> IO () foreign import ccall unsafe "xenctrl.h xc_map_foreign_batch" xc_map_foreign_batch :: XCHandle -> DomId -> MemoryProtectionFlags -> Ptr XenPFN -> CInt -> IO () foreign import ccall unsafe "xenctrl.h xc_translate_foreign_address" xc_translate_foreign_address :: XCHandle -> DomId -> CInt -> CULLong -> IO CULong foreign import ccall unsafe "xenctrl.h xc_get_pfn_list" xc_get_pfn_list :: XCHandle -> DomId -> Ptr Word64 -> CULong -> IO CInt #if defined(__ia64__) foreign import ccall unsafe "xenctrl.h xc_ia64_fpsr_default" xc_ia64_fpsr_default :: IO () foreign import ccall unsafe "xenctrl.h xc_ia64_get_pfn_list" xc_ia64_get_pfn_list :: XCHandle -> DomId -> Ptr XenPFN -> CUInt -> CUInt -> IO CInt #endif foreign import ccall unsafe "xenctrl.h xc_copy_to_domain_page" xc_copy_to_domain_page :: XCHandle -> DomId -> CULong -> CString -> IO CInt foreign import ccall unsafe "xenctrl.h xc_clear_domain_page" xc_clear_domain_page :: XCHandle -> DomId -> CULong -> IO CInt foreign import ccall unsafe "xenctrl.h xc_get_max_pages" xc_get_max_pages :: XCHandle -> DomId -> IO CLong -- |The user of MMUExtOp must perform their own marshaling operations, note the lack of a Storable instance. data MMUExtOp = MMUExtOp { opCmd :: CUInt, opArg1 :: Either XenPFN CULong, opArg2 :: Either CUInt (Ptr ()) } deriving (Eq, Ord, Show) foreign import ccall unsafe "xenctrl.h xc_mmuext_op" xc_mmuext_op :: XCHandle -> Ptr MMUExtOp -> CUInt -> DomId -> IO CInt foreign import ccall unsafe "xenctrl.h xc_memory_op" xc_memory_op :: XCHandle -> CInt -> Ptr () -> IO CInt foreign import ccall unsafe "xenctrl.h xc_get_pfn_type_batch" xc_get_pfn_type_batch :: XCHandle -> DomId -> CInt -> Ptr Word32 -> IO CInt foreign import ccall unsafe "xenctrl.h xc_get_tot_pages" xc_get_tot_pages :: XCHandle -> DomId -> IO CLong -- Trace buffer operations foreign import ccall unsafe "xenctrl.h xc_tbuf_enable" xc_tbuf_enable :: XCHandle -> CULong -> Ptr CULong -> Ptr CULong -> IO CInt foreign import ccall unsafe "xenctrl.h xc_tbuf_disable" xc_tbuf_disable :: XCHandle -> IO CInt foreign import ccall unsafe "xenctrl.h xc_tbuf_get_size" xc_tbuf_get_size :: XCHandle -> Ptr CULong -> IO CInt foreign import ccall unsafe "xenctrl.h xc_tbuf_set_cpu_mask" xc_tbuf_set_cpu_mask :: XCHandle -> Word32 -> IO CInt foreign import ccall unsafe "xenctrl.h xc_tbuf_set_evt_mask" xc_tbuf_set_evt_mask :: XCHandle -> Word32 -> IO CInt data XenDomCtl = XenDomCtl data XenSysCtl = XenSysCtl foreign import ccall unsafe "xenctrl.h xc_domctl" xc_domctl :: XCHandle -> Ptr XenDomCtl -> IO CInt foreign import ccall unsafe "xenctrl.h xc_sysctl" xc_sysctl :: XCHandle -> Ptr XenSysCtl -> IO CInt foreign import ccall unsafe "xenctrl.h xc_version" xc_version :: XCHandle -> XenVersion -> Ptr () -> IO CInt foreign import ccall unsafe "xenctrl.h xc_acm_op" xc_acm_op :: XCHandle -> CInt -> Ptr () -> CULong -> IO CInt -- Grant Table Operations newtype GTHandle = GTHandle CInt deriving (Eq, Ord, Show) instance Storable GTHandle where sizeOf _ = sizeOf (undefined :: CInt) alignment _ = alignment (undefined :: CInt) peek ptr = peek (castPtr ptr) >>= return . GTHandle poke ptr (GTHandle h) = poke (castPtr ptr) h foreign import ccall unsafe "xenctrl.h xc_gnttab_open" xc_gnttab_open :: IO CInt -- Does not return GTHandle because (-1) can be returned. foreign import ccall unsafe "xenctrl.h xc_gnttab_close" xc_gnttab_close :: GTHandle -> IO CInt foreign import ccall unsafe "xenctrl.h xc_gnttab_map_grant_ref" xc_gnttab_map_grant_ref :: GTHandle -> DomId -> Word32 -> CInt -> IO (Ptr a) foreign import ccall unsafe "xenctrl.h xc_gnttab_map_grant_refs" xc_gnttab_map_grant_refs :: GTHandle -> Word32 -> Ptr Word32 -> Ptr Word32 -> CInt -> IO (Ptr a) foreign import ccall unsafe "xenctrl.h xc_gnttab_munmap" xc_gnttab_munmap :: GTHandle -> Ptr a -> Word32 -> IO CInt -- FIXME: Why does much of Xen use uint32_t for 'dom' args then have a 16 bit domid_t? type DomId_t = Word16 foreign import ccall unsafe "xenctrl.h xc_hvm_set_pci_intx_level" xc_hvm_set_pci_intx_level :: XCHandle -> DomId_t -> Word8 -> Word8 -> Word8 -> Word8 -> CUInt -> IO CInt foreign import ccall unsafe "xenctrl.h xc_hvm_set_isa_irq_level" xc_hvm_set_isa_irq_level :: XCHandle -> DomId_t -> Word8 -> CUInt -> IO CInt foreign import ccall unsafe "xenctrl.h xc_hvm_set_pci_link_route" xc_hvm_set_pci_link_route :: XCHandle -> DomId_t -> Word8 -> Word8 -> IO CInt data XCErrorCode = XCErrorNone | XCInternalError | XCInvalidKernel | XCInvalidParam | XCOutOfMemory deriving (Eq, Ord, Show, Enum) instance Storable XCErrorCode 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) (fromIntegral (fromEnum a) :: CInt) xcMaxErrorMsgLen = 1024 data XCError = XCError { xceCode :: XCErrorCode, xceMsg :: B.ByteString } deriving (Eq, Ord, Show) foreign import ccall unsafe "xenctrl.h xc_get_last_error" xc_get_last_error :: IO (Ptr XCError) foreign import ccall unsafe "xenctrl.h xc_clear_last_error" xc_clear_last_error :: IO () type XCErrorHandler = FunPtr (XCError -> IO ()) foreign import ccall unsafe "xenctrl.h xc_default_error_handler" xc_default_error_handler :: Ptr XCErrorHandler -> IO () -- arg1 should be XCErrorCode, but GHC rejects that foreign import ccall unsafe "xenctrl.h xc_error_code_to_desc" xc_error_code_to_desc_c :: CInt -> IO CString xc_error_code_to_desc :: XCErrorCode -> IO CString 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 foreign import ccall unsafe "xenctrl.h xc_set_hvm_param" xc_set_hvm_param :: XCHandle -> DomId_t -> CInt -> CULong -> IO CInt 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" xc_ia64_save_to_nvram :: XCHandle -> DomId -> IO CInt foreign import ccall unsafe "xenctrl.h xc_ia64_nvram_init" xc_ia64_nvram_init :: XCHandle -> CString -> DomId -> IO CInt #endif -- Data and functions for debugging 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 _ = (#size xc_core_header_t) alignment _ = alignment (undefined :: CInt) peek ptr = do m <- (#peek xc_core_header_t, xch_magic) ptr v <- (#peek xc_core_header_t, xch_nr_vcpus) ptr p <- (#peek xc_core_header_t, xch_nr_pages) ptr c <- (#peek xc_core_header_t, xch_ctxt_offset) ptr i <- (#peek xc_core_header_t, xch_index_offset) ptr g <- (#peek xc_core_header_t, xch_pages_offset) ptr return (XC_Core_Header m v p c i g) poke ptr (XC_Core_Header m v p c i g) = do (#poke xc_core_header_t, xch_magic) ptr m (#poke xc_core_header_t, xch_nr_vcpus) ptr v (#poke xc_core_header_t, xch_nr_pages) ptr p (#poke xc_core_header_t, xch_ctxt_offset) ptr c (#poke xc_core_header_t, xch_index_offset) ptr i (#poke xc_core_header_t, xch_pages_offset) ptr g newtype XenVersion = XV CInt deriving (Eq, Ord, Show, Enum) instance Storable XenVersion 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) (fromIntegral (fromEnum a) :: CInt) xENVER_version = XV 0 xENVER_extraversion = XV 1 xENVER_compile_info = XV 2 xENVER_capabilities = XV 3 xENVER_changeset = XV 4 xENVER_platform_parameters = XV 5 xENVER_get_features = XV 6 xENVER_pagesize = XV 7 xENVER_guest_handle = XV 8