X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FMain.hs;h=38dd2e5ad5e8af5c4336c667507a6a87b74c0ccd;hb=bb74b494c23a737b9c0355148d25f090545b856b;hp=02b42ff09b2f5b58b3357147d03a5679e43f606b;hpb=ac3a81eb6d0f8ca4e212752d5b390a4fc220cceb;p=dead%2Fhtsn.git diff --git a/src/Main.hs b/src/Main.hs index 02b42ff..38dd2e5 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -5,7 +5,7 @@ module Main where import Control.Concurrent ( threadDelay ) -import Control.Exception.Base ( bracket ) +import Control.Exception ( bracket, throw ) import Control.Monad ( when ) import Data.List ( isPrefixOf ) import Data.Maybe ( isNothing ) @@ -37,61 +37,20 @@ import ExitCodes ( exit_no_password, exit_no_username, exit_pidfile_exists ) -import Logging ( - init_logging, - log_debug, - log_error, - log_info, - log_warning ) +import FeedHosts ( FeedHosts(..) ) +import Network.Services.TSN.Logging ( init_logging ) import qualified OptionalConfiguration as OC ( OptionalConfiguration(..), from_rc ) -import Terminal ( - display_debug, - display_error, - display_info, - display_sent, - display_warning ) -import TSN.FeedHosts ( FeedHosts(..) ) -import TSN.Xml ( parse_xmlfid ) +import Network.Services.TSN.Report ( + report_debug, + report_info, + report_warning, + report_error ) +import Network.Services.TSN.Terminal ( display_sent ) +import Xml ( parse_xmlfid ) import Unix ( full_daemonize ) --- | Display and log debug information. WARNING! This does not --- automatically append a newline. The output is displayed/logged --- as-is, for, you know, debug purposes. -report_debug :: String -> IO () -report_debug s = do - display_debug s - log_debug s - - --- | Display and log an error condition. This will prefix the error --- with "ERROR: " when displaying (but not logging) it so that it --- stands out. --- -report_error :: String -> IO () -report_error s = do - display_error $ "ERROR: " ++ s - log_error s - - --- | Display and log an informational (status) message. --- -report_info :: String -> IO () -report_info s = do - display_info s - log_info s - - --- | Display and log a warning. This will prefix the warning with --- "WARNING: " when displaying (but not logging) it so that it --- stands out. --- -report_warning :: String -> IO () -report_warning s = do - display_warning $ "WARNING: " ++ s - log_warning s - -- | Receive a single line of text from a Handle, and send it to the -- debug log. @@ -198,6 +157,7 @@ log_in cfg h = do else do send_cred h (password cfg) _ <- recv_line h -- "The Sports Network" + report_info $ "Logged in as " ++ (username cfg) ++ "." return () where username_prompt = "Username: " @@ -296,7 +256,7 @@ main = do -- logging before the missing parameter checks below so that we can -- log the errors. let cfg = (def :: Configuration) `merge_optional` opt_config - init_logging (log_file cfg) (log_level cfg) (syslog cfg) + init_logging (log_level cfg) (log_file cfg) (syslog cfg) -- Check the optional config for missing required options. This is -- necessary because if the user specifies an empty list of @@ -336,7 +296,7 @@ main = do -- If we were asked to daemonize, do that; otherwise just run the thing. if (daemonize cfg) - then full_daemonize cfg run_program + then try_daemonize cfg run_program else run_program where @@ -353,3 +313,16 @@ main = do catchIOError (connect_and_parse cfg host) (report_error . show) thread_sleep 5 -- Wait 5s before attempting to reconnect. round_robin cfg $ (feed_host_idx + 1) `mod` (length hosts) + + + -- | A exception handler around full_daemonize. If full_daemonize + -- doesn't work, we report the error and crash. This is fine; we + -- only need the program to be resilient once it actually starts. + -- + try_daemonize :: Configuration -> IO () -> IO () + try_daemonize cfg program = + catchIOError + (full_daemonize cfg program) + (\e -> do + report_error (show e) + throw e)