Allow log_file and syslog to coexist.
# username = "whoever"
-# The password used to connect to the feed.
+# The password associated with your TSN username.
#
# Default: none (required)
#
# password = "whatever"
-# By default, htsn will output the XML files to the current working
+# By default, XML files will be written to the current working
# directory. Often this is not desirable, and you would rather save
# them to a specific location. Specify it here.
#
-# Default: "." (here)
+# Default: "."
#
# output-directory = "/var/lib/htsn"
-# A list of hostnames that supply the feed.
+# A list of hostnames that supply the feed. You probably don't need to
+# change this, but you can.
#
# Default: ["feed1.sportsnetwork.com",
# "feed2.sportsnetwork.com",
# feed-hosts = [ "hostname1", "hostname2", ... ]
-# Do you want to log to syslog? If so, the log_file option below will
-# be ignored. This will log to the event log on Windows.
+# Do you want to log to syslog? On Windows this will attempt to
+# communicate (over UDP) with a syslog daemon on localhost, which will
+# most likely not work.
#
-# Default: True
+# Default: False
#
-# syslog = False
+# syslog = True
-# If syslog = False, which file should we use for a log? Can be either
-# a relative or absolute path. It will not be auto-rotated; use
-# something log logrotate for that.
+# If you specify a file path here, logs will be written to it
+# (possibly in addition to syslog). Can be either a relative or
+# absolute path. It will not be auto-rotated; use something like
+# logrotate for that.
#
-# Default: htsn.log
+# Default: empty
#
# log_file = /var/log/htsn/htsn.log
import Data.Version (showVersion)
import OptionalConfiguration ( OptionalConfiguration(..) )
-import TSN.FeedHosts ( FeedHosts(..) )
-- | The description of the program, displayed as part of the help.
description :: String
-- | A description of the "log_file" option.
log_file_help :: String
log_file_help =
- "If syslog == False, log to the given file."
+ "Log to the given file."
log_level_help :: String
log_level_help =
-- | A description of the "syslog" option.
syslog_help :: String
syslog_help =
- "Enable (default) or disable logging to syslog."
+ "Enable logging to syslog."
-- | A description of the "username" option.
username_help :: String
-- Use an empty list for feed_hosts since cmdargs will appends to
-- the default when the user supplies feed hosts. If he specifies
-- any, those are all we should use.
- feed_hosts = FeedHosts [] &= typ "HOSTNAMES" &= args,
+ feed_hosts = def &= typ "HOSTNAMES" &= args,
log_file = def &= typFile &= help log_file_help,
log_level = def &= typ "LEVEL" &= help log_level_help,
password = def &= typ "PASSWORD" &= help password_help,
import System.Console.CmdArgs.Default ( Default(..) )
import System.Log ( Priority( INFO ) )
-import qualified OptionalConfiguration as OC (OptionalConfiguration(..))
+import qualified OptionalConfiguration as OC (
+ OptionalConfiguration(..),
+ merge_maybes )
import TSN.FeedHosts (FeedHosts(..))
data Configuration =
Configuration {
feed_hosts :: FeedHosts,
- log_file :: FilePath,
+ log_file :: Maybe FilePath,
log_level :: Priority,
password :: String,
output_directory :: FilePath,
-- | A Configuration with all of its fields set to their default
-- values.
instance Default Configuration where
- def = Configuration def "htsn.log" INFO def "." True def
+ def = Configuration def def INFO def "." def def
-- | Merge a Configuration with an OptionalConfiguration. This is more
merge_optional cfg opt_cfg =
Configuration
all_feed_hosts
- (merge (log_file cfg) (OC.log_file opt_cfg))
+ (OC.merge_maybes (log_file cfg) (OC.log_file opt_cfg))
(merge (log_level cfg) (OC.log_level opt_cfg))
(merge (password cfg) (OC.password opt_cfg))
(merge (output_directory cfg) (OC.output_directory opt_cfg))
(merge (syslog cfg) (OC.syslog opt_cfg))
(merge (username cfg) (OC.username opt_cfg))
where
+ -- | If the thing on the right is Just something, return that
+ -- something, otherwise return the thing on the left.
merge :: a -> Maybe a -> a
merge x Nothing = x
merge _ (Just y) = y
log_warning )
where
+import Control.Monad ( when )
import System.Log.Formatter ( simpleLogFormatter )
import System.Log.Handler ( setFormatter )
-import System.Log.Handler.Simple ( fileHandler )
+import System.Log.Handler.Simple ( GenericHandler, fileHandler )
import System.Log.Handler.Syslog (
Facility ( USER ),
openlog )
import System.Log.Logger (
- Priority ( DEBUG, INFO ),
+ Priority ( INFO ),
+ addHandler,
debugM,
errorM,
infoM,
-- | Why don't we take a Configuration as an argument? Because it
-- would create circular imports!
-init_logging :: FilePath -> Priority -> Bool -> IO ()
-init_logging log_file log_level syslog
- | syslog == True = do
- handler' <- openlog rootLoggerName [] USER level
- -- Syslog should output the date by itself.
- let slf = simpleLogFormatter "htsn[$pid] $prio: $msg"
- let handler = setFormatter handler' slf
- updateGlobalLogger rootLoggerName (setLevel level . setHandlers [handler])
- | otherwise = do
- handler' <- fileHandler log_file level
- let slf = simpleLogFormatter "$time: htsn[$pid] $prio: $msg"
- let handler = setFormatter handler' slf
- updateGlobalLogger rootLoggerName (setLevel level . setHandlers [handler])
- where
- min_level = if syslog then INFO else DEBUG
- level = if log_level < min_level then min_level else log_level
+init_logging :: Maybe FilePath -> Priority -> Bool -> IO ()
+init_logging log_file log_level syslog = do
+ -- First set the global log level and clear the default handler.
+ let no_handlers = [] :: [GenericHandler a]
+ updateGlobalLogger rootLoggerName (setLevel log_level .
+ setHandlers no_handlers)
+
+ when syslog $ do
+ let min_level = INFO
+ let sl_level = if log_level < min_level then min_level else log_level
+
+ -- The syslog handle gets its own level which will cowardly refuse
+ -- to log all debug info (i.e. the entire feed) to syslog.
+ sl_handler' <- openlog rootLoggerName [] USER sl_level
+
+ -- Syslog should output the date by itself.
+ let sl_formatter = simpleLogFormatter "htsn[$pid] $prio: $msg"
+ let sl_handler = setFormatter sl_handler' sl_formatter
+
+ updateGlobalLogger rootLoggerName (addHandler sl_handler)
+
+ case log_file of
+ Nothing -> return ()
+ Just lf -> do
+ lf_handler' <- fileHandler lf log_level
+ let lf_formatter = simpleLogFormatter "$time: htsn[$pid] $prio: $msg"
+ let lf_handler = setFormatter lf_handler' lf_formatter
+ updateGlobalLogger rootLoggerName (addHandler lf_handler)
module OptionalConfiguration (
OptionalConfiguration(..),
- from_rc )
+ from_rc,
+ merge_maybes )
where
import qualified Data.Configurator as DC (
import System.FilePath ( (</>) )
import System.IO.Error ( catchIOError )
import System.Log ( Priority(..) )
+
import Logging ( log_error )
import TSN.FeedHosts ( FeedHosts(..) )
deriving (Show, Data, Typeable)
+-- | Combine two Maybes into one, essentially mashing them
+-- together. We give precedence to the second argument when both are
+-- Justs.
+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
+
+
-- | The Monoid instance for these lets us "combine" two
-- OptionalConfigurations. The "combine" operation that we'd like to
-- perform is, essentially, to mash them together. So if we have two
-- OptionalConfigurations, each half full, we could combine them
-- into one big one.
--
--- One of the two must take precedence during this mashing, and we
--- choose the second one for no reason.
---
-- This is used to merge command-line and config-file settings.
--
instance Monoid OptionalConfiguration where
cfg1 `mappend` cfg2 =
OptionalConfiguration
all_feed_hosts
- (merge (log_file cfg1) (log_file cfg2))
- (merge (log_level cfg1) (log_level cfg2))
- (merge (password cfg1) (password cfg2))
- (merge (output_directory cfg1) (output_directory cfg2))
- (merge (syslog cfg1) (syslog cfg2))
- (merge (username cfg1) (username cfg2))
+ (merge_maybes (log_file cfg1) (log_file cfg2))
+ (merge_maybes (log_level cfg1) (log_level cfg2))
+ (merge_maybes (password cfg1) (password cfg2))
+ (merge_maybes (output_directory cfg1) (output_directory cfg2))
+ (merge_maybes (syslog cfg1) (syslog cfg2))
+ (merge_maybes (username cfg1) (username cfg2))
where
- 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
-
-- Use only the latter feed_hosts if there are any.
all_feed_hosts =
feed_hosts $ if (null (get_feed_hosts (feed_hosts cfg2)))
projects / dead / htsn.git / commitdiff