From 98b9d8768fe78d9948151e499ec52f7f616bd6e9 Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Fri, 17 Jul 2015 23:40:43 -0400 Subject: [PATCH] Add a "threshold" to the configuration. --- harbl-cli/src/CommandLine.hs | 13 ++- harbl-cli/src/Configuration.hs | 25 +++--- harbl-cli/src/Hosts.hs | 2 +- harbl-cli/src/Lists.hs | 2 +- harbl-cli/src/OptionalConfiguration.hs | 107 ++++++++++++++++++++++--- harbl.cabal | 1 + harbl/src/Network/DNS/RBL/Weight.hs | 29 ++++++- 7 files changed, 150 insertions(+), 29 deletions(-) diff --git a/harbl-cli/src/CommandLine.hs b/harbl-cli/src/CommandLine.hs index a3481fe..9de575f 100644 --- a/harbl-cli/src/CommandLine.hs +++ b/harbl-cli/src/CommandLine.hs @@ -35,12 +35,18 @@ my_summary :: String my_summary = program_name ++ "-" ++ (showVersion version) --- | A description of the "daemonize" option. +-- | A description of the \"lists\" option. lists_help :: String lists_help = "A list of RBLs to check. See the manual for advanced syntax." +-- | A description of the \"threshold\" option. +threshold_help :: String +threshold_help = + "The \"score\" a host must have to be considered blacklisted." + + -- | A data structure representing the possible command-line -- options. The CmdArgs library is doing heavy magic beneath the -- hood here. @@ -48,8 +54,9 @@ lists_help = arg_spec :: OptionalConfiguration arg_spec = OptionalConfiguration { - hosts = def &= typ "HOSTS" &= args, - lists = def &= typ "RBLs" &= help lists_help } + hosts = def &= typ "HOSTS" &= args, + lists = def &= typ "RBLs" &= help lists_help, + threshold = def &= typ "INTEGER" &= help threshold_help } &= program program_name &= summary my_summary &= details [description] diff --git a/harbl-cli/src/Configuration.hs b/harbl-cli/src/Configuration.hs index a6798e9..c3c55f0 100644 --- a/harbl-cli/src/Configuration.hs +++ b/harbl-cli/src/Configuration.hs @@ -7,14 +7,17 @@ module Configuration ( merge_optional ) where -import Data.Monoid ( Monoid(..) ) +-- System imports. import System.Console.CmdArgs.Default ( Default(..) ) --- From the harbl library. +-- Harbl library imports. import Network.DNS.RBL.Weight ( Weight ) +-- Local imports. import qualified OptionalConfiguration as OC ( - OptionalConfiguration(..) ) + OptionalConfiguration(..), + merge_maybe, + merge_monoid ) import Hosts ( Hosts(..) ) import Lists ( Lists(..) ) @@ -25,8 +28,8 @@ import Lists ( Lists(..) ) data Configuration = Configuration { hosts :: Hosts, - lists :: Lists } --- threshold :: Weight } + lists :: Lists, + threshold :: Weight } deriving (Show) @@ -35,8 +38,8 @@ data Configuration = -- instance Default Configuration where def = Configuration { hosts = def, - lists = def } --- threshold = def } + lists = def, + threshold = def } -- | Merge a 'Configuration' with an 'OptionalConfiguration'. This is @@ -46,8 +49,8 @@ instance Default Configuration where merge_optional :: Configuration -> OC.OptionalConfiguration -> Configuration -merge_optional cfg opt_cfg = - Configuration all_hosts all_lists +merge_optional cfg opt_cfg = Configuration hs ls t where - all_hosts = (hosts cfg) `mappend` (OC.hosts opt_cfg) - all_lists = (lists cfg) `mappend` (OC.lists opt_cfg) + hs = OC.merge_monoid (hosts cfg) (OC.hosts opt_cfg) + ls = OC.merge_monoid (lists cfg) (OC.lists opt_cfg) + t = OC.merge_maybe (threshold cfg) (OC.threshold opt_cfg) diff --git a/harbl-cli/src/Hosts.hs b/harbl-cli/src/Hosts.hs index 83bf7c3..cf70dc7 100644 --- a/harbl-cli/src/Hosts.hs +++ b/harbl-cli/src/Hosts.hs @@ -22,7 +22,7 @@ import Configurator ( convert_newtype_list ) -- newtype Hosts = Hosts { get_hosts :: [String] } - deriving (Data, Monoid, Show, Typeable) + deriving (Data, Eq, Monoid, Show, Typeable) -- | The default list of hosts. It's empty. diff --git a/harbl-cli/src/Lists.hs b/harbl-cli/src/Lists.hs index d94e85d..4870f89 100644 --- a/harbl-cli/src/Lists.hs +++ b/harbl-cli/src/Lists.hs @@ -22,7 +22,7 @@ import Configurator ( convert_newtype_list ) -- newtype Lists = Lists { get_lists :: [String] } - deriving (Data, Monoid, Show, Typeable) + deriving (Data, Eq, Monoid, Show, Typeable) -- | The default list of white/blacklists. It's empty. diff --git a/harbl-cli/src/OptionalConfiguration.hs b/harbl-cli/src/OptionalConfiguration.hs index 35ca7d4..37d05a9 100644 --- a/harbl-cli/src/OptionalConfiguration.hs +++ b/harbl-cli/src/OptionalConfiguration.hs @@ -11,6 +11,8 @@ -- module OptionalConfiguration ( OptionalConfiguration(..), + merge_maybe, + merge_monoid, from_rc ) where @@ -30,6 +32,9 @@ import System.FilePath ( () ) import System.IO.Error ( catchIOError ) import System.IO ( hPutStrLn, stderr ) +-- Harbl library imports. +import Network.DNS.RBL.Weight ( Weight ) + -- Local imports. import Hosts ( Hosts(..) ) import Lists ( Lists(..) ) @@ -43,10 +48,88 @@ import Lists ( Lists(..) ) data OptionalConfiguration = OptionalConfiguration { hosts :: Hosts, - lists :: Lists } + lists :: Lists, + threshold :: Maybe Weight } deriving (Show, Data, Typeable) +-- | Choose a nonempty monoid from our two arguments, preferring the +-- second. So if the second monoid is non-'mempty', we'll return +-- that. Otherwise the first. +-- +-- ==== _Examples_ +-- +-- The second list is preferred if both are nonempty: +-- +-- >>> merge_monoid [1,2] [3,4] +-- [3,4] +-- +-- However, if the second list is empty, the first is returned: +-- +-- >>> merge_monoid [1,2] [] +-- [1,2] +-- +-- And if both are empty, we return the first (i.e. empty) list: +-- +-- >>> merge_monoid [] [] +-- [] +-- +merge_monoid :: (Eq a, Monoid a) => a -> a -> a +merge_monoid l1 l2 = if l2 == mempty then l1 else l2 + + +-- | Like 'merge_monoid', except for optional things. We take two +-- (potentially 'Nothing') values, and then try to choose a +-- non-'Nothing' one, preferring the second argument. +-- +-- ==== _Examples_ +-- +-- The second is preferred if it is non-'Nothing': +-- +-- >>> merge_maybes (Just 3) (Just 4) +-- Just 4 +-- +-- >>> merge_maybes Nothing (Just 4) +-- Just 4 +-- +-- However, if the second argument is 'Nothing', the first is +-- returned: +-- +-- >>> merge_maybes (Just 1) Nothing +-- Just 1 +-- +-- If both are 'Nothing', we return 'Nothing': +-- +-- >>> merge_maybes Nothing Nothing +-- Nothing +-- +merge_maybes :: (Maybe a) -> (Maybe a) -> (Maybe a) +merge_maybes _ y@(Just _) = y +merge_maybes x@(Just _) Nothing = x +merge_maybes Nothing Nothing = Nothing + + +-- | Return the (thing contained in the) second argument if it is +-- non-'Nothing'. Otherwise return the first argument. +-- +-- ==== _Examples_ +-- +-- The second is preferred if it is non-'Nothing': +-- +-- >>> merge_maybe 3 (Just 4) +-- 4 +-- +-- However, if the second argument is 'Nothing', the first is +-- returned: +-- +-- >>> merge_maybe 1 Nothing +-- 1 +-- +merge_maybe :: a -> Maybe a -> a +merge_maybe x Nothing = x +merge_maybe _ (Just y) = y + + -- | The Monoid instance for these lets us \"combine\" two -- OptionalConfigurations. The \"combine\" operation that we'd like to -- perform is, essentially, to mash them together. So if we have two @@ -57,18 +140,14 @@ data OptionalConfiguration = -- instance Monoid OptionalConfiguration where -- | An empty OptionalConfiguration. - mempty = OptionalConfiguration (Hosts []) (Lists []) - + mempty = OptionalConfiguration mempty mempty Nothing -- | Combine @cfg1@ and @cfg2@, giving precedence to @cfg2@. - -- XML files can only be specified on the command-line, so we - -- just join them together here. - cfg1 `mappend` cfg2 = - OptionalConfiguration all_hosts all_lists + cfg1 `mappend` cfg2 = OptionalConfiguration hs ls t where - all_hosts = Hosts $ (get_hosts $ hosts cfg1) ++ (get_hosts $ hosts cfg2) - all_lists = Lists $ (get_lists $ lists cfg1) ++ (get_lists $ lists cfg2) - + hs = merge_monoid (hosts cfg1) (hosts cfg2) + ls = merge_monoid (lists cfg1) (lists cfg2) + t = merge_maybes (threshold cfg1) (threshold cfg2) -- | Obtain an OptionalConfiguration from harblrc in either the global @@ -93,5 +172,9 @@ from_rc = do cfg <- DC.load [ DC.Optional global_config_path, DC.Optional user_config_path ] cfg_lists <- DC.lookup cfg "lists" - let cfg_hosts = Hosts [] -- This won't be in the config file. - return $ OptionalConfiguration cfg_hosts (fromMaybe def cfg_lists) + cfg_hosts <- DC.lookup cfg "hosts" + cfg_threshold <- DC.lookup cfg "threshold" + return $ OptionalConfiguration + (fromMaybe def cfg_hosts) + (fromMaybe def cfg_lists) + cfg_threshold diff --git a/harbl.cabal b/harbl.cabal index e59c437..24a67c2 100644 --- a/harbl.cabal +++ b/harbl.cabal @@ -18,6 +18,7 @@ library base >= 4.6 && < 5, bytestring >= 0.9, cmdargs >= 0.10.6, + configurator >= 0.2, dns >= 2, iproute >= 1.4, parsec >= 3, diff --git a/harbl/src/Network/DNS/RBL/Weight.hs b/harbl/src/Network/DNS/RBL/Weight.hs index 8447ab3..db8c7a7 100644 --- a/harbl/src/Network/DNS/RBL/Weight.hs +++ b/harbl/src/Network/DNS/RBL/Weight.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -- | The 'Weight' type, its instances, and a Parsec parser to parse @@ -15,6 +16,11 @@ module Network.DNS.RBL.Weight ( weight ) where +import Data.Configurator () -- Needed for predefined instances. +import Data.Configurator.Types ( Configured(..), Value( Number ), convert ) +import Data.Data ( Data ) +import Data.Ratio ( numerator ) +import Data.Typeable ( Typeable ) import System.Console.CmdArgs.Default ( Default(..) ) import Text.Parsec ( (<|>), @@ -48,7 +54,7 @@ import Network.DNS.RBL.Pretty ( Pretty(..) ) -- >>> sum [w1, w2, w3] -- Weight 4 -- -newtype Weight = Weight Int deriving (Eq, Num, Ord, Show) +newtype Weight = Weight Int deriving (Data, Eq, Num, Ord, Show, Typeable) -- | Pretty-print a 'Weight'. This just shows/prints the underlying 'Int'. @@ -74,6 +80,27 @@ instance Pretty Weight where instance Default Weight where def = 1 +-- | Allow the configurator library to parse a 'Weight' from a config +-- file. +-- +-- ==== _Examples_ +-- +-- >>> import Data.Configurator () -- Get predefined 'Configured' instances. +-- >>> import Data.Text ( pack ) +-- >>> import Data.Configurator.Types ( Value( Number, String ) ) +-- >>> let n1 = Number 2 +-- >>> convert n1 :: Maybe Weight +-- Just (Weight 2) +-- >>> let s = String (pack "foo1") +-- >>> convert s :: Maybe Weight +-- Nothing +-- +instance Configured Weight where + -- Don't give us a fractional weight, we'll ignore the denominator. + convert (Number x) = Just (Weight (fromInteger $ numerator x)) + convert _ = Nothing + + -- | Parse the weight multiplier off the end of an input 'Site'. This -- expects there to be a \"multiplier\" character (an asterisk) -- before the integral weight. -- 2.44.2