module System.Win32.DHCP
( DhcpApi ()
, loadDHCP
, Context (..)
, ClientType (..)
, DATE_TIME (..)
, HOST_INFO (..)
, SEARCH_INFO (..)
, Client (..)
, enumClients
, lookupClient
, deleteClient
, Mapping (..)
, Reservation(..)
, addReservation
, enumReservations
, removeReservation
) where
import Control.Monad (unless)
import Foreign
import Foreign.C.Types
import System.Win32.Types
import Data.Ip
import System.Win32.DHCP.DhcpStructure
import System.Win32.DHCP.HOST_INFO
import System.Win32.DHCP.Internal
import System.Win32.DHCP.Client
import System.Win32.DHCP.LengthBuffer
import System.Win32.DHCP.Reservation
import System.Win32.DHCP.SEARCH_INFO
import System.Win32.DHCP.SUBNET_CLIENT_INFO_ARRAY_V4
import System.Win32.DHCP.SUBNET_ELEMENT_DATA_V4
import System.Win32.DHCP.SUBNET_ELEMENT_INFO_ARRAY_V4
import System.Win32.DHCP.Types
data Context = Context
{
contextServer :: !String
,
contextSubnet :: !Ip
} deriving (Eq, Ord)
deleteClient :: DhcpApi
-> String
-> SEARCH_INFO
-> IO ()
deleteClient api server si =
withTString server $ \pserver ->
withSearchInfo si $ \psi -> do
failUnlessSuccess (unwords ["DeleteClientInfo", server, show si])
$ c_DeleteClientInfo api pserver psi
enumClients :: DhcpApi
-> Context
-> IO [Client]
enumClients dhcp (Context server subnet) =
enumSubnetClientsV4 dhcp server subnet
lookupClient :: DhcpApi
-> String
-> SEARCH_INFO
-> IO (Maybe Client)
lookupClient api serverip si =
withTString serverip $ \pserverip ->
withSearchInfo si $ \psi ->
with nullPtr $ \ppclientinfo -> do
siType <- peek (castPtr psi :: Ptr CInt)
siPayload <- peekElemOff (castPtr psi :: Ptr (Ptr ())) 4
failUnlessSuccess (unwords ["GetClientInfoV4", serverip, show si])
$ c_GetClientInfoV4 api pserverip siType siPayload ppclientinfo
pclientinfo <- peek ppclientinfo
if pclientinfo == nullPtr
then return Nothing
else do
clientinfo <- peekDhcp clientInfo pclientinfo
freeDhcp clientInfo (rpcFreeMemory api) pclientinfo
poke (castPtr pclientinfo) nullPtr
return $ Just clientinfo
addReservation :: DhcpApi -> Context -> Mapping -> IO ()
addReservation dhcp (Context server subnet) mapping =
addSubnetElementV4 dhcp server subnet
$ ReservedIps (Reservation mapping Both)
enumReservations :: DhcpApi -> Context -> IO [Reservation]
enumReservations dhcp (Context server subnet) = do
ex <- enumSubnetElementsV4 dhcp server subnet 2
res <- flip mapM ex $ \element -> do
case element of
ReservedIps res -> return res
_ -> error "bug in Win32 API."
return res
removeReservation :: DhcpApi -> Context -> Mapping
-> ClientType
-> Bool
-> IO ()
removeReservation dhcp (Context server subnet) mapping ct force =
removeSubnetElementV4 dhcp server subnet
(ReservedIps $ Reservation mapping ct) fForce
where
fForce = if force then FullForce else NoForce
enumSubnetClientsV4 :: DhcpApi -> String -> Ip -> IO [Client]
enumSubnetClientsV4 dhcp server subnet =
withTString server $ \pServer ->
with 0 $ \pResumeHandle ->
alloca $ \pElementsRead ->
alloca $ \pElementsTotal ->
with nullPtr $ \ppInfoArray -> do
let loop acc = do
ret <- c_EnumSubnetClientsV4 dhcp pServer (toWord32 subnet)
pResumeHandle 0xFFFFFFFF ppInfoArray
pElementsRead pElementsTotal
unless (elem ret [eRROR_SUCCESS, eRROR_MORE_DATA, eRROR_NO_MORE_ITEMS]) $ do
failWith (unwords ["EnumSubnetClientsV4", server, showIp subnet]) ret
pInfoArray <- peek ppInfoArray
elems <- if pInfoArray == nullPtr
then return []
else do
SUBNET_CLIENT_INFO_ARRAY_V4 (LengthBuffer _ elems) <- peekDhcp clientInfoArray pInfoArray
freeDhcp clientInfoArray (rpcFreeMemory dhcp) pInfoArray
poke ppInfoArray nullPtr
return elems
elementsTotal <- peek pElementsTotal
elementsRead <- peek pElementsRead
if (ret == eRROR_NO_MORE_ITEMS || (ret == eRROR_SUCCESS && elementsTotal == elementsRead))
then return (eRROR_SUCCESS, elems:acc)
else loop (elems:acc)
(ret, revelemss) <- loop []
failUnlessSuccess (unwords ["EnumSubnetClientsV4", server, showIp subnet])
$ return ret
return $ concat $ reverse revelemss
where
eRROR_SUCCESS = 0x00000000
eRROR_NO_MORE_ITEMS = 0x00000103
eRROR_MORE_DATA = 0x000000ea
enumSubnetElementsV4 :: DhcpApi -> String -> Ip -> CInt
-> IO [SUBNET_ELEMENT_DATA_V4]
enumSubnetElementsV4 dhcp server subnet elementType =
withTString server $ \pServer ->
with 0 $ \pResumeHandle ->
alloca $ \pElementsRead ->
alloca $ \pElementsTotal ->
with nullPtr $ \ppEnumElementInfoArray -> do
let loop acc = do
ret <- c_EnumSubnetElementsV4 dhcp pServer (toWord32 subnet) elementType
pResumeHandle 0xFFFFFFFF ppEnumElementInfoArray
pElementsRead pElementsTotal
unless (elem ret [eRROR_SUCCESS, eRROR_MORE_DATA, eRROR_NO_MORE_ITEMS]) $ do
failWith (unwords ["EnumSubnetElementsV4", server
, showIp subnet, show elementType]) ret
pEnumElementInfoArray <- peek ppEnumElementInfoArray
elems <- if pEnumElementInfoArray == nullPtr
then return []
else do
SUBNET_ELEMENT_INFO_ARRAY_V4 (LengthBuffer _ elems) <- peekDhcp infoArray pEnumElementInfoArray
freeDhcp infoArray (rpcFreeMemory dhcp) pEnumElementInfoArray
poke ppEnumElementInfoArray nullPtr
return elems
elementsTotal <- peek pElementsTotal
if (ret == eRROR_NO_MORE_ITEMS || (ret == eRROR_SUCCESS && elementsTotal == 0))
then return (eRROR_SUCCESS, elems:acc)
else loop (elems:acc)
(ret, revelemss) <- loop []
failUnlessSuccess (unwords ["EnumSubnetElementsV4", server
, showIp subnet, show elementType])
$ return ret
return $ concat $ reverse revelemss
where
eRROR_SUCCESS = 0x00000000
eRROR_NO_MORE_ITEMS = 0x00000103
eRROR_MORE_DATA = 0x000000ea
addSubnetElementV4 :: DhcpApi -> String -> Ip -> SUBNET_ELEMENT_DATA_V4 -> IO ()
addSubnetElementV4 dhcp server subnet elementData =
withTString server $ \pServer ->
withDhcp subnetElementData elementData $ \pElementData ->
failUnlessSuccess (unwords ["AddSubnetElementsV4", server, showIp subnet])
$ c_AddSubnetElementV4 dhcp pServer (toWord32 subnet) pElementData
removeSubnetElementV4
:: DhcpApi
-> String
-> Ip
-> SUBNET_ELEMENT_DATA_V4
-> FORCE_FLAG
-> IO ()
removeSubnetElementV4 dhcp server subnet elementData forceFlag =
withTString server $ \pServer ->
withDhcp subnetElementData elementData $ \pElementData ->
failUnlessSuccess (unwords ["RemoveSubnetElementV4", server, showIp subnet
, (show . elementTypeOf) elementData])
$ c_RemoveSubnetElementV4 dhcp pServer (toWord32 subnet) pElementData
(fromIntegral . fromEnum $ forceFlag)