1 {-# LANGUAGE DoAndIfThenElse #-}
6 import Control.Monad ( liftM, when )
7 import Data.Monoid ( (<>) )
8 import Text.Parsec ( ParseError, parse )
9 import System.Console.CmdArgs ( def )
10 import System.Exit ( exitSuccess, exitWith, ExitCode (ExitFailure) )
11 import System.IO ( hPrint, stderr )
13 import CommandLine ( get_args )
14 import Configuration ( Configuration(..), merge_optional )
16 exit_host_blacklisted,
19 exit_unparseable_host,
20 exit_unparseable_list )
21 import Hosts ( Hosts(..) )
22 import Lists ( Lists(..) )
23 import qualified OptionalConfiguration as OC ( from_rc )
24 import Network.DNS.RBL (
33 -- | The 'concatMapM' function generalizes 'concatMap' to arbitrary monads.
34 -- See e.g. <https://ghc.haskell.org/trac/ghc/ticket/2042>
35 concatMapM :: (Monad m) => (a -> m [b]) -> [a] -> m [b]
36 concatMapM f xs = liftM concat (mapM f xs)
38 -- | Parse a list of RBL sites from the user's input. If he was nice,
39 -- he would have given us a list of individual RBLs. But we also
40 -- handle the case where a big comma-separated string is given to
43 parse_lists :: Lists -> Either ParseError [Site]
44 parse_lists (Lists ls) = concatMapM (parse sites "") ls
46 -- | Parse a list of hosts from the user's input. Each one should be
47 -- parseable as a 'Host'.
49 parse_hosts :: Hosts -> Either ParseError [Host]
50 parse_hosts (Hosts hs) = mapM (parse host "") hs
58 -- Merge the config file options with the command-line ones,
59 -- prefering the command-line ones.
60 let opt_config = rc_cfg <> cmd_cfg
62 -- Update a default config with any options that have been set in
63 -- either the config file or on the command-line. We initialize
64 -- logging before the missing parameter checks below so that we can
66 let cfg = (def :: Configuration) `merge_optional` opt_config
68 when (null $ get_hosts $ hosts cfg) $
69 exitWith (ExitFailure exit_no_hosts)
71 when (null $ get_lists $ lists cfg) $
72 exitWith (ExitFailure exit_no_lists)
74 case (parse_lists $ lists cfg) of
77 exitWith (ExitFailure exit_unparseable_list)
79 case (parse_hosts $ hosts cfg) of
82 exitWith (ExitFailure exit_unparseable_host)
84 listings <- concatMapM (lookup_rbl ls) hs
85 mapM_ (putStrLn . listing_message) listings
88 else exitWith (ExitFailure exit_host_blacklisted)