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

diff --git a/Main.hs b/Main.hs
index 1b441ee..46eb3e2 100644
--- a/Main.hs
+++ b/Main.hs
@@ -1,32 +1,54 @@
 {-# LANGUAGE CPP #-}
 import           Control.Monad
+import           Data.List
 import           Data.Maybe
 import           Network
 import           Network.HTTP.Lucu
+import           OpenSSL
 import           Rakka.Environment
+import           Rakka.Resource.CheckAuth
+import           Rakka.Resource.DumpRepos
 import           Rakka.Resource.Index
+import           Rakka.Resource.JavaScript
+import           Rakka.Resource.PageEntity
 import           Rakka.Resource.Object
 import           Rakka.Resource.Render
+import           Rakka.Resource.Search
+import           Rakka.Resource.SystemConfig
+-- import           Rakka.Resource.TrackBack
+import           Rakka.Resource.Users
+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
@@ -38,9 +60,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"]
@@ -55,6 +81,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."
@@ -69,9 +107,11 @@ printUsage = do putStrLn "Usage:"
 
 
 main :: IO ()
-main = do (opts, nonOpts, errors) <- return . getOpt Permute options =<< getArgs
+main = withOpenSSL $
+       withSubversion $
+       do (opts, nonOpts, errors) <- return . getOpt Permute options =<< getArgs
 
-          when (not $ null errors)
+          unless (null errors)
                    $ do mapM_ putStr errors
                         exitWith $ ExitFailure 1
 
@@ -79,7 +119,7 @@ main = do (opts, nonOpts, errors) <- return . getOpt Permute options =<< getArgs
                    $ do printUsage
                         exitWith ExitSuccess
 
-          when (not $ null nonOpts)
+          unless (null nonOpts)
                    $ do printUsage
                         exitWith $ ExitFailure 1
 
@@ -93,14 +133,29 @@ main = do (opts, nonOpts, errors) <- return . getOpt Permute options =<< getArgs
           setGroupID gid
           setUserID  uid
 
-          env     <- setupEnv lsdir portNum
-          runHttpd (envLucuConf env) (resTree env) [fallbackRender 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)
+                , (["dumpRepos"   ], resDumpRepos    env)
+                , (["js"          ], javaScript         )
+                , (["object"      ], resObject       env)
+                , (["render"      ], resRender       env)
+                , (["search"      ], resSearch       env)
+                , (["search.html" ], resSearch       env)
+                , (["search.xml"  ], resSearch       env)
+                , (["systemConfig"], resSystemConfig env)
+                -- , (["trackback"   ], resTrackBack    env)
+		, (["users"       ], resUsers        env)
                 ]
 
 
@@ -156,7 +211,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)