X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Main.hs;h=b3313d68fd29ffb456b05d627e500e903d4a2f0d;hb=ed76b2142889f565bb226bd72c0ff862ff6e862a;hp=5ce9eb14a79605ae20db7549f39a37a7051d19a9;hpb=0b1235464affca4fb349c713278d2e37fd8e9584;p=Rakka.git diff --git a/Main.hs b/Main.hs index 5ce9eb1..b3313d6 100644 --- a/Main.hs +++ b/Main.hs @@ -6,8 +6,11 @@ import Network import Network.HTTP.Lucu import Rakka.Environment 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 @@ -20,6 +23,8 @@ import System.Posix.Files import System.Posix.Types import System.Posix.User + +logger :: String logger = "Main" @@ -30,12 +35,13 @@ data CmdOpt | 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 @@ -53,7 +59,7 @@ 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"] @@ -76,6 +82,10 @@ options = [ Option ['p'] ["port"] (NoArg OptDisableStderrLog) ("Disable logging to stderr.") + , Option [] ["rebuild-index"] + (NoArg OptRebuildIndex) + ("Rebuild the index database.") + , Option ['h'] ["help"] (NoArg OptHelp) "Print this message." @@ -118,14 +128,18 @@ main = withSubversion $ setupLogger opts env <- setupEnv lsdir portNum - noticeM logger ("Listening to " ++ show portNum ++ "/tcp...") - runHttpd (envLucuConf env) (resTree env) [fallbackRender env] + 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) + , (["js" ], javaScript ) , (["object"], resObject env) + , (["render"], resRender env) ] @@ -202,3 +216,12 @@ 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