X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Fhtsn.git;a=blobdiff_plain;f=src%2FMain.hs;h=b6403614d5d46af193e1f7b2b2adef5ccc8c4bcd;hp=4ebada07e858fb53d2ca983503ced14201a1fd22;hb=f6cb0ba712e06e52d080b86e9eba6c3585a7514b;hpb=4e53c500d87df2dbe1413d47562786fe4cc88f2a diff --git a/src/Main.hs b/src/Main.hs index 4ebada0..b640361 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -35,7 +35,8 @@ import Configuration ( Configuration(..), merge_optional ) import ExitCodes ( exit_no_feed_hosts, exit_no_password, - exit_no_username ) + exit_no_username, + exit_pidfile_exists ) import Logging ( init_logging, log_debug, @@ -53,7 +54,7 @@ import Terminal ( display_warning ) import TSN.FeedHosts ( FeedHosts(..) ) import TSN.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 @@ -81,15 +82,6 @@ report_info s = do log_info s --- | A special case of report_debug for reporting the two bits of data --- that we sent to TSN: the username and password. --- -report_sent :: String -> IO () -report_sent s = do - display_sent s - log_debug s - - -- | Display and log a warning. This will prefix the warning with -- "WARNING: " when displaying (but not logging) it so that it -- stands out. @@ -191,6 +183,7 @@ log_in cfg h = do send_line h' s = do let line = s ++ "\r\n" hPutStr h' line + -- Don't log the username/password! display_sent line recv_chars :: Int -> Handle -> IO String @@ -282,13 +275,27 @@ main = do report_error "No username supplied." exitWith (ExitFailure exit_no_username) + when (daemonize cfg) $ do + pidfile_exists <- doesFileExist (pidfile cfg) + when pidfile_exists $ do + report_error $ "PID file " ++ (pidfile cfg) ++ " already exists. " + ++ "Refusing to start." + exitWith (ExitFailure exit_pidfile_exists) + -- This may be superstition (and I believe stderr is unbuffered), -- but it can't hurt. hSetBuffering stderr NoBuffering hSetBuffering stdout NoBuffering - -- Begin connecting to our feed hosts, starting with the first one. - round_robin cfg 0 + -- The rest of the program is kicked off by the following line which + -- begins connecting to our feed hosts, starting with the first one, + -- and proceeds in a round-robin fashion. + let run_program = round_robin cfg 0 + + -- If we were asked to daemonize, do that; otherwise just run the thing. + if (daemonize cfg) + then full_daemonize cfg run_program + else run_program where -- | This is the top-level "loop forever" function. If an