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
19 import Rakka.Resource.Users
22 import System.Console.GetOpt
23 import System.Directory
24 import System.Environment
27 import System.Log.Handler.Simple
28 import System.Log.Logger
29 import System.Posix.Files
30 import System.Posix.Types
31 import System.Posix.User
39 = OptPortNum PortNumber
43 | OptLogLevel Priority
50 defaultPort :: PortNumber
51 defaultPort = toEnum 8080
53 defaultLocalStateDir :: FilePath
54 defaultLocalStateDir = LOCALSTATEDIR -- replaced by CPP
56 defaultUserName :: String
57 defaultUserName = "daemon"
59 defaultGroupName :: String
60 defaultGroupName = "daemon"
63 defaultLogLevel :: Priority
64 defaultLogLevel = NOTICE
67 options :: [OptDescr CmdOpt]
68 options = [ Option ['p'] ["port"]
69 (ReqArg (OptPortNum . toEnum . read) "NUM")
70 ("Port number to listen. (default: " ++ show defaultPort ++ ")")
72 , Option ['d'] ["localstatedir"]
73 (ReqArg OptLSDir "DIR")
74 ("Path to the database directory. (default: " ++ defaultLocalStateDir ++ ")")
76 , Option ['u'] ["user"]
77 (ReqArg OptUserName "USER")
78 ("Which user to setuid. (default: " ++ defaultUserName ++ ")")
80 , Option ['g'] ["group"]
81 (ReqArg OptGroupName "GROUP")
82 ("Which user to setgid. (default: " ++ defaultGroupName ++ ")")
84 , Option ['l'] ["log-level"]
85 (ReqArg (OptLogLevel . read) "LEVEL")
86 ("The lowest log level to show. (default: " ++ show defaultLogLevel ++ ")")
88 , Option [] ["disable-stderr-log"]
89 (NoArg OptDisableStderrLog)
90 ("Disable logging to stderr.")
92 , Option [] ["rebuild-index"]
93 (NoArg OptRebuildIndex)
94 ("Rebuild the index database.")
96 , Option ['h'] ["help"]
103 printUsage = do putStrLn "Usage:"
104 putStrLn " rakka [OPTIONS...]"
106 putStr $ usageInfo "Options:" options
112 do (opts, nonOpts, errors) <- return . getOpt Permute options =<< getArgs
114 when (not $ null errors)
115 $ do mapM_ putStr errors
116 exitWith $ ExitFailure 1
118 when (any (\ x -> x == OptHelp) opts)
122 when (not $ null nonOpts)
124 exitWith $ ExitFailure 1
126 portNum <- getPortNum opts
127 uid <- getUserID opts
128 gid <- getGroupID opts
129 lsdir <- getLocalStateDir opts
131 createLocalStateDir lsdir uid gid
137 env <- setupEnv lsdir portNum
139 rebuildIndexIfRequested env opts
141 infoM logger ("Listening to " ++ show portNum ++ "/tcp...")
142 runHttpd (envLucuConf env) (resTree env) [fallbackPageEntity env]
145 resTree :: Environment -> ResTree
147 = mkResTree [ ([] , resIndex env)
148 , (["checkAuth" ], resCheckAuth env)
149 , (["dumpRepos" ], resDumpRepos env)
150 , (["js" ], javaScript )
151 , (["object" ], resObject env)
152 , (["render" ], resRender env)
153 , (["search" ], resSearch env)
154 , (["search.html" ], resSearch env)
155 , (["search.xml" ], resSearch env)
156 , (["systemConfig"], resSystemConfig env)
157 -- , (["trackback" ], resTrackBack env)
158 , (["users" ], resUsers env)
162 getPortNum :: [CmdOpt] -> IO PortNumber
164 = do let xs = mapMaybe (\ x -> case x of
165 OptPortNum n -> Just n
168 [] -> return defaultPort
170 _ -> error "too many --port options."
173 getUserID :: [CmdOpt] -> IO UserID
175 = do let xs = mapMaybe (\ x -> case x of
176 OptUserName n -> Just n
179 [] -> defaultUserName
181 _ -> error "too many --user options."
183 userEnt <- getUserEntryForName name
184 return $ userID userEnt
187 getGroupID :: [CmdOpt] -> IO GroupID
189 = do let xs = mapMaybe (\ x -> case x of
190 OptGroupName n -> Just n
193 [] -> defaultGroupName
195 _ -> error "too many --group options."
197 groupEnt <- getGroupEntryForName name
198 return $ groupID groupEnt
201 getLocalStateDir :: [CmdOpt] -> IO FilePath
202 getLocalStateDir opts
203 = do let xs = mapMaybe (\ x -> case x of
207 [] -> defaultLocalStateDir
209 _ -> error "too many --localstatedir options."
214 setupLogger :: [CmdOpt] -> IO ()
216 = do let disableStderrLog = find (== OptDisableStderrLog) opts /= Nothing
217 logHandlers = if disableStderrLog then
220 [verboseStreamHandler stderr DEBUG]
221 logLevel = fromMaybe defaultLogLevel
222 $ do OptLogLevel l <- find (\ x -> case x of
223 OptLogLevel _ -> True
227 logHandlers' <- sequence logHandlers
228 updateGlobalLogger rootLoggerName (setHandlers logHandlers' . setLevel logLevel)
231 createLocalStateDir :: FilePath -> UserID -> GroupID -> IO ()
232 createLocalStateDir path uid gid
233 = do createDirectoryIfMissing True path
234 setOwnerAndGroup path uid gid
237 rebuildIndexIfRequested :: Environment -> [CmdOpt] -> IO ()
238 rebuildIndexIfRequested env opts
239 = do let rebuild = isJust $ find (\ x -> case x of
240 OptRebuildIndex -> True
243 $ rebuildIndex (envStorage env)