module System.Win32.DHCP.Client
( Client (..)
, clientInfo
) where
import Data.Ip
import Data.Mac
import Import
import System.Win32.DHCP.CLIENT_UID
import System.Win32.DHCP.DhcpStructure
import System.Win32.DHCP.HOST_INFO
import System.Win32.DHCP.Types
data Client = Client
{ clientIp :: !Ip
, clientSubnetMask :: !Ip
, clientHardwareAddress :: !Mac
, clientName :: Maybe String
, clientComment :: Maybe String
, clientLeaseExpires :: !DATE_TIME
, clientOwnerHost :: !HOST_INFO
, clientType :: !ClientType
}
clientInfo :: DhcpStructure Client
clientInfo = DhcpStructure
{ peekDhcp = peekClientInfoV4
, freeDhcpChildren = freeClientInfoV4
, withDhcp' = withClientInfo'
, sizeDhcp = 48
}
withClientInfo' :: Client -> Ptr Client -> IO r -> IO r
withClientInfo' c ptr f =
withMac (clientHardwareAddress c) $ \pcuidsrc ->
withMaybeTString (clientName c) $ \pclientName ->
withMaybeTString (clientComment c) $ \pclientComment ->
withDhcp' hostInfo (clientOwnerHost c) (pownerHost ptr) $ do
poke (pclientIP ptr) $ clientIp c
poke (psubnetMask ptr) $ clientSubnetMask c
copyBytes (pmac ptr) pcuidsrc $ sizeDhcp clientUid
poke (ppclientName ptr) pclientName
poke (ppclientComment ptr) pclientComment
poke (pleaseExpires ptr) $ clientLeaseExpires c
poke (pclientType ptr) $ clientType c
f
peekClientInfoV4 :: Ptr Client -> IO Client
peekClientInfoV4 ptr = Client
<$> (peek $ pclientIP ptr)
<*> (peek $ psubnetMask ptr)
<*> (macCuid <$> peekDhcp clientUid (pmac ptr))
<*> (peek (ppclientName ptr) >>= peekMaybeTString)
<*> (peek (ppclientComment ptr) >>= peekMaybeTString)
<*> (peek $ pleaseExpires ptr)
<*> (peekDhcp hostInfo $ pownerHost ptr)
<*> (peek $ pclientType ptr)
freeClientInfoV4 :: (forall a. Ptr a -> IO ()) -> Ptr Client -> IO ()
freeClientInfoV4 freefunc ptr = do
freeDhcpChildren clientUid freefunc $ pmac ptr
freefunc `scrubbing_` ppclientName ptr
freefunc `scrubbing_` ppclientComment ptr
freeDhcpChildren hostInfo freefunc $ pownerHost ptr
pclientIP :: Ptr Client -> Ptr Ip
pclientIP = castPtr
psubnetMask :: Ptr Client -> Ptr Ip
psubnetMask ptr = castPtr ptr `plusPtr` 4
pmac :: Ptr Client -> Ptr CLIENT_UID
pmac ptr = castPtr ptr `plusPtr` 8
ppclientName :: Ptr Client -> Ptr LPWSTR
ppclientName ptr = castPtr ptr `plusPtr` 16
ppclientComment :: Ptr Client -> Ptr LPWSTR
ppclientComment ptr = castPtr ptr `plusPtr` 20
pleaseExpires :: Ptr Client -> Ptr DATE_TIME
pleaseExpires ptr = castPtr ptr `plusPtr` 24
pownerHost :: Ptr Client -> Ptr HOST_INFO
pownerHost ptr = castPtr ptr `plusPtr` 32
pclientType :: Ptr Client -> Ptr ClientType
pclientType ptr = castPtr ptr `plusPtr` 44