X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Main.hs;h=46eb3e2ad4867ef7361cb8c681a7ac2ac10d7f41;hb=c21f22c897782e6d49ce1e8cd06e2cb27d02d2f6;hp=5ce9eb14a79605ae20db7549f39a37a7051d19a9;hpb=0b1235464affca4fb349c713278d2e37fd8e9584;p=Rakka.git diff --git a/Main.hs b/Main.hs index 5ce9eb1..46eb3e2 100644 --- a/Main.hs +++ b/Main.hs @@ -4,10 +4,20 @@ 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 @@ -20,6 +30,8 @@ import System.Posix.Files import System.Posix.Types import System.Posix.User + +logger :: String logger = "Main" @@ -30,12 +42,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 +66,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"] @@ -74,7 +87,11 @@ options = [ Option ['p'] ["port"] , Option [] ["disable-stderr-log"] (NoArg OptDisableStderrLog) - ("Disable logging to stderr.") + "Disable logging to stderr." + + , Option [] ["rebuild-index"] + (NoArg OptRebuildIndex) + "Rebuild the index database." , Option ['h'] ["help"] (NoArg OptHelp) @@ -90,10 +107,11 @@ printUsage = do putStrLn "Usage:" main :: IO () -main = withSubversion $ +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 @@ -101,7 +119,7 @@ main = withSubversion $ $ do printUsage exitWith ExitSuccess - when (not $ null nonOpts) + unless (null nonOpts) $ do printUsage exitWith $ ExitFailure 1 @@ -118,14 +136,26 @@ 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) - , (["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) ] @@ -202,3 +232,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)