X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Main.hs;h=866fe5d097b92bc9832446ec359242b6279ac9d8;hb=0fd09a6316e0be424e6eb454124f0cab6ade40b4;hp=942787c025443fd4a8daee4f88ee9cf0c4478222;hpb=03d4363a24998cd670061fde1ea4b8db8cbc5b32;p=Rakka.git diff --git a/Main.hs b/Main.hs index 942787c..866fe5d 100644 --- a/Main.hs +++ b/Main.hs @@ -1,24 +1,61 @@ {-# LANGUAGE CPP #-} +import Control.Exception import Control.Monad +import Data.List import Data.Maybe -import Network -import System.Console.GetOpt +import Network.Socket +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 -- FIXME: Use better library than this. +import System.Directory import System.Environment import System.Exit +import System.FilePath +import System.IO +import System.Log.Handler.Simple +import System.Log.Logger +import System.Posix.Files +import System.Posix.IO +import System.Posix.Process import System.Posix.Types import System.Posix.User + +logger :: String +logger = "Main" + + data CmdOpt - = OptPortNum PortNumber + = OptPortNum ServiceName | OptLSDir FilePath | OptUserName String | OptGroupName String + | OptLogLevel Priority + | OptVerbose + | OptRebuildIndex | OptHelp deriving (Eq, Show) -defaultPort :: PortNumber -defaultPort = fromIntegral 8080 +defaultPort :: ServiceName +defaultPort = "8080" + +defaultLocalStateDir :: FilePath +defaultLocalStateDir = LOCALSTATEDIR -- replaced by CPP defaultUserName :: String defaultUserName = "daemon" @@ -27,14 +64,18 @@ defaultGroupName :: String defaultGroupName = "daemon" +defaultLogLevel :: Priority +defaultLogLevel = NOTICE + + options :: [OptDescr CmdOpt] options = [ Option ['p'] ["port"] - (ReqArg (OptPortNum . fromIntegral . read) "NUM") - ("Port number to listen. (default: " ++ show defaultPort ++ ")") + (ReqArg OptPortNum "NUM") + ("Port number to listen. (default: " ++ 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 +85,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 ['v'] ["verbose"] + (NoArg OptVerbose) + "Enable logging to stderr." + + , Option ['r'] ["rebuild-index"] + (NoArg OptRebuildIndex) + "Rebuild the index database. (Only for debug purposes)" + , Option ['h'] ["help"] (NoArg OptHelp) "Print this message." @@ -58,9 +111,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 @@ -68,18 +123,52 @@ 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 portNum <- getPortNum opts - uid <- getUserID opts + uid <- getUserID opts + gid <- getGroupID opts + lsdir <- getLocalStateDir opts - print portNum - print uid + -- Create our localstatedir *before* dropping privileges. + createLocalStateDir lsdir uid gid + setGroupID gid + setUserID uid -getPortNum :: [CmdOpt] -> IO PortNumber + -- Now that we have our localstatedir. Let's acquire a lock + -- on the lockfile. Then create other files. + withSystemLock (lsdir "lock") $ + withPidFile (lsdir "pid") $ + do 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) + , (["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) + ] + + +getPortNum :: [CmdOpt] -> IO ServiceName getPortNum opts = do let xs = mapMaybe (\ x -> case x of OptPortNum n -> Just n @@ -102,4 +191,88 @@ 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 verbose = find (== OptVerbose) opts /= Nothing + logHandlers = if verbose then + [verboseStreamHandler stderr DEBUG] + else + [] -- FIXME: enable file log + 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) + +withSystemLock :: FilePath -> IO a -> IO a +withSystemLock lockfile = bracket lock' unlock' . const + where + lock' :: IO Fd + lock' = do fd <- openFd + lockfile + ReadWrite + (Just 420) -- 0644, -rw-r--r-- + defaultFileFlags + setLock fd (WriteLock, AbsoluteSeek, 0, 0) + return fd + + unlock' :: Fd -> IO () + unlock' = closeFd + +withPidFile :: FilePath -> IO a -> IO a +withPidFile lockfile = bracket_ mkPid' delPid' + where + mkPid' :: IO () + mkPid' = withFile lockfile WriteMode $ \ h -> + do pid <- getProcessID + hPutStrLn h (show pid) + + delPid' :: IO () + delPid' = removeFile lockfile