6 import Network.HTTP.Lucu
7 import Rakka.Environment
8 import Rakka.Resource.CheckAuth
9 import Rakka.Resource.Index
10 import Rakka.Resource.JavaScript
11 import Rakka.Resource.PageEntity
12 import Rakka.Resource.Object
13 import Rakka.Resource.Render
14 import Rakka.Resource.Search
15 import Rakka.Resource.SystemConfig
16 import Rakka.Resource.TrackBack
19 import System.Console.GetOpt
20 import System.Directory
21 import System.Environment
24 import System.Log.Handler.Simple
25 import System.Log.Logger
26 import System.Posix.Files
27 import System.Posix.Types
28 import System.Posix.User
36 = OptPortNum PortNumber
40 | OptLogLevel Priority
47 defaultPort :: PortNumber
48 defaultPort = toEnum 8080
50 defaultLocalStateDir :: FilePath
51 defaultLocalStateDir = LOCALSTATEDIR -- replaced by CPP
53 defaultUserName :: String
54 defaultUserName = "daemon"
56 defaultGroupName :: String
57 defaultGroupName = "daemon"
60 defaultLogLevel :: Priority
61 defaultLogLevel = NOTICE
64 options :: [OptDescr CmdOpt]
65 options = [ Option ['p'] ["port"]
66 (ReqArg (OptPortNum . toEnum . read) "NUM")
67 ("Port number to listen. (default: " ++ show defaultPort ++ ")")
69 , Option ['d'] ["localstatedir"]
70 (ReqArg OptLSDir "DIR")
71 ("Path to the database directory. (default: " ++ defaultLocalStateDir ++ ")")
73 , Option ['u'] ["user"]
74 (ReqArg OptUserName "USER")
75 ("Which user to setuid. (default: " ++ defaultUserName ++ ")")
77 , Option ['g'] ["group"]
78 (ReqArg OptGroupName "GROUP")
79 ("Which user to setgid. (default: " ++ defaultGroupName ++ ")")
81 , Option ['l'] ["log-level"]
82 (ReqArg (OptLogLevel . read) "LEVEL")
83 ("The lowest log level to show. (default: " ++ show defaultLogLevel ++ ")")
85 , Option [] ["disable-stderr-log"]
86 (NoArg OptDisableStderrLog)
87 ("Disable logging to stderr.")
89 , Option [] ["rebuild-index"]
90 (NoArg OptRebuildIndex)
91 ("Rebuild the index database.")
93 , Option ['h'] ["help"]
100 printUsage = do putStrLn "Usage:"
101 putStrLn " rakka [OPTIONS...]"
103 putStr $ usageInfo "Options:" options
107 main = withSubversion $
108 do (opts, nonOpts, errors) <- return . getOpt Permute options =<< getArgs
110 when (not $ null errors)
111 $ do mapM_ putStr errors
112 exitWith $ ExitFailure 1
114 when (any (\ x -> x == OptHelp) opts)
118 when (not $ null nonOpts)
120 exitWith $ ExitFailure 1
122 portNum <- getPortNum opts
123 uid <- getUserID opts
124 gid <- getGroupID opts
125 lsdir <- getLocalStateDir opts
127 createLocalStateDir lsdir uid gid
133 env <- setupEnv lsdir portNum
135 rebuildIndexIfRequested env opts
137 infoM logger ("Listening to " ++ show portNum ++ "/tcp...")
138 runHttpd (envLucuConf env) (resTree env) [fallbackPageEntity env]
141 resTree :: Environment -> ResTree
143 = mkResTree [ ([] , resIndex env)
144 , (["checkAuth" ], resCheckAuth env)
145 , (["js" ], javaScript )
146 , (["object" ], resObject env)
147 , (["render" ], resRender env)
148 , (["search" ], resSearch env)
149 , (["search.html" ], resSearch env)
150 , (["search.xml" ], resSearch env)
151 , (["systemConfig"], resSystemConfig env)
152 , (["trackback" ], resTrackBack env)
156 getPortNum :: [CmdOpt] -> IO PortNumber
158 = do let xs = mapMaybe (\ x -> case x of
159 OptPortNum n -> Just n
162 [] -> return defaultPort
164 _ -> error "too many --port options."
167 getUserID :: [CmdOpt] -> IO UserID
169 = do let xs = mapMaybe (\ x -> case x of
170 OptUserName n -> Just n
173 [] -> defaultUserName
175 _ -> error "too many --user options."
177 userEnt <- getUserEntryForName name
178 return $ userID userEnt
181 getGroupID :: [CmdOpt] -> IO GroupID
183 = do let xs = mapMaybe (\ x -> case x of
184 OptGroupName n -> Just n
187 [] -> defaultGroupName
189 _ -> error "too many --group options."
191 groupEnt <- getGroupEntryForName name
192 return $ groupID groupEnt
195 getLocalStateDir :: [CmdOpt] -> IO FilePath
196 getLocalStateDir opts
197 = do let xs = mapMaybe (\ x -> case x of
201 [] -> defaultLocalStateDir
203 _ -> error "too many --localstatedir options."
208 setupLogger :: [CmdOpt] -> IO ()
210 = do let disableStderrLog = find (== OptDisableStderrLog) opts /= Nothing
211 logHandlers = if disableStderrLog then
214 [verboseStreamHandler stderr DEBUG]
215 logLevel = fromMaybe defaultLogLevel
216 $ do OptLogLevel l <- find (\ x -> case x of
217 OptLogLevel _ -> True
221 logHandlers' <- sequence logHandlers
222 updateGlobalLogger rootLoggerName (setHandlers logHandlers' . setLevel logLevel)
225 createLocalStateDir :: FilePath -> UserID -> GroupID -> IO ()
226 createLocalStateDir path uid gid
227 = do createDirectoryIfMissing True path
228 setOwnerAndGroup path uid gid
231 rebuildIndexIfRequested :: Environment -> [CmdOpt] -> IO ()
232 rebuildIndexIfRequested env opts
233 = do let rebuild = isJust $ find (\ x -> case x of
234 OptRebuildIndex -> True
237 $ rebuildIndex (envStorage env)