X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Main.hs;h=78de22fad823e90529f0b5cd0948b33ebbea0dc1;hb=8631d8de8373ec8226d19019ae7cf3a1bf2e44e5;hp=5db2fcceef8ee0ee0dfa1815dea1595cd3787ffa;hpb=7a4f13a3d483c950743e1ced001ade4406d239d3;p=Rakka.git diff --git a/Main.hs b/Main.hs index 5db2fcc..78de22f 100644 --- a/Main.hs +++ b/Main.hs @@ -1,24 +1,36 @@ {-# LANGUAGE CPP #-} +import Control.Exception import Control.Monad 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 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 @@ -33,14 +45,14 @@ data CmdOpt | OptUserName String | OptGroupName String | OptLogLevel Priority - | OptDisableStderrLog + | OptVerbose | OptRebuildIndex | OptHelp deriving (Eq, Show) defaultPort :: PortNumber -defaultPort = fromIntegral 8080 +defaultPort = toEnum 8080 defaultLocalStateDir :: FilePath defaultLocalStateDir = LOCALSTATEDIR -- replaced by CPP @@ -58,7 +70,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"] @@ -77,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." , Option ['h'] ["help"] (NoArg OptHelp) @@ -99,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 @@ -110,7 +123,7 @@ main = withSubversion $ $ do printUsage exitWith ExitSuccess - when (not $ null nonOpts) + unless (null nonOpts) $ do printUsage exitWith $ ExitFailure 1 @@ -119,25 +132,39 @@ 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) - , (["object"], resObject env) - , (["js" ], javaScript ) + = 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) ] @@ -195,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) @@ -222,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