2 import Control.Exception
7 import Network.HTTP.Lucu
9 import Rakka.Environment
10 import Rakka.Resource.CheckAuth
11 import Rakka.Resource.DumpRepos
12 import Rakka.Resource.Index
13 import Rakka.Resource.JavaScript
14 import Rakka.Resource.PageEntity
15 import Rakka.Resource.Object
16 import Rakka.Resource.Render
17 import Rakka.Resource.Search
18 import Rakka.Resource.SystemConfig
19 -- import Rakka.Resource.TrackBack
20 import Rakka.Resource.Users
23 import System.Console.GetOpt -- FIXME: Use better library than this.
24 import System.Directory
25 import System.Environment
27 import System.FilePath
29 import System.Log.Handler.Simple
30 import System.Log.Logger
31 import System.Posix.Files
32 import System.Posix.IO
33 import System.Posix.Process
34 import System.Posix.Types
35 import System.Posix.User
43 = OptPortNum ServiceName
47 | OptLogLevel Priority
54 defaultPort :: ServiceName
57 defaultLocalStateDir :: FilePath
58 defaultLocalStateDir = LOCALSTATEDIR -- replaced by CPP
60 defaultUserName :: String
61 defaultUserName = "daemon"
63 defaultGroupName :: String
64 defaultGroupName = "daemon"
67 defaultLogLevel :: Priority
68 defaultLogLevel = NOTICE
71 options :: [OptDescr CmdOpt]
72 options = [ Option ['p'] ["port"]
73 (ReqArg OptPortNum "NUM")
74 ("Port number to listen. (default: " ++ defaultPort ++ ")")
76 , Option ['d'] ["localstatedir"]
77 (ReqArg OptLSDir "DIR")
78 ("Path to the database directory. (default: " ++ defaultLocalStateDir ++ ")")
80 , Option ['u'] ["user"]
81 (ReqArg OptUserName "USER")
82 ("Which user to setuid. (default: " ++ defaultUserName ++ ")")
84 , Option ['g'] ["group"]
85 (ReqArg OptGroupName "GROUP")
86 ("Which user to setgid. (default: " ++ defaultGroupName ++ ")")
88 , Option ['l'] ["log-level"]
89 (ReqArg (OptLogLevel . read) "LEVEL")
90 ("The lowest log level to show. (default: " ++ show defaultLogLevel ++ ")")
92 , Option ['v'] ["verbose"]
94 "Enable logging to stderr."
96 , Option ['r'] ["rebuild-index"]
97 (NoArg OptRebuildIndex)
98 "Rebuild the index database. (Only for debug purposes)"
100 , Option ['h'] ["help"]
102 "Print this message."
107 printUsage = do putStrLn "Usage:"
108 putStrLn " rakka [OPTIONS...]"
110 putStr $ usageInfo "Options:" options
116 do (opts, nonOpts, errors) <- return . getOpt Permute options =<< getArgs
119 $ do mapM_ putStr errors
120 exitWith $ ExitFailure 1
122 when (any (\ x -> x == OptHelp) opts)
126 unless (null nonOpts)
128 exitWith $ ExitFailure 1
130 portNum <- getPortNum opts
131 uid <- getUserID opts
132 gid <- getGroupID opts
133 lsdir <- getLocalStateDir opts
135 -- Create our localstatedir *before* dropping privileges.
136 createLocalStateDir lsdir uid gid
141 -- Now that we have our localstatedir. Let's acquire a lock
142 -- on the lockfile. Then create other files.
143 withSystemLock (lsdir </> "lock") $
144 withPidFile (lsdir </> "pid") $
146 env <- setupEnv lsdir portNum
148 rebuildIndexIfRequested env opts
150 infoM logger ("Listening to " ++ show portNum ++ "/tcp...")
151 runHttpd (envLucuConf env) (resTree env) [fallbackPageEntity env]
154 resTree :: Environment -> ResTree
156 = mkResTree [ ([] , resIndex env)
157 , (["checkAuth" ], resCheckAuth env)
158 , (["dumpRepos" ], resDumpRepos env)
159 , (["js" ], javaScript )
160 , (["object" ], resObject env)
161 , (["render" ], resRender env)
162 , (["search" ], resSearch env)
163 , (["search.html" ], resSearch env)
164 , (["search.xml" ], resSearch env)
165 , (["systemConfig"], resSystemConfig env)
166 -- , (["trackback" ], resTrackBack env)
167 , (["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."
182 getUserID :: [CmdOpt] -> IO UserID
184 = do let xs = mapMaybe (\ x -> case x of
185 OptUserName n -> Just n
188 [] -> defaultUserName
190 _ -> error "too many --user options."
192 userEnt <- getUserEntryForName name
193 return $ userID userEnt
196 getGroupID :: [CmdOpt] -> IO GroupID
198 = do let xs = mapMaybe (\ x -> case x of
199 OptGroupName n -> Just n
202 [] -> defaultGroupName
204 _ -> error "too many --group options."
206 groupEnt <- getGroupEntryForName name
207 return $ groupID groupEnt
210 getLocalStateDir :: [CmdOpt] -> IO FilePath
211 getLocalStateDir opts
212 = do let xs = mapMaybe (\ x -> case x of
216 [] -> defaultLocalStateDir
218 _ -> error "too many --localstatedir options."
223 setupLogger :: [CmdOpt] -> IO ()
225 = do let verbose = find (== OptVerbose) opts /= Nothing
226 logHandlers = if verbose then
227 [verboseStreamHandler stderr DEBUG]
229 [] -- FIXME: enable file log
230 logLevel = fromMaybe defaultLogLevel
231 $ do OptLogLevel l <- find (\ x -> case x of
232 OptLogLevel _ -> True
236 logHandlers' <- sequence logHandlers
237 updateGlobalLogger rootLoggerName (setHandlers logHandlers' . setLevel logLevel)
240 createLocalStateDir :: FilePath -> UserID -> GroupID -> IO ()
241 createLocalStateDir path uid gid
242 = do createDirectoryIfMissing True path
243 setOwnerAndGroup path uid gid
246 rebuildIndexIfRequested :: Environment -> [CmdOpt] -> IO ()
247 rebuildIndexIfRequested env opts
248 = do let rebuild = isJust $ find (\ x -> case x of
249 OptRebuildIndex -> True
252 $ rebuildIndex (envStorage env)
254 withSystemLock :: FilePath -> IO a -> IO a
255 withSystemLock lockfile = bracket lock' unlock' . const
258 lock' = do fd <- openFd
261 (Just 420) -- 0644, -rw-r--r--
263 setLock fd (WriteLock, AbsoluteSeek, 0, 0)
266 unlock' :: Fd -> IO ()
269 withPidFile :: FilePath -> IO a -> IO a
270 withPidFile lockfile = bracket_ mkPid' delPid'
273 mkPid' = withFile lockfile WriteMode $ \ h ->
274 do pid <- getProcessID
275 hPutStrLn h (show pid)
278 delPid' = removeFile lockfile