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.TrackBack
23 import Rakka.Resource.Users
26 import System.Console.GetOpt
27 import System.Directory
28 import System.Environment
30 import System.FilePath
32 import System.Log.Handler.Simple
33 import System.Log.Logger
34 import System.Posix.Files
35 import System.Posix.IO
36 import System.Posix.Process
37 import System.Posix.Types
38 import System.Posix.User
46 = OptPortNum ServiceName
50 | OptLogLevel Priority
57 defaultPort ∷ ServiceName
60 defaultLocalStateDir :: FilePath
61 defaultLocalStateDir = LOCALSTATEDIR -- replaced by CPP
63 defaultUserName :: String
64 defaultUserName = "daemon"
66 defaultGroupName :: String
67 defaultGroupName = "daemon"
70 defaultLogLevel :: Priority
71 defaultLogLevel = NOTICE
74 options :: [OptDescr CmdOpt]
75 options = [ Option ['p'] ["port"]
76 (ReqArg OptPortNum "NUM")
77 ("Port number to listen. (default: " ++ defaultPort ++ ")")
79 , Option ['d'] ["localstatedir"]
80 (ReqArg OptLSDir "DIR")
81 ("Path to the database directory. (default: " ++ defaultLocalStateDir ++ ")")
83 , Option ['u'] ["user"]
84 (ReqArg OptUserName "USER")
85 ("Which user to setuid. (default: " ++ defaultUserName ++ ")")
87 , Option ['g'] ["group"]
88 (ReqArg OptGroupName "GROUP")
89 ("Which user to setgid. (default: " ++ defaultGroupName ++ ")")
91 , Option ['l'] ["log-level"]
92 (ReqArg (OptLogLevel . read) "LEVEL")
93 ("The lowest log level to show. (default: " ++ show defaultLogLevel ++ ")")
95 , Option ['v'] ["verbose"]
97 "Enable logging to stderr."
99 , Option ['r'] ["rebuild-index"]
100 (NoArg OptRebuildIndex)
101 "Rebuild the index database. (Only for debug purposes)"
103 , Option ['h'] ["help"]
105 "Print this message."
110 printUsage = do putStrLn "Usage:"
111 putStrLn " rakka [OPTIONS...]"
113 putStr $ usageInfo "Options:" options
119 do (opts, nonOpts, errors) <- return . getOpt Permute options =<< getArgs
122 $ do mapM_ putStr errors
123 exitWith $ ExitFailure 1
125 when (any (\ x -> x == OptHelp) opts)
129 unless (null nonOpts)
131 exitWith $ ExitFailure 1
133 portNum <- getPortNum opts
134 uid <- getUserID opts
135 gid <- getGroupID opts
136 lsdir <- getLocalStateDir opts
138 -- Create our localstatedir *before* dropping privileges.
139 createLocalStateDir lsdir uid gid
144 -- Now that we have our localstatedir. Let's acquire a lock
145 -- on the lockfile. Then create other files.
146 withSystemLock (lsdir </> "lock") $
147 withPidFile (lsdir </> "pid") $
149 env ← setupEnv lsdir portNum
151 rebuildIndexIfRequested env opts
153 infoM logger ("Listening to " ++ show portNum ++ "/tcp...")
154 runHttpd (envLucuConf env) (resTree env) [fallbackPageEntity env]
157 resTree :: Environment -> ResTree
159 = mkResTree [ ([] , resIndex env)
160 , (["checkAuth" ], resCheckAuth env)
161 , (["dumpRepos" ], resDumpRepos env)
162 , (["js" ], javaScript )
163 , (["object" ], resObject env)
164 , (["render" ], resRender env)
165 , (["search" ], resSearch env)
166 , (["search.html" ], resSearch env)
167 , (["search.xml" ], resSearch env)
168 , (["systemConfig"], resSystemConfig env)
169 -- , (["trackback" ], resTrackBack env)
170 , (["users" ], resUsers env)
173 getPortNum ∷ [CmdOpt] → IO ServiceName
175 = do let xs = mapMaybe (\x → case x of
176 OptPortNum n → Just n
179 [] → return defaultPort
181 _ → error "too many --port options."
183 getUserID :: [CmdOpt] -> IO UserID
185 = do let xs = mapMaybe (\ x -> case x of
186 OptUserName n -> Just n
189 [] -> defaultUserName
191 _ -> error "too many --user options."
193 userEnt <- getUserEntryForName name
194 return $ userID userEnt
197 getGroupID :: [CmdOpt] -> IO GroupID
199 = do let xs = mapMaybe (\ x -> case x of
200 OptGroupName n -> Just n
203 [] -> defaultGroupName
205 _ -> error "too many --group options."
207 groupEnt <- getGroupEntryForName name
208 return $ groupID groupEnt
211 getLocalStateDir :: [CmdOpt] -> IO FilePath
212 getLocalStateDir opts
213 = do let xs = mapMaybe (\ x -> case x of
217 [] -> defaultLocalStateDir
219 _ -> error "too many --localstatedir options."
224 setupLogger :: [CmdOpt] -> IO ()
226 = do let verbose = find (== OptVerbose) opts /= Nothing
227 logHandlers = if verbose then
228 [verboseStreamHandler stderr DEBUG]
230 [] -- FIXME: enable file log
231 logLevel = fromMaybe defaultLogLevel
232 $ do OptLogLevel l <- find (\ x -> case x of
233 OptLogLevel _ -> True
237 logHandlers' <- sequence logHandlers
238 updateGlobalLogger rootLoggerName (setHandlers logHandlers' . setLevel logLevel)
241 createLocalStateDir :: FilePath -> UserID -> GroupID -> IO ()
242 createLocalStateDir path uid gid
243 = do createDirectoryIfMissing True path
244 setOwnerAndGroup path uid gid
247 rebuildIndexIfRequested :: Environment -> [CmdOpt] -> IO ()
248 rebuildIndexIfRequested env opts
249 = do let rebuild = isJust $ find (\ x -> case x of
250 OptRebuildIndex -> True
253 $ rebuildIndex (envStorage env)
255 withSystemLock :: FilePath -> IO a -> IO a
256 withSystemLock lockfile = bracket lock' unlock' . const
259 lock' = do fd <- openFd
262 (Just 420) -- 0644, -rw-r--r--
264 setLock fd (WriteLock, AbsoluteSeek, 0, 0)
267 unlock' :: Fd -> IO ()
270 withPidFile :: FilePath -> IO a -> IO a
271 withPidFile lockfile = bracket_ mkPid' delPid'
274 mkPid' = withFile lockfile WriteMode $ \ h ->
275 do pid <- getProcessID
276 hPutStrLn h (show pid)
279 delPid' = removeFile lockfile