-{-# LANGUAGE CPP #-}
+{-# LANGUAGE
+ CPP
+ , UnicodeSyntax
+ #-}
+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.Page
-import System.Console.GetOpt
+import Rakka.Resource.Render
+import Rakka.Resource.Search
+import Rakka.Resource.SystemConfig
+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
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")
(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."
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
$ do printUsage
exitWith ExitSuccess
- when (not $ null nonOpts)
+ unless (null nonOpts)
$ do printUsage
exitWith $ ExitFailure 1
gid <- getGroupID opts
lsdir <- getLocalStateDir opts
+ -- Create our localstatedir *before* dropping privileges.
createLocalStateDir lsdir uid gid
setGroupID gid
setUserID uid
- env <- setupEnv lsdir portNum
- runHttpd (envLucuConf env) (resTree env) [fallbackPage env]
+ -- 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)
- , (["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)
+ , (["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
- _ -> Nothing) opts
+ = do let xs = mapMaybe (\x → case x of
+ OptPortNum n → Just n
+ _ → Nothing) opts
case xs of
- [] -> return defaultPort
- (x:[]) -> return x
- _ -> error "too many --port options."
-
+ [] → return defaultPort
+ (x:[]) → return x
+ _ → error "too many --port options."
getUserID :: [CmdOpt] -> IO UserID
getUserID opts
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
projects / Rakka.git / blobdiff