improved the page editor

[Rakka.git] / Main.hs

diff --git a/Main.hs b/Main.hs
index 942787c025443fd4a8daee4f88ee9cf0c4478222..77c17a16a4b5c212b9268e22a827baf456f2d8a4 100644 (file)
--- a/Main.hs
+++ b/Main.hs
@@ -1,24 +1,51 @@
 {-# 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.Render
+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
 
 defaultUserName :: String
 defaultUserName = "daemon"
@@ -27,14 +54,18 @@ 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"]
                    (ReqArg OptLSDir "DIR")
-                   ("Path to the database directory. (default: " ++ LOCALSTATEDIR ++ ")")
+                   ("Path to the database directory. (default: " ++ defaultLocalStateDir ++ ")")
 
           , Option ['u'] ["user"]
                    (ReqArg OptUserName "USER")
@@ -44,6 +75,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."
@@ -58,7 +101,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
@@ -73,10 +117,32 @@ main = do (opts, nonOpts, errors) <- return . getOpt Permute options =<< getArgs
                         exitWith $ ExitFailure 1
 
           portNum <- getPortNum opts
-          uid     <- getUserID opts
+          uid     <- getUserID  opts
+          gid     <- getGroupID opts
+          lsdir   <- getLocalStateDir opts
+
+          createLocalStateDir lsdir uid gid
+
+          setGroupID gid
+          setUserID  uid
+
+          setupLogger opts
+          env <- setupEnv lsdir portNum
 
-          print portNum
-          print uid
+          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)
+                , (["checkAuth"], resCheckAuth env)
+                , (["js"       ], javaScript      )
+                , (["object"   ], resObject    env)
+                , (["render"   ], resRender    env)
+                ]
 
 
 getPortNum :: [CmdOpt] -> IO PortNumber
@@ -102,4 +168,62 @@ getUserID opts
 
          userEnt <- getUserEntryForName name
          return $ userID userEnt
-           
\ No newline at end of file
+
+
+getGroupID :: [CmdOpt] -> IO GroupID
+getGroupID opts
+    = do let xs   = mapMaybe (\ x -> case x of
+                                       OptGroupName n -> Just n
+                                       _              -> Nothing) opts
+             name = case xs of
+                      []     -> defaultGroupName
+                      (x:[]) -> x
+                      _      -> error "too many --group options."
+
+         groupEnt <- getGroupEntryForName name
+         return $ groupID groupEnt
+
+
+getLocalStateDir :: [CmdOpt] -> IO FilePath
+getLocalStateDir opts
+    = do let xs   = mapMaybe (\ x -> case x of
+                                       OptLSDir n -> Just n
+                                       _          -> Nothing) opts
+             path = case xs of
+                      []     -> defaultLocalStateDir
+                      (x:[]) -> x
+                      _      -> error "too many --localstatedir options."
+         
+         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