From 15fd6f764f88f79424d7caaba564e57df564b532 Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Wed, 16 Jul 2014 16:28:16 -0400 Subject: [PATCH] Add configuration options for daemonize, pidfile, run_as_group and run_as_user. --- src/CommandLine.hs | 121 ++++++++++++++++++++++++----------- src/Configuration.hs | 64 ++++++++++-------- src/OptionalConfiguration.hs | 63 +++++++++++------- src/Usernames.hs | 17 ++++- 4 files changed, 174 insertions(+), 91 deletions(-) diff --git a/src/CommandLine.hs b/src/CommandLine.hs index 01b5a80..45d43ab 100644 --- a/src/CommandLine.hs +++ b/src/CommandLine.hs @@ -15,6 +15,7 @@ import System.Console.CmdArgs ( program, summary, typ, + typFile, versionArg ) import System.Environment ( withArgs ) @@ -44,16 +45,10 @@ my_summary :: String my_summary = program_name ++ "-" ++ (showVersion version) --- | Help string for the \"consumer_key\" option. --- -consumer_key_help :: String -consumer_key_help = "Your Twitter API consumer key" - - --- | Help string for the \"consumer_secret\" option. +-- | Help string for the \"access_secret\" option. -- -consumer_secret_help :: String -consumer_secret_help = "Your Twitter API consumer secret" +access_secret_help :: String +access_secret_help = "Your Twitter API access secret" -- | Help string for the \"access_token\" option @@ -62,22 +57,22 @@ access_token_help :: String access_token_help = "Your Twitter API access token" --- | Help string for the \"access_secret\" option. +-- | Help string for the \"consumer_key\" option. -- -access_secret_help :: String -access_secret_help = "Your Twitter API access secret" +consumer_key_help :: String +consumer_key_help = "Your Twitter API consumer key" --- | Help string for the \"heartbeat\" option. +-- | Help string for the \"consumer_secret\" option. -- -heartbeat_help :: String -heartbeat_help = "How many seconds to wait between polling" +consumer_secret_help :: String +consumer_secret_help = "Your Twitter API consumer secret" --- | Help string for the \"to_address\" option. +-- | A description of the \"daemonize\" option. -- -to_address_help :: String -to_address_help = "Send tweets to ADDRESS" +daemonize_help :: String +daemonize_help = "Run as a daemon, in the background." -- | Help string for the \"from_address\" option. @@ -86,10 +81,10 @@ from_address_help :: String from_address_help = "Send tweets from ADDRESS" --- | Help string for the \"sendmail_path\" option. +-- | Help string for the \"heartbeat\" option. -- -sendmail_path_help :: String -sendmail_path_help = "Use PATH to send mail" +heartbeat_help :: String +heartbeat_help = "How many seconds to wait between polling" -- | Help string for the \"ignore_replies\" option. @@ -104,6 +99,37 @@ ignore_retweets_help :: String ignore_retweets_help = "Ignore retweets from other users" +-- | 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)." + + +-- | Help string for the \"to_address\" option. +-- +to_address_help :: String +to_address_help = "Send tweets to ADDRESS" + + + +-- | Help string for the \"sendmail_path\" option. +-- +sendmail_path_help :: String +sendmail_path_help = "Use PATH to send mail" + + -- | Help string for the \"verbose\" option. -- verbose_help :: String @@ -113,25 +139,36 @@ verbose_help = "Be verbose about stuff" arg_spec :: OptionalCfg arg_spec = OptionalCfg { - consumer_key = - def &= typ "KEY" - &= groupname "Twitter API" - &= help consumer_key_help, - consumer_secret = + access_secret = def &= typ "SECRET" &= groupname "Twitter API" - &= help consumer_secret_help, + &= help access_secret_help, access_token = def &= typ "TOKEN" &= groupname "Twitter API" &= help access_token_help, - access_secret = + consumer_key = + def &= typ "KEY" + &= groupname "Twitter API" + &= help consumer_key_help, + + consumer_secret = def &= typ "SECRET" &= groupname "Twitter API" - &= help access_secret_help, + &= help consumer_secret_help, + + + daemonize = + def &= groupname "Miscellaneous" + &= help daemonize_help, + + from_address = + def &= typ "ADDRESS" + &= groupname "Mail Options" + &= help from_address_help, heartbeat = def &= groupname "Miscellaneous" @@ -145,20 +182,23 @@ arg_spec = def &= groupname "Miscellaneous" &= help ignore_retweets_help, - verbose = - def &= groupname "Miscellaneous" - &= help verbose_help, + pidfile = + def &= typFile + &= help pidfile_help, + + run_as_group = + def &= typ "GROUP" + &= help run_as_group_help, + + run_as_user = + def &= typ "USER" + &= help run_as_user_help, sendmail_path = def &= typ "PATH" &= groupname "Mail Options" &= help sendmail_path_help, - from_address = - def &= typ "ADDRESS" - &= groupname "Mail Options" - &= help from_address_help, - to_address = def &= typ "ADDRESS" &= groupname "Mail Options" @@ -166,7 +206,11 @@ arg_spec = usernames = def &= args - &= typ "USERNAMES" } + &= typ "USERNAMES", + + verbose = + def &= groupname "Miscellaneous" + &= help verbose_help } &= program program_name &= summary my_summary @@ -174,6 +218,7 @@ arg_spec = &= helpArg [groupname "Common flags"] &= versionArg [groupname "Common flags"] + show_help :: IO OptionalCfg show_help = withArgs ["--help"] get_args diff --git a/src/Configuration.hs b/src/Configuration.hs index c213643..4a38d06 100644 --- a/src/Configuration.hs +++ b/src/Configuration.hs @@ -8,6 +8,7 @@ module Configuration ( merge_optional ) where +import Data.Monoid ( Monoid(..) ) import System.Console.CmdArgs.Default ( Default(..) ) import qualified OptionalConfiguration as OC ( OptionalCfg(..) ) @@ -18,36 +19,44 @@ import Usernames ( Usernames(..) ) -- can be set in a config file or on the command line. -- data Cfg = - Cfg { consumer_key :: String, - consumer_secret :: String, + Cfg { access_secret :: String, access_token :: String, - access_secret :: String, + consumer_key :: String, + consumer_secret :: String, + daemonize :: Bool, + from_address :: Maybe String, heartbeat :: Int, ignore_replies :: Bool, ignore_retweets :: Bool, + pidfile :: FilePath, + run_as_group :: Maybe String, + run_as_user :: Maybe String, sendmail_path :: FilePath, - from_address :: Maybe String, to_address :: Maybe String, - verbose :: Bool, - usernames :: Usernames } + usernames :: Usernames, + verbose :: Bool } deriving (Show) instance Default Cfg where -- | A 'Cfg' with all of its fields set to their default values. -- - def = Cfg { consumer_key = def, - consumer_secret = def, + def = Cfg { access_secret = def, access_token = def, - access_secret = def, + consumer_key = def, + consumer_secret = def, + daemonize = def, + from_address = def, heartbeat = 600, ignore_replies = def, ignore_retweets = def, + pidfile = "/run/halcyon/halcyon.pid", + run_as_group = def, + run_as_user = def, sendmail_path = "/usr/sbin/sendmail", - from_address = def, to_address = def, - verbose = def, - usernames = def } + usernames = def, + verbose = def } -- | Merge a 'Cfg' with an 'OptionalCfg'. This is more or less the @@ -57,31 +66,30 @@ instance Default Cfg where merge_optional :: Cfg -> OC.OptionalCfg -> Cfg merge_optional cfg opt_cfg = Cfg + (merge (access_secret cfg) (OC.access_secret opt_cfg)) + (merge (access_token cfg) (OC.access_token opt_cfg)) (merge (consumer_key cfg) (OC.consumer_key opt_cfg)) (merge (consumer_secret cfg) (OC.consumer_secret opt_cfg)) - (merge (access_token cfg) (OC.access_token opt_cfg)) - (merge (access_secret cfg) (OC.access_secret opt_cfg)) + (merge (daemonize cfg) (OC.daemonize opt_cfg)) + (merge_maybes (from_address cfg) (OC.from_address opt_cfg)) (merge (heartbeat cfg) (OC.heartbeat opt_cfg)) (merge (ignore_replies cfg) (OC.ignore_replies opt_cfg)) (merge (ignore_retweets cfg) (OC.ignore_retweets opt_cfg)) + (merge (pidfile cfg) (OC.pidfile opt_cfg)) + (merge_maybes (run_as_group cfg) (OC.run_as_group opt_cfg)) + (merge_maybes (run_as_user cfg) (OC.run_as_user opt_cfg)) (merge (sendmail_path cfg) (OC.sendmail_path opt_cfg)) - (merge' (from_address cfg) (OC.from_address opt_cfg)) - (merge' (to_address cfg) (OC.to_address opt_cfg)) + (merge_maybes (to_address cfg) (OC.to_address opt_cfg)) + ((usernames cfg) `mappend` (OC.usernames opt_cfg)) (merge (verbose cfg) (OC.verbose opt_cfg)) - all_usernames where merge :: a -> Maybe a -> a merge x Nothing = x merge _ (Just y) = y - -- Used for the to/from address - merge' :: Maybe a -> Maybe a -> Maybe a - merge' Nothing Nothing = Nothing - merge' (Just x) Nothing = Just x - merge' Nothing (Just x) = Just x - merge' (Just _) (Just y) = Just y - - -- If there are any optional usernames, use only those. - all_usernames = if (null (get_usernames (OC.usernames opt_cfg))) - then (usernames cfg) - else (OC.usernames opt_cfg) + -- Used for the truly optional fields + merge_maybes :: Maybe a -> Maybe a -> Maybe a + merge_maybes Nothing Nothing = Nothing + merge_maybes (Just x) Nothing = Just x + merge_maybes Nothing (Just x) = Just x + merge_maybes (Just _) (Just y) = Just y diff --git a/src/OptionalConfiguration.hs b/src/OptionalConfiguration.hs index 8fd9f6c..fca9e58 100644 --- a/src/OptionalConfiguration.hs +++ b/src/OptionalConfiguration.hs @@ -38,18 +38,22 @@ import Usernames ( Usernames(..) ) -- can parse more than one of them. -- data OptionalCfg = - OptionalCfg { consumer_key :: Maybe String, - consumer_secret :: Maybe String, + OptionalCfg { access_secret :: Maybe String, access_token :: Maybe String, - access_secret :: Maybe String, + consumer_key :: Maybe String, + consumer_secret :: Maybe String, + daemonize :: Maybe Bool, + from_address :: Maybe String, heartbeat :: Maybe Int, ignore_replies :: Maybe Bool, ignore_retweets :: Maybe Bool, + pidfile :: Maybe FilePath, + run_as_group :: Maybe String, + run_as_user :: Maybe String, sendmail_path :: Maybe String, - from_address :: Maybe String, to_address :: Maybe String, - verbose :: Maybe Bool, - usernames :: Usernames } + usernames :: Usernames, + verbose :: Maybe Bool } deriving (Show, Data, Typeable) instance Monoid OptionalCfg where @@ -65,22 +69,30 @@ instance Monoid OptionalCfg where Nothing Nothing Nothing - (Usernames []) + Nothing + Nothing + Nothing + mempty + Nothing cfg1 `mappend` cfg2 = OptionalCfg + (merge (access_secret cfg1) (access_secret cfg2)) + (merge (access_token cfg1) (access_token cfg2)) (merge (consumer_key cfg1) (consumer_key cfg2)) (merge (consumer_secret cfg1) (consumer_secret cfg2)) - (merge (access_token cfg1) (access_token cfg2)) - (merge (access_secret cfg1) (access_secret cfg2)) + (merge (daemonize cfg1) (daemonize cfg2)) + (merge (from_address cfg1) (from_address cfg2)) (merge (heartbeat cfg1) (heartbeat cfg2)) (merge (ignore_replies cfg1) (ignore_replies cfg2)) (merge (ignore_retweets cfg1) (ignore_retweets cfg2)) + (merge (pidfile cfg1) (pidfile cfg2)) + (merge (run_as_group cfg1) (run_as_group cfg2)) + (merge (run_as_user cfg1) (run_as_user cfg2)) (merge (sendmail_path cfg1) (sendmail_path cfg2)) - (merge (from_address cfg1) (from_address cfg2)) (merge (to_address cfg1) (to_address cfg2)) + ((usernames cfg1) `mappend` (usernames cfg2)) (merge (verbose cfg1) (verbose cfg2)) - all_usernames where merge :: (Maybe a) -> (Maybe a) -> (Maybe a) merge Nothing Nothing = Nothing @@ -88,11 +100,6 @@ instance Monoid OptionalCfg where merge Nothing (Just x) = Just x merge (Just _) (Just y) = Just y - -- Use only the latter usernames if there are any. - all_usernames = - usernames $ if (null (get_usernames (usernames cfg2))) - then cfg1 - else cfg2 -- | Obtain an 'OptionalCfg' from halcyonrc in either the global @@ -117,29 +124,37 @@ from_rc = do cfg <- DC.load [ DC.Optional global_config_path, DC.Optional user_config_path ] + cfg_access_secret <- DC.lookup cfg "access-secret" + cfg_access_token <- DC.lookup cfg "access-token" cfg_consumer_key <- DC.lookup cfg "consumer-key" cfg_consumer_secret <- DC.lookup cfg "consumer-secret" - cfg_access_token <- DC.lookup cfg "access-token" - cfg_access_secret <- DC.lookup cfg "access-secret" + cfg_daemonize <- DC.lookup cfg "daemonize" + cfg_from_address <- DC.lookup cfg "from" cfg_heartbeat <- DC.lookup cfg "heartbeat" cfg_ignore_replies <- DC.lookup cfg "ignore-replies" cfg_ignore_retweets <- DC.lookup cfg "ignore-retweets" + cfg_pidfile <- DC.lookup cfg "pidfile" + cfg_run_as_group <- DC.lookup cfg "run_as_group" + cfg_run_as_user <- DC.lookup cfg "run_as_user" cfg_sendmail_path <- DC.lookup cfg "sendmail-path" - cfg_from_address <- DC.lookup cfg "from" cfg_to_address <- DC.lookup cfg "to" - cfg_verbose <- DC.lookup cfg "verbose" cfg_usernames <- DC.lookup cfg "usernames" + cfg_verbose <- DC.lookup cfg "verbose" return $ OptionalCfg + cfg_access_secret + cfg_access_token cfg_consumer_key cfg_consumer_secret - cfg_access_token - cfg_access_secret + cfg_daemonize + cfg_from_address cfg_heartbeat cfg_ignore_replies cfg_ignore_retweets + cfg_pidfile + cfg_run_as_group + cfg_run_as_user cfg_sendmail_path - cfg_from_address cfg_to_address + (fromMaybe mempty cfg_usernames) cfg_verbose - (fromMaybe (Usernames []) cfg_usernames) diff --git a/src/Usernames.hs b/src/Usernames.hs index 6aec228..e31b118 100644 --- a/src/Usernames.hs +++ b/src/Usernames.hs @@ -11,8 +11,9 @@ where import qualified Data.Configurator as DC() import qualified Data.Configurator.Types as DCT import Data.Data ( Data ) -import System.Console.CmdArgs.Default ( Default(..) ) +import Data.Monoid ( Monoid(..) ) import Data.Typeable ( Typeable ) +import System.Console.CmdArgs.Default ( Default(..) ) -- | Wrapper around a list of strings (usernames). @@ -28,6 +29,20 @@ instance Default Usernames where def = Usernames [] +-- | The 'Monoid' instance for 'Usernames' uses an +-- 'Monoid' instance for lists. +-- +instance Monoid Usernames where + -- | The \"empty\" 'Usernames' simply wraps an empty list. + mempty = Usernames [] + + -- | This mappend is a little funny; it always chooses the second + -- list if that list is nonempty. Otherwise, it chooses the + -- first. This is actually associative! + u1 `mappend` u2 + | null (get_usernames u2) = u1 + | otherwise = u2 + instance DCT.Configured Usernames where -- | This allows us to read a 'Usernames' object out of a -- 2.43.2