hsXenCtrl 0.0.2 → 0.0.3
raw patch · 2 files changed
+362/−11 lines, 2 files
Files
- System/Xen/CBindings.hsc +351/−7
- hsXenCtrl.cabal +11/−4
System/Xen/CBindings.hsc view
@@ -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 <xenctrl.h>+#include <xen/sysctl.h> 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 <xen/sched.h>+-- |SHUTDOWN constants matching those found in <xen/sched.h> 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 {
hsXenCtrl.cabal view
@@ -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