Added basic logging facility: it needs a fix later

[Rakka.git] / Main.hs

diff --git a/Main.hs b/Main.hs
index 44855689c7c26baefd9f2d55f73bbdc94a6040f6..5ce9eb14a79605ae20db7549f39a37a7051d19a9 100644 (file)
--- a/Main.hs
+++ b/Main.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE CPP #-}
 import           Control.Monad
+import           Data.List
 import           Data.Maybe
 import           Network
 import           Network.HTTP.Lucu
@@ -12,16 +13,23 @@ import           System.Console.GetOpt
 import           System.Directory
 import           System.Environment
 import           System.Exit
+import           System.IO
+import           System.Log.Handler.Simple
+import           System.Log.Logger
 import           System.Posix.Files
 import           System.Posix.Types
 import           System.Posix.User
 
+logger = "Main"
+
 
 data CmdOpt
     = OptPortNum   PortNumber
     | OptLSDir     FilePath
     | OptUserName  String
     | OptGroupName String
+    | OptLogLevel  Priority
+    | OptDisableStderrLog
     | OptHelp
     deriving (Eq, Show)
 
@@ -39,6 +47,10 @@ defaultGroupName :: String
 defaultGroupName = "daemon"
 
 
+defaultLogLevel :: Priority
+defaultLogLevel = NOTICE
+
+
 options :: [OptDescr CmdOpt]
 options = [ Option ['p'] ["port"]
                    (ReqArg (OptPortNum . fromIntegral . read) "NUM")
@@ -56,6 +68,14 @@ options = [ Option ['p'] ["port"]
                    (ReqArg OptGroupName "GROUP")
                    ("Which user to setgid. (default: " ++ defaultGroupName ++ ")")
 
+          , Option ['l'] ["log-level"]
+                   (ReqArg (OptLogLevel . read) "LEVEL")
+                   ("The lowest log level to show. (default: " ++ show defaultLogLevel ++ ")")
+
+          , Option [] ["disable-stderr-log"]
+                   (NoArg OptDisableStderrLog)
+                   ("Disable logging to stderr.")
+
           , Option ['h'] ["help"]
                    (NoArg OptHelp)
                    "Print this message."
@@ -95,7 +115,10 @@ main = withSubversion $
           setGroupID gid
           setUserID  uid
 
-          env     <- setupEnv lsdir portNum
+          setupLogger opts
+          env <- setupEnv lsdir portNum
+
+          noticeM logger ("Listening to " ++ show portNum ++ "/tcp...")
           runHttpd (envLucuConf env) (resTree env) [fallbackRender env]
 
           
@@ -158,6 +181,23 @@ getLocalStateDir opts
          return path
 
 
+setupLogger :: [CmdOpt] -> IO ()
+setupLogger opts
+    = do let disableStderrLog = find (== OptDisableStderrLog) opts /= Nothing
+             logHandlers      = if disableStderrLog then
+                                    []
+                                else
+                                    [verboseStreamHandler stderr DEBUG]
+             logLevel         = fromMaybe defaultLogLevel
+                                $ do OptLogLevel l <- find (\ x -> case x of
+                                                                     OptLogLevel _ -> True
+                                                                     _             -> False) opts
+                                     return l
+
+         logHandlers' <- sequence logHandlers
+         updateGlobalLogger rootLoggerName (setHandlers logHandlers' . setLevel logLevel)
+
+
 createLocalStateDir :: FilePath -> UserID -> GroupID -> IO ()
 createLocalStateDir path uid gid
     = do createDirectoryIfMissing True path