2 import Control.Exception
7 import Network.HTTP.Lucu
8 import Rakka.Environment
9 import Rakka.Resource.CheckAuth
10 import Rakka.Resource.DumpRepos
11 import Rakka.Resource.Index
12 import Rakka.Resource.JavaScript
13 import Rakka.Resource.PageEntity
14 import Rakka.Resource.Object
15 import Rakka.Resource.Render
16 import Rakka.Resource.Search
17 import Rakka.Resource.SystemConfig
18 import Rakka.Resource.Users
21 import System.Console.GetOpt -- FIXME: Use better library than this.
22 import System.Directory
23 import System.Environment
25 import System.FilePath
27 import System.Log.Handler.Simple
28 import System.Log.Logger
29 import System.Posix.Files
30 import System.Posix.IO
31 import System.Posix.Process
32 import System.Posix.Types
33 import System.Posix.User
41 = OptPortNum ServiceName
45 | OptLogLevel Priority
52 defaultPort :: ServiceName
55 defaultLocalStateDir :: FilePath
56 defaultLocalStateDir = LOCALSTATEDIR -- replaced by CPP
58 defaultUserName :: String
59 defaultUserName = "daemon"
61 defaultGroupName :: String
62 defaultGroupName = "daemon"
65 defaultLogLevel :: Priority
66 defaultLogLevel = NOTICE
69 options :: [OptDescr CmdOpt]
70 options = [ Option ['p'] ["port"]
71 (ReqArg OptPortNum "NUM")
72 ("Port number to listen. (default: " ++ defaultPort ++ ")")
74 , Option ['d'] ["localstatedir"]
75 (ReqArg OptLSDir "DIR")
76 ("Path to the database directory. (default: " ++ defaultLocalStateDir ++ ")")
78 , Option ['u'] ["user"]
79 (ReqArg OptUserName "USER")
80 ("Which user to setuid. (default: " ++ defaultUserName ++ ")")
82 , Option ['g'] ["group"]
83 (ReqArg OptGroupName "GROUP")
84 ("Which user to setgid. (default: " ++ defaultGroupName ++ ")")
86 , Option ['l'] ["log-level"]
87 (ReqArg (OptLogLevel . read) "LEVEL")
88 ("The lowest log level to show. (default: " ++ show defaultLogLevel ++ ")")
90 , Option ['v'] ["verbose"]
92 "Enable logging to stderr."
94 , Option ['r'] ["rebuild-index"]
95 (NoArg OptRebuildIndex)
96 "Rebuild the index database. (Only for debug purposes)"
98 , Option ['h'] ["help"]
100 "Print this message."
105 printUsage = do putStrLn "Usage:"
106 putStrLn " rakka [OPTIONS...]"
108 putStr $ usageInfo "Options:" options
114 do (opts, nonOpts, errors) <- return . getOpt Permute options =<< getArgs
117 $ do mapM_ putStr errors
118 exitWith $ ExitFailure 1
120 when (any (\ x -> x == OptHelp) opts)
124 unless (null nonOpts)
126 exitWith $ ExitFailure 1
128 portNum <- getPortNum opts
129 uid <- getUserID opts
130 gid <- getGroupID opts
131 lsdir <- getLocalStateDir opts
133 -- Create our localstatedir *before* dropping privileges.
134 createLocalStateDir lsdir uid gid
139 -- Now that we have our localstatedir. Let's acquire a lock
140 -- on the lockfile. Then create other files.
141 withSystemLock (lsdir </> "lock") $
142 withPidFile (lsdir </> "pid") $
144 env <- setupEnv lsdir portNum
146 rebuildIndexIfRequested env opts
148 infoM logger ("Listening to " ++ show portNum ++ "/tcp...")
149 runHttpd (envLucuConf env) (resTree env) [fallbackPageEntity env]
152 resTree :: Environment -> ResTree
154 = mkResTree [ ([] , resIndex env)
155 , (["checkAuth" ], resCheckAuth env)
156 , (["dumpRepos" ], resDumpRepos env)
157 , (["js" ], javaScript )
158 , (["object" ], resObject env)
159 , (["render" ], resRender env)
160 , (["search" ], resSearch env)
161 , (["search.html" ], resSearch env)
162 , (["search.xml" ], resSearch env)
163 , (["systemConfig"], resSystemConfig env)
164 -- , (["trackback" ], resTrackBack env)
165 , (["users" ], resUsers env)
169 getPortNum :: [CmdOpt] -> IO ServiceName
171 = do let xs = mapMaybe (\ x -> case x of
172 OptPortNum n -> Just n
175 [] -> return defaultPort
177 _ -> error "too many --port options."
180 getUserID :: [CmdOpt] -> IO UserID
182 = do let xs = mapMaybe (\ x -> case x of
183 OptUserName n -> Just n
186 [] -> defaultUserName
188 _ -> error "too many --user options."
190 userEnt <- getUserEntryForName name
191 return $ userID userEnt
194 getGroupID :: [CmdOpt] -> IO GroupID
196 = do let xs = mapMaybe (\ x -> case x of
197 OptGroupName n -> Just n
200 [] -> defaultGroupName
202 _ -> error "too many --group options."
204 groupEnt <- getGroupEntryForName name
205 return $ groupID groupEnt
208 getLocalStateDir :: [CmdOpt] -> IO FilePath
209 getLocalStateDir opts
210 = do let xs = mapMaybe (\ x -> case x of
214 [] -> defaultLocalStateDir
216 _ -> error "too many --localstatedir options."
221 setupLogger :: [CmdOpt] -> IO ()
223 = do let verbose = find (== OptVerbose) opts /= Nothing
224 logHandlers = if verbose then
225 [verboseStreamHandler stderr DEBUG]
227 [] -- FIXME: enable file log
228 logLevel = fromMaybe defaultLogLevel
229 $ do OptLogLevel l <- find (\ x -> case x of
230 OptLogLevel _ -> True
234 logHandlers' <- sequence logHandlers
235 updateGlobalLogger rootLoggerName (setHandlers logHandlers' . setLevel logLevel)
238 createLocalStateDir :: FilePath -> UserID -> GroupID -> IO ()
239 createLocalStateDir path uid gid
240 = do createDirectoryIfMissing True path
241 setOwnerAndGroup path uid gid
244 rebuildIndexIfRequested :: Environment -> [CmdOpt] -> IO ()
245 rebuildIndexIfRequested env opts
246 = do let rebuild = isJust $ find (\ x -> case x of
247 OptRebuildIndex -> True
250 $ rebuildIndex (envStorage env)
252 withSystemLock :: FilePath -> IO a -> IO a
253 withSystemLock lockfile = bracket lock' unlock' . const
256 lock' = do fd <- openFd
259 (Just 420) -- 0644, -rw-r--r--
261 setLock fd (WriteLock, AbsoluteSeek, 0, 0)
264 unlock' :: Fd -> IO ()
267 withPidFile :: FilePath -> IO a -> IO a
268 withPidFile lockfile = bracket_ mkPid' delPid'
271 mkPid' = withFile lockfile WriteMode $ \ h ->
272 do pid <- getProcessID
273 hPutStrLn h (show pid)
276 delPid' = removeFile lockfile