module Net.DHCP where
import Net.Bits(Word8,Word16,Word32,testBit)
import qualified Net.IPv4 as IP
import qualified Net.Ethernet as Eth
import Net.PacketParsing
import Net.PortNumber
serverPort = bootps
clientPort = bootpc
data Packet = Packet
{ opcode::Operation,
xid::Word32,
secs::Word16,
flags::Flags,
ciaddr,yiaddr,siaddr,giaddr::IP.Addr,
chaddr::Eth.Addr,
sname::String,
file::String,
options::Options
}
deriving (Show)
data Operation = BootRequest | BootReply deriving (Eq,Bounded,Enum,Show)
data Flags = Flags {broadcast::Bool} deriving (Eq,Show)
newtype Options = Options [Option] deriving (Eq,Show)
data Option
= Pad
| End
| SubnetMask IP.Addr
| TimeOffset
| Routers [IP.Addr]
| DNS_Servers [IP.Addr]
| HostName String
| DomainName String
| BroadcastAddress IP.Addr
| NTP_Servers [IP.Addr]
| RequestedIPAddress IP.Addr
| LeaseTime Word32
| OptionOverload Word8
| MessageType MessageType
| ServerIdentifier IP.Addr
| Unknown Word8 [Word8]
deriving (Eq,Show)
data MessageType
= Discover
| Offer
| Request
| Decline
| Ack
| Nak
| Release
| Inform
deriving (Eq,Bounded,Enum,Show)
template mac =
Packet { opcode=BootRequest,
xid=0,
secs=0,
flags=Flags{broadcast=False},
ciaddr=z,yiaddr=z,siaddr=z,giaddr=z,
chaddr=mac,
sname="",
file="",
options=Options []
}
where
z = IP.Addr 0 0 0 0
instance Parse Operation where parse = bounded 1 =<< word8
instance Parse MessageType where parse = bounded 1 =<< word8
instance Unparse MessageType where unparse t = unparse (unEnum 1 t::Word8)
instance Unparse Operation where unparse t = unparse (unEnum 1 t::Word8)
instance Parse Flags where
parse = do w <- word16
return Flags{broadcast=testBit w 15}
instance Unparse Flags where
unparse Flags{broadcast=b} = unparse (if b then 0x8000 else 0::Word16)
magic = [99,130,83,99::Word8]
instance Parse Options where
parse = do bs <- bytes 4
if bs==magic
then Options # po
else return (Options [])
where
po = do o <- parse
case o of
End -> return []
_ -> (o:) # po
instance Unparse Options where
unparse (Options []) = unparse ()
unparse (Options os) = unparse (magic,os,End)
instance Unparse Option where
unparse End = unparse (255::Word8)
unparse Pad = unparse (0::Word8)
unparse (RequestedIPAddress ip) = unparse ([50,4::Word8],ip)
unparse (MessageType t) = unparse ([53,1::Word8],t)
unparse (ServerIdentifier ip) = unparse ([54,4::Word8],ip)
unparse (Unknown b bs) = unparse (b,n,bs)
where n = fromIntegral (length bs)::Word8
instance Parse Option where
parse = do b <- word8
case b of
0 -> return Pad
1 -> do check8 4
SubnetMask # parse
3 -> Routers # ips
6 -> DNS_Servers # ips
255 -> return End
51 -> return LeaseTime #! check8 4 <# parse
53 -> return MessageType #! check8 1 <# parse
54 -> return ServerIdentifier #! check8 4 <# parse
_ -> do n <- fromIntegral # word8
bs <- bytes n
return (Unknown b bs)
where
ips = do n <- fromIntegral # word8
parses (n `div` 4)
parses n = sequence (replicate n parse)
instance Parse Packet where
parse = Packet # parse #! check8 1 #! check8 6 #! word8
<# parse <# parse <# parse
<# parse <# parse <# parse <# parse
<# parse
#! bytes 10
<# zstring 64
<# zstring 128
<# parse
#! therest
instance Unparse Packet where
unparse (Packet op xid secs flags ci yi si gi ch sname file options) =
unparse ((op,[1,6,0::Word8],xid,secs,flags),(ci,yi,si,gi,ch),
replicate 10 (0::Word8),
(zstring 64 sname,zstring 128 file),
options)
where
zstring n s = take n (s++repeat '\0')
zstring :: Int -> PacketParser String
zstring n = map (toEnum.fromIntegral) . takeWhile (/=0) # bytes n
bounded z n = bounded' undefined (fromIntegral nz)
where
bounded' :: (Bounded a,Enum a) => a -> Int -> PacketParser a
bounded' r i =
if 0<=i && i<=fromEnum (maxBound `asTypeOf` r)
then return (toEnum i)
else fail "out of range"
unEnum z t = fromIntegral (fromEnum t+z)