From 9c0dbbefd192b1fe55181c33f7052c978d18cd38 Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Sat, 4 Jul 2015 17:44:34 -0400 Subject: [PATCH] Add more documentation and a pretty-printer to IPv4Pattern. Stub out the coming DnsblSite module. --- harbl.cabal | 1 + src/DnsblSite.hs | 18 +++ src/IPv4Pattern.hs | 285 ++++++++++++++++++++++++++++++++++----------- 3 files changed, 236 insertions(+), 68 deletions(-) create mode 100644 src/DnsblSite.hs diff --git a/harbl.cabal b/harbl.cabal index 5069501..1d22e0c 100644 --- a/harbl.cabal +++ b/harbl.cabal @@ -24,6 +24,7 @@ executable harbl Main.hs other-modules: + DnsblSite IPv4Pattern hs-source-dirs: diff --git a/src/DnsblSite.hs b/src/DnsblSite.hs new file mode 100644 index 0000000..df4437d --- /dev/null +++ b/src/DnsblSite.hs @@ -0,0 +1,18 @@ +-- | This module contains the 'DnsblSite' data type representing one +-- blacklist with its associated return codes and multiplier. For example, +-- in Postfix's main.cf you might have, +-- +-- postscreen_dnsbl_sites = bl.mailspike.net=127.0.0.[2;10;11]*2, ... +-- +-- Here, the 'Domain' is \"bl.mailspike.net\", the return code +-- pattern is \"127.0.0.[2;10;11]\", and the multiplier is \"2". +-- +module DnsblSite +where + +import IPv4Pattern ( IPv4Pattern ) + +newtype Domain = Domain String +newtype Multiplier = Multiplier Int + +data DnsblSite = DnsblSite Domain IPv4Pattern Multiplier diff --git a/src/IPv4Pattern.hs b/src/IPv4Pattern.hs index 19fec7b..5540320 100644 --- a/src/IPv4Pattern.hs +++ b/src/IPv4Pattern.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE FlexibleInstances #-} + -- | An IPv4 address pattern has four fields separated by ".". Each -- field is either a decimal number, or a sequence inside "[]" that -- contains one or more ";"-separated decimal numbers or @@ -31,26 +33,111 @@ import Text.Parsec.String ( Parser ) import Text.Read ( readMaybe ) +class Pretty a where + -- | Obtain a pretty 'String' representation of the given thingy. + prettyshow :: a -> String + + -- | Pretty-print the given thingy. + pp :: a -> IO () + pp = putStrLn . prettyshow + + +-- | Define a 'Pretty' instance for the result of 'parse'. This lets +-- us pretty-print the result of a parse attempt without worrying +-- about whether or not it failed. If the parse failed, you get the +-- same output that you usually would. Otherwise we pretty-print the +-- parsed value. +-- +instance Pretty a => Pretty (Either ParseError a) where + prettyshow (Left err) = show err + prettyshow (Right v) = prettyshow v + + +-- * Octets + +-- | An ipv4 octet; that is, an integer between @0@ and @255@ +-- inclusive. This is the data type corresponding to a \"v4octet\" +-- in the postscreen parser. +-- newtype IPv4Octet = IPv4Octet Int deriving (Eq, Show) + +instance Pretty IPv4Octet where + prettyshow (IPv4Octet x) = show x + + +-- | Parse an IPv4 octet, which should contain a string of digits. +-- Should fail if the parsed integer does not lie between @0@ and +-- @255@ inclusive. +-- +-- ==== _Examples_ +-- +-- Standard octets are parsed correctly: +-- +-- >>> parseTest v4octet "0" +-- IPv4Octet 0 +-- +-- >>> parseTest v4octet "127" +-- IPv4Octet 127 +-- +-- >>> parseTest v4octet "255" +-- IPv4Octet 255 +-- +-- Non-digit input throws an error: +-- +-- >>> parseTest v4octet "Hello, World!" +-- parse error at (line 1, column 1): +-- unexpected "H" +-- expecting digit +-- +-- If we're given an integer outside the range @0..255@ (i.e. not a +-- valid octet), we fail: +-- +-- >>> parseTest v4octet "9000" +-- parse error at (line 1, column 5): +-- unexpected end of input +-- expecting digit +-- Octet "9000" must be between 0 and 255. +-- +v4octet :: Parser IPv4Octet +v4octet = do + s <- many1 digit + case ( readMaybe s :: Maybe Int ) of + -- If "many1 digit" gives us a list of digits, we should be able + -- to convert that to an Int! It will overflow rather than fail + -- if the input is too big/small, so it should really always + -- succeed. + Nothing -> unexpected "readMaybe failed on a sequence of digits!" + + -- If we got an Int, make sure it's actually a representation of + -- an octet. + Just k -> if 0 <= k && k <= 255 + then return (IPv4Octet k) + else fail ("Octet \"" ++ (show k) + ++ "\" must be between 0 and 255.") + + + + +-- * Sequence members + + +-- | An ipv4 \"sequence member\". A sequence member is either an +-- integer (an octet) or a range of integers (contained in an +-- octet). This data type corresponds to \"v4seq_member\" in the +-- postscreen parser. +-- data IPv4SequenceMember = IPv4SequenceMemberOctet IPv4Octet | IPv4SequenceMemberOctetRange IPv4Octet IPv4Octet deriving (Eq, Show) -data IPv4Sequence = - IPv4SequenceSingleMember IPv4SequenceMember - | IPv4SequenceOptions IPv4SequenceMember IPv4Sequence - deriving (Eq, Show) - -data IPv4Field = IPv4FieldOctet IPv4Octet | IPv4FieldSequence IPv4Sequence - deriving (Eq, Show) - -data IPv4Pattern = - IPv4Pattern IPv4Field IPv4Field IPv4Field IPv4Field - deriving (Eq, Show) +instance Pretty IPv4SequenceMember where + prettyshow (IPv4SequenceMemberOctet octet) = prettyshow octet + prettyshow (IPv4SequenceMemberOctetRange octet1 octet2) = + (prettyshow octet1) ++ ".." ++ (prettyshow octet2) -- | Parse an IPv4 \"sequence member\". A sequence member is either an @@ -76,6 +163,27 @@ v4seq_member = try both <|> just_one just_one = fmap IPv4SequenceMemberOctet v4octet + +-- * Sequences + +-- | An ipv4 \"sequence\". A sequence contains either a single +-- \"sequence member\" (see 'IPv4SequenceMember'), or a sequence +-- member along with another sequence. So, this is a potentially +-- recursive definition. This type corresponds to \"v4sequence\" in +-- the postscreen parser. +-- +data IPv4Sequence = + IPv4SequenceSingleMember IPv4SequenceMember + | IPv4SequenceOptions IPv4SequenceMember IPv4Sequence + deriving (Eq, Show) + + +instance Pretty IPv4Sequence where + prettyshow (IPv4SequenceSingleMember member) = prettyshow member + prettyshow (IPv4SequenceOptions member subsequence) = + (prettyshow member) ++ ";" ++ (prettyshow subsequence) + + -- | Parse an IPv4 \"sequence\". A sequence is whatever is allowed -- within square brackets. Basically it can be three things: -- @@ -89,11 +197,11 @@ v4seq_member = try both <|> just_one -- >>> parseTest v4sequence "1" -- IPv4SequenceSingleMember (IPv4SequenceMemberOctet (IPv4Octet 1)) -- --- >>> parseTest v4sequence "1..2" --- IPv4SequenceSingleMember (IPv4SequenceMemberOctetRange (IPv4Octet 1) (IPv4Octet 2)) +-- >>> pp $ parse v4sequence "" "1..2" +-- 1..2 -- --- >>> parseTest v4sequence "1..2;8" --- IPv4SequenceOptions (IPv4SequenceMemberOctetRange (IPv4Octet 1) (IPv4Octet 2)) (IPv4SequenceSingleMember (IPv4SequenceMemberOctet (IPv4Octet 8))) +-- >>> pp $ parse v4sequence "" "1..2;8" +-- 1..2;8 -- v4sequence :: Parser IPv4Sequence v4sequence = try both <|> just_one -- Maybe sepBy is appropriate here? @@ -107,6 +215,18 @@ v4sequence = try both <|> just_one -- Maybe sepBy is appropriate here? just_one = fmap IPv4SequenceSingleMember v4seq_member + +-- * Fields + +data IPv4Field = IPv4FieldOctet IPv4Octet | IPv4FieldSequence IPv4Sequence + deriving (Eq, Show) + + +instance Pretty IPv4Field where + prettyshow (IPv4FieldOctet octet) = prettyshow octet + prettyshow (IPv4FieldSequence seq) = "[" ++ (prettyshow seq) ++ "]" + + -- | Parse an IPv4 \"field\", which is either a boring old octet, or a -- 'v4sequence' within square brackets. -- @@ -115,8 +235,8 @@ v4sequence = try both <|> just_one -- Maybe sepBy is appropriate here? -- >>> parseTest v4field "127" -- IPv4FieldOctet (IPv4Octet 127) -- --- >>> parseTest v4field "[127]" --- IPv4FieldSequence (IPv4SequenceSingleMember (IPv4SequenceMemberOctet (IPv4Octet 127))) +-- >>> pp $ parse v4field "" "[127]" +-- [127] -- v4field :: Parser IPv4Field v4field = just_octet <|> brackets @@ -130,55 +250,22 @@ v4field = just_octet <|> brackets return $ IPv4FieldSequence s --- | Parse an IPv4 octet, which should contain a string of digits. --- Should fail if the parsed integer does not lie between @0@ and --- @255@ inclusive. --- --- ==== _Examples_ --- --- Standard octets are parsed correctly: --- --- parseTest v4octet "0" --- IPv4Octet 0 --- --- >>> parseTest v4octet "127" --- IPv4Octet 127 --- --- >>> parseTest v4octet "255" --- IPv4Octet 255 --- --- Non-digit input throws an error: --- --- >>> parseTest v4octet "Hello, World!" --- parse error at (line 1, column 1): --- unexpected "H" --- expecting digit --- --- If we're given an integer outside the range @0..255@ (i.e. not a --- valid octet), we fail: --- --- >>> parseTest v4octet "9000" --- parse error at (line 1, column 5): --- unexpected end of input --- expecting digit --- Octet "9000" must be between 0 and 255. --- -v4octet :: Parser IPv4Octet -v4octet = do - s <- many1 digit - case ( readMaybe s :: Maybe Int ) of - -- If "many1 digit" gives us a list of digits, we should be able - -- to convert that to an Int! It will overflow rather than fail - -- if the input is too big/small, so it should really always - -- succeed. - Nothing -> unexpected "readMaybe failed on a sequence of digits!" - -- If we got an Int, make sure it's actually a representation of - -- an octet. - Just k -> if 0 <= k && k <= 255 - then return (IPv4Octet k) - else fail ("Octet \"" ++ (show k) - ++ "\" must be between 0 and 255.") +-- * Patterns + +data IPv4Pattern = + IPv4Pattern IPv4Field IPv4Field IPv4Field IPv4Field + deriving (Eq, Show) + + +instance Pretty IPv4Pattern where + prettyshow (IPv4Pattern f1 f2 f3 f4) = + (prettyshow f1) ++ "." + ++ (prettyshow f2) + ++ "." + ++ (prettyshow f3) + ++ "." + ++ (prettyshow f4) -- | Parse an ipv4 address pattern. This consists of four fields, @@ -189,8 +276,27 @@ v4octet = do -- -- ==== _Examples_ -- --- >>> parseTest v4pattern "127.0.0.1" --- IPv4Pattern (IPv4FieldOctet (IPv4Octet 127)) (IPv4FieldOctet (IPv4Octet 0)) (IPv4FieldOctet (IPv4Octet 0)) (IPv4FieldOctet (IPv4Octet 1)) +-- >>> pp $ parse v4pattern "" "127.0.0.1" +-- 127.0.0.1 +-- +-- >>> pp $ parse v4pattern "" "127.0.[1..3].1" +-- 127.0.[1..3].1 +-- +-- >>> pp $ parse v4pattern "" "127.0.[1..3;8].1" +-- 127.0.[1..3;8].1 +-- +-- In the module intro, it is mentioned that this is invalid: +-- +-- >>> parseTest v4pattern "1.2.[3.4]" +-- parse error at (line 1, column 7): +-- unexpected "." +-- expecting digit or "]" +-- +-- This one is /also/ invalid; however, we'll parse the valid part off +-- the front of it: +-- +-- >>> pp $ parse v4pattern "" "1.2.3.3[6..9]" +-- 1.2.3.3 -- v4pattern :: Parser IPv4Pattern v4pattern = do @@ -204,6 +310,9 @@ v4pattern = do return $ IPv4Pattern field1 field2 field3 field4 + +-- * Enumeration + -- | Enumerate the members of an 'IPv4SequenceMember'. A sequence -- member is either an octet, which is easy to enumerate -- we just -- print it -- or an octet range whose members can be enumerated @@ -255,11 +364,50 @@ sequences (IPv4SequenceOptions sm s) = (sequence_members sm) ++ (sequences s) +-- | Enumerate the members of an 'IPv4Field'. If the field contains a +-- single 'IPv4Octet', we simply 'show' it. Otherwise it contains an +-- 'IPv4FieldSequence', and we enumerate that recursively using +-- 'sequences'. +-- +-- ==== _Examples_ +-- +-- >>> let (Right r) = parse v4field "" "1" +-- >>> fields r +-- ["1"] +-- +-- >>> let (Right r) = parse v4field "" "[127..135]" +-- >>> fields r +-- ["127","128","129","130","131","132","133","134","135"] +-- fields :: IPv4Field -> [String] fields (IPv4FieldOctet (IPv4Octet i)) = [show i] fields (IPv4FieldSequence s) = sequences s +-- | Enumerate the addresses represented by a given 'IPv4Pattern'. +-- +-- A pattern contains four fields, sepearated by period +-- characters. We want to list all possible combinations of +-- addresses where the first octet comes from the first field, the +-- second octet comes from the second field... and so on. To do +-- this, we take advantage of the List monad and the fact that +-- 'fields' returns a list of 'String's. +-- +-- ==== _Examples_ +-- +-- A single address: +-- +-- >>> let (Right r) = parse v4pattern "" "127.0.0.1" +-- >>> addresses r +-- ["127.0.0.1"] +-- +-- Anything between 127.0.0.2 and 127.0.0.4, and either 127.0.0.10 +-- or 127.0.0.11: +-- +-- >>> let (Right r) = parse v4pattern "" "127.0.0.[2..4;10;11]" +-- >>> addresses r +-- ["127.0.0.2","127.0.0.3","127.0.0.4","127.0.0.10","127.0.0.11"] +-- addresses :: IPv4Pattern -> [String] addresses (IPv4Pattern field1 field2 field3 field4) = do f1 <- fields field1 @@ -269,7 +417,8 @@ addresses (IPv4Pattern field1 field2 field3 field4) = do return $ f1 ++ "." ++ f2 ++ "." ++ f3 ++ "." ++ f4 --- Tests + +-- * Tests v4octet_tests :: TestTree v4octet_tests = -- 2.43.2