6 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.TrackBack
21 import System.Console.GetOpt
22 import System.Directory
23 import System.Environment
26 import System.Log.Handler.Simple
27 import System.Log.Logger
28 import System.Posix.Files
29 import System.Posix.Types
30 import System.Posix.User
38 = OptPortNum PortNumber
42 | OptLogLevel Priority
49 defaultPort :: PortNumber
50 defaultPort = toEnum 8080
52 defaultLocalStateDir :: FilePath
53 defaultLocalStateDir = LOCALSTATEDIR -- replaced by CPP
55 defaultUserName :: String
56 defaultUserName = "daemon"
58 defaultGroupName :: String
59 defaultGroupName = "daemon"
62 defaultLogLevel :: Priority
63 defaultLogLevel = NOTICE
66 options :: [OptDescr CmdOpt]
67 options = [ Option ['p'] ["port"]
68 (ReqArg (OptPortNum . toEnum . read) "NUM")
69 ("Port number to listen. (default: " ++ show defaultPort ++ ")")
71 , Option ['d'] ["localstatedir"]
72 (ReqArg OptLSDir "DIR")
73 ("Path to the database directory. (default: " ++ defaultLocalStateDir ++ ")")
75 , Option ['u'] ["user"]
76 (ReqArg OptUserName "USER")
77 ("Which user to setuid. (default: " ++ defaultUserName ++ ")")
79 , Option ['g'] ["group"]
80 (ReqArg OptGroupName "GROUP")
81 ("Which user to setgid. (default: " ++ defaultGroupName ++ ")")
83 , Option ['l'] ["log-level"]
84 (ReqArg (OptLogLevel . read) "LEVEL")
85 ("The lowest log level to show. (default: " ++ show defaultLogLevel ++ ")")
87 , Option [] ["disable-stderr-log"]
88 (NoArg OptDisableStderrLog)
89 ("Disable logging to stderr.")
91 , Option [] ["rebuild-index"]
92 (NoArg OptRebuildIndex)
93 ("Rebuild the index database.")
95 , Option ['h'] ["help"]
102 printUsage = do putStrLn "Usage:"
103 putStrLn " rakka [OPTIONS...]"
105 putStr $ usageInfo "Options:" options
111 do (opts, nonOpts, errors) <- return . getOpt Permute options =<< getArgs
113 when (not $ null errors)
114 $ do mapM_ putStr errors
115 exitWith $ ExitFailure 1
117 when (any (\ x -> x == OptHelp) opts)
121 when (not $ null nonOpts)
123 exitWith $ ExitFailure 1
125 portNum <- getPortNum opts
126 uid <- getUserID opts
127 gid <- getGroupID opts
128 lsdir <- getLocalStateDir opts
130 createLocalStateDir lsdir uid gid
136 env <- setupEnv lsdir portNum
138 rebuildIndexIfRequested env opts
140 infoM logger ("Listening to " ++ show portNum ++ "/tcp...")
141 runHttpd (envLucuConf env) (resTree env) [fallbackPageEntity env]
144 resTree :: Environment -> ResTree
146 = mkResTree [ ([] , resIndex env)
147 , (["checkAuth" ], resCheckAuth env)
148 , (["dumpRepos" ], resDumpRepos env)
149 , (["js" ], javaScript )
150 , (["object" ], resObject env)
151 , (["render" ], resRender env)
152 , (["search" ], resSearch env)
153 , (["search.html" ], resSearch env)
154 , (["search.xml" ], resSearch env)
155 , (["systemConfig"], resSystemConfig env)
156 , (["trackback" ], resTrackBack env)
160 getPortNum :: [CmdOpt] -> IO PortNumber
162 = do let xs = mapMaybe (\ x -> case x of
163 OptPortNum n -> Just n
166 [] -> return defaultPort
168 _ -> error "too many --port options."
171 getUserID :: [CmdOpt] -> IO UserID
173 = do let xs = mapMaybe (\ x -> case x of
174 OptUserName n -> Just n
177 [] -> defaultUserName
179 _ -> error "too many --user options."
181 userEnt <- getUserEntryForName name
182 return $ userID userEnt
185 getGroupID :: [CmdOpt] -> IO GroupID
187 = do let xs = mapMaybe (\ x -> case x of
188 OptGroupName n -> Just n
191 [] -> defaultGroupName
193 _ -> error "too many --group options."
195 groupEnt <- getGroupEntryForName name
196 return $ groupID groupEnt
199 getLocalStateDir :: [CmdOpt] -> IO FilePath
200 getLocalStateDir opts
201 = do let xs = mapMaybe (\ x -> case x of
205 [] -> defaultLocalStateDir
207 _ -> error "too many --localstatedir options."
212 setupLogger :: [CmdOpt] -> IO ()
214 = do let disableStderrLog = find (== OptDisableStderrLog) opts /= Nothing
215 logHandlers = if disableStderrLog then
218 [verboseStreamHandler stderr DEBUG]
219 logLevel = fromMaybe defaultLogLevel
220 $ do OptLogLevel l <- find (\ x -> case x of
221 OptLogLevel _ -> True
225 logHandlers' <- sequence logHandlers
226 updateGlobalLogger rootLoggerName (setHandlers logHandlers' . setLevel logLevel)
229 createLocalStateDir :: FilePath -> UserID -> GroupID -> IO ()
230 createLocalStateDir path uid gid
231 = do createDirectoryIfMissing True path
232 setOwnerAndGroup path uid gid
235 rebuildIndexIfRequested :: Environment -> [CmdOpt] -> IO ()
236 rebuildIndexIfRequested env opts
237 = do let rebuild = isJust $ find (\ x -> case x of
238 OptRebuildIndex -> True
241 $ rebuildIndex (envStorage env)