From 0b1235464affca4fb349c713278d2e37fd8e9584 Mon Sep 17 00:00:00 2001 From: pho Date: Tue, 23 Oct 2007 15:33:17 +0900 Subject: [PATCH] Added basic logging facility: it needs a fix later darcs-hash:20071023063317-62b54-b5e49722759603b45acff683cfc7bea57eff1d47.gz --- Main.hs | 42 +++++++++++++++++++++++++++++++++++++++++- Rakka.cabal | 4 ++-- Rakka/Environment.hs | 9 +++++++-- Rakka/SystemConfig.hs | 21 ++++++++++++++++----- 4 files changed, 66 insertions(+), 10 deletions(-) diff --git a/Main.hs b/Main.hs index 4485568..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 @@ -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 diff --git a/Rakka.cabal b/Rakka.cabal index 844381b..2a546d8 100644 --- a/Rakka.cabal +++ b/Rakka.cabal @@ -25,8 +25,8 @@ Extensions: GHC-Options: -fwarn-unused-imports -fglasgow-exts Build-Depends: - Crypto, HUnit, HsSVN, Lucu, base, encoding, filepath, hxt, mtl, - network, parsec, stm, unix + Crypto, HUnit, HsSVN, Lucu, base, encoding, filepath, hslogger, + hxt, mtl, network, parsec, stm, unix Exposed-Modules: Rakka.Page Rakka.Storage diff --git a/Rakka/Environment.hs b/Rakka/Environment.hs index b554df8..6ae6f11 100644 --- a/Rakka/Environment.hs +++ b/Rakka/Environment.hs @@ -20,6 +20,9 @@ import Rakka.Wiki.Interpreter.Base import Subversion.Repository import System.Directory import System.FilePath +import System.Log.Logger + +logger = "Rakka.Environment" data Environment = Environment { @@ -45,9 +48,11 @@ setupEnv lsdir portNum reposExist <- doesDirectoryExist reposPath repos <- if reposExist then - openRepository reposPath + do debugM logger ("Found a subversion repository on " ++ reposPath) + openRepository reposPath else - createRepository reposPath [] [] + do noticeM logger ("Creating a subversion repository on " ++ reposPath) + createRepository reposPath [] [] sysConf <- mkSystemConfig lucuConf repos interpTable <- mkInterpTable diff --git a/Rakka/SystemConfig.hs b/Rakka/SystemConfig.hs index 8a6be02..58de2be 100644 --- a/Rakka/SystemConfig.hs +++ b/Rakka/SystemConfig.hs @@ -28,6 +28,9 @@ import Subversion.FileSystem.Revision import Subversion.FileSystem.Root import Subversion.Repository import System.FilePath.Posix +import System.Log.Logger + +logger = "Rakka.SystemConfig" data SystemConfig = SystemConfig { @@ -72,20 +75,28 @@ getSysConf sc key getSysConf' :: SystemConfig -> SysConfValue -> IO SysConfValue getSysConf' sc key - = do fs <- getRepositoryFS (scRepository sc) + = do let path = fromConfPath (sysConfPath key) + + fs <- getRepositoryFS (scRepository sc) rev <- getYoungestRev fs value <- withRevision fs rev - $ do let path = fromConfPath (sysConfPath key) - exists <- isFile path + $ do exists <- isFile path case exists of True -> do str <- getFileContentsLBS path return $ Just $ chomp $ decodeLazy UTF8 str False -> return Nothing + case value of - Just str -> return $ unmarshalSysConf key str - Nothing -> sysConfDefault sc key + Just str + -> do let val = unmarshalSysConf key str + debugM logger ("Got a config value at `" ++ path ++ "': " ++ show val) + return val + Nothing + -> do val <- sysConfDefault sc key + debugM logger ("Got no config value at `" ++ path ++ "'. Defaulting to " ++ show val) + return val getSysConfA :: ArrowIO a => SystemConfig -> SysConfValue -> a b SysConfValue -- 2.40.0