diff --git a/System/Xen/CBindings.hsc b/System/Xen/CBindings.hsc --- a/System/Xen/CBindings.hsc +++ b/System/Xen/CBindings.hsc @@ -15,22 +15,87 @@ , 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_domain_send_trigger + -- 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 + , xc_ia64_fpsr_default + , xc_ia64_get_pfn_list + , xc_copy_to_domain_page + , xc_clear_domain_page + , xc_mmuext_op + , xc_memory_op + , xc_get_pfn_type_batch + , xc_get_tot_pages + -- Start data types , xc_CORE_MAGIC , xc_CORE_MAGIC_HVM , DomId(..) , XCHandle(..) + , EventChanPortOrError + , XCEHandle(..) + , EventChannelPort(..) + , XCPhysInfo(..) + , XCCPUInfo(..) + , XCperfcDesc(..) + , XCperfcVal + , XenPFN + , PerfcOp + , perfcOpReset + , perfcOpQuery + , MemoryProtectionFlags + , MMUExtOp(..) ) 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 +import Foreign.Marshal.Array (peekArray, pokeArray) #include +#include xc_CORE_MAGIC :: CInt xc_CORE_MAGIC = 0xF00FEBED @@ -107,9 +172,7 @@ domHandles = take 16 $ diDomHandle a ++ repeat 0 pokeArray p domHandles --- FIXME VCPU Guest Context Type - --- SHUTDOWN constants can be found in +-- |SHUTDOWN constants matching those found in data XCShutdown = SHUTDOWN_poweroff | SHUTDOWN_reboot | SHUTDOWN_suspend | SHUTDOWN_crash deriving (Eq, Ord, Show, Read, Enum) @@ -119,6 +182,7 @@ 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 @@ -127,6 +191,7 @@ 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 @@ -182,14 +247,293 @@ 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 + +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 + -- TODO need to base VCPU_Guest_Context on arch specific info --- how can I trick that info from cabal and use it here? -- -- 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 +-- +-- -- FIXME define VCPUInfo and make a storable instance +-- 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_getinfolist" - xc_domain_getinfolist :: XCHandle -> DomId -> CUInt -> Ptr XC_DomInfo -> 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 -> 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 + +{- 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 = XCEHdl 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 + +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 -> IO EventChanPortOrError + +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, + piSocketsPerNode :: Word32, + piNrNodes :: Word32, + 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 + s <- (#peek xen_sysctl_physinfo_t, sockets_per_node) ptr + nr <- (#peek xen_sysctl_physinfo_t, nr_nodes) ptr + 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 + (#poke xen_sysctl_physinfo_t, sockets_per_node) ptr s + (#poke xen_sysctl_physinfo_t, nr_nodes) ptr nr + (#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 + +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 + +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 -- Data and functions for debugging data XC_Core_Header = XC_Core_Header { diff --git a/hsXenCtrl.cabal b/hsXenCtrl.cabal --- a/hsXenCtrl.cabal +++ b/hsXenCtrl.cabal @@ -1,19 +1,26 @@ name: hsXenCtrl -version: 0.0.2 +version: 0.0.3 synopsis: FFI bindings to the Xen Control library. description: FFI bindings to xenctrl.h and perhaps more. - This is an early (incomplete) release, but in general - the System.Xen.CBindings should provide direct access + The System.Xen.CBindings should provide direct access to the C API while System.Xen will eventually provide - a higher level abstraction. + a higher level abstraction. This library binding + allows pure haskell programs to use XenCtrl functions; + this 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. category: System license: BSD3 license-file: LICENSE author: Thomas M. DuBuisson maintainer: thomas.dubuisson@gmail.com +homepage: http://haskell.org/haskellwiki/HsXenCtrl stability: experimental build-Depends: base, bytestring, mtl, array build-type: Simple ghc-options: exposed-modules: System.Xen.CBindings extensions: ForeignFunctionInterface, FlexibleInstances +extra-libraries: xenctrl +extra-lib-dirs: /usr/lib