Add configuration options for daemonize, pidfile, run_as_group and run_as_user.

diff --git a/src/CommandLine.hs b/src/CommandLine.hs
index 01b5a806219e8f131fc69b9a7646f64890e3b02e..45d43abe41dc5082d6edcf3b71267b32c18f4c43 100644 (file)
--- a/src/CommandLine.hs
+++ b/src/CommandLine.hs
@@ -15,6 +15,7 @@ import System.Console.CmdArgs (
   program,
   summary,
   typ,
   program,
   summary,
   typ,

+  typFile,

   versionArg )
 import System.Environment ( withArgs )
 
   versionArg )
 import System.Environment ( withArgs )
 


@@ -44,16 +45,10 @@ my_summary :: String
 my_summary = program_name ++ "-" ++ (showVersion version)
 
 
 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
 
 
 -- | Help string for the \"access_token\" option


@@ -62,22 +57,22 @@ access_token_help :: String
 access_token_help = "Your Twitter API access token"
 
 
 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.
 
 
 -- | Help string for the \"from_address\" option.


@@ -86,10 +81,10 @@ from_address_help :: String
 from_address_help = "Send tweets from ADDRESS"
 
 
 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.
 
 
 -- | Help string for the \"ignore_replies\" option.


@@ -104,6 +99,37 @@ ignore_retweets_help :: String
 ignore_retweets_help = "Ignore retweets from other users"
 
 
 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
 -- | 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 {
 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"
       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_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"
       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"
 
     heartbeat =
       def &= groupname "Miscellaneous"


@@ -145,20 +182,23 @@ arg_spec =
       def &= groupname "Miscellaneous"
           &= help ignore_retweets_help,
 
       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,
 
 
     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"
     to_address =
       def &= typ "ADDRESS"
           &= groupname "Mail Options"


@@ -166,7 +206,11 @@ arg_spec =
 
     usernames =
       def &= args
 
     usernames =
       def &= args

-          &= typ "USERNAMES" }
+          &= typ "USERNAMES",
+
+    verbose =
+      def &= groupname "Miscellaneous"
+          &= help verbose_help }

 
   &= program program_name
   &= summary my_summary
 
   &= program program_name
   &= summary my_summary


@@ -174,6 +218,7 @@ arg_spec =
   &= helpArg [groupname "Common flags"]
   &= versionArg [groupname "Common flags"]
 
   &= helpArg [groupname "Common flags"]
   &= versionArg [groupname "Common flags"]
 

+

 show_help :: IO OptionalCfg
 show_help = withArgs ["--help"] get_args
 
 show_help :: IO OptionalCfg
 show_help = withArgs ["--help"] get_args
 

diff --git a/src/Configuration.hs b/src/Configuration.hs
index c2136431577a574cd2ace86a67e93dc7d3747e2d..4a38d0664cd4d8c4c22fd2b853cb3d1d38ed821b 100644 (file)
--- a/src/Configuration.hs
+++ b/src/Configuration.hs
@@ -8,6 +8,7 @@ module Configuration (
   merge_optional )
 where
 
   merge_optional )
 where
 

+import Data.Monoid ( Monoid(..) )

 import System.Console.CmdArgs.Default ( Default(..) )
 
 import qualified OptionalConfiguration as OC ( OptionalCfg(..) )
 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 =
 --   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_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,
         heartbeat :: Int,
         ignore_replies :: Bool,
         ignore_retweets :: Bool,

+        pidfile :: FilePath,
+        run_as_group     :: Maybe String,
+        run_as_user      :: Maybe String,

         sendmail_path :: FilePath,
         sendmail_path :: FilePath,

-        from_address :: Maybe String,

         to_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.
   --
     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_token = def,

-              access_secret = def,
+              consumer_key = def,
+              consumer_secret = def,
+              daemonize = def,
+              from_address = def,

               heartbeat = 600,
               ignore_replies = def,
               ignore_retweets = 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",
               sendmail_path = "/usr/sbin/sendmail",

-              from_address = def,

               to_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
 
 
 -- | 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_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 (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 (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 (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))
     (merge (verbose cfg) (OC.verbose opt_cfg))

-    all_usernames

   where
     merge :: a -> Maybe a -> a
     merge x Nothing  = x
     merge _ (Just y) = y
 
   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 8fd9f6c68319d204a94efc4e3a9d17f052124758..fca9e58eca283abfa8d45912a71dfee3baa03b39 100644 (file)
--- a/src/OptionalConfiguration.hs
+++ b/src/OptionalConfiguration.hs
@@ -38,18 +38,22 @@ import Usernames ( Usernames(..) )
 --   can parse more than one of them.
 --
 data OptionalCfg =
 --   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_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,
                 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,
                 sendmail_path :: Maybe String,

-                from_address :: Maybe String,

                 to_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
     deriving (Show, Data, Typeable)
 
 instance Monoid OptionalCfg where


@@ -65,22 +69,30 @@ instance Monoid OptionalCfg where
              Nothing
              Nothing
              Nothing
              Nothing
              Nothing
              Nothing

-             (Usernames [])
+             Nothing
+             Nothing
+             Nothing
+             mempty
+             Nothing

 
   cfg1 `mappend` cfg2 =
     OptionalCfg
 
   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 (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 (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 (sendmail_path cfg1) (sendmail_path cfg2))

-      (merge (from_address cfg1) (from_address cfg2))

       (merge (to_address cfg1) (to_address cfg2))
       (merge (to_address cfg1) (to_address cfg2))

+      ((usernames cfg1) `mappend` (usernames cfg2))

       (merge (verbose cfg1) (verbose cfg2))
       (merge (verbose cfg1) (verbose cfg2))

-      all_usernames

     where
       merge :: (Maybe a) -> (Maybe a) -> (Maybe a)
       merge Nothing Nothing   = Nothing
     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
 
       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
 
 
 -- | 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 <- 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_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_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_sendmail_path <- DC.lookup cfg "sendmail-path"

-  cfg_from_address <- DC.lookup cfg "from"

   cfg_to_address <- DC.lookup cfg "to"
   cfg_to_address <- DC.lookup cfg "to"

-  cfg_verbose <- DC.lookup cfg "verbose"

   cfg_usernames <- DC.lookup cfg "usernames"
   cfg_usernames <- DC.lookup cfg "usernames"

+  cfg_verbose <- DC.lookup cfg "verbose"

 
   return $ OptionalCfg
 
   return $ OptionalCfg

+             cfg_access_secret
+             cfg_access_token

              cfg_consumer_key
              cfg_consumer_secret
              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_heartbeat
              cfg_ignore_replies
              cfg_ignore_retweets

+             cfg_pidfile
+             cfg_run_as_group
+             cfg_run_as_user

              cfg_sendmail_path
              cfg_sendmail_path

-             cfg_from_address

              cfg_to_address
              cfg_to_address

+             (fromMaybe mempty cfg_usernames)

              cfg_verbose
              cfg_verbose

-             (fromMaybe (Usernames []) cfg_usernames)

diff --git a/src/Usernames.hs b/src/Usernames.hs
index 6aec228ed06397873a3dc496afcf221f5dc9a19c..e31b118405c908c1eab3e09b6fc54b43d3e18cae 100644 (file)
--- 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 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 Data.Typeable ( Typeable )

+import System.Console.CmdArgs.Default ( Default(..) )

 
 
 -- | Wrapper around a list of strings (usernames).
 
 
 -- | Wrapper around a list of strings (usernames).


@@ -28,6 +29,20 @@ instance Default Usernames where
   def = Usernames []
 
 
   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
 
 instance DCT.Configured Usernames where
   -- | This allows us to read a 'Usernames' object out of a