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)