5 import Control.Exception
10 import Network.HTTP.Lucu
12 import Rakka.Environment
13 import Rakka.Resource.CheckAuth
14 import Rakka.Resource.DumpRepos
15 import Rakka.Resource.Index
16 import Rakka.Resource.JavaScript
17 import Rakka.Resource.PageEntity
18 import Rakka.Resource.Object
19 import Rakka.Resource.Render
20 import Rakka.Resource.Search
21 import Rakka.Resource.SystemConfig
22 import Rakka.Resource.Users
25 import System.Console.GetOpt -- FIXME: Use better library than this.
26 import System.Directory
27 import System.Environment
29 import System.FilePath
31 import System.Log.Handler.Simple
32 import System.Log.Logger
33 import System.Posix.Files
34 import System.Posix.IO
35 import System.Posix.Process
36 import System.Posix.Types
37 import System.Posix.User
45 = OptPortNum ServiceName
49 | OptLogLevel Priority
56 defaultPort ∷ ServiceName
59 defaultLocalStateDir :: FilePath
60 defaultLocalStateDir = LOCALSTATEDIR -- replaced by CPP
62 defaultUserName :: String
63 defaultUserName = "daemon"
65 defaultGroupName :: String
66 defaultGroupName = "daemon"
69 defaultLogLevel :: Priority
70 defaultLogLevel = NOTICE
73 options :: [OptDescr CmdOpt]
74 options = [ Option ['p'] ["port"]
75 (ReqArg OptPortNum "NUM")
76 ("Port number to listen. (default: " ++ defaultPort ++ ")")
78 , Option ['d'] ["localstatedir"]
79 (ReqArg OptLSDir "DIR")
80 ("Path to the database directory. (default: " ++ defaultLocalStateDir ++ ")")
82 , Option ['u'] ["user"]
83 (ReqArg OptUserName "USER")
84 ("Which user to setuid. (default: " ++ defaultUserName ++ ")")
86 , Option ['g'] ["group"]
87 (ReqArg OptGroupName "GROUP")
88 ("Which user to setgid. (default: " ++ defaultGroupName ++ ")")
90 , Option ['l'] ["log-level"]
91 (ReqArg (OptLogLevel . read) "LEVEL")
92 ("The lowest log level to show. (default: " ++ show defaultLogLevel ++ ")")
94 , Option ['v'] ["verbose"]
96 "Enable logging to stderr."
98 , Option ['r'] ["rebuild-index"]
99 (NoArg OptRebuildIndex)
100 "Rebuild the index database. (Only for debug purposes)"
102 , Option ['h'] ["help"]
104 "Print this message."
109 printUsage = do putStrLn "Usage:"
110 putStrLn " rakka [OPTIONS...]"
112 putStr $ usageInfo "Options:" options
118 do (opts, nonOpts, errors) <- return . getOpt Permute options =<< getArgs
121 $ do mapM_ putStr errors
122 exitWith $ ExitFailure 1
124 when (any (\ x -> x == OptHelp) opts)
128 unless (null nonOpts)
130 exitWith $ ExitFailure 1
132 portNum <- getPortNum opts
133 uid <- getUserID opts
134 gid <- getGroupID opts
135 lsdir <- getLocalStateDir opts
137 -- Create our localstatedir *before* dropping privileges.
138 createLocalStateDir lsdir uid gid
143 -- Now that we have our localstatedir. Let's acquire a lock
144 -- on the lockfile. Then create other files.
145 withSystemLock (lsdir </> "lock") $
146 withPidFile (lsdir </> "pid") $
148 env ← setupEnv lsdir portNum
150 rebuildIndexIfRequested env opts
152 infoM logger ("Listening to " ++ show portNum ++ "/tcp...")
153 runHttpd (envLucuConf env) (resTree env) [fallbackPageEntity env]
156 resTree :: Environment -> ResTree
158 = mkResTree [ ([] , resIndex env)
159 , (["checkAuth" ], resCheckAuth env)
160 , (["dumpRepos" ], resDumpRepos env)
161 , (["js" ], javaScript )
162 , (["object" ], resObject env)
163 , (["render" ], resRender env)
164 , (["search" ], resSearch env)
165 , (["search.html" ], resSearch env)
166 , (["search.xml" ], resSearch env)
167 , (["systemConfig"], resSystemConfig env)
168 , (["users" ], resUsers env)
171 getPortNum ∷ [CmdOpt] → IO ServiceName
173 = do let xs = mapMaybe (\x → case x of
174 OptPortNum n → Just n
177 [] → return defaultPort
179 _ → error "too many --port options."
181 getUserID :: [CmdOpt] -> IO UserID
183 = do let xs = mapMaybe (\ x -> case x of
184 OptUserName n -> Just n
187 [] -> defaultUserName
189 _ -> error "too many --user options."
191 userEnt <- getUserEntryForName name
192 return $ userID userEnt
195 getGroupID :: [CmdOpt] -> IO GroupID
197 = do let xs = mapMaybe (\ x -> case x of
198 OptGroupName n -> Just n
201 [] -> defaultGroupName
203 _ -> error "too many --group options."
205 groupEnt <- getGroupEntryForName name
206 return $ groupID groupEnt
209 getLocalStateDir :: [CmdOpt] -> IO FilePath
210 getLocalStateDir opts
211 = do let xs = mapMaybe (\ x -> case x of
215 [] -> defaultLocalStateDir
217 _ -> error "too many --localstatedir options."
222 setupLogger :: [CmdOpt] -> IO ()
224 = do let verbose = find (== OptVerbose) opts /= Nothing
225 logHandlers = if verbose then
226 [verboseStreamHandler stderr DEBUG]
228 [] -- FIXME: enable file log
229 logLevel = fromMaybe defaultLogLevel
230 $ do OptLogLevel l <- find (\ x -> case x of
231 OptLogLevel _ -> True
235 logHandlers' <- sequence logHandlers
236 updateGlobalLogger rootLoggerName (setHandlers logHandlers' . setLevel logLevel)
239 createLocalStateDir :: FilePath -> UserID -> GroupID -> IO ()
240 createLocalStateDir path uid gid
241 = do createDirectoryIfMissing True path
242 setOwnerAndGroup path uid gid
245 rebuildIndexIfRequested :: Environment -> [CmdOpt] -> IO ()
246 rebuildIndexIfRequested env opts
247 = do let rebuild = isJust $ find (\ x -> case x of
248 OptRebuildIndex -> True
251 $ rebuildIndex (envStorage env)
253 withSystemLock :: FilePath -> IO a -> IO a
254 withSystemLock lockfile = bracket lock' unlock' . const
257 lock' = do fd <- openFd
260 (Just 420) -- 0644, -rw-r--r--
262 setLock fd (WriteLock, AbsoluteSeek, 0, 0)
265 unlock' :: Fd -> IO ()
268 withPidFile :: FilePath -> IO a -> IO a
269 withPidFile lockfile = bracket_ mkPid' delPid'
272 mkPid' = withFile lockfile WriteMode $ \ h ->
273 do pid <- getProcessID
274 hPutStrLn h (show pid)
277 delPid' = removeFile lockfile