X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Rakka.git;a=blobdiff_plain;f=Main.hs;h=4328e707b21c01614d0d7189c0c030a5a3665342;hp=df2cccb5a17ccfd5e37835adb22eeba0c3f709d3;hb=d843e97aa04278677eaede4e50ef680af32867e7;hpb=790089d18791029ad268b3306ca71f8d5ae44ce1

diff --git a/Main.hs b/Main.hs
index df2cccb..4328e70 100644
--- a/Main.hs
+++ b/Main.hs
@@ -1,31 +1,49 @@
 {-# LANGUAGE CPP #-}
 import           Control.Monad
+import           Data.List
 import           Data.Maybe
 import           Network
 import           Network.HTTP.Lucu
 import           Rakka.Environment
+import           Rakka.Resource.CheckAuth
 import           Rakka.Resource.Index
+import           Rakka.Resource.JavaScript
+import           Rakka.Resource.PageEntity
 import           Rakka.Resource.Object
-import           Rakka.Resource.Page
+import           Rakka.Resource.Render
+import           Rakka.Resource.TrackBack
+import           Rakka.Storage
+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 :: String
+logger = "Main"
+
+
 data CmdOpt
     = OptPortNum   PortNumber
     | OptLSDir     FilePath
     | OptUserName  String
     | OptGroupName String
+    | OptLogLevel  Priority
+    | OptDisableStderrLog
+    | OptRebuildIndex
     | OptHelp
     deriving (Eq, Show)
 
 
 defaultPort :: PortNumber
-defaultPort = fromIntegral 8080
+defaultPort = toEnum 8080
 
 defaultLocalStateDir :: FilePath
 defaultLocalStateDir = LOCALSTATEDIR -- replaced by CPP
@@ -37,9 +55,13 @@ defaultGroupName :: String
 defaultGroupName = "daemon"
 
 
+defaultLogLevel :: Priority
+defaultLogLevel = NOTICE
+
+
 options :: [OptDescr CmdOpt]
 options = [ Option ['p'] ["port"]
-                   (ReqArg (OptPortNum . fromIntegral . read) "NUM")
+                   (ReqArg (OptPortNum . toEnum . read) "NUM")
                    ("Port number to listen. (default: " ++ show defaultPort ++ ")")
 
           , Option ['d'] ["localstatedir"]
@@ -54,6 +76,18 @@ 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 [] ["rebuild-index"]
+                   (NoArg OptRebuildIndex)
+                   ("Rebuild the index database.")
+
           , Option ['h'] ["help"]
                    (NoArg OptHelp)
                    "Print this message."
@@ -68,7 +102,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
@@ -92,14 +127,23 @@ main = do (opts, nonOpts, errors) <- return . getOpt Permute options =<< getArgs
           setGroupID gid
           setUserID  uid
 
-          env     <- setupEnv lsdir portNum
-          runHttpd (envLucuConf env) (resTree env) [fallbackPage env]
+          setupLogger opts
+          env <- setupEnv lsdir portNum
+
+          rebuildIndexIfRequested env opts
+
+          infoM logger ("Listening to " ++ show portNum ++ "/tcp...")
+          runHttpd (envLucuConf env) (resTree env) [fallbackPageEntity env]
 
           
 resTree :: Environment -> ResTree
 resTree env
-    = mkResTree [ ([]        , resIndex  env)
-                , (["object"], resObject env)
+    = mkResTree [ ([]           , resIndex     env)
+                , (["checkAuth"], resCheckAuth env)
+                , (["js"       ], javaScript      )
+                , (["object"   ], resObject    env)
+                , (["render"   ], resRender    env)
+                , (["trackback"], resTrackBack env)
                 ]
 
 
@@ -155,7 +199,33 @@ 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
          setOwnerAndGroup path uid gid
+
+
+rebuildIndexIfRequested :: Environment -> [CmdOpt] -> IO ()
+rebuildIndexIfRequested env opts
+    = do let rebuild = isJust $ find (\ x -> case x of
+                                               OptRebuildIndex -> True
+                                               _               -> False) opts
+         when rebuild
+                  $ rebuildIndex (envStorage env)
\ No newline at end of file