import Data.Word ( Word8, Word16, Word32 ) import Data.Char ( isDigit ) import Data.List ( foldl1' ) type Address = Word32 type Port = Word16 type Subnet = Word8 -- The two following types/aliases are yours to define. You can change the -- declaration from 'data' (= distinct type) to 'type' (= alias), but you must -- retain their arities (Packet must remain binary and PacketHeader nullary). data Packet header payload data PacketHeader -- Here, 'header' represents a packet header type which does not need to be -- PacketHeader (and our tests do indeed use their own header type). type Chain header = [Rule header] type Rule header = ([Match header], Action header) type Match header = header -> Bool data Action header = Accept | Reject | Call (Chain header) | Return getPayload :: Packet header payload -> payload getPayload = undefined getHeader :: Packet header payload -> header getHeader = undefined mkPacket :: header -> payload -> Packet header payload mkPacket = undefined mkHeader :: Address -> Port -> Address -> Port -> PacketHeader mkHeader = undefined packetFilter :: Chain header -> [Packet header payload] -> [Packet header payload] packetFilter = undefined -- You also need to add the correct types to the following functions/constants. -- These are here as a reminder of what eDSL elements you are to implement. -- Feel free to start by commenting out or erasing this entire section and -- writing the simpler variant presented in the assignment text. src, dst :: a -> b -> c -> Match PacketHeader port, addr, equals, member, within, subnet :: () src _ _ _ = const True dst _ _ _ = const True port = () addr = () equals = () member = () within = () subnet = () -- -------- -- -- EXAMPLES -- -- -------- -- -- NOTE: Many of the examples below are commented out as to not interfere with -- your work on the eDSL. Uncomment those once you are finished with it. -- You can test your ‹packetFilter› with simpler packets first: ex_simplePackets :: [ Packet Int () ] ex_simplePackets = map (flip mkPacket ()) [-12..12] ex_simpleChain :: Chain Int ex_simpleChain = [([ (== 11) ], Reject) ,([ (< 0), odd ], Reject) ,([ (> 1)], Call [([ odd ], Accept) ,([ (== 6) ], Return) ,([ (> 3), (<= 9) ], Reject) ]) ,([ (== 0) . (`mod` 3) ], Accept) ] -- ‹packetFilter ex_simpleChain ex_simplePackets› should return the following: ex_simpleExpected :: [ Packet Int () ] ex_simpleExpected = map (flip mkPacket ()) [-12, -6, 0, 3, 5, 6, 7, 9, 12] -- These examples are designed to work with the “full” eDSL which does not need -- explicit conversion of strings to IP addresses. Should you choose to -- implement only the simpler eDSL, you need to add the ‹ip› calls manually. -- First, a simple list of all combinations to check that your eDSL is typeable: {- Uncomment to check that your eDSL compiles. ex_rules :: [Match PacketHeader] ex_rules = [ src port equals 23 , src port within (5000, 5100) , src port member [80, 443, 8080] , dst port equals 23 , dst port within (5000, 5100) , dst port member [80, 443, 8080] {- Version with explicit IP address conversion (after step 3 of the tutorial) , src addr equals (ip "192.168.0.0") , src addr within (ip "192.168.0.0", ip "192.168.255.255") , src addr member [ip "192.168.0.1", ip "192.168.0.3"] , src addr subnet (ip "192.168.0.0", 16) , dst addr equals (ip "192.168.0.0") , dst addr within (ip "192.168.0.0", ip "192.168.255.255") , dst addr member [ip "192.168.0.1", ip "192.168.0.3"] , dst addr subnet (ip "192.168.0.0", 16) -} {- Full version (after step 4 of the tutorial; comment out the previous block - of address matching) , src addr equals "192.168.0.0" , src addr within ("192.168.0.0", "192.168.255.255") , src addr member ["192.168.0.1", "192.168.0.3"] , src addr subnet ("192.168.0.0", 16) , dst addr equals "192.168.0.0" , dst addr within ("192.168.0.0", "192.168.255.255") , dst addr member ["192.168.0.1", "192.168.0.3"] , dst addr subnet ("192.168.0.0", 16) -} {- Optional bonus: match negation , src port ! equals 23 , dst port ! within (0, 1024) , dst addr ! member ["192.168.0.1", "192.168.0.3"] , src addr ! subnet ("192.168.0.0", 16) -} ] -} -- Now an example of chains inspired by networking of Faculty of Informatics. -- We consider anything in the 147.251.48.0/20 network (that is, addresses from -- 147.251.48.0 to 147.251.63.255) to be in “the FI network”. -- -- There is one main chain and three supplementary named ones to make the rules -- a bit more readable. {- Uncomment to enable the bigger example. ex_chainSsh, ex_chainOnlyFI, ex_chainAllowOutbound :: Chain PacketHeader -- SSH uses port 22. Calling this chains is just a slightly more readable -- way to allow incoming SSH traffic. ex_chainSsh = [([dst port equals 22], Accept)] -- Calling this chain rejects anything not from the FI network. -- Note that we return (not accept) on a FI-originating packet, so that next -- rules are used. ex_chainOnlyFI = [([src addr subnet ("147.251.48.0", 20)], Return) ,([], Reject) ] -- Calling this chain accepts anything that goes outside FI. Packets coming into -- tho FI network must be decided by subsequent rules. ex_chainAllowOutbound = [([dst addr subnet ("147.251.48.0", 20)], Return) ,([], Accept) ] ex_chainMain :: Chain PacketHeader ex_chainMain = -- Allow all comunication from FI to the outside world [([src addr subnet ("147.251.48.0", 20)], Call ex_chainAllowOutbound) -- Accept traffic to dynamic ports inside FI ,([dst addr subnet ("147.251.48.0", 20), dst port within (49152, 65535)], Accept) -- Aisa (is an SSH server and a webserver) ,([dst addr equals "147.251.48.1"], Call [ ([], Call ex_chainSsh) , ([dst port member [80, 443]], Accept) -- 80 = HTTP, 443 = HTTPS ] ) -- Nymfe{01..105} (SSH, only from within FI networks) ,([dst addr within ("147.251.53.11", "147.251.53.115")], Call [([], Call ex_chainOnlyFI) ,([], Call ex_chainSsh) ] ) -- Drop all other trafic (default rule when the main chain falls through) ] ex_packets :: [Packet PacketHeader String] ex_packets = [ mkPacket (mkHeader (ip sip) sport (ip dip) dport) desc | (sip, sdesc) <- hosts , (dip, ddesc) <- hosts , (sport, spdesc) <- sports , (dport, dpdesc) <- dports , sip /= dip , let desc = unwords [ sdesc, spdesc, "-->", ddesc, dpdesc ] ] where hosts = [("147.251.48.1", "aisa") ,("147.251.53.11", "nymfe01") ,("55.55.75.67", "outsider") ] sports = [(55550, "dynamic") ] dports = [( 22, "ssh") ,( 443, "https") ] ++ sports ex_filtered :: [String] ex_filtered = map getPayload $ packetFilter ex_chainMain ex_packets - The following packets (and only these) must be in ‹ex_filtered›: ex_filteredExpected :: [String] ex_filteredExpected = [ "aisa dynamic --> nymfe01 ssh" , "aisa dynamic --> nymfe01 dynamic" , "aisa dynamic --> outsider ssh" , "aisa dynamic --> outsider https" , "aisa dynamic --> outsider dynamic" , "nymfe01 dynamic --> aisa ssh" , "nymfe01 dynamic --> aisa https" , "nymfe01 dynamic --> aisa dynamic" , "nymfe01 dynamic --> outsider ssh" , "nymfe01 dynamic --> outsider https" , "nymfe01 dynamic --> outsider dynamic" , "outsider dynamic --> aisa ssh" , "outsider dynamic --> aisa https" , "outsider dynamic --> aisa dynamic" , "outsider dynamic --> nymfe01 dynamic" ] -} -- ------------------------- -- -- PROVIDED HELPER FUNCTIONS -- -- ------------------------- -- -- Evaluates to True when the address in the first argument belongs to the -- subnet specified by the second argument. -- 'prefixLength' is the number of most significant bits of 'net' which describe -- the net (i.e., the number after the slash in CIDR notation). isInNet :: Address -> (Address, Subnet) -> Bool isInNet _ ( _, 0) = True isInNet a (net, prefixLength) = if prefixLength <= 32 then a >= low && a <= high else error "Prefix longer than entire address" where hostMask = 2 ^ (32 - prefixLength) low = net - (net `mod` hostMask) high = low + (hostMask - 1) -- Converts an IPv4 address from the usual dot notation to a 32-bit number. -- -- Note that this is not what a pretty converting function in Haskell looks -- like, but we wanted to keep it independent on external libraries nor we -- wished to use advanced techniques that you are not familiar with. ip :: String -> Address ip addr = let inOctets = splitOctets addr nOctets = length inOctets octets = take 4 $ inOctets ++ repeat 0 in if nOctets > 4 then error "Too many octets" else foldl1' (\a o -> a * 256 + o) octets where splitOctets :: String -> [Word32] splitOctets addr = let (o, rest) = span isDigit addr octet = read o in if null o then error "Empty octet" else if octet > 255 then error "Number too big for octet" else octet : checkAndSplit rest checkAndSplit [] = [] checkAndSplit ('.' : rest) = splitOctets rest checkAndSplit _ = error "Expected dot or end of string"