packages feed

Win32-dhcp-server (empty) → 0.1

raw patch · 21 files changed

+1614/−0 lines, 21 filesdep +Win32dep +basedep +safesetup-changed

Dependencies added: Win32, base, safe

Files

+ Data/Ip.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+-- | This module was taken, with modifications, from the
+-- <http://hackage.haskell.org/package/maccatcher maccatcher> package.
+module Data.Ip
+    ( Ip ()
+    -- * String conversions
+    , readIp
+    , showIp
+    -- * Octet conversions
+    , fromOctets
+    , toOctets
+    -- * Other conversions
+    , toWord32
+    ) where
+
+import Control.Applicative
+import Data.Bits
+import Data.List (intercalate)
+import Data.Word
+import Foreign
+import Safe
+
+-- |An Ip can be used as an IP address or subnet address.
+--
+-- A `Show` instance is omitted to avoid confusion. Use `showIp` and `readIp`
+-- to convert between `String`s.
+newtype Ip = Ip {unIp :: Word32}
+   deriving (Eq, Ord, Bounded, Storable)
+
+-- |Represent an `Ip` as a `String`.
+--
+-- >>> showIp $ fromOctets 192 168 1 100
+-- "192.168.1.100"
+showIp :: Ip -> String
+showIp ip = intercalate "." . map show $ [a, b, c, d]
+  where (a, b, c, d) = toOctets ip
+
+-- |Parse a `String` value as an `Ip`. The string should be of the form
+-- "X.X.X.X" where each 'X' is a decimal value between 0 and 255 inclusive.
+--
+-- >>> let Just ip = readIp "192.168.1.100"
+-- >>> toOctets ip
+-- (192, 168, 1, 100)
+readIp :: String -> Maybe Ip
+readIp s = case octets' s of
+             [a, b, c, d] -> fromOctets <$> readMay a <*> readMay b
+                                        <*> readMay c <*> readMay d
+             _ -> Nothing
+  where 
+    octets' os = case break (=='.') (dropWhile (=='.') os) of
+                  ("", _) -> []
+                  (o, os') -> o : octets' os'
+
+-- |An IP address is 32-bits wide. This function will construct an `Ip` from
+-- 4 octets.
+fromOctets :: Word8 -> Word8 -> Word8 -> Word8 -> Ip
+fromOctets a b c d = Ip
+      $ (fromIntegral a `shiftL` 24)
+    .|. (fromIntegral b `shiftL` 16)
+    .|. (fromIntegral c `shiftL` 8)
+    .|. (fromIntegral d)
+
+-- |Extract each of the 4 octets from an `Ip`.
+toOctets :: Ip -> (Word8, Word8, Word8, Word8)
+toOctets (Ip word) = (byte 3 word, byte 2 word, byte 1 word, byte 0 word)
+  where
+    byte i w = fromIntegral (w `shiftR` (i * 8))
+
+toWord32 :: Ip -> Word32
+toWord32 = unIp
+ Data/Mac.hs view
@@ -0,0 +1,106 @@+-- | This module was taken, with modifications, from the
+-- <http://hackage.haskell.org/package/maccatcher maccatcher> package.
+module Data.Mac
+    ( Mac ()
+    -- ** String conversions
+    , readMac
+    , showMac
+    -- ** Octet conversions
+    , fromOctets
+    , toOctets
+    -- ** Other conversions
+    , toWord64
+    ) where
+
+import Control.Applicative
+import Data.Bits
+import Data.List
+import Data.Word
+import Foreign
+import Numeric (showHex)
+import Safe
+
+-- |A Mac is a 6-byte unique identifier used in layer-two network addressing.
+-- Its `Storable` instance occupies 6 bytes of memory when `poke`d with the
+-- first byte occupying the lowest address, and the last byte occupying the
+-- highest address.
+--
+-- A `Show` instance is omitted to avoid confusion. Use `showMac` and
+-- `readMac` to convert between `String`s.
+newtype Mac =  Mac { unMac :: Word64 }
+   deriving (Bounded, Eq, Ord)
+
+instance Storable Mac where
+  sizeOf _ =  6
+  alignment _ =  1
+  peek p =  fromOctets <$> (peek $ castPtr p) <*> peekByteOff p 1
+      <*> peekByteOff p 2 <*> peekByteOff p 3 <*> peekByteOff p 4
+      <*> peekByteOff p 5
+  poke p mac   =  do
+    poke (castPtr p) a
+    pokeByteOff p 1 b
+    pokeByteOff p 2 c
+    pokeByteOff p 3 d
+    pokeByteOff p 4 e
+    pokeByteOff p 5 f
+    where
+      (a, b, c, d, e, f) = toOctets mac
+
+toWord64 :: Mac -> Word64
+toWord64 = unMac
+
+-- |Represent a `Mac` as a `String`. The supplied separator will be placed
+-- between each octet in the final output.
+--
+-- >>> showMac "" $ fromOctets 0xa 0xb 0xc 0xd 0xe 0xf
+-- "0a0b0c0d0e0f"
+--
+-- >>> showMac ":" $ fromOctets 0x11 0x22 0x33 0x44 0x55 0x66
+-- "11:22:33:44:55:66"
+showMac :: String -> Mac -> String
+showMac sep mac = intercalate sep
+                . map (\n -> pad 2 $ showHex n "")
+                $ [a, b, c, d, e, f]
+  where
+    (a, b, c, d, e, f) = toOctets mac
+
+pad :: Int -> String -> String
+pad n str = replicate zeroes '0' ++ str
+  where
+    zeroes = max 0 (n - length str)
+
+-- |Parse a `String` value as a `Mac`. The string should not use any
+-- separators between octets.
+--
+-- >>> let Just mac = readMac "000102030405"
+-- >>> toOctets mac
+-- (0, 1, 2, 3, 4, 5)
+readMac :: String -> Maybe Mac
+readMac str = case sequence (go str) of
+    Just [a, b, c, d, e, f] -> Just $ fromOctets a b c d e f
+    _ -> Nothing
+   where
+    go :: String -> [Maybe Word8]
+    -- There should always be 2 characters
+    go [_] = [Nothing]
+    -- We've reached the end
+    go [] = []
+    go s = let (b, rest) = splitAt 2 s in readMay ("0x" ++ b) : go rest
+
+-- |A Mac address is 48-bits wide. This function will construct a `Mac` from
+-- 6 octets.
+fromOctets :: Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Mac
+fromOctets a b c d e f = Mac
+      $ (fromIntegral a `shiftL` 40)
+    .|. (fromIntegral b `shiftL` 32)
+    .|. (fromIntegral c `shiftL` 24)
+    .|. (fromIntegral d `shiftL` 16)
+    .|. (fromIntegral e `shiftL` 8)
+    .|. (fromIntegral f)
+
+-- |Extract each of the 6 octets from a `Mac`.
+toOctets :: Mac -> (Word8, Word8, Word8, Word8, Word8, Word8)
+toOctets (Mac word) = ( byte 5 word, byte 4 word, byte 3 word
+                      , byte 2 word, byte 1 word, byte 0 word)
+  where
+    byte i w = fromIntegral (w `shiftR` (i * 8))
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2013, Michael Steele
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Michael Steele nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple
+main = defaultMain
+ System/Win32/DHCP.hs view
@@ -0,0 +1,281 @@+module System.Win32.DHCP
+    ( DhcpApi ()
+    , loadDHCP
+    -- * General Types
+    , Context (..)
+    , ClientType (..)
+    , DATE_TIME (..)
+    , HOST_INFO (..)
+    , SEARCH_INFO (..)
+    -- * Leases
+    , Client (..)
+    , enumClients
+    , lookupClient
+    , deleteClient
+    -- * Reservations
+    , 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
+
+-- | A Context defines which server and scope within that server a command
+-- refers to.  Microsoft's DHCP server supports multiple scopes. This allows
+-- different configurations to be sent to devices based on their hardware
+-- (MAC) address.  Scopes are identified by their network address.
+data Context = Context
+    { -- | The DHCP server management API uses an RPC mechanism to control the
+      -- server.
+      contextServer :: !String
+    , -- | Scopes are identified by a subnet identifier. This is useful in
+      -- cases where multiple scopes are defined, but still required in the
+      -- common case of a single scope.
+      contextSubnet :: !Ip
+    } deriving (Eq, Ord)
+
+-- | Delete an active DHCP lease from the server.
+-- The `SEARCH_INFO` argument determines which search criteria
+-- to use. Searching by name will delete all active leases
+-- with that name. This action corresponds to MSDN's DhcpDeleteClientInfoV4
+-- function.
+deleteClient :: DhcpApi
+    -> String
+    -- ^ Unicode string that specifies the IP address or hostname of the DHCP
+    -- server.
+    -> SEARCH_INFO
+    -- ^ Define how to lookup a client to delete. Only deleting based on
+    -- IP addresses have been tested.
+    -> IO ()
+    -- ^ This action may throw exceptions. According to Microsoft's protocol
+    -- specification an ERROR_DHCP_JET_ERROR (0x00004E2D) will be returned
+    -- if no client was found on the server.
+deleteClient api server si =
+    withTString server $ \pserver ->
+    withSearchInfo si $ \psi -> do
+    failUnlessSuccess (unwords ["DeleteClientInfo", server, show si])
+        $ c_DeleteClientInfo api pserver psi
+
+-- | Perform a lookup operation for all client lease records within a
+-- scope. This action corresponds to MSDN's DhcpEnumSubnetClientsV4 function.
+enumClients :: DhcpApi
+    -> Context
+    -- ^ Specify which server and scope to search for client leases.
+    -> IO [Client]
+    -- ^ The empty list means that no client records exist for the provided
+    -- subnet. An exception will be thrown if the provided server or subnet
+    -- does not exist, or any other error occurs.
+enumClients dhcp (Context server subnet) =
+    enumSubnetClientsV4 dhcp server subnet
+
+-- | Search the DHCP server for a lease matching the given search criteria.
+-- `Nothing` is returned when no lease was found. This corresponds to MSDN's
+-- DhcpGetClientInfoV4 function.
+lookupClient :: DhcpApi
+    -> String
+    -- ^ According to MSDN this must specify the IP address of the server.
+    -- Other functions (including this one) may or may not also accept
+    -- a Unicode host name.
+    -> SEARCH_INFO
+    -- ^ Define how to lookup a client. Only searching based on an
+    -- IP addresses has been tested.
+    -> IO (Maybe Client)
+    -- ^ A `Nothing` indicates that no client was found. An exception will
+    -- be thrown if any internal error occurs. Though MSDN documents don't say
+    -- so, an ERROR_DHCP_JET_ERROR (0x00004E2D) may be thrown if no client
+    -- record is found. The reason I think this is that other functions are
+    -- said to behave like this.
+lookupClient api serverip si =
+    withTString serverip $ \pserverip ->
+    withSearchInfo si $ \psi ->
+    with nullPtr $ \ppclientinfo -> do
+    -- DhcpGetClientInfo takes a structure on the stack.
+    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
+
+-- | Remove a reservation from the server
+removeReservation :: DhcpApi -> Context -> Mapping
+    -> ClientType
+    -- ^ Specify a DHCP reservation, BOOTP reservation, or both. This is untested.
+    -> Bool
+    -- ^ Specify whether any active leases for the reservation should be
+    -- removed as well.
+    -> 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 ->
+    -- inout parameter. Supply on successive calls to retreive more elements
+    with 0 $ \pResumeHandle ->
+    alloca $ \pElementsRead ->
+    alloca $ \pElementsTotal ->
+    with nullPtr $ \ppInfoArray -> do
+    -- We have to call enumSubnetElementsV4 at least twice for a sucessfull run.
+    -- Failure to use the returned resumeHandle may result in an internal access
+    -- violation within RPCRT4.dll.
+    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 ->
+    -- inout parameter. Supply on successive calls to retreive more elements
+    with 0 $ \pResumeHandle ->
+    alloca $ \pElementsRead ->
+    alloca $ \pElementsTotal ->
+    with nullPtr $ \ppEnumElementInfoArray -> do
+    -- We have to call enumSubnetElementsV4 at least twice for a sucessfull run.
+    -- Failure to use the returned resumeHandle may result in an internal access
+    -- violation within RPCRT4.dll.
+    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
+
+-- | Remove an IPv4 subnet element from an IPv4 subnet defined on the DHCPv4
+--   server.
+removeSubnetElementV4
+    :: DhcpApi
+    -> String -- ^ Unicode string that specifies the IP address, such as
+              --   \"123.456.789.012\", or hostname, such as \"server\",
+              --   of the DHCP server.
+    -> Ip -- ^ 'DWORD' value that specifies the IP address of the
+                  --   subnet gateway and uniquely identifies it. As an
+                  --   example, with the above IP address and a subnet mask
+                  --   of 255.255.255.0, the subnet would be 123.456.789.0.
+                  --   This must then be converted to a 'DWORD' value of
+                  --   2,093,683,968.
+    -> SUBNET_ELEMENT_DATA_V4 -- ^ 'DHCP_SUBNET_ELEMENT_DATA_V4' structure
+                              --   that contains information used to find the
+                              --   element that will be removed from subnet
+                              --   specified in SubnetAddress.
+    -> FORCE_FLAG -- ^ DHCP_FORCE_FLAG enumeration value that indicates
+                  --   whether or not the clients affected by the removal of
+                  --   the subnet element should also be deleted.
+                  -- 
+                  --   Note If the flag is set to DhcpNoForce and this subnet
+                  --   has served an IPv4 address to DHCPv4/BOOTP clients, the
+                  --   IPv4 range is not deleted; conversely, if the flag is
+                  --   set to DhcpFullForce, the IPv4 range is deleted along
+                  --   with the DHCPv4 client lease record on the DHCPv4
+                  --   server.
+    -> IO () -- ^ Following the convention of the Win32 package, an exeption
+             --   indicating the win32 error code will be raised if the
+             --   underlying API call returns anything other than
+             --   ERROR_SUCCESS.
+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)
+ System/Win32/DHCP/CLIENT_UID.hs view
@@ -0,0 +1,55 @@+module System.Win32.DHCP.CLIENT_UID
+    ( CLIENT_UID (..)
+    , clientUid
+    , macCuid
+    , macCuidDrop5
+    , withMac
+    ) where
+
+import Foreign
+import System.Win32.Types
+
+import Data.Mac
+import System.Win32.DHCP.DhcpStructure
+import System.Win32.DHCP.LengthBuffer
+-- typedef struct _DHCP_BINARY_DATA {
+--   DWORD DataLength;
+--   BYTE  *Data;
+-- } DHCP_BINARY_DATA, *LPDHCP_BINARY_DATA, DHCP_CLIENT_UID;
+
+-- Byte 0 - 3: The result of a binary AND on the IP address and the subnet
+--             mask in reverse order.
+-- Byte 4: Hardware identifier. This value is always 0x01.
+-- Byte 5 - 10: The Mac address of the client.
+newtype CLIENT_UID = CLIENT_UID (LengthBuffer BYTE)
+
+unwrap :: CLIENT_UID -> LengthBuffer BYTE
+unwrap (CLIENT_UID uid) = uid
+
+clientUid :: DhcpStructure CLIENT_UID
+clientUid = newtypeDhcpStructure CLIENT_UID unwrap
+    $ lengthBuffer (basicDhcpArray storableDhcpStructure)
+
+-- Functions returning a CLIENT_UID often have the first 5 bytes hold
+-- information about the subnet being used.
+macCuidDrop5 :: CLIENT_UID -> Mac
+macCuidDrop5 (CLIENT_UID (LengthBuffer _ bytes)) = fromOctets a b c d e f
+  where
+    [a, b, c, d, e, f] = drop 5 bytes
+
+macCuid :: CLIENT_UID -> Mac
+macCuid (CLIENT_UID (LengthBuffer _ bytes)) = fromOctets a b c d e f
+  where
+    [a, b, c, d, e, f] = bytes
+
+fromMac :: Mac -> CLIENT_UID
+fromMac mac = CLIENT_UID (LengthBuffer 6 [a, b, c, d, e, f])
+  where
+    (a, b, c, d, e, f) = toOctets mac
+
+-- |When creating CLIENT_UID structures in memory we only need 6 bytes
+-- representing the Mac address. This is contrary to MSDN documentation, which
+-- states that there should be 11 bytes, with the first 5 being constructed
+-- from the IP and subnet.
+withMac :: Mac -> (Ptr CLIENT_UID -> IO b) -> IO b
+withMac mac f = withDhcp clientUid (fromMac mac) f
+ System/Win32/DHCP/Client.hs view
@@ -0,0 +1,117 @@+module System.Win32.DHCP.Client
+  ( Client (..)
+  , clientInfo
+  ) where
+
+import Control.Applicative
+import Foreign
+
+import System.Win32.Types
+
+import Data.Ip
+import Data.Mac
+import System.Win32.DHCP.CLIENT_UID
+import System.Win32.DHCP.DhcpStructure
+import System.Win32.DHCP.HOST_INFO
+import System.Win32.DHCP.Types
+import Utils
+
+-- | Information about an active lease. This type corresponds to
+-- MSDN's DHCP_CLIENT_INFO_V4 structure.
+--
+-- > typedef struct _DHCP_CLIENT_INFO_V4 {
+-- >   DHCP_IP_ADDRESS ClientIpAddress;
+-- >   DHCP_IP_MASK    SubnetMask;
+-- >   DHCP_CLIENT_UID ClientHardwareAddress;
+-- >   LPWSTR          ClientName;
+-- >   LPWSTR          ClientComment;
+-- >   DATE_TIME       ClientLeaseExpires;
+-- >   DHCP_HOST_INFO  OwnerHost;
+-- >   BYTE            bClientType;
+-- > } DHCP_CLIENT_INFO_V4, *LPDHCP_CLIENT_INFO_V4;
+data Client = Client
+    { clientIp              :: !Ip
+    , clientSubnetMask      :: !Ip
+    , clientHardwareAddress :: !Mac
+    , clientName            :: Maybe String
+    , clientComment         :: Maybe String
+    , clientLeaseExpires    :: !DATE_TIME
+    -- ^ MSDN: The date and time the DHCP client lease will expire, in UTC time.
+    --
+    -- I don't know of any available functions to work with a `DATE_TIME`.
+    , clientOwnerHost       :: !HOST_INFO
+    -- ^ Information on the DHCP server that assigned the lease to the client.
+    , clientType            :: !ClientType
+    }
+ 
+clientInfo :: DhcpStructure Client
+clientInfo = DhcpStructure
+    { peekDhcp = peekClientInfoV4
+    , freeDhcp = freeClientInfoV4
+    , withDhcp' = withClientInfo'
+    -- 12-byte alignment because of the inlined HOST_INFO struct
+    , sizeDhcp = 48
+    }
+
+withClientInfo' :: Client -> Ptr Client -> IO r -> IO r
+withClientInfo' c ptr f = 
+    -- The Mac is inlined, so we'll need to copy pmacsrc into pmac
+    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
+    -- we can't use the Storable instance for Mac here.
+    copyBytes (pmac ptr) pcuidsrc $ sizeDhcp clientUid
+    poke (ppclientName ptr)    pclientName
+    poke (ppclientComment ptr) pclientComment
+    poke (pleaseExpires ptr) $ clientLeaseExpires c
+     -- Owner host has already been poked
+    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 :: (Ptr a -> IO ()) -> Ptr Client -> IO ()
+freeClientInfoV4 freefunc ptr = do
+    freeDhcp clientUid freefunc $ pmac ptr
+    freeptr freefunc $ ppclientName ptr
+    freeptr freefunc $ ppclientComment ptr
+    freeDhcp hostInfo freefunc $ pownerHost ptr
+    freefunc $ castPtr ptr
+
+pclientIP :: Ptr Client -> Ptr Ip
+pclientIP = castPtr
+
+psubnetMask :: Ptr Client -> Ptr Ip
+psubnetMask ptr = castPtr ptr `plusPtr` 4
+
+-- The client_uid is inlined into the client_info structure.
+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
+
+-- the HOST_INFO is inlined into the CLIENT_INFO structure
+pownerHost :: Ptr Client -> Ptr HOST_INFO
+pownerHost ptr = castPtr ptr `plusPtr` 32
+
+pclientType :: Ptr Client -> Ptr ClientType
+pclientType ptr = castPtr ptr `plusPtr` 44
+ System/Win32/DHCP/DhcpStructure.hs view
@@ -0,0 +1,177 @@+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE RankNTypes #-}
+
+module System.Win32.DHCP.DhcpStructure where
+
+import Control.Applicative
+import Foreign.Marshal.Alloc (allocaBytes)
+import Foreign.Ptr
+import Foreign.Storable
+
+import Utils (freeptr)
+
+-- |Function dictionary for objects used with the DHCP api.
+--  * Ability to peek from a pointer to that object.
+--  * Ability to properly free an object using Win32's rpcFreeMemory
+--    created by the DHCP api.
+--  * Ability to use the with* metaphor to temporarily poke an
+--    object into C memory, call a continuation on it, and then
+--    free the memory from Haskell's heap.
+--
+-- Extra features made possible by the typeclass
+--  * Ability to turn any Storable instance into a DhpcStructure instance
+--    by wrapping it into a StorableDhcpStructure.
+--  * Ability to peek an array of DHCP structures into a list.
+--  * Ability to poke a list of objects into contiguous memory, then
+--    call a continuation on that block of memory.
+data DhcpStructure a = DhcpStructure
+    { peekDhcp  :: Ptr a -> IO a
+    , freeDhcp  :: forall x. (Ptr x -> IO ()) -> Ptr a -> IO ()
+    -- |Like `withDhcp`, but without any allocation or cleanup of memory.
+    -- The continuation is not automatically given a pointer because
+    -- the caller should already have it.
+    , withDhcp' :: forall r. a -> Ptr a -> IO r -> IO r
+    , sizeDhcp :: Int
+    }
+
+-- |Allocate memory for a structure, poke it into memory, apply
+-- a function, and then clean up the memory.
+withDhcp :: DhcpStructure a -> a -> (Ptr a -> IO r) -> IO r
+withDhcp dict a f = allocaBytes (sizeDhcp dict) $ \ptr ->
+    withDhcp' dict a ptr $ f ptr
+
+-- |Convert a DhcpStructure so that it can be used with a newtype
+-- wrapper.
+newtypeDhcpStructure :: (a -> nt) -> (nt -> a)
+    -> DhcpStructure a -> DhcpStructure nt
+newtypeDhcpStructure wrap unwrap dict =
+    DhcpStructure peekNt freeNt withNt' (sizeDhcp dict)
+  where
+    peekNt ptr = wrap <$> peekDhcp dict (castPtr ptr)
+    freeNt f = freeDhcp dict f . castPtr
+    withNt' a ptr f = withDhcp' dict (unwrap a) (castPtr ptr) f
+
+storableDhcpStructure :: forall a. (Storable a) => DhcpStructure a
+storableDhcpStructure = DhcpStructure
+    { peekDhcp  = peek
+    , freeDhcp  = free
+    , withDhcp' = withStorable'
+    , sizeDhcp  = sizeOf (undefined :: a)
+    }
+  where
+    free freefunc ptr = freeptr freefunc $ castPtr ptr
+    withStorable' x ptr f = poke ptr x >> f
+
+data DhcpArray a = DhcpArray
+    { peekDhcpArray  :: Int -> Ptr a -> IO [a]
+    , freeDhcpArray  :: forall x. (Ptr x -> IO ()) -> Int -> Ptr a -> IO ()
+    , withDhcpArray' :: forall r. [a] -> Ptr a -> IO r -> IO r
+    , dhcpStructure   :: DhcpStructure a
+    }
+
+-- |Allocate enough contiguous memory for each element. Recursively
+-- free all memory once the supplied function returns.
+-- The continuation receives a length argument. This is because
+-- the length must be calculated in the course of execution, and will
+-- likely be needed again by the caller.
+withDhcpArray ::  DhcpArray a -> [a] -> (Int -> Ptr a -> IO r) -> IO r
+withDhcpArray dict elems f =
+    allocaBytes (stride * size) $ \ptr ->
+    -- `f` is meant to be called on the array as a whole; not individual elements.
+    -- It's supplied its pointer here because we want it called on position 0.
+    withDhcpArray' dict elems ptr $ f size ptr
+  where
+    size = length elems
+    stride = sizeDhcp . dhcpStructure $ dict
+
+-- |This dictionary is a default set to "base" other versions on.
+-- Scanning through the buffer happens dhcpSize bytes at a time. Memory
+-- is freed by calling the freeing function on every element in the buffer.
+baseDhcpArray :: DhcpStructure a -> DhcpArray a
+baseDhcpArray s = DhcpArray
+    { peekDhcpArray = basePeekArray s
+    , freeDhcpArray = baseFreeArray s
+    , withDhcpArray' = baseWithArray' s
+    , dhcpStructure = s
+    }
+
+-- |This differs from `baseDhcpArray` in that the entire buffer
+-- is freed with a single call to the freeing function.
+basicDhcpArray :: DhcpStructure a -> DhcpArray a
+basicDhcpArray dict = (baseDhcpArray dict)
+    { freeDhcpArray = basicFreeArray dict
+    }
+
+ptrDhcpArray :: DhcpStructure a -> DhcpArray a
+ptrDhcpArray dict = (baseDhcpArray dict)
+    { peekDhcpArray = ptrPeekArray dict
+    , freeDhcpArray = ptrFreeArray dict
+    , withDhcpArray' = ptrWithArray' dict
+    }
+
+basePeekArray :: DhcpStructure a -> Int -> Ptr a -> IO [a]
+basePeekArray dict numElements ptr
+  | numElements <= 0 = return []
+  | otherwise = f (numElements - 1) []
+  where
+    f 0 acc = do
+        e <- peekDhcp dict ptr
+        return (e:acc)
+    f n acc = do
+        e <- peekDhcp dict (ptr `plusPtr` (sizeDhcp dict * n))
+        f (n - 1) (e:acc)
+
+baseFreeArray :: DhcpStructure a -> (Ptr x -> IO ()) -> Int -> Ptr a -> IO ()
+baseFreeArray dict freefunc len ptr = f (len - 1)
+  where
+    f 0 = freeDhcp dict freefunc ptr
+    f n = do
+        freeDhcp dict freefunc $ ptr `plusPtr` (n * sizeDhcp dict)
+        f (n - 1)
+
+baseWithArray' :: DhcpStructure a -> [a] -> Ptr a -> IO r -> IO r
+baseWithArray' _    []     _   f = f
+baseWithArray' dict (e:es) ptr f =
+    -- We're not concerned with the individual element.
+    withDhcp' dict e ptr
+    $ baseWithArray' dict es (ptr `plusPtr` sizeDhcp dict) f
+
+basicFreeArray :: DhcpStructure a -> (Ptr x -> IO ()) -> Int -> Ptr a -> IO ()
+basicFreeArray dict freefunc _ ptr = freeDhcp dict freefunc ptr
+
+ptrPeekArray :: DhcpStructure a -> Int -> Ptr a -> IO [a]
+ptrPeekArray dict numElements ptr
+  | numElements <= 0 = return []
+  | otherwise = f (numElements - 1) []
+  where
+    --Each element is a pointer to the real data
+    pptr = castPtr ptr
+    f 0 acc = do
+        e <- peek pptr >>= peekDhcp dict
+        return (e:acc)
+    f n acc = do
+        pe <- peek $ pptr `plusPtr` (sizeOf nullPtr * n)
+        e <- peekDhcp dict pe
+        f (n - 1) (e:acc)
+
+ptrFreeArray :: DhcpStructure a -> (Ptr x -> IO ()) -> Int -> Ptr a -> IO ()
+ptrFreeArray dict freefunc len ptr = f (len - 1)
+  where
+    --Each element is a pointer to the real data
+    pptr = castPtr ptr
+    f 0 = peek pptr >>= freeDhcp dict freefunc
+    f n = do
+        pElem <- peek $ pptr `plusPtr` (sizeOf nullPtr * n)
+        freeDhcp dict freefunc pElem
+        f (n - 1)
+
+ptrWithArray' :: DhcpStructure a -> [a] -> Ptr a -> IO r -> IO r
+ptrWithArray' _    []     _   f = f
+ptrWithArray' dict (e:es) ptr f =
+    -- We're not concerned with the individual element.
+    withDhcp dict e $ \pe -> do
+    poke pptr pe
+    ptrWithArray' dict es (ptr `plusPtr` sizeOf nullPtr) f
+  where
+    --Each element is a pointer to the real data
+    pptr = castPtr ptr
+ System/Win32/DHCP/HOST_INFO.hs view
@@ -0,0 +1,56 @@+module System.Win32.DHCP.HOST_INFO
+    ( HOST_INFO (..)
+    , hostInfo
+    ) where
+
+import Control.Applicative
+import Foreign
+
+import System.Win32.Types
+
+import Data.Ip
+import System.Win32.DHCP.DhcpStructure
+import Utils
+
+-- typedef struct _DHCP_HOST_INFO {
+--   DHCP_IP_ADDRESS IpAddress;
+--   LPWSTR          NetBiosName;
+--   LPWSTR          HostName;
+-- } DHCP_HOST_INFO, *LPDHCP_HOST_INFO;
+data HOST_INFO = HOST_INFO !Ip (Maybe String) (Maybe String)
+
+
+hostInfo :: DhcpStructure HOST_INFO
+hostInfo = DhcpStructure
+    { peekDhcp = peekHostInfo
+    , freeDhcp = freeHostInfoChildren
+    , withDhcp' = withHostInfo'
+    , sizeDhcp = 12
+    }
+
+peekHostInfo :: Ptr HOST_INFO -> IO HOST_INFO
+peekHostInfo ptr = do
+    pnetBiosName <- peek $ ppnetBiosName ptr
+    phostName <- peek $ pphostName ptr
+    HOST_INFO <$> peek (castPtr ptr) <*> peekMaybeTString pnetBiosName
+              <*> peekMaybeTString phostName
+
+withHostInfo' :: HOST_INFO -> Ptr HOST_INFO -> IO r -> IO r
+withHostInfo' (HOST_INFO ip netbiosname hostname) ptr f =
+    withMaybeTString netbiosname $ \pnetbiosname ->
+    withMaybeTString hostname    $ \phostname -> do
+    poke (castPtr ptr) ip
+    pokeByteOff (castPtr ptr) 4 pnetbiosname
+    pokeByteOff (castPtr ptr) 8 phostname
+    f
+
+freeHostInfoChildren :: (Ptr a -> IO ()) -> Ptr HOST_INFO -> IO ()
+freeHostInfoChildren rpcfree phi = do
+    freeptr rpcfree $ ppnetBiosName phi
+    freeptr rpcfree $ pphostName phi
+
+ppnetBiosName :: Ptr HOST_INFO -> Ptr LPWSTR
+ppnetBiosName ptr = castPtr ptr `plusPtr` 4
+
+pphostName :: Ptr HOST_INFO -> Ptr LPWSTR
+pphostName ptr = castPtr ptr `plusPtr` 8
+ System/Win32/DHCP/IP_CLUSTER.hs view
@@ -0,0 +1,25 @@+module System.Win32.DHCP.IP_CLUSTER
+    ( IP_CLUSTER (..)
+    ) where
+
+import Control.Applicative
+import Foreign
+
+import System.Win32.Types
+
+import Data.Ip
+
+-- typedef struct _DHCP_IP_CLUSTER {
+--   DHCP_IP_ADDRESS ClusterAddress;
+--   DWORD           ClusterMask;
+-- } DHCP_IP_CLUSTER, *LPDHCP_IP_CLUSTER;
+data IP_CLUSTER = IP_CLUSTER !Ip !DWORD
+
+instance Storable IP_CLUSTER where
+  sizeOf _ = 8
+  alignment _ = 1
+  peek ptr = IP_CLUSTER <$> (peek . castPtr $ ptr)
+      <*> (castPtr ptr `peekByteOff` 4)
+  poke ptr (IP_CLUSTER ip cmask) = do
+      poke (castPtr ptr) ip
+      pokeByteOff (castPtr ptr) 4 cmask
+ System/Win32/DHCP/IP_RANGE.hs view
@@ -0,0 +1,22 @@+module System.Win32.DHCP.IP_RANGE
+    ( IP_RANGE (..)
+    ) where
+
+import Control.Applicative
+import Foreign
+
+import Data.Ip
+
+data IP_RANGE = IP_RANGE !Ip !Ip
+
+instance Storable IP_RANGE where
+  sizeOf _ = 8
+  alignment _ = 1
+  peek ptr = IP_RANGE
+      <$> (peek . castPtr) ptr
+      <*> castPtr ptr `peekByteOff` 4
+  poke ptr (IP_RANGE start end) = do
+      pokeElemOff addrPtr 0 start
+      pokeElemOff addrPtr 1 end
+    where
+      addrPtr = castPtr ptr :: Ptr Ip
+ System/Win32/DHCP/Internal.hs view
@@ -0,0 +1,151 @@+{-# LANGUAGE ForeignFunctionInterface #-}
+
+module System.Win32.DHCP.Internal where
+
+import Foreign
+import Foreign.C
+import System.Win32.DLL
+import System.Win32.Types
+
+import System.Win32.DHCP.Client
+import System.Win32.DHCP.SEARCH_INFO
+import System.Win32.DHCP.SUBNET_CLIENT_INFO_ARRAY_V4
+import System.Win32.DHCP.SUBNET_ELEMENT_INFO_ARRAY_V4
+import System.Win32.DHCP.SUBNET_ELEMENT_DATA_V4
+import System.Win32.DHCP.Types
+
+-- DWORD DHCP_API_FUNCTION DhcpDeleteClientInfo(
+--   _In_  DHCP_CONST WCHAR *ServerIpAddress,
+--   _In_  DHCP_CONST DHCP_SEARCH_INFO *ClientInfo
+-- );
+type DeleteClientInfo = CWString -> Ptr SEARCH_INFO -> IO DWORD
+foreign import stdcall "dynamic"
+    mkDeleteClientInfo :: FunPtr DeleteClientInfo -> DeleteClientInfo
+
+-- DWORD DHCP_API_FUNCTION DhcpEnumSubnetClientsV4(
+--   _In_     DHCP_CONST WCHAR *ServerIpAddress,
+--   _In_     DHCP_IP_ADDRESS SubnetAddress,
+--   _Inout_  DHCP_RESUME_HANDLE *ResumeHandle,
+--   _In_     DWORD PreferredMaximum,
+--   _Out_    LPDHCP_CLIENT_INFO_ARRAY_V4 *ClientInfo,
+--   _Out_    DWORD *ClientsRead,
+--   _Out_    DWORD *ClientsTotal
+-- );
+type EnumSubnetClientsV4 = CWString -> Word32 -> Ptr RESUME_HANDLE
+    -> DWORD -> Ptr (Ptr SUBNET_CLIENT_INFO_ARRAY_V4) -> Ptr DWORD
+    -> Ptr DWORD -> IO DWORD
+foreign import stdcall "dynamic"
+    mkEnumSubnetClientsV4 :: FunPtr EnumSubnetClientsV4
+        -> EnumSubnetClientsV4
+
+-- DWORD DHCP_API_FUNCTION DhcpEnumSubnetElementsV4(
+--   __in     DHCP_CONST WCHAR *ServerIpAddress,
+--   __in     DHCP_IP_ADDRESS SubnetAddress,
+--   __in     DHCP_SUBNET_ELEMENT_TYPE EnumElementType,
+--   __inout  DHCP_RESUME_HANDLE *ResumeHandle,
+--   __in     DWORD PreferredMaximum,
+--   __out    LPDHCP_SUBNET_ELEMENT_INFO_ARRAY_V4 *EnumElementInfo,
+--  __out    DWORD *ElementsRead,
+--  __out    DWORD *ElementsTotal
+-- );
+type EnumSubnetElementsV4 = CWString -> Word32 -> CInt -> Ptr RESUME_HANDLE
+    -> DWORD -> Ptr (Ptr SUBNET_ELEMENT_INFO_ARRAY_V4) -> Ptr DWORD
+    -> Ptr DWORD -> IO DWORD
+foreign import stdcall "dynamic"
+    mkEnumSubnetElementsV4 :: FunPtr EnumSubnetElementsV4
+        -> EnumSubnetElementsV4
+
+-- DWORD DHCP_API_FUNCTION DhcpGetClientInfoV4(
+--   _In_   DHCP_CONST WCHAR ServerIpAddress,
+--   _In_   DHCP_CONST DHCP_SEARCH_INFO SearchInfo,
+--   _Out_  LPDHCP_CLIENT_INFO_V4 *ClientInfo
+-- );
+type GetClientInfoV4 = CWString -> SEARCH_INFO_TYPE -> Ptr ()
+    -> Ptr (Ptr Client) -> IO DWORD
+foreign import stdcall "dynamic"
+    mkGetClientInfoV4 :: FunPtr GetClientInfoV4 -> GetClientInfoV4
+
+-- | Foreign wrapper to DhcpRemoveSubnetElementV4.
+-- 
+--   The DhcpRemoveSubnetElementV4 function removes an IPv4 subnet element
+--   from an IPv4 subnet defined on the DHCPv4 server. The function extends
+--   the functionality provided by DhcpRemoveSubnetElement by allowing the
+--   specification of a subnet that contains client type (DHCP or BOOTP)
+--   information.
+-- 
+--   See <http://msdn.microsoft.com/en-us/library/ee309533(v=VS.85).aspx> for
+--   official documentation.
+-- 
+-- @
+--   DWORD DHCP_API_FUNCTION DhcpRemoveSubnetElementV4(
+--     __in  DHCP_CONST WCHAR *ServerIpAddress,
+--     __in  DHCP_IP_ADDRESS SubnetAddress,
+--     __in  DHCP_CONST DHCP_SUBNET_ELEMENT_DATA_V4 *RemoveElementInfo,
+--     __in  DHCP_FORCE_FLAG ForceFlag
+--   );
+-- @
+type RemoveSubnetElementV4 = CWString -> Word32 -> Ptr SUBNET_ELEMENT_DATA_V4
+    -> CInt -> IO DWORD
+foreign import stdcall "dynamic"
+    mkRemoveSubnetElementV4 :: FunPtr RemoveSubnetElementV4
+        -> RemoveSubnetElementV4
+
+-- DWORD DhcpAddSubnetElementV4(
+--   __in  DHCP_CONST WCHAR *ServerIpAddress,
+--   __in  DHCP_IP_ADDRESS SubnetAddress,
+--   __in  DHCP_CONST DHCP_SUBNET_ELEMENT_DATA_V4 AddElementInfo
+-- );
+type AddSubnetElementV4 = CWString -> Word32 -> Ptr SUBNET_ELEMENT_DATA_V4
+    -> IO DWORD
+foreign import stdcall "dynamic"
+    mkAddSubnetElementV4 :: FunPtr AddSubnetElementV4 -> AddSubnetElementV4
+
+-- VOID DHCP_API_FUNCTION DhcpRpcFreeMemory(
+--   PVOID BufferPointer
+-- );
+type RpcFreeMemory = Ptr () -> IO ()
+foreign import stdcall "dynamic"
+    mkRpcFreeMemory :: FunPtr RpcFreeMemory -> RpcFreeMemory
+
+-- | In an effort to avoid potential compile-time linker errors this package
+-- uses runtime dynamic linking. Internally a `DhcpApi` is a dictionary of
+-- dynamically bound foreign calls. Most actions require one to be passed.
+-- Simply call `loadDhcp` to obtain one.
+data DhcpApi = DhcpApi
+    { c_DeleteClientInfo :: DeleteClientInfo
+    , c_EnumSubnetClientsV4 :: EnumSubnetClientsV4
+    , c_EnumSubnetElementsV4 :: EnumSubnetElementsV4
+    , c_GetClientInfoV4 :: GetClientInfoV4
+    , c_RemoveSubnetElementV4 :: RemoveSubnetElementV4
+    , c_AddSubnetElementV4 :: AddSubnetElementV4
+    , c_RpcFreeMemory :: RpcFreeMemory
+    }
+
+-- | Calling this function performs runtime dynamic linking for every internal
+-- foreign call into the Dhcp Server Management Api. It is safe to call this
+-- action multiple times. I recommend calling this function once as the part
+-- of a process's initialization, and then pass the returned `DhcpApi` to
+-- functions that need it.
+loadDHCP :: IO DhcpApi
+loadDHCP = do
+    lib <- loadLibrary "dhcpsapi"
+    deleteclient <- getProcAddress lib "DhcpDeleteClientInfo"
+    enumClients <- getProcAddress lib "DhcpEnumSubnetClientsV4"
+    enumElements <- getProcAddress lib "DhcpEnumSubnetElementsV4"
+    getclient <- getProcAddress lib "DhcpGetClientInfoV4"
+    remove <- getProcAddress lib "DhcpRemoveSubnetElementV4"
+    add <- getProcAddress lib "DhcpAddSubnetElementV4"
+    rpcfree <- getProcAddress lib "DhcpRpcFreeMemory"
+    return $ DhcpApi (mkDeleteClientInfo . castPtrToFunPtr $ deleteclient)
+                     (mkEnumSubnetClientsV4 . castPtrToFunPtr $ enumClients)
+                     (mkEnumSubnetElementsV4 . castPtrToFunPtr $ enumElements)
+                     (mkGetClientInfoV4 . castPtrToFunPtr $ getclient)
+                     (mkRemoveSubnetElementV4 . castPtrToFunPtr $ remove)
+                     (mkAddSubnetElementV4 . castPtrToFunPtr $ add)
+                     (mkRpcFreeMemory . castPtrToFunPtr $ rpcfree)
+
+-- |Free a block of memory created by DHCP's api.
+--  MSDN only mensions this function in DhcpEnumSubnetElementsV5. The original,
+--  v4, and v6 variants of the function don't say how memory should be freed.
+rpcFreeMemory :: DhcpApi -> Ptr a -> IO ()
+rpcFreeMemory api ptr = c_RpcFreeMemory api $ castPtr ptr
+ System/Win32/DHCP/LengthBuffer.hs view
@@ -0,0 +1,52 @@+module System.Win32.DHCP.LengthBuffer
+  ( LengthBuffer (..)
+  , lengthBuffer
+  ) where
+
+import Control.Applicative
+import Foreign.Ptr
+import Foreign.Storable
+import System.Win32.Types (DWORD)
+
+import System.Win32.DHCP.DhcpStructure
+import Utils (freeptr)
+
+-- |A LengthBuffer is a list of items which can be marshalled in and out
+-- of memory with a `DhcpArray` instance. 
+data LengthBuffer a = LengthBuffer
+    { lbLength :: Int
+    , buffer :: [a]
+    }
+
+lengthBuffer :: DhcpArray a -> DhcpStructure (LengthBuffer a)
+lengthBuffer dict = DhcpStructure
+    { peekDhcp = peekLb dict
+    , freeDhcp = freeLb dict
+    , withDhcp' = withLb' dict
+    , sizeDhcp = 8
+    }
+
+peekLb :: DhcpArray a -> Ptr (LengthBuffer a) -> IO (LengthBuffer a)
+peekLb dict ptr = do
+    len <- fromIntegral <$> peek (pNumElements ptr)
+    pElements <- peek $ ppElements ptr
+    LengthBuffer len <$> peekDhcpArray dict len pElements
+
+freeLb :: DhcpArray a -> (Ptr x -> IO ()) -> Ptr (LengthBuffer a) -> IO ()
+freeLb dict freefunc ptr = do
+    len <- fromIntegral <$> peek (pNumElements ptr)
+    pElements <- peek $ ppElements ptr
+    freeDhcpArray dict freefunc len pElements
+
+withLb' :: DhcpArray a -> LengthBuffer a -> Ptr (LengthBuffer a) -> IO r -> IO r
+withLb' dict (LengthBuffer _ elems) ptr f =
+    withDhcpArray dict elems $ \size pelems -> do
+    pokeByteOff ptr 0 (fromIntegral size :: DWORD)
+    poke (ppElements ptr) (castPtr pelems)
+    f
+
+pNumElements :: Ptr (LengthBuffer a) -> Ptr DWORD
+pNumElements ptr = castPtr ptr
+
+ppElements :: Ptr (LengthBuffer a) -> Ptr (Ptr a)
+ppElements ptr = castPtr ptr `plusPtr` 4
+ System/Win32/DHCP/Reservation.hs view
@@ -0,0 +1,81 @@+module System.Win32.DHCP.Reservation
+    ( Mapping (..)
+    , Reservation (..)
+    , reservation
+    ) where
+
+import Control.Applicative
+import Foreign
+
+import Data.Ip
+import Data.Mac
+import System.Win32.DHCP.CLIENT_UID
+import System.Win32.DHCP.DhcpStructure
+import System.Win32.DHCP.Types (ClientType)
+import Utils (freeptr)
+
+-- | A Reservation guarantees that a device with a given Mac address will
+-- always be assigned to a particular IP address. A reservation is not the
+-- same thing as a lease, and there are separate calls to work with both
+-- objects.
+--
+-- This type corresponds to MSDN's DHCP_IP_RESERVATION_V4 structure.
+--
+-- > typedef struct _DHCP_IP_RESERVATION_V4 {
+-- >   DHCP_IP_ADDRESS ReservedIpAddress;
+-- >   DHCP_CLIENT_UID *ReservedForClient;
+-- >   BYTE            bAllowedClientTypes;
+-- > } DHCP_IP_RESERVATION_V4, *LPDHCP_IP_RESERVATION_V4;
+data Reservation = Reservation
+    { reservationMapping :: !Mapping
+    , reservationType    :: !ClientType
+    } deriving (Eq)
+
+-- | A mapping between an IP and a MAC address. Each IP number may map to
+-- only one MAC address, and each MAC address may map to only one IP number.
+--
+-- This is a separate type from `Reservation` for practical reasons. When
+-- writing software to work with a DHCP server, `Reservation`'s
+-- `ClientType` field is often not important. Without the `Mapping` type
+-- defined here it would often be necessary to define a custom type in
+-- each project.
+data Mapping = Mapping
+    { mappingMac :: !Mac
+    , mappingIp  :: !Ip
+    } deriving (Eq, Ord)
+
+reservation :: DhcpStructure Reservation
+reservation = DhcpStructure
+    { peekDhcp = peekReservation
+    , freeDhcp = freeReservation
+    , withDhcp' = withReservation'
+    , sizeDhcp = 10
+    }
+
+peekReservation :: Ptr Reservation -> IO Reservation
+peekReservation ptr = do
+    pCuid <- peek $ ppCuid ptr
+    mac <- macCuidDrop5 <$> peekDhcp clientUid pCuid
+    addr <- peek pAddress
+    clientType <- peekByteOff (castPtr ptr) 8
+    return $ Reservation (Mapping mac addr) clientType
+  where
+    pAddress = castPtr ptr :: Ptr Ip
+
+freeReservation :: (Ptr a -> IO ()) -> Ptr Reservation -> IO ()
+freeReservation freefunc ptr = do
+    peek (ppCuid ptr) >>= freeDhcp clientUid freefunc
+    freeptr freefunc $ ppCuid ptr
+    freefunc $ castPtr ptr
+
+ppCuid :: Ptr Reservation -> Ptr (Ptr CLIENT_UID)
+ppCuid ptr = castPtr ptr `plusPtr` 4
+
+withReservation' :: Reservation -> Ptr Reservation
+    -> IO r -> IO r
+withReservation' (Reservation (Mapping mac address) clientType) ptr f =
+    withMac mac $ \pCuid -> do
+    poke (castPtr ptr) address
+    pokeByteOff (castPtr ptr) 4 pCuid
+    pokeByteOff (castPtr ptr) 8 clientType
+    f
+ System/Win32/DHCP/SEARCH_INFO.hs view
@@ -0,0 +1,64 @@+module System.Win32.DHCP.SEARCH_INFO
+  ( SEARCH_INFO_TYPE
+  , SEARCH_INFO (..)
+  , withSearchInfo
+  ) where
+
+import Foreign
+import Foreign.C.Types
+
+import System.Win32.Types
+
+import Data.Ip
+import Data.Mac
+import System.Win32.DHCP.CLIENT_UID
+
+-- typedef enum _DHCP_CLIENT_SEARCH_TYPE { 
+--   DhcpClientIpAddress,
+--   DhcpClientHardwareAddress,
+--   DhcpClientName
+-- } DHCP_SEARCH_INFO_TYPE, *LPDHCP_SEARCH_INFO_TYPE;
+type SEARCH_INFO_TYPE = CInt
+
+-- | Filter criteria used in actions that look up reservation or lease
+-- records.
+--
+-- > typedef struct _DHCP_CLIENT_SEARCH_INFO {
+-- >   DHCP_SEARCH_INFO_TYPE SearchType;
+-- >   union {
+-- >     DHCP_IP_ADDRESS ClientIpAddress;
+-- >     DHCP_CLIENT_UID ClientHardwareAddress;
+-- >     LPWSTR          ClientName;
+-- >   } SearchInfo;
+-- > } DHCP_SEARCH_INFO, *LPDHCP_SEARCH_INFO;
+data SEARCH_INFO
+  -- | Search based on an IP address. All scopes are searched. It should
+  -- not be possible for multiple records to exist.
+  = ClientIpAddress       !Ip
+  -- | Search based on a subnet and MAC address. This method of searching
+  -- has not been tested.
+  | ClientHardwareAddress !Mac
+  -- | Search based on a client's name. Multiple records may exist, and
+  -- what happens in that case will depend on the function being called.
+  -- This method of searching has not been tested.
+  | ClientName            !String
+
+instance Show SEARCH_INFO where
+  show (ClientIpAddress ip) = "ClientIpAddress " ++ showIp ip
+  show (ClientHardwareAddress mac) = "ClientHardwareAddress " ++ showMac ":" mac
+  show (ClientName name) = "ClientName " ++ name
+
+siTypeOf :: SEARCH_INFO -> SEARCH_INFO_TYPE
+siTypeOf (ClientIpAddress _) = 0
+siTypeOf (ClientHardwareAddress _) = 1
+siTypeOf (ClientName _) = 2
+
+-- Allocate 12 because a SEARCH_INFO.SearchInfo member's in-structure alignment is 4 with a size of 8.
+withSearchInfo :: SEARCH_INFO -> (Ptr SEARCH_INFO -> IO r) -> IO r
+withSearchInfo si f = allocaBytes 12 $ \ptr -> do
+    let pX = ptr `plusPtr` 4
+    poke (castPtr ptr) $ siTypeOf si
+    case si of
+      ClientIpAddress x -> poke (castPtr pX) x >> f ptr
+      ClientHardwareAddress m -> withMac m $ \pm -> copyBytes (castPtr pX) pm 8 >> f ptr
+      ClientName str -> withTString str $ \pstr -> copyBytes (castPtr pX) pstr 4 >> f ptr
+ System/Win32/DHCP/SUBNET_CLIENT_INFO_ARRAY_V4.hs view
@@ -0,0 +1,22 @@+module System.Win32.DHCP.SUBNET_CLIENT_INFO_ARRAY_V4
+  ( SUBNET_CLIENT_INFO_ARRAY_V4 (..)
+  , clientInfoArray
+  ) where
+
+import System.Win32.DHCP.Client
+import System.Win32.DHCP.DhcpStructure
+import System.Win32.DHCP.LengthBuffer
+
+-- typedef struct _DHCP_CLIENT_INFO_ARRAY_V4 {
+--   DWORD                 NumElements;
+--   LPDHCP_CLIENT_INFO_V4 *Clients;
+-- } DHCP_CLIENT_INFO_ARRAY_V4, *LPDHCP_CLIENT_INFO_ARRAY_V4;
+newtype SUBNET_CLIENT_INFO_ARRAY_V4
+    = SUBNET_CLIENT_INFO_ARRAY_V4 (LengthBuffer Client)
+
+unwrap :: SUBNET_CLIENT_INFO_ARRAY_V4 -> LengthBuffer Client
+unwrap (SUBNET_CLIENT_INFO_ARRAY_V4 ia) = ia
+
+clientInfoArray :: DhcpStructure SUBNET_CLIENT_INFO_ARRAY_V4
+clientInfoArray = newtypeDhcpStructure SUBNET_CLIENT_INFO_ARRAY_V4 unwrap
+    $ lengthBuffer (ptrDhcpArray clientInfo)
+ System/Win32/DHCP/SUBNET_ELEMENT_DATA_V4.hs view
@@ -0,0 +1,100 @@+module System.Win32.DHCP.SUBNET_ELEMENT_DATA_V4
+    ( SUBNET_ELEMENT_DATA_V4 (..)
+    , SUBNET_ELEMENT_TYPE
+    , elementTypeOf
+    , subnetElementData
+    ) where
+
+import Control.Applicative
+import Foreign
+import Foreign.C.Types
+
+import System.Win32.DHCP.DhcpStructure
+import System.Win32.DHCP.HOST_INFO
+import System.Win32.DHCP.IP_CLUSTER
+import System.Win32.DHCP.IP_RANGE
+import System.Win32.DHCP.Reservation
+
+-- typedef struct _DHCP_SUBNET_ELEMENT_DATA_V4 {
+--   DHCP_SUBNET_ELEMENT_TYPE ElementType;
+--   union {
+--     DHCP_IP_RANGE          *IpRange;
+--     DHCP_HOST_INFO         *SecondaryHost;
+--     DHCP_IP_RESERVATION_V4 *ReservedIp;
+--     DHCP_IP_RANGE          *ExcludeIpRange;
+--     DHCP_IP_CLUSTER        *IpUsedCluster;
+--   } Element;
+-- } DHCP_SUBNET_ELEMENT_DATA_V4, *LPDHCP_SUBNET_ELEMENT_DATA_V4;
+data SUBNET_ELEMENT_DATA_V4
+    = IpRanges         !IP_RANGE
+    | SecondaryHosts   !HOST_INFO
+    | ReservedIps      !Reservation
+    | ExcludedIpRanges !IP_RANGE
+    | IpUsedCluster    !IP_CLUSTER
+
+-- typedef enum _DHCP_SUBNET_ELEMENT_TYPE_V5 {
+--   DhcpIpRanges,
+--   DhcpSecondaryHosts,
+--   DhcpReservedIps,
+--   DhcpExcludedIpRanges,
+--   DhcpIpRangesDhcpOnly,
+--   DhcpIpRangesDhcpBootp,
+--   DhcpIpRangesBootpOnly
+-- } DHCP_SUBNET_ELEMENT_TYPE, *LPDHCP_SUBNET_ELEMENT_TYPE;
+type SUBNET_ELEMENT_TYPE = CInt
+
+subnetElementData :: DhcpStructure SUBNET_ELEMENT_DATA_V4
+subnetElementData = DhcpStructure
+    { peekDhcp = peekSubnetElementData
+    , freeDhcp = freeSubnetElementData
+    , withDhcp' = withSubnetElementData'
+    , sizeDhcp = 8
+    }
+
+peekSubnetElementData :: Ptr SUBNET_ELEMENT_DATA_V4 -> IO SUBNET_ELEMENT_DATA_V4
+peekSubnetElementData ptr = do
+    elementType <- (peek . castPtr) ptr :: IO SUBNET_ELEMENT_TYPE
+    pElement <- peekByteOff ptr 4
+    case elementType of
+      0 -> IpRanges         <$> peek (castPtr pElement)
+      1 -> SecondaryHosts   <$> peekDhcp hostInfo (castPtr pElement)
+      2 -> ReservedIps      <$> peekDhcp reservation (castPtr pElement)
+      3 -> ExcludedIpRanges <$> peek (castPtr pElement)
+      4 -> IpUsedCluster    <$> peek (castPtr pElement)
+      _ -> error "Invalid element type found in SUBNET_ELEMENT_DATA_V4."
+
+freeSubnetElementData :: (Ptr a -> IO ()) -> Ptr SUBNET_ELEMENT_DATA_V4 -> IO ()
+freeSubnetElementData freefunc ptr = do
+    elementType <- (peek . castPtr) ptr :: IO SUBNET_ELEMENT_TYPE
+    pElement <- peek $ ppElement ptr
+    case elementType of
+      0 -> return ()
+      1 -> freeDhcp hostInfo freefunc $ castPtr pElement
+      2 -> freeDhcp reservation freefunc $ castPtr pElement
+      3 -> return ()
+      4 -> return ()
+      _ -> error "Invalid element type found in SUBNET_ELEMENT_DATA_V4."
+    poke (ppElement ptr) nullPtr
+    freefunc $ castPtr ptr
+
+-- Also used by withSubnetElementDataArray.
+withSubnetElementData' :: SUBNET_ELEMENT_DATA_V4 -> Ptr SUBNET_ELEMENT_DATA_V4
+    -> IO r -> IO r
+withSubnetElementData' elementData ptr f = do
+    castPtr ptr `poke` elementTypeOf elementData
+    case elementData of
+      IpRanges x -> with x $ \pX -> poke (ppElement ptr) pX >> f
+      SecondaryHosts x -> withDhcp hostInfo x $ \pX -> poke (ppElement ptr) pX >> f
+      ReservedIps x -> withDhcp reservation x $ \pX -> poke (ppElement ptr) pX >> f
+      ExcludedIpRanges x -> with x $ \pX -> poke (ppElement ptr) pX >> f
+      IpUsedCluster x -> with x $ \pX -> poke (ppElement ptr) pX >> f
+
+ppElement :: Ptr SUBNET_ELEMENT_DATA_V4 -> Ptr a
+ppElement ptr = castPtr $ ptr `plusPtr` 4
+
+elementTypeOf :: SUBNET_ELEMENT_DATA_V4 -> SUBNET_ELEMENT_TYPE
+elementTypeOf (IpRanges _)         = 0
+elementTypeOf (SecondaryHosts _)   = 1
+elementTypeOf (ReservedIps _)      = 2
+elementTypeOf (ExcludedIpRanges _) = 3
+elementTypeOf (IpUsedCluster _)    = 4
+ System/Win32/DHCP/SUBNET_ELEMENT_INFO_ARRAY_V4.hs view
@@ -0,0 +1,22 @@+module System.Win32.DHCP.SUBNET_ELEMENT_INFO_ARRAY_V4
+  ( SUBNET_ELEMENT_INFO_ARRAY_V4 (..)
+  , infoArray
+  ) where
+
+import System.Win32.DHCP.DhcpStructure
+import System.Win32.DHCP.LengthBuffer
+import System.Win32.DHCP.SUBNET_ELEMENT_DATA_V4
+
+-- typedef struct _DHCP_SUBNET_ELEMENT_INFO_ARRAY_V4 {
+--   DWORD                         NumElements;
+--   LPDHCP_SUBNET_ELEMENT_DATA_V4 Elements;
+-- } DHCP_SUBNET_ELEMENT_INFO_ARRAY_V4, *LPDHCP_SUBNET_ELEMENT_INFO_ARRAY_V4;
+newtype SUBNET_ELEMENT_INFO_ARRAY_V4
+    = SUBNET_ELEMENT_INFO_ARRAY_V4 (LengthBuffer SUBNET_ELEMENT_DATA_V4)
+
+unwrap :: SUBNET_ELEMENT_INFO_ARRAY_V4 -> LengthBuffer SUBNET_ELEMENT_DATA_V4
+unwrap (SUBNET_ELEMENT_INFO_ARRAY_V4 ia) = ia
+
+infoArray :: DhcpStructure SUBNET_ELEMENT_INFO_ARRAY_V4
+infoArray = newtypeDhcpStructure SUBNET_ELEMENT_INFO_ARRAY_V4 unwrap
+    $ lengthBuffer (baseDhcpArray subnetElementData)
+ System/Win32/DHCP/Types.hs view
@@ -0,0 +1,76 @@+module System.Win32.DHCP.Types
+  ( ClientType (..)
+  , DATE_TIME (..)
+  , FORCE_FLAG (..)
+  , RESUME_HANDLE
+  ) where
+
+import Control.Applicative
+import Foreign
+
+import System.Win32.Types
+
+-- | Microsoft's DHCP server supports DHCP and BOOTP. Both protocols server
+-- similar purposes, but DHCP is more widely used. Lease and reservation
+-- records contain a flag field indicating which protocol the record is valid
+-- for. In most cases this flag will be `Both`, because that is the default
+-- behavior.
+data ClientType = Unspecified | Dhcp | Bootp | Both | ReservationFlag | None
+    deriving (Eq)
+
+instance Enum ClientType where
+  toEnum 0x00 = Unspecified
+  toEnum 0x01 = Dhcp
+  toEnum 0x02 = Bootp
+  toEnum 0x03 = Both
+  toEnum 0x04 = ReservationFlag
+  toEnum 0x64 = None
+  toEnum x    = error $ "invalid ClientType: " ++ show x
+  fromEnum Unspecified     = 0x00
+  fromEnum Dhcp            = 0x01
+  fromEnum Bootp           = 0x02
+  fromEnum Both            = 0x03
+  fromEnum ReservationFlag = 0x04
+  fromEnum None            = 0x64
+
+instance Storable ClientType where
+  sizeOf _ = sizeOf (undefined :: BYTE)
+  alignment _ = alignment (undefined :: BYTE)
+  peek ptr = toEnum . fromIntegral <$> peek (pbyte ptr)
+  poke ptr ct = poke (pbyte ptr) . fromIntegral . fromEnum $ ct
+
+pbyte :: Ptr ClientType -> Ptr BYTE
+pbyte = castPtr
+
+-- | The number of ticks (100-nanosecond increments) since 12:00 midnight,
+-- January 1, 1 C.E. in the Gregorian calendar.
+--
+-- Microsoft does not provide any functions I know of for converting this
+-- value into something more convenient to work with.
+--
+-- > typedef struct _DATE_TIME {
+-- >     DWORD dwLowDateTime;
+-- >     DWORD dwHighDateTime;
+-- > } DATE_TIME,*PDATE_TIME, *LPDATE_TIME;
+data DATE_TIME = DATE_TIME !DWORD !DWORD
+
+instance Storable DATE_TIME where
+  sizeOf _ = 8
+  alignment _ = 4
+  peek ptr = DATE_TIME <$> peekElemOff (pdword ptr) 0
+                       <*> peekElemOff (pdword ptr) 1
+  poke ptr (DATE_TIME l h) = do
+    pokeElemOff (pdword ptr) 0 l
+    pokeElemOff (pdword ptr) 1 h
+
+pdword :: Ptr DATE_TIME -> Ptr DWORD
+pdword ptr = castPtr ptr
+
+-- typedef enum _DHCP_FORCE_FLAG {
+--   DhcpFullForce,
+--   DhcpNoForce
+-- } DHCP_FORCE_FLAG, *LPDHCP_FORCE_FLAG;
+data FORCE_FLAG = FullForce | NoForce
+    deriving (Enum)
+
+type RESUME_HANDLE = DWORD
+ Utils.hs view
@@ -0,0 +1,30 @@+module Utils where
+
+import Control.Applicative
+import Control.Monad (unless)
+import Foreign
+
+import System.Win32.Types
+
+-- |Many DHCP functions return a large object composed of pointers to other
+--  objects. When it comes time to clean up memory we need to walk through
+--  the structure. This helper function calls an action to get a pointer
+--  to free (usually a variant of peek), and then calls the supplied free
+--  action on it. Finally, the pointer is zeroed out.
+freeptr :: (Ptr b -> IO ()) -> Ptr (Ptr a) -> IO ()
+freeptr rpcfree pptr =
+    peek pptr >>= \ptr ->
+    unless (ptr == nullPtr) $ do
+    rpcfree $ castPtr ptr
+    poke pptr nullPtr
+
+-- |Peek a string that might be null. Null pointers become Nothing
+peekMaybeTString :: LPTSTR -> IO (Maybe String)
+peekMaybeTString ptr
+  | ptr == nullPtr = return Nothing
+  | otherwise      = Just <$> peekTString ptr
+
+-- |Temporarily marshal a Maybe String. A nothing becomes a null pointer.
+withMaybeTString :: Maybe String -> (LPTSTR -> IO a) -> IO a
+withMaybeTString Nothing    f = f nullPtr
+withMaybeTString (Just str) f = withTString str f
+ Win32-dhcp-server.cabal view
@@ -0,0 +1,74 @@+Name:                Win32-dhcp-server
+Synopsis:            Win32 DHCP Server Management API.
+Version:             0.1
+License:             BSD3
+License-file:        LICENSE
+Author:              Michael Steele
+Maintainer:          mikesteele81@gmail.com
+Copyright:           2013 Michael Steele
+Homepage:            http://github.com/mikesteele81/win32-dhcp-server
+Bug-Reports:         http://github.com/mikesteele81/win32-dhcp-server/issues
+Category:            System
+Build-type:          Simple
+Cabal-version:       >=1.14
+Tested-With:         GHC == 7.6.3
+Stability:           provisional
+Description:
+  This package provides a partial binding to the Win32 DHCP Server Management
+  API. Its purpose is to query and control a Microsoft DHCP server. Enough
+  functionality is defined so so that Ipv4 client lease and reservation
+  records can be manipulated from software.
+  .
+  Here are a few notes on the required environment:
+  .
+  * Only 32-bit executables are supported. This is mainly because pointers
+    are assumed to be 4 bytes wide in a few places. Support for 64-bit
+    executables may be added in the future.
+  .
+  * All library calls should be supported on Windows 7 or above.
+  .
+  /Simple Example and Usage/
+  .
+  @
+  \-\- Print all MAC addresses with an active client lease
+  module Main where
+  .
+  import Data.Ip
+  import Data.Mac
+  import System.Win32.DHCP
+  .
+  main :: IO ()
+  main = do
+  &#x20;   api <- loadDHCP
+  &#x20;   clients <- enumClients api context
+  &#x20;   let macs = map (showMac \":\" . clientHardwareAddress) clients
+  &#x20;   mapM_ putStrLn macs
+  &#x20; where
+  &#x20;   Just subnet = readIp \"192.168.1.0\"
+  &#x20;   context = Context \"192.168.1.5\" subnet
+  @
+
+Library
+  Build-depends: base  >= 4.6 && < 4.8
+               , safe
+               , Win32
+  default-language: Haskell2010
+  Exposed-modules: Data.Ip
+                 , Data.Mac
+                 , System.Win32.DHCP
+  Ghc-Options: -funbox-strict-fields -Wall
+  other-modules: Utils
+               , System.Win32.DHCP.Internal
+               , System.Win32.DHCP.Client
+               , System.Win32.DHCP.CLIENT_UID
+               , System.Win32.DHCP.DhcpStructure
+               , System.Win32.DHCP.HOST_INFO
+               , System.Win32.DHCP.IP_CLUSTER
+               , System.Win32.DHCP.IP_RANGE
+               , System.Win32.DHCP.LengthBuffer
+               , System.Win32.DHCP.SEARCH_INFO
+               , System.Win32.DHCP.Reservation
+               , System.Win32.DHCP.SUBNET_CLIENT_INFO_ARRAY_V4
+               , System.Win32.DHCP.SUBNET_ELEMENT_DATA_V4
+               , System.Win32.DHCP.SUBNET_ELEMENT_INFO_ARRAY_V4
+               , System.Win32.DHCP.Types