Enhace config handling

portnov [2009-07-07 19:17:42]
Enhace config handling
Filename
Blog/blog.conf
Framework/Config.hs
Framework/Http/HTTPServer.hs
Framework/Types.hs
diff --git a/Blog/blog.conf b/Blog/blog.conf
index edb5810..2ad4618 100644
--- a/Blog/blog.conf
+++ b/Blog/blog.conf
@@ -14,3 +14,7 @@ path = tmp
 [sessions]
 path = tmp/sessions

+[logs]
+access = access.log
+errors = errors.log
+
diff --git a/Framework/Config.hs b/Framework/Config.hs
index 446da47..2fff319 100644
--- a/Framework/Config.hs
+++ b/Framework/Config.hs
@@ -37,6 +37,8 @@ readConfig name sc = do
                 cachePath      = get' cp "cache"    "path"      "/var/cache/web",
                 sessionsDriver = get' cp "sessions" "backend"   "files",
                 sessionsPath   = get' cp "sessions" "path"      "/var/sessions",
+                accessLogPath  = get' cp "logs"     "access"    "/var/log/web/access.log",
+                errorsLogPath  = get' cp "logs"     "errors"    "/var/log/web/errors.log",
                 dbpool  = dbpoolSC sc,
                 cpool   = cpoolSC sc,
                 logChan = logChanSC sc,
diff --git a/Framework/Http/HTTPServer.hs b/Framework/Http/HTTPServer.hs
index b9b1837..14cce06 100644
--- a/Framework/Http/HTTPServer.hs
+++ b/Framework/Http/HTTPServer.hs
@@ -88,6 +88,14 @@ cleanup dbPool cPool hacc herr = do
     hClose herr
     exitWith ExitSuccess

+openLog :: String -> IO Handle
+openLog file = do
+    ex <- doesFileExist file
+    openFile file $
+      if ex
+        then AppendMode
+        else WriteMode
+
 -- | Start HTTP server
 serveHttp :: String           -- ^ Name of the config file
           -> URLConf          -- ^ URL dispatcher config
@@ -100,13 +108,9 @@ serveHttp name urlconf = do
     conf <- readConfig name $ StartupConfig dbPool cPool aLog eLog
     garbageCollector dbPool disconnect'
     garbageCollector cPool cDisconnect
-    hAccess <- openFile "access.log" WriteMode
-    hErrors <- openFile "errors.log" WriteMode
+    hAccess <- openLog (accessLogPath conf)
+    hErrors <- openLog (errorsLogPath conf)
     runLogWriter aLog eLog hAccess hErrors
-    let conf' = conf {dbpool = dbPool,
-                      cpool = cPool,
-                      logChan = aLog,
-                      errChan = eLog }
     installHandler sigINT (CatchOnce (cleanup dbPool cPool hAccess hErrors)) Nothing
-    initServer conf' (httpWorker conf' urlconf)
+    initServer conf (httpWorker conf urlconf)

diff --git a/Framework/Types.hs b/Framework/Types.hs
index ca6b0ef..4c2a730 100644
--- a/Framework/Types.hs
+++ b/Framework/Types.hs
@@ -39,6 +39,8 @@ data StaticConfig = HP {
     cachePath :: String,           -- ^ Info for cache backend
     sessionsDriver :: String,      -- ^ Sessions backend name
     sessionsPath :: String,        -- ^ Info for sessions backend
+    accessLogPath :: String,
+    errorsLogPath :: String,
     dbpool :: MPool DBConnection,  -- ^ DB connections pool
     cpool :: MPool CacheConnection,-- ^ Cache connections pool
     logChan :: Log,                -- ^ Handle to log
ViewGit