{-# LANGUAGE DoAndIfThenElse #-} module Main ( main ) where import Control.Monad ( liftM, when ) import Data.Monoid ( (<>) ) import Text.Parsec ( ParseError, parse ) import System.Console.CmdArgs ( def ) import System.Exit ( exitSuccess, exitWith, ExitCode (ExitFailure) ) import System.IO ( hPutStrLn, stderr ) import CommandLine ( get_args ) import Configuration ( Configuration(..), merge_optional ) import ExitCodes ( exit_host_blacklisted, exit_no_hosts, exit_no_lists, exit_unparseable_host, exit_unparseable_list ) import Hosts ( Hosts(..) ) import Lists ( Lists(..) ) import qualified OptionalConfiguration as OC ( from_rc ) import Network.DNS.RBL ( Host, Site, host, listing_message, lookup_rbl, sites ) -- | The 'concatMapM' function generalizes 'concatMap' to arbitrary monads. -- See e.g. concatMapM :: (Monad m) => (a -> m [b]) -> [a] -> m [b] concatMapM f xs = liftM concat (mapM f xs) -- | Parse a list of RBL sites from the user's input. If he was nice, -- he would have given us a list of individual RBLs. But we also -- handle the case where a big comma-separated string is given to -- us. -- parse_lists :: Lists -> Either ParseError [Site] parse_lists (Lists ls) = concatMapM (parse sites "") ls -- | Parse a list of hosts from the user's input. Each one should be -- parseable as a 'Host'. -- parse_hosts :: Hosts -> Either ParseError [Host] parse_hosts (Hosts hs) = mapM (parse host "") hs main :: IO () main = do rc_cfg <- OC.from_rc cmd_cfg <- get_args -- Merge the config file options with the command-line ones, -- prefering the command-line ones. let opt_config = rc_cfg <> cmd_cfg -- Update a default config with any options that have been set in -- either the config file or on the command-line. We initialize -- logging before the missing parameter checks below so that we can -- log the errors. let cfg = (def :: Configuration) `merge_optional` opt_config when (null $ get_hosts $ hosts cfg) $ exitWith (ExitFailure exit_no_hosts) when (null $ get_lists $ lists cfg) $ exitWith (ExitFailure exit_no_lists) case (parse_lists $ lists cfg) of Left e -> do hPutStrLn stderr (show e) exitWith (ExitFailure exit_unparseable_list) Right ls -> do case (parse_hosts $ hosts cfg) of Left e -> do hPutStrLn stderr (show e) exitWith (ExitFailure exit_unparseable_host) Right hs -> do listings <- concatMapM (lookup_rbl ls) hs mapM_ (putStrLn . listing_message) listings if null listings then exitSuccess else exitWith (ExitFailure exit_host_blacklisted)