X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Rakka.git;a=blobdiff_plain;f=Main.hs;h=866fe5d097b92bc9832446ec359242b6279ac9d8;hp=4328e707b21c01614d0d7189c0c030a5a3665342;hb=223d4df57fa1371945075d4d2714e5f36c1fc5dd;hpb=d843e97aa04278677eaede4e50ef680af32867e7 diff --git a/Main.hs b/Main.hs index 4328e70..866fe5d 100644 --- a/Main.hs +++ b/Main.hs @@ -1,27 +1,36 @@ {-# LANGUAGE CPP #-} +import Control.Exception import Control.Monad import Data.List import Data.Maybe -import Network +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.TrackBack +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.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 @@ -31,19 +40,19 @@ logger = "Main" data CmdOpt - = OptPortNum PortNumber + = OptPortNum ServiceName | OptLSDir FilePath | OptUserName String | OptGroupName String | OptLogLevel Priority - | OptDisableStderrLog + | OptVerbose | OptRebuildIndex | OptHelp deriving (Eq, Show) -defaultPort :: PortNumber -defaultPort = toEnum 8080 +defaultPort :: ServiceName +defaultPort = "8080" defaultLocalStateDir :: FilePath defaultLocalStateDir = LOCALSTATEDIR -- replaced by CPP @@ -61,8 +70,8 @@ defaultLogLevel = NOTICE options :: [OptDescr CmdOpt] options = [ Option ['p'] ["port"] - (ReqArg (OptPortNum . toEnum . read) "NUM") - ("Port number to listen. (default: " ++ show defaultPort ++ ")") + (ReqArg OptPortNum "NUM") + ("Port number to listen. (default: " ++ defaultPort ++ ")") , Option ['d'] ["localstatedir"] (ReqArg OptLSDir "DIR") @@ -80,13 +89,13 @@ options = [ Option ['p'] ["port"] (ReqArg (OptLogLevel . read) "LEVEL") ("The lowest log level to show. (default: " ++ show defaultLogLevel ++ ")") - , Option [] ["disable-stderr-log"] - (NoArg OptDisableStderrLog) - ("Disable logging to stderr.") + , Option ['v'] ["verbose"] + (NoArg OptVerbose) + "Enable logging to stderr." - , Option [] ["rebuild-index"] + , Option ['r'] ["rebuild-index"] (NoArg OptRebuildIndex) - ("Rebuild the index database.") + "Rebuild the index database. (Only for debug purposes)" , Option ['h'] ["help"] (NoArg OptHelp) @@ -102,10 +111,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 @@ -113,7 +123,7 @@ main = withSubversion $ $ do printUsage exitWith ExitSuccess - when (not $ null nonOpts) + unless (null nonOpts) $ do printUsage exitWith $ ExitFailure 1 @@ -122,32 +132,43 @@ main = withSubversion $ gid <- getGroupID opts lsdir <- getLocalStateDir opts + -- Create our localstatedir *before* dropping privileges. createLocalStateDir lsdir uid gid setGroupID gid setUserID uid - setupLogger opts - env <- setupEnv lsdir portNum + -- 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 + rebuildIndexIfRequested env opts - infoM logger ("Listening to " ++ show portNum ++ "/tcp...") - runHttpd (envLucuConf env) (resTree env) [fallbackPageEntity env] + 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) - , (["trackback"], resTrackBack 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 PortNumber +getPortNum :: [CmdOpt] -> IO ServiceName getPortNum opts = do let xs = mapMaybe (\ x -> case x of OptPortNum n -> Just n @@ -201,16 +222,16 @@ getLocalStateDir opts 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 + = 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) @@ -228,4 +249,30 @@ rebuildIndexIfRequested env opts OptRebuildIndex -> True _ -> False) opts when rebuild - $ rebuildIndex (envStorage env) \ No newline at end of file + $ 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