From ac3a81eb6d0f8ca4e212752d5b390a4fc220cceb Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Sun, 22 Dec 2013 21:40:03 -0500 Subject: [PATCH] Add more code documentation. --- src/CommandLine.hs | 11 +++++--- src/Configuration.hs | 2 ++ src/ExitCodes.hs | 5 ++-- src/Logging.hs | 12 ++++++++- src/Main.hs | 62 +++++++++++++++++++++++++++++++++++++------- src/TSN/FeedHosts.hs | 3 +++ src/Terminal.hs | 25 +++++++++++++++++- src/Unix.hs | 21 ++++++++++++++- 8 files changed, 122 insertions(+), 19 deletions(-) diff --git a/src/CommandLine.hs b/src/CommandLine.hs index b734d77..adbb0d8 100644 --- a/src/CommandLine.hs +++ b/src/CommandLine.hs @@ -36,6 +36,7 @@ my_summary :: String my_summary = program_name ++ "-" ++ (showVersion version) +-- | A description of the "daemonize" option. daemonize_help :: String daemonize_help = "Run as a daemon, in the background." @@ -45,6 +46,7 @@ log_file_help :: String log_file_help = "Log to the given file." +-- | A description of the "log_level" option. log_level_help :: String log_level_help = "How verbose should the logs be? One of INFO, WARNING, ERROR." @@ -52,21 +54,24 @@ log_level_help = -- | A description of the "output_directory" option. output_directory_help :: String output_directory_help = - "Directory in which to output the XML files; must be writable" + "Directory in which to output the XML files; must be writable." -- | A description of the "password" option. password_help :: String password_help = - "Password to use when connecting to the feed" + "Password to use when connecting to the feed." +-- | A description of the "pidfile" option. pidfile_help :: String pidfile_help = "Location to create PID file (daemon only)." +-- | A description of the "run_as_group" option. run_as_group_help :: String run_as_group_help = "System group to run as (daemon only)." +-- | A description of the "run_as_user" option. run_as_user_help :: String run_as_user_help = "System user to run under (daemon only)." @@ -79,7 +84,7 @@ syslog_help = -- | A description of the "username" option. username_help :: String username_help = - "Username to use when connecting to the feed" + "Username to use when connecting to the feed." -- | A data structure representing the possible command-line -- options. The CmdArgs library is doing heavy magic beneath the diff --git a/src/Configuration.hs b/src/Configuration.hs index 68751d6..0a657e2 100644 --- a/src/Configuration.hs +++ b/src/Configuration.hs @@ -15,6 +15,8 @@ import qualified OptionalConfiguration as OC ( merge_maybes ) import TSN.FeedHosts (FeedHosts(..)) +-- | The main configuration data type. This will be passed to most of +-- the important functions once it has been created. data Configuration = Configuration { daemonize :: Bool, diff --git a/src/ExitCodes.hs b/src/ExitCodes.hs index f412a07..4f8cd53 100644 --- a/src/ExitCodes.hs +++ b/src/ExitCodes.hs @@ -1,6 +1,5 @@ --- |All exit codes that the program can return (excepting --- ExitSuccess). There's only one, since the program will try and fail --- forever upon errors. +-- | All exit codes that the program can return (excepting +-- ExitSuccess). module ExitCodes ( exit_no_feed_hosts, exit_no_password, diff --git a/src/Logging.hs b/src/Logging.hs index 8e80ac9..ede739a 100644 --- a/src/Logging.hs +++ b/src/Logging.hs @@ -26,20 +26,30 @@ import System.Log.Logger ( warningM ) +-- | Log a message at the DEBUG level. log_debug :: String -> IO () log_debug = debugM rootLoggerName +-- | Log a message at the ERROR level. log_error :: String -> IO () log_error = errorM rootLoggerName +-- | Log a message at the INFO level. log_info :: String -> IO () log_info = infoM rootLoggerName +-- | Log a message at the WARNING level. log_warning :: String -> IO () log_warning = warningM rootLoggerName --- | Why don't we take a Configuration as an argument? Because it +-- | Set up the logging. All logs are handled by the global "root" +-- logger provided by HSLogger. We remove all of its handlers so +-- that it does nothing; then we conditionally add back two handlers +-- -- one for syslog, and one for a normal file -- dependent upon +-- the 'syslog' and 'log_file' configuration items. +-- +-- Why don't we take a Configuration as an argument? Because it -- would create circular imports! init_logging :: Maybe FilePath -> Priority -> Bool -> IO () init_logging log_file log_level syslog = do diff --git a/src/Main.hs b/src/Main.hs index b640361..02b42ff 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -76,6 +76,7 @@ report_error s = do -- | Display and log an informational (status) message. +-- report_info :: String -> IO () report_info s = do display_info s @@ -159,6 +160,29 @@ loop !cfg !h !buffer = do loop cfg h new_buffer +-- | Once we're connected to a feed, we need to log in. There's no +-- protocol for this (the docs don't mention one), but we have +-- (apparently) successfully guessed it. +-- +-- The first thing TSN sends once we've connected is the string +-- "Username: ", containing 10 ASCII characters. We then send a +-- username, followed by a newline. If TSN likes the username, the +-- second they'll send is the string "Password: ", also containing +-- 10 ASCII characters, to which we reply in kind. +-- +-- Assuming the above will always hold, it is implemented as follows: +-- +-- 1. Receive 10 chars +-- +-- 2. Send username if we got the username prompt +-- +-- 3. Receive 10 chars +-- +-- 4. Send password if we got the password prompt +-- +-- If TSN likes the password as well, they send the string "The +-- Sports Network" before finally beginning to stream the feed. +-- log_in :: Configuration -> Handle -> IO () log_in cfg h = do prompt1 <- recv_prompt h @@ -166,25 +190,25 @@ log_in cfg h = do if prompt1 /= username_prompt then report_error "Didn't receive username prompt." else do - send_line h (username cfg) + send_cred h (username cfg) prompt2 <- recv_prompt h if prompt2 /= password_prompt then report_error "Didn't receive password prompt." else do - send_line h (password cfg) + send_cred h (password cfg) _ <- recv_line h -- "The Sports Network" return () where username_prompt = "Username: " password_prompt = "Password: " - send_line :: Handle -> String -> IO () - send_line h' s = do + send_cred :: Handle -> String -> IO () + send_cred h' s = do + -- The carriage return is super important! let line = s ++ "\r\n" hPutStr h' line - -- Don't log the username/password! - display_sent line + display_sent line -- Don't log the username/password! recv_chars :: Int -> Handle -> IO String recv_chars n h' = do @@ -196,8 +220,22 @@ log_in cfg h = do recv_prompt = recv_chars 10 -connect_and_loop :: Configuration -> String -> IO () -connect_and_loop cfg host = do +-- | Connect to @host@ and attempt to parse the feed. As long as we +-- stay connected and nothing bad happens, the program will remain in +-- this function. If anything goes wrong, then the current invocation +-- of connect_and_parse will return, and get called again later +-- (probably with a different @host@). +-- +-- Steps: +-- +-- 1. Connect to the host on the XML port +-- +-- 2. Log in +-- +-- 3. Go into the eternal read/save loop. +-- +connect_and_parse :: Configuration -> String -> IO () +connect_and_parse cfg host = do report_info $ "Connecting to " ++ host ++ "." bracket acquire_handle release_handle action return () @@ -228,7 +266,8 @@ connect_and_loop cfg host = do -- login_worked <- timeout five_seconds $ log_in cfg h case login_worked of - Nothing -> report_info "Login timed out (5s)." + Nothing -> report_info $ "Login timed out (5 seconds). " + ++ "Waiting 5 seconds to reconnect." Just _ -> loop cfg h [] @@ -242,6 +281,7 @@ thread_sleep seconds = do -- | The entry point of the program. +-- main :: IO () main = do rc_cfg <- OC.from_rc @@ -276,6 +316,8 @@ main = do exitWith (ExitFailure exit_no_username) when (daemonize cfg) $ do + -- Old PID files can be left around after an unclean shutdown. We + -- only care if we're running as a daemon. pidfile_exists <- doesFileExist (pidfile cfg) when pidfile_exists $ do report_error $ "PID file " ++ (pidfile cfg) ++ " already exists. " @@ -308,6 +350,6 @@ main = do round_robin cfg feed_host_idx = do let hosts = get_feed_hosts $ feed_hosts cfg let host = hosts !! feed_host_idx - catchIOError (connect_and_loop cfg host) (report_error . show) + 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) diff --git a/src/TSN/FeedHosts.hs b/src/TSN/FeedHosts.hs index d2f295b..81f57aa 100644 --- a/src/TSN/FeedHosts.hs +++ b/src/TSN/FeedHosts.hs @@ -22,10 +22,13 @@ import System.Console.CmdArgs.Default (Default(..)) import Data.Typeable (Typeable) +-- | A (wrapper around a) list of hostnames that supply the XML feed. +-- newtype FeedHosts = FeedHosts { get_feed_hosts :: [String] } deriving (Data, Show, Typeable) + instance Default FeedHosts where -- | The default list of feed hosts. These were found by checking -- PTR records in the neighborhood of the IP address in use. There diff --git a/src/Terminal.hs b/src/Terminal.hs index 6031d62..064c5ff 100644 --- a/src/Terminal.hs +++ b/src/Terminal.hs @@ -33,24 +33,47 @@ with_color h color = with_sgr h [SetColor Foreground Vivid color] +-- | Write the given String to a handle in color. The funnyCaps are +-- for synergy with putstrLn and friends. +-- hPutStrColor :: Handle -> Color -> String -> IO () hPutStrColor h c = with_color h c . hPutStr h + +-- | Write the given line to a handle in color. The funnyCaps are for +-- synergy with putstrLn and friends. +-- hPutStrColorLn :: Handle -> Color -> String -> IO () hPutStrColorLn h c s = hPutStrColor h c (s ++ "\n") --- | Don't automatically append a newline. + +-- | Display text sent to the feed on the console. Don't automatically +-- append a newline. +-- display_sent :: String -> IO () display_sent = hPutStrColor stdout Green + +-- | Display debug text on the console. Don't automatically append a +-- newline in case the raw text is needed for, uh, debugging. +-- display_debug :: String -> IO () display_debug = putStr + +-- | Display an informational message on the console. +-- display_info :: String -> IO () display_info = hPutStrColorLn stdout Cyan + +-- | Display a warning on the console. Uses stderr instead of stdout. +-- display_warning :: String -> IO () display_warning = hPutStrColorLn stderr Yellow + +-- | Display an error on the console. Uses stderr instead of stdout. +-- display_error :: String -> IO () display_error = hPutStrColorLn stderr Red diff --git a/src/Unix.hs b/src/Unix.hs index 8931326..a4389be 100644 --- a/src/Unix.hs +++ b/src/Unix.hs @@ -1,3 +1,5 @@ +-- | Non-portable code for daemonizing on unix. +-- module Unix where @@ -28,22 +30,39 @@ import Configuration ( run_as_user )) import Logging ( log_info ) +-- | Retrieve the uid associated with the given system user name. We +-- take a Maybe String as an argument so the user name can be passed +-- in directly from the config. +-- get_user_id :: Maybe String -> IO UserID get_user_id Nothing = getRealUserID get_user_id (Just s) = fmap userID (getUserEntryForName s) + +-- | Retrieve the gid associated with the given system group name. We +-- take a Maybe String as an argument so the group name can be +-- passed in directly from the config. +-- get_group_id :: Maybe String -> IO GroupID get_group_id Nothing = getRealGroupID get_group_id (Just s) = fmap groupID (getGroupEntryForName s) + +-- | This function will be called in response to a SIGTERM; i.e. when +-- someone tries to kill our process. We simply delete the PID file +-- and signal our parent thread to quit (successfully). graceful_shutdown :: Configuration -> ThreadId -> IO () graceful_shutdown cfg main_thread_id = do log_info "SIGTERM received, removing PID file and shutting down." removeLink (pidfile cfg) throwTo main_thread_id ExitSuccess + +-- | Write a PID file, install a SIGTERM handler, drop privileges, and +-- finally do the daemonization dance. +-- full_daemonize :: Configuration -> IO () -> IO () -full_daemonize cfg program = do +full_daemonize cfg program = -- This is the 'daemonize' from System.Posix.Daemonize. daemonize program' where -- 2.43.2