X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Main.hs;h=5ce9eb14a79605ae20db7549f39a37a7051d19a9;hb=0b1235464affca4fb349c713278d2e37fd8e9584;hp=1b441ee2725d5b2678e1b944722746f371b9d837;hpb=8a7556db44cd91ac0bb52279472bcc2abaa3f18e;p=Rakka.git

diff --git a/Main.hs b/Main.hs
index 1b441ee..5ce9eb1 100644
--- 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
@@ -7,20 +8,28 @@ import           Rakka.Environment
 import           Rakka.Resource.Index
 import           Rakka.Resource.Object
 import           Rakka.Resource.Render
+import           Subversion
 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)
 
@@ -38,6 +47,10 @@ defaultGroupName :: String
 defaultGroupName = "daemon"
 
 
+defaultLogLevel :: Priority
+defaultLogLevel = NOTICE
+
+
 options :: [OptDescr CmdOpt]
 options = [ Option ['p'] ["port"]
                    (ReqArg (OptPortNum . fromIntegral . read) "NUM")
@@ -55,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."
@@ -69,7 +90,8 @@ printUsage = do putStrLn "Usage:"
 
 
 main :: IO ()
-main = do (opts, nonOpts, errors) <- return . getOpt Permute options =<< getArgs
+main = withSubversion $
+       do (opts, nonOpts, errors) <- return . getOpt Permute options =<< getArgs
 
           when (not $ null errors)
                    $ do mapM_ putStr errors
@@ -93,7 +115,10 @@ main = do (opts, nonOpts, errors) <- return . getOpt Permute options =<< getArgs
           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]
 
           
@@ -156,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